{-# language AllowAmbiguousTypes #-}
{-# language CPP #-}
{-# language ConstraintKinds #-}
{-# language PartialTypeSignatures #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

{-# options_ghc -Wno-orphans #-}
{-# options_ghc -fno-warn-name-shadowing #-}


module Nix.Exec where

import           Nix.Prelude             hiding ( putStr
                                                , putStrLn
                                                , print
                                                )
import           GHC.Exception                  ( ErrorCall(ErrorCall) )
import           Control.Monad.Catch     hiding ( catchJust )
import           Control.Monad.Fix
import           Data.Fix
import qualified Data.HashMap.Lazy             as M
import qualified Data.List.NonEmpty            as NE
import qualified Data.Text                     as Text
import           Nix.Atoms
import           Nix.Cited
import           Nix.Convert
import           Nix.Effects
import           Nix.Eval                      as Eval
import           Nix.Expr.Types
import           Nix.Expr.Types.Annotated
import           Nix.Frames
import           Nix.Options
import           Nix.Pretty
import           Nix.Render
import           Nix.Scope
import           Nix.String
import           Nix.String.Coerce
import           Nix.Thunk
import           Nix.Value
import           Nix.Value.Equal
import           Nix.Value.Monad
import           Prettyprinter
import qualified Text.Show.Pretty              as PS

#ifdef MIN_VERSION_ghc_datasize 
import           GHC.DataSize
#endif

type MonadCited t f m =
  ( HasCitations m (NValue t f m) t
  , HasCitations1 m (NValue t f m) f
  , MonadDataContext f m
  )

mkNVConstantWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> NAtom
  -> NValue t f m
mkNVConstantWithProvenance :: forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m) -> SrcSpan -> NAtom -> NValue t f m
mkNVConstantWithProvenance Scopes m (NValue t f m)
scopes SrcSpan
span NAtom
x =
  forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scopes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. SrcSpan -> NAtom -> NExprLocF r
NConstantAnnF SrcSpan
span forall a b. (a -> b) -> a -> b
$ NAtom
x) forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NAtom -> Free (NValue' t w m) a
NVConstant NAtom
x

mkNVStrWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> NixString
  -> NValue t f m
mkNVStrWithProvenance :: forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m) -> SrcSpan -> NixString -> NValue t f m
mkNVStrWithProvenance Scopes m (NValue t f m)
scopes SrcSpan
span NixString
x =
  forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scopes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. SrcSpan -> NString r -> NExprLocF r
NStrAnnF SrcSpan
span forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. [Antiquoted Text r] -> NString r
DoubleQuoted forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v r. v -> Antiquoted v r
Plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> Text
ignoreContext forall a b. (a -> b) -> a -> b
$ NixString
x) forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NixString -> Free (NValue' t w m) a
NVStr NixString
x

mkNVPathWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> Path
  -> Path
  -> NValue t f m
mkNVPathWithProvenance :: forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m) -> SrcSpan -> Path -> Path -> NValue t f m
mkNVPathWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span Path
lit Path
real =
  forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. SrcSpan -> Path -> NExprLocF r
NLiteralPathAnnF SrcSpan
span forall a b. (a -> b) -> a -> b
$ Path
lit) forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Path -> Free (NValue' t w m) a
NVPath Path
real

mkNVClosureWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> Params ()
  -> (NValue t f m -> m (NValue t f m))
  -> NValue t f m
mkNVClosureWithProvenance :: forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> Params ()
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
mkNVClosureWithProvenance Scopes m (NValue t f m)
scopes SrcSpan
span Params ()
x NValue t f m -> m (NValue t f m)
f =
  forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scopes forall a b. (a -> b) -> a -> b
$ forall r. SrcSpan -> Params r -> r -> NExprLocF r
NAbsAnnF SrcSpan
span (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Params ()
x) forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Params ()
-> (NValue t w m -> m (Free (NValue' t w m) a))
-> Free (NValue' t w m) a
NVClosure Params ()
x NValue t f m -> m (NValue t f m)
f

mkNVUnaryOpWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> NUnaryOp
  -> Maybe (NValue t f m)
  -> NValue t f m
  -> NValue t f m
mkNVUnaryOpWithProvenance :: forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> NUnaryOp
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
mkNVUnaryOpWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span NUnaryOp
op Maybe (NValue t f m)
val =
  forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall a b. (a -> b) -> a -> b
$ forall r. SrcSpan -> NUnaryOp -> r -> NExprLocF r
NUnaryAnnF SrcSpan
span NUnaryOp
op Maybe (NValue t f m)
val)

mkNVAppOpWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> Maybe (NValue t f m)
  -> Maybe (NValue t f m)
  -> NValue t f m
  -> NValue t f m
mkNVAppOpWithProvenance :: forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
mkNVAppOpWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span Maybe (NValue t f m)
lval Maybe (NValue t f m)
rval =
  forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall a b. (a -> b) -> a -> b
$ forall r. SrcSpan -> r -> r -> NExprLocF r
NAppAnnF SrcSpan
span Maybe (NValue t f m)
lval Maybe (NValue t f m)
rval)

mkNVBinaryOpWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> NBinaryOp
  -> Maybe (NValue t f m)
  -> Maybe (NValue t f m)
  -> NValue t f m
  -> NValue t f m
mkNVBinaryOpWithProvenance :: forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
mkNVBinaryOpWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span NBinaryOp
op Maybe (NValue t f m)
lval Maybe (NValue t f m)
rval =
  forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall a b. (a -> b) -> a -> b
$ forall r. SrcSpan -> NBinaryOp -> r -> r -> NExprLocF r
NBinaryAnnF SrcSpan
span NBinaryOp
op Maybe (NValue t f m)
lval Maybe (NValue t f m)
rval)

type MonadCitedThunks t f m =
  ( MonadThunk t m (NValue t f m)
  , MonadDataErrorContext t f m
  , HasCitations m (NValue t f m) t
  , HasCitations1 m (NValue t f m) f
  )

type MonadNix e t f m =
  ( Has e SrcSpan
  , Has e Options
  , Scoped (NValue t f m) m
  , Framed e m
  , MonadFix m
  , MonadCatch m
  , MonadThrow m
  , Alternative m
  , MonadEffects t f m
  , MonadCitedThunks t f m
  , MonadValue (NValue t f m) m
  )

data ExecFrame t f m = Assertion SrcSpan (NValue t f m)
  deriving (Int -> ExecFrame t f m -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Applicative f, Show t) =>
Int -> ExecFrame t f m -> ShowS
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Applicative f, Show t) =>
[ExecFrame t f m] -> ShowS
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Applicative f, Show t) =>
ExecFrame t f m -> String
showList :: [ExecFrame t f m] -> ShowS
$cshowList :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Applicative f, Show t) =>
[ExecFrame t f m] -> ShowS
show :: ExecFrame t f m -> String
$cshow :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Applicative f, Show t) =>
ExecFrame t f m -> String
showsPrec :: Int -> ExecFrame t f m -> ShowS
$cshowsPrec :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Applicative f, Show t) =>
Int -> ExecFrame t f m -> ShowS
Show, Typeable)

