{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Types and functions to represent interfaces between Nix code and Haskell
--     code.
module Hercules.CNix.Expr.Schema
  ( -- * Core
    PSObject (..),
    MonadEval,

    -- * Error handling
    Provenance (..),
    NixException (..),
    appendProvenance,

    -- * Alternatives

    --
    -- Runtime type matching. Use of @|@ comes from the implicit sum types that
    -- constitute Nix values.
    type (|.),
    (|!),

    -- * Functions
    type (->.),
    (.$),
    (>>$.),
    type (->?),
    ($?),
    (>>$?),

    -- * Simple types
    type StringWithoutContext,

    -- * Attribute sets
    basicAttrsWithProvenance,
    --
    -- Common type that can represent both simultaneously.
    type Attrs',

    -- * Attribute sets as records
    type Attrs,
    type (::.),
    (#.),
    (>>.),
    type (::?),
    (#?),
    (>>?),
    (#?!),

    -- * Attribute sets as used as dictionaries
    type Dictionary,
    dictionaryToMap,
    lookupDict,
    lookupDictBS,
    requireDict,
    requireDictBS,

    -- * Serialization
    toPSObject,
    FromPSObject (..),
    check,
    getText_,
    getByteString_,

    -- * Parsing Nix
    exprWithBasePath,
    exprWithBasePathBS,

    -- * Utilities
    uncheckedCast,
    englishOr,
  )
where

import Data.Coerce (coerce)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified GHC.TypeLits as TL
import Hercules.CNix.Expr (CheckType, EvalState, HasRawValueType, NixAttrs, NixFunction, NixPath, NixString, RawValue, ToRawValue (..), ToValue (..), Value (rtValue), apply, checkType, getAttr, getRawValueType, getStringIgnoreContext, hasContext, rawValueType, toRawValue, valueFromExpressionString)
import qualified Hercules.CNix.Expr as Expr
import Hercules.CNix.Expr.Raw (RawValueType, canonicalRawType)
import Protolude hiding (TypeError, check, evalState)

-- TODO add Pos fields
data Provenance
  = File FilePath
  | Other Text
  | Data
  | Attribute Provenance Text
  | Application Provenance Provenance
  deriving (Int -> Provenance -> ShowS
[Provenance] -> ShowS
Provenance -> [Char]
(Int -> Provenance -> ShowS)
-> (Provenance -> [Char])
-> ([Provenance] -> ShowS)
-> Show Provenance
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Provenance] -> ShowS
$cshowList :: [Provenance] -> ShowS
show :: Provenance -> [Char]
$cshow :: Provenance -> [Char]
showsPrec :: Int -> Provenance -> ShowS
$cshowsPrec :: Int -> Provenance -> ShowS
Show, Provenance -> Provenance -> Bool
(Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool) -> Eq Provenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Provenance -> Provenance -> Bool
$c/= :: Provenance -> Provenance -> Bool
== :: Provenance -> Provenance -> Bool
$c== :: Provenance -> Provenance -> Bool
Eq, Eq Provenance
Eq Provenance
-> (Provenance -> Provenance -> Ordering)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Provenance)
-> (Provenance -> Provenance -> Provenance)
-> Ord Provenance
Provenance -> Provenance -> Bool
Provenance -> Provenance -> Ordering
Provenance -> Provenance -> Provenance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Provenance -> Provenance -> Provenance
$cmin :: Provenance -> Provenance -> Provenance
max :: Provenance -> Provenance -> Provenance
$cmax :: Provenance -> Provenance -> Provenance
>= :: Provenance -> Provenance -> Bool
$c>= :: Provenance -> Provenance -> Bool
> :: Provenance -> Provenance -> Bool
$c> :: Provenance -> Provenance -> Bool
<= :: Provenance -> Provenance -> Bool
$c<= :: Provenance -> Provenance -> Bool
< :: Provenance -> Provenance -> Bool
$c< :: Provenance -> Provenance -> Bool
compare :: Provenance -> Provenance -> Ordering
$ccompare :: Provenance -> Provenance -> Ordering
Ord)

data NixException
  = MissingAttribute Provenance Text
  | TypeError
      Provenance
      RawValueType
      -- ^ actual
      [RawValueType]
      -- ^ expected
  | InvalidText Provenance UnicodeException
  | StringContextNotAllowed Provenance
  deriving (Int -> NixException -> ShowS
[NixException] -> ShowS
NixException -> [Char]
(Int -> NixException -> ShowS)
-> (NixException -> [Char])
-> ([NixException] -> ShowS)
-> Show NixException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NixException] -> ShowS
$cshowList :: [NixException] -> ShowS
show :: NixException -> [Char]
$cshow :: NixException -> [Char]
showsPrec :: Int -> NixException -> ShowS
$cshowsPrec :: Int -> NixException -> ShowS
Show, NixException -> NixException -> Bool
(NixException -> NixException -> Bool)
-> (NixException -> NixException -> Bool) -> Eq NixException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixException -> NixException -> Bool
$c/= :: NixException -> NixException -> Bool
== :: NixException -> NixException -> Bool
$c== :: NixException -> NixException -> Bool
Eq)

instance Exception NixException where
  displayException :: NixException -> [Char]
displayException (MissingAttribute Provenance
p Text
name) = [Char]
"Missing attribute " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. (Show a, ConvertText [Char] b) => a -> b
show Text
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Provenance -> [Char]
appendProvenance Provenance
p
  displayException (TypeError Provenance
p RawValueType
actual [RawValueType]
expected) = [Char]
"Expecting a value of type " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. ConvertText a b => a -> b
toS ([Text] -> Text
englishOr ((RawValueType -> Text) -> [RawValueType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RawValueType -> Text
forall a b. (Show a, ConvertText [Char] b) => a -> b
show [RawValueType]
expected)) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
", but got type " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> RawValueType -> [Char]
forall a b. (Show a, ConvertText [Char] b) => a -> b
show RawValueType
actual [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"." [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Provenance -> [Char]
appendProvenance Provenance
p
  displayException (InvalidText Provenance
p UnicodeException
ue) = UnicodeException -> [Char]
forall e. Exception e => e -> [Char]
displayException UnicodeException
ue [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Provenance -> [Char]
appendProvenance Provenance
p
  displayException (StringContextNotAllowed Provenance
p) = [Char]
"This string must not have a context. It must be usable without building store paths." [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Provenance -> [Char]
appendProvenance Provenance
p

appendProvenance :: Provenance -> [Char]
appendProvenance :: Provenance -> [Char]
appendProvenance (Attribute Provenance
p Text
name) = [Char]
"\n  in attribute " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. (Show a, ConvertText [Char] b) => a -> b
show Text
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Provenance -> [Char]
appendProvenance Provenance
p
appendProvenance (Other Text
x) = [Char]
"\n  in " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a b. ConvertText a b => a -> b
toS Text
x
appendProvenance Provenance
Data = [Char]
""
appendProvenance (Application Provenance
p Provenance
_p) = [Char]
"\n  in function result" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Provenance -> [Char]
appendProvenance Provenance
p
appendProvenance (File [Char]
f) = [Char]
"\n  in file " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. (Show a, ConvertText [Char] b) => a -> b
show [Char]
f

-- | Alternative schema. The value only needs to satisfy one subschema.
data a |. b

-- | Function schema.
data a ->. b

infixr 1 ->.

-- | Optional function. If the value is not a function, use it as the result.
type a ->? b = (a ->. b) |. b

infixr 1 ->?

-- | Attribute set schema with known attributes and wildcard type for remaining attributes.
data Attrs' (as :: [Attr]) w

-- | Attribute set schema with known attributes only
type Attrs as = Attrs' as Void

-- | Attribute set functioning as a "dictionary" from string keys to a certain type.
type Dictionary = Attrs' '[]

-- | A kind for attribute declarations.
data Attr
  = -- | Required attribute. Use '::.'.
    Symbol :. Type
  | -- | Optional attribute. Use ':?.'.
    Symbol :? Type

data StringWithoutContext

infix 0 :.

infix 0 :?

infix 0 ::.

infix 0 ::?

-- | Optional (@_?@) attribute name and type (@::_@)
--
-- This indicates that the attribute may be omitted in its entirety, which is
-- distinct from an attribute that may be @null@.
type a ::? b = a ':? b

-- | Required (@_.@) attribute name and type (@::_@)
--
-- Note that the type may still be nullable, but the attribute is expected to exist.
type a ::. b = a ':. b

-- | An object (thunk or value) with its 'Provenance' and an expected schema type attached as a
-- phantom type.
--
-- The phantom specifies the expactation, not a checked type.
data PSObject (a :: Type) = PSObject
  { -- | Tracks the origin of the object, which is useful informaton for error messages.
    forall a. PSObject a -> Provenance
provenance :: Provenance,
    -- | The Nix object, which may be a thunk (producing errors, non-termination, etc) or a 'Value' of any type.
    --
    -- Use 'check' and/or '|.' to evaluate it (whnf) and narrow down its runtime type to a specific 'Value'.
    forall a. PSObject a -> RawValue
value :: RawValue
  }

instance ToRawValue (PSObject a) where
  toRawValue :: Ptr EvalState -> PSObject a -> IO RawValue
toRawValue Ptr EvalState
_ = RawValue -> IO RawValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawValue -> IO RawValue)
-> (PSObject a -> RawValue) -> PSObject a -> IO RawValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSObject a -> RawValue
forall a. PSObject a -> RawValue
value

instance
  ( CheckType (NixTypeForSchema t),
    HasRawValueType (NixTypeForSchema t)
  ) =>
  ToValue (PSObject t)
  where
  type NixTypeFor (PSObject t) = NixTypeForSchema t
  toValue :: Ptr EvalState -> PSObject t -> IO (Value (NixTypeFor (PSObject t)))
toValue Ptr EvalState
es PSObject t
v = ReaderT (Ptr EvalState) IO (Value (NixTypeForSchema t))
-> Ptr EvalState -> IO (Value (NixTypeForSchema t))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (PSObject t
-> ReaderT (Ptr EvalState) IO (Value (NixTypeForSchema t))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject t
v) Ptr EvalState
es

(.$) :: (MonadIO m) => PSObject (a ->. b) -> PSObject a -> m (PSObject b)
PSObject (a ->. b)
f .$ :: forall (m :: * -> *) a b.
MonadIO m =>
PSObject (a ->. b) -> PSObject a -> m (PSObject b)
.$ PSObject a
a = do
  RawValue
v <- IO RawValue -> m RawValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PSObject (a ->. b) -> RawValue
forall a. PSObject a -> RawValue
value PSObject (a ->. b)
f RawValue -> RawValue -> IO RawValue
`apply` PSObject a -> RawValue
forall a. PSObject a -> RawValue
value PSObject a
a)
  PSObject b -> m (PSObject b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject
      { provenance :: Provenance
provenance = Provenance -> Provenance -> Provenance
Application (PSObject (a ->. b) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (a ->. b)
f) (PSObject a -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject a
a),
        value :: RawValue
value = RawValue
v
      }

type AttrType as s = AttrType' as as s

type family AttrType' all as s where
  AttrType' all ((s ':. t) ': as) s = t
  AttrType' all ((s ':? t) ': as) s =
    TL.TypeError
      ( 'TL.Text "The attribute set field named " 'TL.:<>: 'TL.ShowType s 'TL.:<>: 'TL.Text " is optional."
          'TL.:$$: 'TL.Text "  Try the optional variation, e.g. (#?) instead of (#.)"
      )
  AttrType' all (_ ': as) s = AttrType' all as s
  AttrType' all '[] s =
    TL.TypeError
      ( 'TL.Text "Schema for attribute set does not declare a field named " 'TL.:<>: 'TL.ShowType s 'TL.:<>: 'TL.Text "."
          'TL.:$$: 'TL.Text "  Known attributes are " 'TL.:<>: 'TL.ShowType all
      )

type OptionalAttrType as s = OptionalAttrType' as as s

type family OptionalAttrType' all as s where
  OptionalAttrType' all ((s ':? t) ': as) s = t
  OptionalAttrType' all ((s ':. t) ': as) s =
    TL.TypeError
      ( 'TL.Text "The attribute set field named " 'TL.:<>: 'TL.ShowType s 'TL.:<>: 'TL.Text " is required, but you're asking for an optional field."
          'TL.:$$: 'TL.Text "  Try the required variation, e.g. (#.) instead of (#?)"
      )
  OptionalAttrType' all (_ ': as) s = OptionalAttrType' all as s
  OptionalAttrType' all '[] s =
    TL.TypeError
      ( 'TL.Text "Schema for attribute set does not declare a field named " 'TL.:<>: 'TL.ShowType s 'TL.:<>: 'TL.Text "."
          'TL.:$$: 'TL.Text "  Known attributes are " 'TL.:<>: 'TL.ShowType all
      )