instance MonadDataErrorContext t f m => Exception (ExecFrame t f m)

nverr :: forall e t f s m a . (MonadNix e t f m, Exception s) => s -> m a
nverr :: forall e t (f :: * -> *) s (m :: * -> *) a.
(MonadNix e t f m, Exception s) =>
s -> m a
nverr = forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
evalError @(NValue t f m)

askSpan :: forall e m . (MonadReader e m, Has e SrcSpan) => m SrcSpan
askSpan :: forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan = forall t (m :: * -> *) a. (MonadReader t m, Has t a) => m a
askLocal

wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc
wrapExprLoc :: forall r. SrcSpan -> NExprLocF r -> NExprLoc
wrapExprLoc SrcSpan
span NExprLocF r
x = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ SrcSpan -> VarName -> NExprLoc
NSymAnn SrcSpan
span VarName
"<?>" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprLocF r
x
{-# inline wrapExprLoc #-}

--  2021-01-07: NOTE: This instance belongs to be beside MonadEval type class.
-- Currently instance is stuck in orphanage between the requirements to be MonadEval, aka Eval stage, and emposed requirement to be MonadNix (Execution stage). MonadNix constraint tries to put the cart before horse and seems superflous, since Eval in Nix also needs and can throw exceptions. It is between `nverr` and `evalError`.
instance MonadNix e t f m => MonadEval (NValue t f m) m where
  freeVariable :: VarName -> m (NValue t f m)
freeVariable VarName
var =
    forall e t (f :: * -> *) s (m :: * -> *) a.
(MonadNix e t f m, Exception s) =>
s -> m a
nverr @e @t @f forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString @Text forall a b. (a -> b) -> a -> b
$ Text
"Undefined variable '" forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce VarName
var forall a. Semigroup a => a -> a -> a
<> Text
"'"

  synHole :: VarName -> m (NValue t f m)
synHole VarName
name =
    do
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
evalError @(NValue t f m) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) v. SynHoleInfo m v -> EvalFrame m v
SynHole forall a b. (a -> b) -> a -> b
$
        SynHoleInfo
          { _synHoleInfo_expr :: NExprLoc
_synHoleInfo_expr  = SrcSpan -> VarName -> NExprLoc
NSynHoleAnn SrcSpan
span VarName
name
          , _synHoleInfo_scope :: Scopes m (NValue t f m)
_synHoleInfo_scope = Scopes m (NValue t f m)
scope
          }


  attrMissing :: NonEmpty VarName -> Maybe (NValue t f m) -> m (NValue t f m)
attrMissing NonEmpty VarName
ks Maybe (NValue t f m)
ms =
    forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
evalError @(NValue t f m) forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString forall a b. (a -> b) -> a -> b
$
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Text
"Inheriting unknown attribute: " forall a. Semigroup a => a -> a -> a
<> Text
attr)
        (\ NValue t f m
s -> Text
"Could not look up attribute " forall a. Semigroup a => a -> a -> a
<> Text
attr forall a. Semigroup a => a -> a -> a
<> Text
" in " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (forall t (f :: * -> *) (m :: * -> *) ann.
MonadDataContext f m =>
NValue t f m -> Doc ann
prettyNValue NValue t f m
s))
        Maybe (NValue t f m)
ms
       where
        attr :: Text
attr = Text -> [Text] -> Text
Text.intercalate Text
"." forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce NonEmpty VarName
ks

  evalCurPos :: m (NValue t f m)
evalCurPos =
    do
      Scopes m (NValue t f m)
scope                  <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      span :: SrcSpan
span@(SrcSpan NSourcePos
delta NSourcePos
_) <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance @_ @_ @(NValue t f m)
        (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. SrcSpan -> VarName -> NExprLocF r
NSymAnnF SrcSpan
span forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce @Text Text
"__curPos") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue NSourcePos
delta

  evaledSym :: VarName -> NValue t f m -> m (NValue t f m)
evaledSym VarName
name NValue t f m
val =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      pure $
        forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance @_ @_ @(NValue t f m)
          (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall a b. (a -> b) -> a -> b
$ forall r. SrcSpan -> VarName -> NExprLocF r
NSymAnnF SrcSpan
span VarName
name)
          NValue t f m
val

  evalConstant :: NAtom -> m (NValue t f m)
evalConstant NAtom
c =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      pure $ forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m) -> SrcSpan -> NAtom -> NValue t f m
mkNVConstantWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span NAtom
c

  evalString :: NString (m (NValue t f m)) -> m (NValue t f m)
evalString =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (forall e t (f :: * -> *) s (m :: * -> *) a.
(MonadNix e t f m, Exception s) =>
s -> m a
nverr forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Failed to assemble string")
      (\ NixString
ns ->
        do
          Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
          SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
          pure $ forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m) -> SrcSpan -> NixString -> NValue t f m
mkNVStrWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span NixString
ns
      )
      forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall v (m :: * -> *).
(MonadEval v m, FromValue NixString m v) =>
NString (m v) -> m (Maybe NixString)
assembleString

  evalLiteralPath :: Path -> m (NValue t f m)
evalLiteralPath Path
p =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m) -> SrcSpan -> Path -> Path -> NValue t f m
mkNVPathWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span Path
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
Path -> m Path
toAbsolutePath @t @f @m Path
p

  evalEnvPath :: Path -> m (NValue t f m)
evalEnvPath Path
p =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m) -> SrcSpan -> Path -> Path -> NValue t f m
mkNVPathWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span Path
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
String -> m Path
findEnvPath @t @f @m (coerce :: forall a b. Coercible a b => a -> b
coerce Path
p)

  evalUnary :: NUnaryOp -> NValue t f m -> m (NValue t f m)
evalUnary NUnaryOp
op NValue t f m
arg =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadCited t f m, Show t) =>
Scopes m (NValue t f m)
-> SrcSpan -> NUnaryOp -> NValue t f m -> m (NValue t f m)
execUnaryOp Scopes m (NValue t f m)
scope SrcSpan
span NUnaryOp
op NValue t f m
arg

  evalBinary :: NBinaryOp -> NValue t f m -> m (NValue t f m) -> m (NValue t f m)
evalBinary NBinaryOp
op NValue t f m
larg m (NValue t f m)
rarg =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadEval (NValue t f m) m) =>
Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> NValue t f m
-> m (NValue t f m)
-> m (NValue t f m)
execBinaryOp Scopes m (NValue t f m)
scope SrcSpan
span NBinaryOp
op NValue t f m
larg m (NValue t f m)
rarg

  evalWith :: m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
evalWith m (NValue t f m)
c m (NValue t f m)
b =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      let f :: NValue t f m -> NValue t f m
f = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. SrcSpan -> r -> r -> NExprLocF r
NWithAnnF SrcSpan
span forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
      NValue t f m -> NValue t f m
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v (m :: * -> *). MonadNixEval v m => m v -> m v -> m v
evalWithAttrSet m (NValue t f m)
c m (NValue t f m)
b

  evalIf :: NValue t f m
-> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
evalIf NValue t f m
c m (NValue t f m)
tVal m (NValue t f m)
fVal =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Bool
bl <- forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
c

      let
        fun :: Maybe (NValue t f m)
-> Maybe (NValue t f m) -> NValue t f m -> NValue t f m
fun Maybe (NValue t f m)
x Maybe (NValue t f m)
y = forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall a b. (a -> b) -> a -> b
$ forall r. SrcSpan -> r -> r -> r -> NExprLocF r
NIfAnnF SrcSpan
span (forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
c) Maybe (NValue t f m)
x Maybe (NValue t f m)
y)
        falseVal :: m (NValue t f m)
falseVal = (Maybe (NValue t f m)
-> Maybe (NValue t f m) -> NValue t f m -> NValue t f m
fun forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NValue t f m)
fVal
        trueVal :: m (NValue t f m)
trueVal = (forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe (NValue t f m)
-> Maybe (NValue t f m) -> NValue t f m -> NValue t f m
fun forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NValue t f m)
tVal

      forall a. a -> a -> Bool -> a
bool
        m (NValue t f m)
falseVal
        m (NValue t f m)
trueVal
        Bool
bl

  evalAssert :: NValue t f m -> m (NValue t f m) -> m (NValue t f m)
evalAssert NValue t f m
c m (NValue t f m)
body =
    do
      SrcSpan
span <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Bool
b <- forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
c
      forall a. a -> a -> Bool -> a
bool
        (forall e t (f :: * -> *) s (m :: * -> *) a.
(MonadNix e t f m, Exception s) =>
s -> m a
nverr forall a b. (a -> b) -> a -> b
$ forall t (f :: * -> *) (m :: * -> *).
SrcSpan -> NValue t f m -> ExecFrame t f m
Assertion SrcSpan
span NValue t f m
c)
        (do
          Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
          forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. SrcSpan -> r -> r -> NExprLocF r
NAssertAnnF SrcSpan
span (forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NValue t f m)
body
        )
        Bool