-- | Like 'Proxy', but with an 'IsLabel' instance. For use with '(^#)'
data AttrLabel a = AttrLabel

instance (s ~ t) => IsLabel s (AttrLabel t) where
  fromLabel :: AttrLabel t
fromLabel = AttrLabel t
forall {k} (a :: k). AttrLabel a
AttrLabel

infixl 9 #.

infixl 9 >>.

type MonadEval m = (MonadIO m, MonadReader (Ptr EvalState) m)

-- | A combination of '>>=' and '#.'.
(>>.) :: (KnownSymbol s, AttrType as s ~ b, MonadEval m) => m (PSObject (Attrs' as w)) -> AttrLabel s -> m (PSObject b)
m (PSObject (Attrs' as w))
mas >>. :: forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, AttrType as s ~ b, MonadEval m) =>
m (PSObject (Attrs' as w)) -> AttrLabel s -> m (PSObject b)
>>. AttrLabel s
p = m (PSObject (Attrs' as w))
mas m (PSObject (Attrs' as w))
-> (PSObject (Attrs' as w) -> m (PSObject b)) -> m (PSObject b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PSObject (Attrs' as w)
as -> PSObject (Attrs' as w)
as PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject b)
forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, AttrType as s ~ b, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject b)
#. AttrLabel s
p

-- | Attribute selector. @a #. #b@ is @a.b@ in Nix. Operates on attributes that are required (@_.@) in the schema, throwing an error if necessary.
(#.) :: (KnownSymbol s, AttrType as s ~ b, MonadEval m) => PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject b)
PSObject (Attrs' as w)
as #. :: forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, AttrType as s ~ b, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject b)
#. AttrLabel s
p = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let name :: Text
name = [Char] -> Text
T.pack (AttrLabel s -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal AttrLabel s
p)
  Value NixAttrs
v <- PSObject (Attrs' as w)
-> m (Value (NixTypeForSchema (Attrs' as w)))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject (Attrs' as w)
as
  IO (Maybe RawValue) -> m (Maybe RawValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
v (Text -> ByteString
encodeUtf8 Text
name)) m (Maybe RawValue)
-> (Maybe RawValue -> m (PSObject b)) -> m (PSObject b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe RawValue
Nothing -> NixException -> m (PSObject b)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NixException -> m (PSObject b)) -> NixException -> m (PSObject b)
forall a b. (a -> b) -> a -> b
$ Provenance -> Text -> NixException
MissingAttribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) Text
name
    Just RawValue
b -> PSObject b -> m (PSObject b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {value :: RawValue
value = RawValue
b, provenance :: Provenance
provenance = Provenance -> Text -> Provenance
Attribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) Text
name}

-- | A combination of '>>=' and '#?'.
(>>?) :: (KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) => m (PSObject (Attrs' as w)) -> AttrLabel s -> m (Maybe (PSObject b))
m (PSObject (Attrs' as w))
mas >>? :: forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) =>
m (PSObject (Attrs' as w)) -> AttrLabel s -> m (Maybe (PSObject b))
>>? AttrLabel s
p = m (PSObject (Attrs' as w))
mas m (PSObject (Attrs' as w))
-> (PSObject (Attrs' as w) -> m (Maybe (PSObject b)))
-> m (Maybe (PSObject b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PSObject (Attrs' as w)
as -> PSObject (Attrs' as w)
as PSObject (Attrs' as w) -> AttrLabel s -> m (Maybe (PSObject b))
forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (Maybe (PSObject b))
#? AttrLabel s
p

-- | Attribute selector. @a #? #b@ is @a.b@ in Nix, but handles the missing case without exception. Operates on attributes that are optional (@_?@) in the schema, throwing an error if necessary.
(#?) :: (KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) => PSObject (Attrs' as w) -> AttrLabel s -> m (Maybe (PSObject b))
PSObject (Attrs' as w)
as #? :: forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (Maybe (PSObject b))
#? AttrLabel s
p = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let name :: Text
name = [Char] -> Text
T.pack (AttrLabel s -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal AttrLabel s
p)
  Value NixAttrs
v <- PSObject (Attrs' as w)
-> m (Value (NixTypeForSchema (Attrs' as w)))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject (Attrs' as w)
as
  IO (Maybe RawValue) -> m (Maybe RawValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
v (Text -> ByteString
encodeUtf8 Text
name))
    m (Maybe RawValue)
-> (Maybe RawValue -> Maybe (PSObject b)) -> m (Maybe (PSObject b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (RawValue -> PSObject b) -> Maybe RawValue -> Maybe (PSObject b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RawValue
b -> PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {value :: RawValue
value = RawValue
b, provenance :: Provenance
provenance = Provenance -> Text -> Provenance
Attribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) Text
name})

-- | Retrieve an optional attribute but throw if it's missing.
--
-- It provides a decent error message with attrset provenance, but can't provide
-- extra context like you can when manually handling the @a '#?' b@ 'Nothing' case.
(#?!) :: (KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) => PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject b)
PSObject (Attrs' as w)
as #?! :: forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (PSObject b)
#?! AttrLabel s
p = do
  PSObject (Attrs' as w)
as PSObject (Attrs' as w) -> AttrLabel s -> m (Maybe (PSObject b))
forall {k} (s :: Symbol) (as :: [Attr]) b (m :: * -> *) (w :: k).
(KnownSymbol s, OptionalAttrType as s ~ b, MonadEval m) =>
PSObject (Attrs' as w) -> AttrLabel s -> m (Maybe (PSObject b))
#? AttrLabel s
p m (Maybe (PSObject b))
-> (Maybe (PSObject b) -> m (PSObject b)) -> m (PSObject b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (PSObject b)
Nothing -> NixException -> m (PSObject b)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NixException -> m (PSObject b)) -> NixException -> m (PSObject b)
forall a b. (a -> b) -> a -> b
$ Provenance -> Text -> NixException
MissingAttribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) ([Char] -> Text
T.pack (AttrLabel s -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal AttrLabel s
p))
    Just PSObject b
x -> PSObject b -> m (PSObject b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject b
x

lookupDictBS :: MonadEval m => ByteString -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
lookupDictBS :: forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
ByteString -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
lookupDictBS ByteString
name PSObject (Attrs' as w)
as = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value NixAttrs
v <- PSObject (Attrs' as w)
-> m (Value (NixTypeForSchema (Attrs' as w)))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject (Attrs' as w)
as
  IO (Maybe RawValue) -> m (Maybe RawValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
v ByteString
name)
    m (Maybe RawValue)
-> (Maybe RawValue -> Maybe (PSObject w)) -> m (Maybe (PSObject w))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (RawValue -> PSObject w) -> Maybe RawValue -> Maybe (PSObject w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RawValue
b -> PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {value :: RawValue
value = RawValue
b, provenance :: Provenance
provenance = Provenance -> Text -> Provenance
Attribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
name)})

lookupDict :: MonadEval m => Text -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
lookupDict :: forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
Text -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
lookupDict Text
name PSObject (Attrs' as w)
as = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value NixAttrs
v <- PSObject (Attrs' as w)
-> m (Value (NixTypeForSchema (Attrs' as w)))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject (Attrs' as w)
as
  IO (Maybe RawValue) -> m (Maybe RawValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
v (Text -> ByteString
encodeUtf8 Text
name))
    m (Maybe RawValue)
-> (Maybe RawValue -> Maybe (PSObject w)) -> m (Maybe (PSObject w))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (RawValue -> PSObject w) -> Maybe RawValue -> Maybe (PSObject w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RawValue
b -> PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {value :: RawValue
value = RawValue
b, provenance :: Provenance
provenance = Provenance -> Text -> Provenance
Attribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) Text
name})

-- | Like '#?!'. Throws an acceptable but not great error message.
requireDictBS :: MonadEval m => ByteString -> PSObject (Attrs' as w) -> m (PSObject w)
requireDictBS :: forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
ByteString -> PSObject (Attrs' as w) -> m (PSObject w)
requireDictBS ByteString
name PSObject (Attrs' as w)
as = do
  ByteString -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
ByteString -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
lookupDictBS ByteString
name PSObject (Attrs' as w)
as m (Maybe (PSObject w))
-> (Maybe (PSObject w) -> m (PSObject w)) -> m (PSObject w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (PSObject w)
Nothing -> NixException -> m (PSObject w)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NixException -> m (PSObject w)) -> NixException -> m (PSObject w)
forall a b. (a -> b) -> a -> b
$ Provenance -> Text -> NixException
MissingAttribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
name)
    Just PSObject w
r -> PSObject w -> m (PSObject w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject w
r

-- | Like '#?!'. Throws an acceptable but not great error message.
requireDict :: MonadEval m => Text -> PSObject (Attrs' as w) -> m (PSObject w)
requireDict :: forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
Text -> PSObject (Attrs' as w) -> m (PSObject w)
requireDict Text
name PSObject (Attrs' as w)
as = do
  Text -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
forall (m :: * -> *) (as :: [Attr]) w.
MonadEval m =>
Text -> PSObject (Attrs' as w) -> m (Maybe (PSObject w))
lookupDict Text
name PSObject (Attrs' as w)
as m (Maybe (PSObject w))
-> (Maybe (PSObject w) -> m (PSObject w)) -> m (PSObject w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (PSObject w)
Nothing -> NixException -> m (PSObject w)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NixException -> m (PSObject w)) -> NixException -> m (PSObject w)
forall a b. (a -> b) -> a -> b
$ Provenance -> Text -> NixException
MissingAttribute (PSObject (Attrs' as w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Attrs' as w)
as) Text
name
    Just PSObject w
r -> PSObject w -> m (PSObject w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject w
r

dictionaryToMap :: MonadEval m => PSObject (Dictionary w) -> m (Map ByteString (PSObject w))
dictionaryToMap :: forall (m :: * -> *) w.
MonadEval m =>
PSObject (Dictionary w) -> m (Map ByteString (PSObject w))
dictionaryToMap PSObject (Dictionary w)
dict = do
  (IO (Map ByteString RawValue) -> m (Map ByteString RawValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map ByteString RawValue) -> m (Map ByteString RawValue))
-> (Value NixAttrs -> IO (Map ByteString RawValue))
-> Value NixAttrs
-> m (Map ByteString RawValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value NixAttrs -> IO (Map ByteString RawValue)
Expr.getAttrs (Value NixAttrs -> m (Map ByteString RawValue))
-> m (Value NixAttrs) -> m (Map ByteString RawValue)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PSObject (Dictionary w)
-> m (Value (NixTypeForSchema (Dictionary w)))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject (Dictionary w)
dict)
    m (Map ByteString RawValue)
-> (Map ByteString RawValue -> Map ByteString (PSObject w))
-> m (Map ByteString (PSObject w))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ByteString -> RawValue -> PSObject w)
-> Map ByteString RawValue -> Map ByteString (PSObject w)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
      ( \ByteString
name RawValue
b ->
          PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {value :: RawValue
value = RawValue
b, provenance :: Provenance
provenance = Provenance -> Text -> Provenance
Attribute (PSObject (Dictionary w) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (Dictionary w)
dict) (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
name)}
      )

type family NixTypeForSchema s where
  NixTypeForSchema (Attrs' _ _) = NixAttrs
  NixTypeForSchema (_ ->. _) = NixFunction
  NixTypeForSchema NixString = NixString
  NixTypeForSchema StringWithoutContext = NixString
  NixTypeForSchema NixPath = NixPath
  NixTypeForSchema Bool = Bool
  NixTypeForSchema Int64 = Int64

class PossibleTypesForSchema s where
  typesForSchema :: Proxy s -> [RawValueType]
  default typesForSchema :: HasRawValueType (NixTypeForSchema s) => Proxy s -> [RawValueType]
  typesForSchema Proxy s
_ = [Proxy (NixTypeForSchema s) -> RawValueType
forall s. HasRawValueType s => Proxy s -> RawValueType
getRawValueType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(NixTypeForSchema s))]

instance PossibleTypesForSchema (Attrs' as w)

instance PossibleTypesForSchema (a ->. b)

instance PossibleTypesForSchema NixString

instance PossibleTypesForSchema NixPath

instance PossibleTypesForSchema Bool

instance PossibleTypesForSchema Int64

instance
  (PossibleTypesForSchema a, PossibleTypesForSchema b) =>
  PossibleTypesForSchema (a |. b)
  where
  typesForSchema :: Proxy (a |. b) -> [RawValueType]
typesForSchema Proxy (a |. b)
_ = Proxy a -> [RawValueType]
forall s. PossibleTypesForSchema s => Proxy s -> [RawValueType]
typesForSchema (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) [RawValueType] -> [RawValueType] -> [RawValueType]
forall a. Semigroup a => a -> a -> a
<> Proxy b -> [RawValueType]
forall s. PossibleTypesForSchema s => Proxy s -> [RawValueType]
typesForSchema (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)

-- | Force and check type, then continue without backtracking
(|!) ::
  forall a b c m.
  ( CheckType (NixTypeForSchema a),
    MonadIO m,
    MonadEval m,
    PossibleTypesForSchema a,
    PossibleTypesForSchema b
  ) =>
  (PSObject a -> m c) ->
  (PSObject b -> m c) ->
  PSObject (a |. b) ->
  m c
PSObject a -> m c
f |! :: forall a b c (m :: * -> *).
(CheckType (NixTypeForSchema a), MonadIO m, MonadEval m,
 PossibleTypesForSchema a, PossibleTypesForSchema b) =>
(PSObject a -> m c)
-> (PSObject b -> m c) -> PSObject (a |. b) -> m c
|! PSObject b -> m c
g = \PSObject (a |. b)
ab -> do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe (Value (NixTypeForSchema a))
t <- IO (Maybe (Value (NixTypeForSchema a)))
-> m (Maybe (Value (NixTypeForSchema a)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Value (NixTypeForSchema a)))
 -> m (Maybe (Value (NixTypeForSchema a))))
-> IO (Maybe (Value (NixTypeForSchema a)))
-> m (Maybe (Value (NixTypeForSchema a)))
forall a b. (a -> b) -> a -> b
$ forall a.
CheckType a =>
Ptr EvalState -> RawValue -> IO (Maybe (Value a))
checkType @(NixTypeForSchema a) Ptr EvalState
evalState (PSObject (a |. b) -> RawValue
forall a. PSObject a -> RawValue
value PSObject (a |. b)
ab)
  RawValueType
rawType <- IO RawValueType -> m RawValueType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValueType -> m RawValueType)
-> IO RawValueType -> m RawValueType
forall a b. (a -> b) -> a -> b
$ RawValue -> IO RawValueType
rawValueType (PSObject (a |. b) -> RawValue
forall a. PSObject a -> RawValue
value PSObject (a |. b)
ab)
  let c :: RawValueType
c = RawValueType -> RawValueType
canonicalRawType RawValueType
rawType
      -- This call makes it O(n*n) because of the nested |! calls, but n is small.
      ts :: [RawValueType]
ts = Proxy (a |. b) -> [RawValueType]
forall s. PossibleTypesForSchema s => Proxy s -> [RawValueType]
typesForSchema (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a |. b))
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RawValueType
c RawValueType -> [RawValueType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RawValueType]
ts) do
    NixException -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NixException -> m ()) -> NixException -> m ()
forall a b. (a -> b) -> a -> b
$ Provenance -> RawValueType -> [RawValueType] -> NixException
TypeError (PSObject (a |. b) -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject (a |. b)
ab) RawValueType
c [RawValueType]
ts
  case Maybe (Value (NixTypeForSchema a))
t of
    Just Value (NixTypeForSchema a)
_abChecked -> PSObject a -> m c
f (PSObject (a |. b)
ab {value :: RawValue
value = PSObject (a |. b) -> RawValue
forall a. PSObject a -> RawValue
value PSObject (a |. b)
ab})
    Maybe (Value (NixTypeForSchema a))
Nothing -> PSObject b -> m c
g (PSObject (a |. b)
ab {value :: RawValue
value = PSObject (a |. b) -> RawValue
forall a. PSObject a -> RawValue
value PSObject (a |. b)
ab})

englishOr :: [Text] -> Text
englishOr :: [Text] -> Text
englishOr [] = Text
"impossible"
englishOr [Text
a] = Text
a
englishOr [Text
y, Text
z] = Text
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" or " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
z
englishOr (Text
a : [Text]
as) = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
englishOr [Text]
as

-- | Optional application.
($?) :: (MonadEval m, PossibleTypesForSchema a, PossibleTypesForSchema b) => PSObject (a ->? b) -> PSObject a -> m (PSObject b)
PSObject (a ->? b)
x $? :: forall (m :: * -> *) a b.
(MonadEval m, PossibleTypesForSchema a,
 PossibleTypesForSchema b) =>
PSObject (a ->? b) -> PSObject a -> m (PSObject b)
$? PSObject a
a =
  PSObject (a ->? b) -> m (PSObject (a ->? b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject (a ->? b)
x m (PSObject (a ->? b)) -> m (PSObject a) -> m (PSObject b)
forall (m :: * -> *) a b.
(MonadEval m, PossibleTypesForSchema a,
 PossibleTypesForSchema b) =>
m (PSObject (a ->? b)) -> m (PSObject a) -> m (PSObject b)
>>$? PSObject a -> m (PSObject a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PSObject a
a

-- | Optional application. Like '$?' but takes care of monadic binding as a convenience.
(>>$?) :: (MonadEval m, PossibleTypesForSchema a, PossibleTypesForSchema b) => m (PSObject (a ->? b)) -> m (PSObject a) -> m (PSObject b)
m (PSObject (a ->? b))
x >>$? :: forall (m :: * -> *) a b.
(MonadEval m, PossibleTypesForSchema a,
 PossibleTypesForSchema b) =>
m (PSObject (a ->? b)) -> m (PSObject a) -> m (PSObject b)
>>$? m (PSObject a)
a =
  ( (\PSObject (a ->. b)
f -> m (PSObject a)
a m (PSObject a) -> (PSObject a -> m (PSObject b)) -> m (PSObject b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PSObject (a ->. b)
f PSObject (a ->. b) -> PSObject a -> m (PSObject b)
forall (m :: * -> *) a b.
MonadIO m =>
PSObject (a ->. b) -> PSObject a -> m (PSObject b)
.$))
      (PSObject (a ->. b) -> m (PSObject b))
-> (PSObject b -> m (PSObject b))
-> PSObject (a ->? b)
-> m (PSObject b)
forall a b c (m :: * -> *).
(CheckType (NixTypeForSchema a), MonadIO m, MonadEval m,
 PossibleTypesForSchema a, PossibleTypesForSchema b) =>
(PSObject a -> m c)
-> (PSObject b -> m c) -> PSObject (a |. b) -> m c
|! PSObject b -> m (PSObject b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  )
    (PSObject (a ->? b) -> m (PSObject b))
-> m (PSObject (a ->? b)) -> m (PSObject b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (PSObject (a ->? b))
x

-- | Application. Like '$.' but takes care of monadic binding as a convenience.
(>>$.) :: (MonadEval m, PossibleTypesForSchema a, PossibleTypesForSchema b) => m (PSObject (a ->. b)) -> m (PSObject a) -> m (PSObject b)
m (PSObject (a ->. b))
f >>$. :: forall (m :: * -> *) a b.
(MonadEval m, PossibleTypesForSchema a,
 PossibleTypesForSchema b) =>
m (PSObject (a ->. b)) -> m (PSObject a) -> m (PSObject b)
>>$. m (PSObject a)
a = do
  PSObject (a ->. b)
f' <- m (PSObject (a ->. b))
f
  PSObject a
a' <- m (PSObject a)
a
  PSObject (a ->. b)
f' PSObject (a ->. b) -> PSObject a -> m (PSObject b)
forall (m :: * -> *) a b.
MonadIO m =>
PSObject (a ->. b) -> PSObject a -> m (PSObject b)
.$ PSObject a
a'

-- | Parses an expression from string
exprWithBasePath ::
  forall schema m.
  (MonadEval m) =>
  -- | Expression text in the Nix language.
  Text ->
  -- | Base path for relative path references in the expression text.
  FilePath ->
  -- | A schema that the expression should satisfy.
  Proxy schema ->
  m (PSObject schema)
exprWithBasePath :: forall schema (m :: * -> *).
MonadEval m =>
Text -> [Char] -> Proxy schema -> m (PSObject schema)
exprWithBasePath Text
expr = ByteString -> [Char] -> Proxy schema -> m (PSObject schema)
forall schema (m :: * -> *).
MonadEval m =>
ByteString -> [Char] -> Proxy schema -> m (PSObject schema)
exprWithBasePathBS (Text -> ByteString
encodeUtf8 Text
expr)

-- | Parses an expression from string
exprWithBasePathBS ::
  forall schema m.
  (MonadEval m) =>
  -- | Expression text in the Nix language.
  ByteString ->
  -- | Base path for relative path references in the expression text.
  FilePath ->
  -- | A schema that the expression should satisfy.
  Proxy schema ->
  m (PSObject schema)
exprWithBasePathBS :: forall schema (m :: * -> *).
MonadEval m =>
ByteString -> [Char] -> Proxy schema -> m (PSObject schema)
exprWithBasePathBS ByteString
expr [Char]
path Proxy schema
_ = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  RawValue
v <- IO RawValue -> m RawValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState -> ByteString -> ByteString -> IO RawValue
valueFromExpressionString Ptr EvalState
evalState ByteString
expr (Text -> ByteString
encodeUtf8 ([Char] -> Text
forall a b. ConvertText a b => a -> b
toS [Char]
path)))
  PSObject schema -> m (PSObject schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PSObject schema -> m (PSObject schema))
-> PSObject schema -> m (PSObject schema)
forall a b. (a -> b) -> a -> b
$ PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {provenance :: Provenance
provenance = Text -> Provenance
Other Text
"internal expression", value :: RawValue
value = RawValue
v}

-- | Ignores string context.
getByteString_ ::
  (MonadEval m) =>
  PSObject NixString ->
  m ByteString
getByteString_ :: forall (m :: * -> *).
MonadEval m =>
PSObject NixString -> m ByteString
getByteString_ PSObject NixString
s = do
  PSObject NixString -> m (Value (NixTypeForSchema NixString))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject NixString
s m (Value NixString)
-> (Value NixString -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString)
-> (Value NixString -> IO ByteString)
-> Value NixString
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value NixString -> IO ByteString
Expr.getStringIgnoreContext

-- | Ignores string context.
getText_ ::
  (MonadEval m) =>
  PSObject NixString ->
  m Text
getText_ :: forall (m :: * -> *). MonadEval m => PSObject NixString -> m Text
getText_ = (PSObject NixString -> m ByteString)
-> (ByteString -> Either UnicodeException Text)
-> (Provenance -> UnicodeException -> NixException)
-> PSObject NixString
-> m Text
forall (m :: * -> *) s a e b.
MonadIO m =>
(PSObject s -> m a)
-> (a -> Either e b)
-> (Provenance -> e -> NixException)
-> PSObject s
-> m b
validateE PSObject NixString -> m ByteString
forall (m :: * -> *).
MonadEval m =>
PSObject NixString -> m ByteString
getByteString_ ByteString -> Either UnicodeException Text
decodeUtf8' Provenance -> UnicodeException -> NixException
InvalidText

validate :: Monad m => (PSObject s -> m a) -> (Provenance -> a -> m b) -> PSObject s -> m b
validate :: forall (m :: * -> *) s a b.
Monad m =>
(PSObject s -> m a)
-> (Provenance -> a -> m b) -> PSObject s -> m b
validate PSObject s -> m a
basicParse Provenance -> a -> m b
validator PSObject s
o = do
  a
a <- PSObject s -> m a
basicParse PSObject s
o
  Provenance -> a -> m b
validator (PSObject s -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject s
o) a
a

validateE :: MonadIO m => (PSObject s -> m a) -> (a -> Either e b) -> (Provenance -> e -> NixException) -> PSObject s -> m b
validateE :: forall (m :: * -> *) s a e b.
MonadIO m =>
(PSObject s -> m a)
-> (a -> Either e b)
-> (Provenance -> e -> NixException)
-> PSObject s
-> m b
validateE PSObject s -> m a
basicParse a -> Either e b
validator Provenance -> e -> NixException
thrower =
  (PSObject s -> m a)
-> (Provenance -> a -> m b) -> PSObject s -> m b
forall (m :: * -> *) s a b.
Monad m =>
(PSObject s -> m a)
-> (Provenance -> a -> m b) -> PSObject s -> m b
validate PSObject s -> m a
basicParse \Provenance
prov a
a ->
    case a -> Either e b
validator a
a of
      (Left e
e) -> NixException -> m b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Provenance -> e -> NixException
thrower Provenance
prov e
e)
      (Right b
b) -> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b

-- | Force a value and check against schema.
check ::
  forall schema m.
  ( CheckType (NixTypeForSchema schema),
    HasRawValueType (NixTypeForSchema schema),
    MonadEval m
  ) =>
  PSObject schema ->
  m (Value (NixTypeForSchema schema))
check :: forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject schema
pv = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (Value (NixTypeForSchema schema))
-> m (Value (NixTypeForSchema schema))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
    Ptr EvalState
-> RawValue -> IO (Maybe (Value (NixTypeForSchema schema)))
forall a.
CheckType a =>
Ptr EvalState -> RawValue -> IO (Maybe (Value a))
checkType Ptr EvalState
evalState (PSObject schema -> RawValue
forall a. PSObject a -> RawValue
value PSObject schema
pv) IO (Maybe (Value (NixTypeForSchema schema)))
-> (Maybe (Value (NixTypeForSchema schema))
    -> IO (Value (NixTypeForSchema schema)))
-> IO (Value (NixTypeForSchema schema))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (Value (NixTypeForSchema schema))
Nothing -> do
        RawValueType
t <- RawValue -> IO RawValueType
rawValueType (PSObject schema -> RawValue
forall a. PSObject a -> RawValue
value PSObject schema
pv)
        NixException -> IO (Value (NixTypeForSchema schema))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NixException -> IO (Value (NixTypeForSchema schema)))
-> NixException -> IO (Value (NixTypeForSchema schema))
forall a b. (a -> b) -> a -> b
$ Provenance -> RawValueType -> [RawValueType] -> NixException
TypeError (PSObject schema -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject schema
pv) RawValueType
t [Proxy (NixTypeForSchema schema) -> RawValueType
forall s. HasRawValueType s => Proxy s -> RawValueType
getRawValueType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(NixTypeForSchema schema))]
      Just Value (NixTypeForSchema schema)
x -> Value (NixTypeForSchema schema)
-> IO (Value (NixTypeForSchema schema))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value (NixTypeForSchema schema)
x

-- TODO make this actually schema-based
toPSObject ::
  (MonadEval m, Expr.ToRawValue a) =>
  a ->
  m (PSObject (Expr.NixTypeFor a))
toPSObject :: forall (m :: * -> *) a.
(MonadEval m, ToRawValue a) =>
a -> m (PSObject (NixTypeFor a))
toPSObject a
a = do
  Ptr EvalState
evalState <- m (Ptr EvalState)
forall r (m :: * -> *). MonadReader r m => m r
ask
  RawValue
v <- IO RawValue -> m RawValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState -> a -> IO RawValue
forall a. ToRawValue a => Ptr EvalState -> a -> IO RawValue
toRawValue Ptr EvalState
evalState a
a)
  PSObject (NixTypeFor a) -> m (PSObject (NixTypeFor a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {provenance :: Provenance
provenance = Provenance
Data, value :: RawValue
value = RawValue
v})

uncheckedCast :: forall (a :: Type) (b :: Type). PSObject a -> PSObject b
uncheckedCast :: forall a b. PSObject a -> PSObject b
uncheckedCast = PSObject a -> PSObject b
coerce

-- | Schema-based parsing type class that constrains neither types nor schemas.
class FromPSObject schema a where
  -- | Parse an object assumed to be in schema @schema@ into a value of type @a@
  -- or throw a 'NixException'.
  fromPSObject :: MonadEval m => PSObject schema -> m a

instance FromPSObject StringWithoutContext ByteString where
  fromPSObject :: forall (m :: * -> *).
MonadEval m =>
PSObject StringWithoutContext -> m ByteString
fromPSObject PSObject StringWithoutContext
o = do
    Value NixString
v <- PSObject StringWithoutContext
-> m (Value (NixTypeForSchema StringWithoutContext))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject StringWithoutContext
o
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      Bool
c <- Value NixString -> IO Bool
hasContext Value NixString
v
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c do
        NixException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NixException -> IO ()) -> NixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Provenance -> NixException
StringContextNotAllowed (PSObject StringWithoutContext -> Provenance
forall a. PSObject a -> Provenance
provenance PSObject StringWithoutContext
o)
    IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Value NixString -> IO ByteString
getStringIgnoreContext Value NixString
v

instance FromPSObject StringWithoutContext Text where
  fromPSObject :: forall (m :: * -> *).
MonadEval m =>
PSObject StringWithoutContext -> m Text
fromPSObject = (PSObject StringWithoutContext -> m ByteString)
-> (ByteString -> Either UnicodeException Text)
-> (Provenance -> UnicodeException -> NixException)
-> PSObject StringWithoutContext
-> m Text
forall (m :: * -> *) s a e b.
MonadIO m =>
(PSObject s -> m a)
-> (a -> Either e b)
-> (Provenance -> e -> NixException)
-> PSObject s
-> m b
validateE PSObject StringWithoutContext -> m ByteString
forall schema a (m :: * -> *).
(FromPSObject schema a, MonadEval m) =>
PSObject schema -> m a
fromPSObject ByteString -> Either UnicodeException Text
decodeUtf8' Provenance -> UnicodeException -> NixException
InvalidText

instance FromPSObject StringWithoutContext [Char] where
  fromPSObject :: forall (m :: * -> *).
MonadEval m =>
PSObject StringWithoutContext -> m [Char]
fromPSObject = (Text -> [Char]) -> m Text -> m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Char]
T.unpack (m Text -> m [Char])
-> (PSObject StringWithoutContext -> m Text)
-> PSObject StringWithoutContext
-> m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSObject StringWithoutContext -> m Text
forall schema a (m :: * -> *).
(FromPSObject schema a, MonadEval m) =>
PSObject schema -> m a
fromPSObject

instance FromPSObject Bool Bool where
  fromPSObject :: forall (m :: * -> *). MonadEval m => PSObject Bool -> m Bool
fromPSObject PSObject Bool
o = do
    Value Bool
v <- PSObject Bool -> m (Value (NixTypeForSchema Bool))
forall schema (m :: * -> *).
(CheckType (NixTypeForSchema schema),
 HasRawValueType (NixTypeForSchema schema), MonadEval m) =>
PSObject schema -> m (Value (NixTypeForSchema schema))
check PSObject Bool
o
    IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Value Bool -> IO Bool
Expr.getBool Value Bool
v)

basicAttrsWithProvenance :: Value NixAttrs -> Provenance -> PSObject (Attrs '[])
basicAttrsWithProvenance :: Value NixAttrs -> Provenance -> PSObject (Attrs '[])
basicAttrsWithProvenance Value NixAttrs
attrs Provenance
p = PSObject :: forall a. Provenance -> RawValue -> PSObject a
PSObject {value :: RawValue
value = Value NixAttrs -> RawValue
forall a. Value a -> RawValue
rtValue Value NixAttrs
attrs, provenance :: Provenance
provenance = Provenance
p}