b

  evalApp :: NValue t f m -> m (NValue t f m) -> m (NValue t f m)
evalApp NValue t f m
f m (NValue t f m)
x =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
mkNVAppOpWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span (forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
f) forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
callFunc NValue t f m
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall v (m :: * -> *). MonadValue v m => m v -> m v
defer m (NValue t f m)
x)

  evalAbs
    :: Params (m (NValue t f m))
    -> ( forall a
      . m (NValue t f m)
      -> ( AttrSet (m (NValue t f m))
        -> m (NValue t f m)
        -> m (a, NValue t f m)
        )
      -> m (a, NValue t f m)
      )
    -> m (NValue t f m)
  evalAbs :: Params (m (NValue t f m))
-> (forall a.
    m (NValue t f m)
    -> (AttrSet (m (NValue t f m))
        -> m (NValue t f m) -> m (a, NValue t f m))
    -> m (a, NValue t f m))
-> m (NValue t f m)
evalAbs Params (m (NValue t f m))
p forall a.
m (NValue t f m)
-> (AttrSet (m (NValue t f m))
    -> m (NValue t f m) -> m (a, NValue t f m))
-> m (a, NValue t f m)
k =
    do
      Scopes m (NValue t f m)
scope <- forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      pure $ forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> Params ()
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
mkNVClosureWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span (forall (f :: * -> *) a. Functor f => f a -> f ()
void Params (m (NValue t f m))
p) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a.
m (NValue t f m)
-> (AttrSet (m (NValue t f m))
    -> m (NValue t f m) -> m (a, NValue t f m))
-> m (a, NValue t f m)
k @()) (forall a b. a -> b -> a
const (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a
mempty ,))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure)

  evalError :: forall s a. Exception s => s -> m a
evalError = forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError

infixl 1 `callFunc`
callFunc
  :: forall e t f m
   . MonadNix e t f m
  => NValue t f m
  -> NValue t f m
  -> m (NValue t f m)
callFunc :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
callFunc NValue t f m
fun NValue t f m
arg =
  do
    Frames
frames <- forall e (m :: * -> *). (MonadReader e m, Has e Frames) => m Frames
askFrames
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length Frames
frames forall a. Ord a => a -> a -> Bool
> Int
2000) forall a b. (a -> b) -> a -> b
$ forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Function call stack exhausted"

    NValue t f m
fun' <- forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
fun
    case NValue t f m
fun' of
      NVBuiltin VarName
name NValue t f m -> m (NValue t f m)
f    ->
        do
          SrcSpan
span <- forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
          forall s e (m :: * -> *) a.
(Framed e m, Exception s) =>
NixLevel -> s -> m a -> m a
withFrame NixLevel
Info ((forall (m :: * -> *) v. VarName -> SrcSpan -> EvalFrame m v
Calling @m @(NValue t f m)) VarName
name SrcSpan
span) forall a b. (a -> b) -> a -> b
$ NValue t f m -> m (NValue t f m)
f NValue t f m
arg -- Is this cool?
      NVClosure Params ()
_params NValue t f m -> m (NValue t f m)
f -> NValue t f m -> m (NValue t f m)
f NValue t f m
arg
      (NVSet PositionSet
_ AttrSet (NValue t f m)
m) | Just NValue t f m
f <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
"__functor" AttrSet (NValue t f m)
m ->
        (forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
`callFunc` NValue t f m
arg) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
`callFunc` NValue t f m
fun') NValue t f m
f
      NValue t f m
_x -> forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Attempt to call non-function: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NValue t f m
_x

execUnaryOp
  :: forall e t f m
   . (Framed e m, MonadCited t f m, Show t)
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> NUnaryOp
  -> NValue t f m
  -> m (NValue t f m)
execUnaryOp :: forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadCited t f m, Show t) =>
Scopes m (NValue t f m)
-> SrcSpan -> NUnaryOp -> NValue t f m -> m (NValue t f m)
execUnaryOp Scopes m (NValue t f m)
scope SrcSpan
span NUnaryOp
op NValue t f m
arg =
  case NValue t f m
arg of
    NVConstant NAtom
c ->
      case (NUnaryOp
op, NAtom
c) of
        (NUnaryOp
NNeg, NInt   Integer
i) -> forall a. (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp Integer -> NAtom
NInt forall a. Num a => a -> a
negate Integer
i
        (NUnaryOp
NNeg, NFloat Float
f) -> forall a. (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp Float -> NAtom
NFloat forall a. Num a => a -> a
negate Float
f
        (NUnaryOp
NNot, NBool  Bool
b) -> forall a. (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp Bool -> NAtom
NBool Bool -> Bool
not Bool
b
        (NUnaryOp, NAtom)
_seq ->
          forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"unsupported argument type for unary operator " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (NUnaryOp, NAtom)
_seq
    NValue t f m
_x ->
      forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"argument to unary operator must evaluate to an atomic type: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NValue t f m
_x
 where
  mkUnaryOp :: (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
  mkUnaryOp :: forall a. (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp a -> NAtom
c a -> a
b a
a = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> NUnaryOp
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
mkNVUnaryOpWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span NUnaryOp
op (forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
arg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NAtom -> Free (NValue' t w m) a
NVConstant forall a b. (a -> b) -> a -> b
$ a -> NAtom
c (a -> a
b a
a)

execBinaryOp
  :: forall e t f m
   . (MonadNix e t f m, MonadEval (NValue t f m) m)
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> NBinaryOp
  -> NValue t f m
  -> m (NValue t f m)
  -> m (NValue t f m)
execBinaryOp :: forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadEval (NValue t f m) m) =>
Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> NValue t f m
-> m (NValue t f m)
-> m (NValue t f m)
execBinaryOp Scopes m (NValue t f m)
scope SrcSpan
span NBinaryOp
op NValue t f m
lval m (NValue t f m)
rarg =
  case NBinaryOp
op of
    NBinaryOp
NEq   -> (Bool -> Bool) -> m (NValue t f m)
helperEq forall a. a -> a
id
    NBinaryOp
NNEq  -> (Bool -> Bool) -> m (NValue t f m)
helperEq Bool -> Bool
not
    NBinaryOp
NOr   -> ((m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m))
 -> m (NValue t f m)
 -> m (NValue t f m)
 -> Bool
 -> m (NValue t f m))
-> Bool -> m (NValue t f m)
helperLogic forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool
True
    NBinaryOp
NAnd  -> ((m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m))
 -> m (NValue t f m)
 -> m (NValue t f m)
 -> Bool
 -> m (NValue t f m))
-> Bool -> m (NValue t f m)
helperLogic forall a. a -> a
id   Bool
False
    NBinaryOp
NImpl -> ((m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m))
 -> m (NValue t f m)
 -> m (NValue t f m)
 -> Bool
 -> m (NValue t f m))
-> Bool -> m (NValue t f m)
helperLogic forall a. a -> a
id   Bool
True
    NBinaryOp
_     ->
      do
        NValue t f m
rval  <- m (NValue t f m)
rarg
        NValue t f m
rval' <- forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
rval
        NValue t f m
lval' <- forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
lval

        forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadEval (NValue t f m) m) =>
Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> NValue t f m
-> NValue t f m
-> m (NValue t f m)
execBinaryOpForced Scopes m (NValue t f m)
scope SrcSpan
span NBinaryOp
op NValue t f m
lval' NValue t f m
rval'

 where

  helperEq :: (Bool -> Bool) -> m (NValue t f m)
  helperEq :: (Bool -> Bool) -> m (NValue t f m)
helperEq Bool -> Bool
flag =
    do
      NValue t f m
rval <- m (NValue t f m)
rarg
      Bool
eq <- forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM NValue t f m
lval NValue t f m
rval
      NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval forall a b. (a -> b) -> a -> b
$ Bool -> Bool
flag Bool
eq

  helperLogic :: ((m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m))
 -> m (NValue t f m)
 -> m (NValue t f m)
 -> Bool
 -> m (NValue t f m))
-> Bool -> m (NValue t f m)
helperLogic (m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m))
-> m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m)
flp Bool
flag =
    (m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m))
-> m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m)
flp forall a. a -> a -> Bool -> a
bool
      (Bool -> m (NValue t f m)
bypass Bool
flag)
      (do
          NValue t f m
rval <- m (NValue t f m)
rarg
          Bool
x <- forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
rval
          NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval Bool
x
      )
      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
lval

  boolOp :: NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval = Maybe (NValue t f m) -> Bool -> m (NValue t f m)
toBoolOp forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
rval

  bypass :: Bool -> m (NValue t f m)
bypass      = Maybe (NValue t f m) -> Bool -> m (NValue t f m)
toBoolOp forall a. Maybe a
Nothing

  toBoolOp :: Maybe (NValue t f m) -> Bool -> m (NValue t f m)
  toBoolOp :: Maybe (NValue t f m) -> Bool -> m (NValue t f m)
toBoolOp Maybe (NValue t f m)
r Bool
b =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
mkNVBinaryOpWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span NBinaryOp
op (forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
lval) Maybe (NValue t f m)
r forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NAtom -> Free (NValue' t w m) a
NVConstant forall a b. (a -> b) -> a -> b
$ Bool -> NAtom
NBool Bool
b

execBinaryOpForced
  :: forall e t f m
   . (MonadNix e t f m, MonadEval (NValue t f m) m)
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> NBinaryOp
  -> NValue t f m
  -> NValue t f m
  -> m (NValue t f m)

execBinaryOpForced :: forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadEval (NValue t f m) m) =>
Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> NValue t f m
-> NValue t f m
-> m (NValue t f m)
execBinaryOpForced Scopes m (NValue t f m)
scope SrcSpan
span NBinaryOp
op NValue t f m
lval NValue t f m
rval =
  case NBinaryOp
op of
    NBinaryOp
NLt    -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
mkCmpOp forall a. Ord a => a -> a -> Bool
(<)
    NBinaryOp
NLte   -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
mkCmpOp forall a. Ord a => a -> a -> Bool
(<=)
    NBinaryOp
NGt    -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
mkCmpOp forall a. Ord a => a -> a -> Bool
(>)
    NBinaryOp
NGte   -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
mkCmpOp forall a. Ord a => a -> a -> Bool
(>=)
    NBinaryOp
NMinus -> (forall a. Num a => a -> a -> a) -> m (NValue t f m)
mkBinNumOp (-)
    NBinaryOp
NMult  -> (forall a. Num a => a -> a -> a) -> m (NValue t f m)
mkBinNumOp forall a. Num a => a -> a -> a
(*)
    NBinaryOp
NDiv   -> (Integer -> Integer -> Integer)
-> (Float -> Float -> Float) -> m (NValue t f m)
mkBinNumOp' forall a. Integral a => a -> a -> a
div forall a. Fractional a => a -> a -> a
(/)
    NBinaryOp
NConcat ->
      case (NValue t f m
lval, NValue t f m
rval) of
        (NVList [NValue t f m]
ls, NVList [NValue t f m]
rs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [NValue t f m] -> NValue t f m
mkListP forall a b. (a -> b) -> a -> b
$ [NValue t f m]
ls forall a. Semigroup a => a -> a -> a
<> [NValue t f m]
rs
        (NValue t f m, NValue t f m)
_ -> m (NValue t f m)
unsupportedTypes

    NBinaryOp
NUpdate ->
      case (NValue t f m
lval, NValue t f m
rval) of
        (NVSet PositionSet
lp AttrSet (NValue t f m)
ls, NVSet PositionSet
rp AttrSet (NValue t f m)
rs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkSetP (PositionSet
rp forall a. Semigroup a => a -> a -> a
<> PositionSet
lp) (AttrSet (NValue t f m)
rs forall a. Semigroup a => a -> a -> a
<> AttrSet (NValue t f m)
ls)
        (NVSet PositionSet
lp AttrSet (NValue t f m)
ls, NVConstant NAtom
NNull) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkSetP PositionSet
lp AttrSet (NValue t f m)
ls
        (NVConstant NAtom
NNull, NVSet PositionSet
rp AttrSet (NValue t f m)
rs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkSetP PositionSet
rp AttrSet (NValue t f m)
rs
        (NValue t f m, NValue t f m)
_ -> m (NValue t f m)
unsupportedTypes

    NBinaryOp
NPlus ->
      case (NValue t f m
lval, NValue t f m
rval) of
        (NVConstant NAtom
_, NVConstant NAtom
_) -> (forall a. Num a => a -> a -> a) -> m (NValue t f m)
mkBinNumOp forall a. Num a => a -> a -> a
(+)
        (NVStr NixString
ls, NVStr NixString
rs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NixString -> NValue t f m
mkStrP (NixString
ls forall a. Semigroup a => a -> a -> a
<> NixString
rs)
        (NVStr NixString
ls, NVPath Path
p) ->
          NixString -> NValue t f m
mkStrP forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NixString
ls forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall (m :: * -> *) e.
(MonadStore m, Framed e m) =>
CopyToStoreMode -> Path -> m NixString
coercePathToNixString CopyToStoreMode
CopyToStore Path
p
        (NVPath Path
ls, NVStr NixString
rs) ->
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"A string that refers to a store path cannot be appended to a path.") -- data/nix/src/libexpr/eval.cc:1412
            (\ Text
rs2 -> Path -> NValue t f m
mkPathP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
Path -> m Path
toAbsolutePath @t @f (Path
ls forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. ToString a => a -> String
toString Text
rs2)))
            (NixString -> Maybe Text
getStringNoContext NixString
rs)
        (NVPath Path
ls, NVPath Path
rs) -> Path -> NValue t f m
mkPathP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
Path -> m Path
toAbsolutePath @t @f (Path
ls forall a. Semigroup a => a -> a -> a
<> Path
rs)

        (ls :: NValue t f m
ls@NVSet{}, NVStr NixString
rs) ->
          NixString -> NValue t f m
mkStrP forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> NixString
rs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
(NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> NValue t f m -> m NixString
coerceAnyToNixString forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
callFunc CopyToStoreMode
DontCopyToStore NValue t f m
ls
        (NVStr NixString
ls, rs :: NValue t f m
rs@NVSet{}) ->
          NixString -> NValue t f m
mkStrP forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NixString
ls forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
(NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> NValue t f m -> m NixString
coerceAnyToNixString forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> NValue t f m -> m (NValue t f m)
callFunc CopyToStoreMode
DontCopyToStore NValue t f m
rs
        (NValue t f m, NValue t f m)
_ -> m (NValue t f m)
unsupportedTypes
    NBinaryOp
_other   -> m (NValue t f m)
shouldBeAlreadyHandled

 where
  addProv :: NValue t f m -> NValue t f m
  addProv :: NValue t f m -> NValue t f m
addProv =
    forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
mkNVBinaryOpWithProvenance Scopes m (NValue t f m)
scope SrcSpan
span NBinaryOp
op (forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
lval) (forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
rval)

  mkBoolP :: Bool -> m (NValue t f m)
  mkBoolP :: Bool -> m (NValue t f m)
mkBoolP = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> NValue t f m
addProv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NAtom -> Free (NValue' t w m) a
NVConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> NAtom
NBool

  mkIntP :: Integer -> m (NValue t f m)
  mkIntP :: Integer -> m (NValue t f m)
mkIntP = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> NValue t f m
addProv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NAtom -> Free (NValue' t w m) a
NVConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NAtom
NInt

  mkFloatP :: Float -> m (NValue t f m)
  mkFloatP :: Float -> m (NValue t f m)
mkFloatP = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> NValue t f m
addProv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NAtom -> Free (NValue' t w m) a
NVConstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> NAtom
NFloat

  mkListP :: [NValue t f m] -> NValue t f m
  mkListP :: [NValue t f m] -> NValue t f m
mkListP = NValue t f m -> NValue t f m
addProv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
[Free (NValue' t w m) a] -> Free (NValue' t w m) a
NVList

  mkStrP :: NixString -> NValue t f m
  mkStrP :: NixString -> NValue t f m
mkStrP = NValue t f m -> NValue t f m
addProv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NixString -> Free (NValue' t w m) a
NVStr

  mkPathP :: Path -> NValue t f m
  mkPathP :: Path -> NValue t f m
mkPathP = NValue t f m -> NValue t f m
addProv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Path -> Free (NValue' t w m) a
NVPath

  mkSetP :: (PositionSet -> AttrSet (NValue t f m) -> NValue t f m)
  mkSetP :: PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkSetP PositionSet
x AttrSet (NValue t f m)
s = NValue t f m -> NValue t f m
addProv forall a b. (a -> b) -> a -> b
$ forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
PositionSet
-> AttrSet (Free (NValue' t w m) a) -> Free (NValue' t w m) a
NVSet PositionSet
x AttrSet (NValue t f m)
s

  mkCmpOp :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
  mkCmpOp :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
mkCmpOp forall a. Ord a => a -> a -> Bool
op = case (NValue t f m
lval, NValue t f m
rval) of
    (NVConstant NAtom
l, NVConstant NAtom
r) -> Bool -> m (NValue t f m)
mkBoolP forall a b. (a -> b) -> a -> b
$ NAtom
l forall a. Ord a => a -> a -> Bool
`op` NAtom
r
    (NVStr NixString
l, NVStr NixString
r) -> Bool -> m (NValue t f m)
mkBoolP forall a b. (a -> b) -> a -> b
$ NixString
l forall a. Ord a => a -> a -> Bool
`op` NixString
r
    (NValue t f m, NValue t f m)
_ -> m (NValue t f m)
unsupportedTypes

  mkBinNumOp :: (forall a. Num a => a -> a -> a) -> m (NValue t f m)
  mkBinNumOp :: (forall a. Num a => a -> a -> a) -> m (NValue t f m)
mkBinNumOp forall a. Num a => a -> a -> a
op = (Integer -> Integer -> Integer)
-> (Float -> Float -> Float) -> m (NValue t f m)
mkBinNumOp' forall a. Num a => a -> a -> a
op forall a. Num a => a -> a -> a
op

  mkBinNumOp'
    :: (Integer -> Integer -> Integer)
    -> (Float -> Float -> Float)
    -> m (NValue t f m)
  mkBinNumOp' :: (Integer -> Integer -> Integer)
-> (Float -> Float -> Float) -> m (NValue t f m)
mkBinNumOp' Integer -> Integer -> Integer
intOp Float -> Float -> Float
floatOp =
    case (NValue t f m
lval, NValue t f m
rval) of
      (NVConstant NAtom
l, NVConstant NAtom
r) ->
        case (NAtom
l, NAtom
r) of
          (NInt   Integer
li, NInt   Integer
ri) -> Integer -> m (NValue t f m)
mkIntP forall a b. (a -> b) -> a -> b
$ Integer
li Integer -> Integer -> Integer
`intOp` Integer
ri
          (NInt   Integer
li, NFloat Float
rf) -> Float -> m (NValue t f m)
mkFloatP forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
li Float -> Float -> Float
`floatOp` Float
rf
          (NFloat Float
lf, NInt   Integer
ri) -> Float -> m (NValue t f m)
mkFloatP forall a b. (a -> b) -> a -> b
$ Float
lf Float -> Float -> Float
`floatOp` forall a. Num a => Integer -> a
fromInteger Integer
ri
          (NFloat Float
lf, NFloat Float
rf) -> Float -> m (NValue t f m)
mkFloatP forall a b. (a -> b) -> a -> b
$ Float
lf Float -> Float -> Float
`floatOp` Float
rf
          (NAtom, NAtom)
_ -> m (NValue t f m)
unsupportedTypes
      (NValue t f m, NValue t f m)
_ -> m (NValue t f m)
unsupportedTypes

  unsupportedTypes :: m (NValue t f m)
unsupportedTypes = forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"Unsupported argument types for binary operator " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NBinaryOp
op forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NValue t f m
lval forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NValue t f m
rval

  shouldBeAlreadyHandled :: m (NValue t f m)
shouldBeAlreadyHandled = forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"This cannot happen: operator " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NBinaryOp
op forall a. Semigroup a => a -> a -> a
<> String
" should have been handled in execBinaryOp."


-- This function is here, rather than in 'Nix.String', because of the need to
-- use 'throwError'.
fromStringNoContext
  :: Framed e m
  => NixString
  -> m Text
fromStringNoContext :: forall e (m :: * -> *). Framed e m => NixString -> m Text
fromStringNoContext NixString
ns =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ String
"expected string with no context, but got " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NixString
ns)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (NixString -> Maybe Text
getStringNoContext NixString
ns)

addTracing
  ::( MonadNix e t f m
    , Has e Options
    , Alternative n
    , MonadReader Int n
    , MonadFail n
    )
  => Alg NExprLocF (m a)
  -> Alg NExprLocF (n (m a))
addTracing :: forall e t (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadNix e t f m, Has e Options, Alternative n, MonadReader Int n,
 MonadFail n) =>
Alg (Compose (AnnUnit SrcSpan) NExprF) (m a)
-> Alg (Compose (AnnUnit SrcSpan) NExprF) (n (m a))
addTracing Alg (Compose (AnnUnit SrcSpan) NExprF) (m a)
k NExprLocF (n (m a))
v = do
  Int
depth <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
depth forall a. Ord a => a -> a -> Bool
< Int
2000
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ do
    v' :: Compose (AnnUnit SrcSpan) NExprF (m a)
v'@(AnnF SrcSpan
span NExprF (m a)
x) <- forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA NExprLocF (n (m a))
v
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
      Options
opts <- forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
      let
        rendered :: Doc Any
rendered =
          forall a. a -> a -> Bool -> a
bool
            (forall ann. NExpr -> Doc ann
prettyNix forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall r. VarName -> NExprF r
NSym VarName
"?") forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprF (m a)
x)
            (forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
PS.ppShow forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void NExprF (m a)
x)
            (Options -> Verbosity
getVerbosity Options
opts forall a. Ord a => a -> a -> Bool
>= Verbosity
Chatty)
        msg :: Doc Any -> Doc Any
msg Doc Any
x = forall a ann. Pretty a => a -> Doc ann
pretty (String
"eval: " forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
depth Char
' ') forall a. Semigroup a => a -> a -> a
<> Doc Any
x
      Doc Any
loc <- forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
span forall a b. (a -> b) -> a -> b
$ Doc Any -> Doc Any
msg Doc Any
rendered forall a. Semigroup a => a -> a -> a
<> Doc Any
" ...\n"
      forall (m :: * -> *). MonadPutStr m => String -> m ()
putStr forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show Doc Any
loc
      a
res <- Alg (Compose (AnnUnit SrcSpan) NExprF) (m a)
k Compose (AnnUnit SrcSpan) NExprF (m a)
v'
      forall (m :: * -> *) a. (MonadPutStr m, Show a) => a -> m ()
print forall a b. (a -> b) -> a -> b
$ Doc Any -> Doc Any
msg Doc Any
rendered forall a. Semigroup a => a -> a -> a
<> Doc Any
" ...done"
      pure a
res

evalWithTracingAndMetaInfo
  :: forall e t f m
  . MonadNix e t f m
  => NExprLoc
  -> ReaderT Int m (m (NValue t f m))
evalWithTracingAndMetaInfo :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> ReaderT Int m (m (NValue t f m))
evalWithTracingAndMetaInfo =
  forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi
    forall r a.
(NExprLoc -> ReaderT r m a) -> NExprLoc -> ReaderT r m a
addMetaInfo
    (forall e t (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadNix e t f m, Has e Options, Alternative n, MonadReader Int n,
 MonadFail n) =>
Alg (Compose (AnnUnit SrcSpan) NExprF) (m a)
-> Alg (Compose (AnnUnit SrcSpan) NExprF) (n (m a))
addTracing forall v (m :: * -> *) ann.
MonadNixEval v m =>
AnnF ann NExprF (m v) -> m v
Eval.evalContent)
  where
  addMetaInfo :: (NExprLoc -> ReaderT r m a) -> NExprLoc -> ReaderT r m a
  addMetaInfo :: forall r a.
(NExprLoc -> ReaderT r m a) -> NExprLoc -> ReaderT r m a
addMetaInfo = (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall v (m :: * -> *) e a.
(Framed e m, Scoped v m, Has e SrcSpan, Typeable m, Typeable v) =>
TransformF NExprLoc (m a)
Eval.addMetaInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

evalExprLoc :: forall e t f m . MonadNix e t f m => NExprLoc -> m (NValue t f m)
evalExprLoc :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> m (NValue t f m)
evalExprLoc NExprLoc
expr =
  do
    Options
opts <- forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
    let
      pTracedAdi :: NExprLoc -> m (NValue t f m)
pTracedAdi =
        forall a. a -> a -> Bool -> a
bool
          forall e v (m :: * -> *).
(MonadNixEval v m, Framed e m, Has e SrcSpan, Typeable m,
 Typeable v) =>
NExprLoc -> m v
Eval.evalWithMetaInfo
          (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` (Int
0 :: Int)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> ReaderT Int m (m (NValue t f m))
evalWithTracingAndMetaInfo)
          (Options -> Bool
isTrace Options
opts)
    NExprLoc -> m (NValue t f m)
pTracedAdi NExprLoc
expr

exec :: (MonadNix e t f m, MonadInstantiate m) => [Text] -> m (NValue t f m)
exec :: forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadInstantiate m) =>
[Text] -> m (NValue t f m)
exec [Text]
args = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> m (NValue t f m)
evalExprLoc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
MonadExec m =>
[Text] -> m (Either ErrorCall NExprLoc)
exec' [Text]
args

-- Please, delete `nix` from the name
nixInstantiateExpr
  :: (MonadNix e t f m, MonadInstantiate m) => Text -> m (NValue t f m)
nixInstantiateExpr :: forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadInstantiate m) =>
Text -> m (NValue t f m)
nixInstantiateExpr Text
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> m (NValue t f m)
evalExprLoc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
MonadInstantiate m =>
Text -> m (Either ErrorCall NExprLoc)
instantiateExpr Text
s