{-# 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 :: Scopes m (NValue t f m) -> SrcSpan -> NAtom -> NValue t f m
mkNVConstantWithProvenance Scopes m (NValue t f m)
scopes SrcSpan
span NAtom
x =
  Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scopes (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> (NAtom -> NExprLocF (Maybe (NValue t f m)))
-> NAtom
-> Provenance m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> NAtom -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> NAtom -> NExprLocF r
NConstantAnnF SrcSpan
span (NAtom -> Provenance m (NValue t f m))
-> NAtom -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ NAtom
x) (NValue t f m -> NValue t f m) -> NValue t f m -> NValue t f m
forall a b. (a -> b) -> a -> b
$ NAtom -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NAtom -> NValue t f m
mkNVConstant NAtom
x

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

mkNVPathWithProvenance
  :: MonadCited t f m
  => Scopes m (NValue t f m)
  -> SrcSpan
  -> Path
  -> Path
  -> NValue t f m
mkNVPathWithProvenance :: 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 =
  Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> (Path -> NExprLocF (Maybe (NValue t f m)))
-> Path
-> Provenance m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Path -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> Path -> NExprLocF r
NLiteralPathAnnF SrcSpan
span (Path -> Provenance m (NValue t f m))
-> Path -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Path
lit) (NValue t f m -> NValue t f m) -> NValue t f m -> NValue t f m
forall a b. (a -> b) -> a -> b
$ Path -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
Path -> NValue t f m
mkNVPath 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 :: 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 =
  Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scopes (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> Params (Maybe (NValue t f m))
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> Params r -> r -> NExprLocF r
NAbsAnnF SrcSpan
span (Maybe (NValue t f m)
forall a. Maybe a
Nothing Maybe (NValue t f m) -> Params () -> Params (Maybe (NValue t f m))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Params ()
x) Maybe (NValue t f m)
forall a. Maybe a
Nothing) (NValue t f m -> NValue t f m) -> NValue t f m -> NValue t f m
forall a b. (a -> b) -> a -> b
$ Params () -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
forall (f :: * -> *) (m :: * -> *) t.
(Applicative f, Functor m) =>
Params () -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
mkNVClosure 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 :: 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 =
  Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> NUnaryOp
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> NUnaryOp -> r -> NExprLocF r
NUnaryAnnF SrcSpan
span NUnaryOp
op Maybe (NValue t f m)
val)

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 :: 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 =
  Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> NBinaryOp
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
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
[ExecFrame t f m] -> ShowS
ExecFrame t f m -> String
(Int -> ExecFrame t f m -> ShowS)
-> (ExecFrame t f m -> String)
-> ([ExecFrame t f m] -> ShowS)
-> Show (ExecFrame t f m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
Int -> ExecFrame t f m -> ShowS
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
[ExecFrame t f m] -> ShowS
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
ExecFrame t f m -> String
showList :: [ExecFrame t f m] -> ShowS
$cshowList :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
[ExecFrame t f m] -> ShowS
show :: ExecFrame t f m -> String
$cshow :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
ExecFrame t f m -> String
showsPrec :: Int -> ExecFrame t f m -> ShowS
$cshowsPrec :: forall t (f :: * -> *) (m :: * -> *).
(Comonad 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 :: s -> m a
nverr = forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a.
(MonadEval (NValue t f m) m, Exception s) =>
s -> m a
evalError @(NValue t f m)

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

wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc
wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc
wrapExprLoc SrcSpan
span NExprLocF r
x = Compose (AnnUnit SrcSpan) NExprF NExprLoc -> NExprLoc
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Compose (AnnUnit SrcSpan) NExprF NExprLoc -> NExprLoc)
-> Compose (AnnUnit SrcSpan) NExprF NExprLoc -> NExprLoc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> VarName -> NExprLoc
NSymAnn SrcSpan
span VarName
"<?>" NExprLoc
-> NExprLocF r -> Compose (AnnUnit SrcSpan) NExprF NExprLoc
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
forall s (m :: * -> *) a.
(MonadNix e t f m, Exception s) =>
s -> m a
nverr @e @t @f (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ ToString Text => Text -> String
forall a. ToString a => a -> String
toString @Text (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Undefined variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VarName -> Text
coerce VarName
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

  synHole :: VarName -> m (NValue t f m)
synHole VarName
name =
    do
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Scopes m (NValue t f m)
scope <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a.
(MonadEval (NValue t f m) m, Exception s) =>
s -> m a
evalError @(NValue t f m) (EvalFrame m (NValue t f m) -> m (NValue t f m))
-> EvalFrame m (NValue t f m) -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ SynHoleInfo m (NValue t f m) -> EvalFrame m (NValue t f m)
forall (m :: * -> *) v. SynHoleInfo m v -> EvalFrame m v
SynHole (SynHoleInfo m (NValue t f m) -> EvalFrame m (NValue t f m))
-> SynHoleInfo m (NValue t f m) -> EvalFrame m (NValue t f m)
forall a b. (a -> b) -> a -> b
$
        SynHoleInfo :: forall (m :: * -> *) v. NExprLoc -> Scopes m v -> SynHoleInfo m v
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
forall (m :: * -> *) s a.
(MonadEval (NValue t f m) m, Exception s) =>
s -> m a
evalError @(NValue t f m) (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
      Text -> (NValue t f m -> Text) -> Maybe (NValue t f m) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Text
"Inheriting unknown attribute: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr)
        (\ NValue t f m
s -> Text
"Could not look up attribute " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc Any -> Text
forall b a. (Show a, IsString b) => a -> b
show (NValue t f m -> Doc Any
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
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty VarName -> NonEmpty Text
coerce NonEmpty VarName
ks

  evalCurPos :: m (NValue t f m)
evalCurPos =
    do
      Scopes m (NValue t f m)
scope                  <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      span :: SrcSpan
span@(SrcSpan SourcePos
delta SourcePos
_) <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance @_ @_ @(NValue t f m)
        (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> (VarName -> NExprLocF (Maybe (NValue t f m)))
-> VarName
-> Provenance m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> VarName -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> VarName -> NExprLocF r
NSymAnnF SrcSpan
span (VarName -> Provenance m (NValue t f m))
-> VarName -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Text -> VarName
coerce @Text Text
"__curPos") (NValue t f m -> NValue t f m)
-> m (NValue t f m) -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          SourcePos -> m (NValue t f m)
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue SourcePos
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      pure $
        Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance @_ @_ @(NValue t f m)
          (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> VarName -> NExprLocF (Maybe (NValue t f m))
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      pure $ Scopes m (NValue t f m) -> SrcSpan -> NAtom -> NValue t f m
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 =
    m (NValue t f m)
-> (NixString -> m (NValue t f m))
-> Maybe NixString
-> m (NValue t f m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (ErrorCall -> m (NValue t f m)
forall e t (f :: * -> *) s (m :: * -> *) a.
(MonadNix e t f m, Exception s) =>
s -> m a
nverr (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
          SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
          pure $ Scopes m (NValue t f m) -> SrcSpan -> NixString -> NValue t f m
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
      )
      (Maybe NixString -> m (NValue t f m))
-> (NString (m (NValue t f m)) -> m (Maybe NixString))
-> NString (m (NValue t f m))
-> m (NValue t f m)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NString (m (NValue t f m)) -> m (Maybe NixString)
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Scopes m (NValue t f m) -> SrcSpan -> Path -> Path -> NValue t f m
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 (Path -> NValue t f m) -> m Path -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> m Path
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Scopes m (NValue t f m) -> SrcSpan -> Path -> Path -> NValue t f m
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 (Path -> NValue t f m) -> m Path -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m Path
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
String -> m Path
findEnvPath @t @f @m (Path -> String
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Scopes m (NValue t f m)
-> SrcSpan -> NUnaryOp -> NValue t f m -> m (NValue t f m)
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> NValue t f m
-> m (NValue t f m)
-> m (NValue t f m)
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      let f :: NValue t f m -> NValue t f m
f = (NValue t f m -> NValue t f m -> NValue t f m)
-> NValue t f m -> NValue t f m
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((NValue t f m -> NValue t f m -> NValue t f m)
 -> NValue t f m -> NValue t f m)
-> (NValue t f m -> NValue t f m -> NValue t f m)
-> NValue t f m
-> NValue t f m
forall a b. (a -> b) -> a -> b
$ Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Provenance m (NValue t f m) -> NValue t f m -> NValue t f m)
-> (NValue t f m -> Provenance m (NValue t f m))
-> NValue t f m
-> NValue t f m
-> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> (NValue t f m -> NExprLocF (Maybe (NValue t f m)))
-> NValue t f m
-> Provenance m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> r -> r -> NExprLocF r
NWithAnnF SrcSpan
span Maybe (NValue t f m)
forall a. Maybe a
Nothing (Maybe (NValue t f m) -> NExprLocF (Maybe (NValue t f m)))
-> (NValue t f m -> Maybe (NValue t f m))
-> NValue t f m
-> NExprLocF (Maybe (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      NValue t f m -> NValue t f m
f (NValue t f m -> NValue t f m)
-> m (NValue t f m) -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m)
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Bool
bl <- NValue t f m -> m Bool
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 = Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> r -> r -> r -> NExprLocF r
NIfAnnF SrcSpan
span (NValue t f m -> Maybe (NValue t f m)
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 Maybe (NValue t f m)
forall a. Maybe a
Nothing (Maybe (NValue t f m) -> NValue t f m -> NValue t f m)
-> (NValue t f m -> Maybe (NValue t f m))
-> NValue t f m
-> NValue t f m
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (NValue t f m -> NValue t f m)
-> m (NValue t f m) -> m (NValue t f m)
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 = ((Maybe (NValue t f m)
 -> Maybe (NValue t f m) -> NValue t f m -> NValue t f m)
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
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 Maybe (NValue t f m)
forall a. Maybe a
Nothing (Maybe (NValue t f m) -> NValue t f m -> NValue t f m)
-> (NValue t f m -> Maybe (NValue t f m))
-> NValue t f m
-> NValue t f m
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (NValue t f m -> NValue t f m)
-> m (NValue t f m) -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NValue t f m)
tVal

      m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m)
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 <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      Bool
b <- NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
c
      m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m)
forall a. a -> a -> Bool -> a
bool
        (ExecFrame t f m -> m (NValue t f m)
forall e t (f :: * -> *) s (m :: * -> *) a.
(MonadNix e t f m, Exception s) =>
s -> m a
nverr (ExecFrame t f m -> m (NValue t f m))
-> ExecFrame t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> NValue t f m -> ExecFrame t f m
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
          (NValue t f m -> NValue t f m -> NValue t f m)
-> NValue t f m -> NValue t f m
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Provenance m (NValue t f m) -> NValue t f m -> NValue t f m
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance (Provenance m (NValue t f m) -> NValue t f m -> NValue t f m)
-> (NValue t f m -> Provenance m (NValue t f m))
-> NValue t f m
-> NValue t f m
-> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopes m (NValue t f m)
-> NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m)
forall (m :: * -> *) v.
Scopes m v -> NExprLocF (Maybe v) -> Provenance m v
Provenance Scopes m (NValue t f m)
scope (NExprLocF (Maybe (NValue t f m)) -> Provenance m (NValue t f m))
-> (NValue t f m -> NExprLocF (Maybe (NValue t f m)))
-> NValue t f m
-> Provenance m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> r -> r -> NExprLocF r
NAssertAnnF SrcSpan
span (NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
c) (Maybe (NValue t f m) -> NExprLocF (Maybe (NValue t f m)))
-> (NValue t f m -> Maybe (NValue t f m))
-> NValue t f m
-> NExprLocF (Maybe (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (NValue t f m -> NValue t f m)
-> m (NValue t f m) -> m (NValue t f m)
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      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
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
NApp (NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
f) Maybe (NValue t f m)
forall a. Maybe a
Nothing (NValue t f m -> NValue t f m)
-> m (NValue t f m) -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NValue t f m -> NValue t f m -> m (NValue t f 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
f (NValue t f m -> m (NValue t f m))
-> m (NValue t f m) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (NValue t f m) -> m (NValue t f m)
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 <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
      pure $ Scopes m (NValue t f m)
-> SrcSpan
-> Params ()
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
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 (Params (m (NValue t f m)) -> Params ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Params (m (NValue t f m))
p) ((((), NValue t f m) -> NValue t f m)
-> m ((), NValue t f m) -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), NValue t f m) -> NValue t f m
forall a b. (a, b) -> b
snd (m ((), NValue t f m) -> m (NValue t f m))
-> (NValue t f m -> m ((), NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (NValue t f m)
 -> (AttrSet (m (NValue t f m))
     -> m (NValue t f m) -> m ((), NValue t f m))
 -> m ((), NValue t f m))
-> (AttrSet (m (NValue t f m))
    -> m (NValue t f m) -> m ((), NValue t f m))
-> m (NValue t f m)
-> m ((), NValue t f m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (m (NValue t f m)
-> (AttrSet (m (NValue t f m))
    -> m (NValue t f m) -> m ((), NValue t f m))
-> 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)
k @()) ((m (NValue t f m) -> m ((), NValue t f m))
-> AttrSet (m (NValue t f m))
-> m (NValue t f m)
-> m ((), NValue t f m)
forall a b. a -> b -> a
const ((NValue t f m -> ((), NValue t f m))
-> m (NValue t f m) -> m ((), NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
forall a. Monoid a => a
mempty ,))) (m (NValue t f m) -> m ((), NValue t f m))
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m ((), NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

  evalError :: s -> m a
evalError = s -> m a
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 :: 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 <- m Frames
forall e (m :: * -> *). (MonadReader e m, Has e Frames) => m Frames
askFrames
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Frames -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Frames
frames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2000) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ErrorCall -> m ()
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m ()) -> ErrorCall -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Function call stack exhausted"

    NValue t f m
fun' <- NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
fun
    case NValue t f m
fun' of
      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
      NVBuiltin VarName
name NValue t f m -> m (NValue t f m)
f    ->
        do
          SrcSpan
span <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
askSpan
          NixLevel
-> EvalFrame m (NValue t f m)
-> m (NValue t f m)
-> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s) =>
NixLevel -> s -> m a -> m a
withFrame NixLevel
Info ((VarName -> SrcSpan -> EvalFrame m (NValue t f m)
forall (m :: * -> *) v. VarName -> SrcSpan -> EvalFrame m v
Calling @m @(NValue t f m)) VarName
name SrcSpan
span) (m (NValue t f m) -> m (NValue t f m))
-> m (NValue t f m) -> m (NValue t f m)
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?
      (NVSet PositionSet
_ AttrSet (NValue t f m)
m) | Just NValue t f m
f <- VarName -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
"__functor" AttrSet (NValue t f m)
m ->
        (NValue t f m -> NValue t f m -> m (NValue t f 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) (NValue t f m -> m (NValue t f m))
-> m (NValue t f m) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (NValue t f m -> NValue t f m -> m (NValue t f 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
fun') NValue t f m
f
      NValue t f m
_x -> ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Attempt to call non-function: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> String
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 :: 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) -> (Integer -> NAtom)
-> (Integer -> Integer) -> Integer -> m (NValue t f m)
forall a. (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp Integer -> NAtom
NInt Integer -> Integer
forall a. Num a => a -> a
negate Integer
i
        (NUnaryOp
NNeg, NFloat Float
f) -> (Float -> NAtom) -> (Float -> Float) -> Float -> m (NValue t f m)
forall a. (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp Float -> NAtom
NFloat Float -> Float
forall a. Num a => a -> a
negate Float
f
        (NUnaryOp
NNot, NBool  Bool
b) -> (Bool -> NAtom) -> (Bool -> Bool) -> Bool -> m (NValue t f m)
forall a. (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp Bool -> NAtom
NBool Bool -> Bool
not Bool
b
        (NUnaryOp, NAtom)
_seq ->
          ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"unsupported argument type for unary operator " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (NUnaryOp, NAtom) -> String
forall b a. (Show a, IsString b) => a -> b
show (NUnaryOp, NAtom)
_seq
    NValue t f m
_x ->
      ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"argument to unary operator must evaluate to an atomic type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> String
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 :: (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)
mkUnaryOp a -> NAtom
c a -> a
b a
a = NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> (NAtom -> NValue t f m) -> NAtom -> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopes m (NValue t f m)
-> SrcSpan
-> NUnaryOp
-> Maybe (NValue t f m)
-> NValue t f m
-> NValue t f m
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 (NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
arg) (NValue t f m -> NValue t f m)
-> (NAtom -> NValue t f m) -> NAtom -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAtom -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NAtom -> NValue t f m
mkNVConstant (NAtom -> m (NValue t f m)) -> NAtom -> m (NValue t f m)
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 :: 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 Bool -> Bool
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 (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)
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 (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)
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 (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)
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' <- NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
rval
        NValue t f m
lval' <- NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
lval

        Scopes m (NValue t f m)
-> SrcSpan
-> NBinaryOp
-> NValue t f m
-> NValue t f m
-> m (NValue t f m)
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 <- NValue t f m -> NValue t f m -> m Bool
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), Comonad 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 (Bool -> m (NValue t f m)) -> Bool -> m (NValue t f m)
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 m (NValue t f m) -> m (NValue t f m) -> Bool -> m (NValue t f m)
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 <- NValue t f m -> m Bool
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
      )
      (Bool -> m (NValue t f m)) -> m Bool -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NValue t f m -> m Bool
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 (Maybe (NValue t f m) -> Bool -> m (NValue t f m))
-> Maybe (NValue t f m) -> Bool -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ NValue t f m -> Maybe (NValue t f m)
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 Maybe (NValue t f m)
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 =
    NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ 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
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 (NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
lval) Maybe (NValue t f m)
r (NValue t f m -> NValue t f m) -> NValue t f m -> NValue t f m
forall a b. (a -> b) -> a -> b
$ NAtom -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NAtom -> NValue t f m
mkNVConstant (NAtom -> NValue t f m) -> NAtom -> NValue t f m
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 :: 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' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Float -> Float -> Float
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) -> NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ [NValue t f m] -> NValue t f m
mkListP ([NValue t f m] -> NValue t f m) -> [NValue t f m] -> NValue t f m
forall a b. (a -> b) -> a -> b
$ [NValue t f m]
ls [NValue t f m] -> [NValue t f m] -> [NValue t f m]
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) -> NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkSetP (PositionSet
rp PositionSet -> PositionSet -> PositionSet
forall a. Semigroup a => a -> a -> a
<> PositionSet
lp) (AttrSet (NValue t f m)
rs AttrSet (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet (NValue t f m)
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) -> NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
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) -> NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
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) -> NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ NixString -> NValue t f m
mkStrP (NixString
ls NixString -> NixString -> NixString
forall a. Semigroup a => a -> a -> a
<> NixString
rs)
        (NVStr NixString
ls, NVPath Path
p) ->
          NixString -> NValue t f m
mkStrP (NixString -> NValue t f m)
-> (NixString -> NixString) -> NixString -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NixString
ls NixString -> NixString -> NixString
forall a. Semigroup a => a -> a -> a
<>) (NixString -> NValue t f m) -> m NixString -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            CopyToStoreMode -> Path -> m NixString
forall (m :: * -> *) e.
(MonadStore m, Framed e m) =>
CopyToStoreMode -> Path -> m NixString
coercePathToNixString CopyToStoreMode
CopyToStore Path
p
        (NVPath Path
ls, NVStr NixString
rs) ->
          m (NValue t f m)
-> (Text -> m (NValue t f m)) -> Maybe Text -> m (NValue t f m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
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 (Path -> NValue t f m) -> m Path -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> m Path
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
Path -> m Path
toAbsolutePath @t @f (Path
ls Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> String -> Path
coerce (Text -> String
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 (Path -> NValue t f m) -> m Path -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> m Path
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
Path -> m Path
toAbsolutePath @t @f (Path
ls Path -> Path -> Path
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 (NixString -> NValue t f m)
-> (NixString -> NixString) -> NixString -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NixString -> NixString -> NixString
forall a. Semigroup a => a -> a -> a
<> NixString
rs) (NixString -> NValue t f m) -> m NixString -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> NValue t f m -> m NixString
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 NValue t f m -> NValue t f m -> m (NValue t f 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 CopyToStoreMode
DontCopyToStore NValue t f m
ls
        (NVStr NixString
ls, rs :: NValue t f m
rs@NVSet{}) ->
          NixString -> NValue t f m
mkStrP (NixString -> NValue t f m)
-> (NixString -> NixString) -> NixString -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NixString
ls NixString -> NixString -> NixString
forall a. Semigroup a => a -> a -> a
<>) (NixString -> NValue t f m) -> m NixString -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> NValue t f m -> m NixString
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 NValue t f m -> NValue t f m -> m (NValue t f 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 CopyToStoreMode
DontCopyToStore NValue t f m
rs
        (NValue t f m, NValue t f m)
_ -> m (NValue t f m)
unsupportedTypes

    NBinaryOp
NApp  -> ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"NApp should be handled by evalApp"
    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 =
    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
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 (NValue t f m -> Maybe (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
lval) (NValue t f m -> Maybe (NValue t f m)
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 = NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> (Bool -> NValue t f m) -> Bool -> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> NValue t f m
addProv (NValue t f m -> NValue t f m)
-> (Bool -> NValue t f m) -> Bool -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAtom -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NAtom -> NValue t f m
mkNVConstant (NAtom -> NValue t f m) -> (Bool -> NAtom) -> Bool -> NValue t f m
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 = NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> (Integer -> NValue t f m) -> Integer -> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> NValue t f m
addProv (NValue t f m -> NValue t f m)
-> (Integer -> NValue t f m) -> Integer -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAtom -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NAtom -> NValue t f m
mkNVConstant (NAtom -> NValue t f m)
-> (Integer -> NAtom) -> Integer -> NValue t f m
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 = NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> (Float -> NValue t f m) -> Float -> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> NValue t f m
addProv (NValue t f m -> NValue t f m)
-> (Float -> NValue t f m) -> Float -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAtom -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NAtom -> NValue t f m
mkNVConstant (NAtom -> NValue t f m)
-> (Float -> NAtom) -> Float -> NValue t f m
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 (NValue t f m -> NValue t f m)
-> ([NValue t f m] -> NValue t f m)
-> [NValue t f m]
-> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NValue t f m] -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
[NValue t f m] -> NValue t f m
mkNVList

  mkStrP :: NixString -> NValue t f m
  mkStrP :: NixString -> NValue t f m
mkStrP = NValue t f m -> NValue t f m
addProv (NValue t f m -> NValue t f m)
-> (NixString -> NValue t f m) -> NixString -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NixString -> NValue t f m
mkNVStr

  mkPathP :: Path -> NValue t f m
  mkPathP :: Path -> NValue t f m
mkPathP = NValue t f m -> NValue t f m
addProv (NValue t f m -> NValue t f m)
-> (Path -> NValue t f m) -> Path -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
Path -> NValue t f m
mkNVPath

  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 (NValue t f m -> NValue t f m) -> NValue t f m -> NValue t f m
forall a b. (a -> b) -> a -> b
$ PositionSet -> AttrSet (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
PositionSet -> AttrSet (NValue t f m) -> NValue t f m
mkNVSet 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 (Bool -> m (NValue t f m)) -> Bool -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ NAtom
l NAtom -> NAtom -> Bool
forall a. Ord a => a -> a -> Bool
`op` NAtom
r
    (NVStr NixString
l, NVStr NixString
r) -> Bool -> m (NValue t f m)
mkBoolP (Bool -> m (NValue t f m)) -> Bool -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ NixString
l NixString -> NixString -> Bool
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' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
op Float -> Float -> Float
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 (Integer -> m (NValue t f m)) -> Integer -> m (NValue t f m)
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 (Float -> m (NValue t f m)) -> Float -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Integer -> Float
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 (Float -> m (NValue t f m)) -> Float -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Float
lf Float -> Float -> Float
`floatOp` Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
ri
          (NFloat Float
lf, NFloat Float
rf) -> Float -> m (NValue t f m)
mkFloatP (Float -> m (NValue t f m)) -> Float -> m (NValue t f m)
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 = ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Unsupported argument types for binary operator " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NBinaryOp -> String
forall b a. (Show a, IsString b) => a -> b
show NBinaryOp
op String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> String
forall b a. (Show a, IsString b) => a -> b
show NValue t f m
lval String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> String
forall b a. (Show a, IsString b) => a -> b
show NValue t f m
rval

  shouldBeAlreadyHandled :: m (NValue t f m)
shouldBeAlreadyHandled = ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"This cannot happen: operator " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NBinaryOp -> String
forall b a. (Show a, IsString b) => a -> b
show NBinaryOp
op String -> ShowS
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 :: NixString -> m Text
fromStringNoContext NixString
ns =
  m Text -> (Text -> m Text) -> Maybe Text -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (ErrorCall -> m Text
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m Text) -> ErrorCall -> m Text
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"expected string with no context, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NixString -> String
forall b a. (Show a, IsString b) => a -> b
show NixString
ns)
    Text -> m Text
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 :: Alg NExprLocF (m a) -> Alg NExprLocF (n (m a))
addTracing Alg NExprLocF (m a)
k NExprLocF (n (m a))
v = do
  Int
depth <- n Int
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool -> n ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> n ()) -> Bool -> n ()
forall a b. (a -> b) -> a -> b
$ Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2000
  (Int -> Int) -> n (m a) -> n (m a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Int -> Int
forall a. Enum a => a -> a
succ (n (m a) -> n (m a)) -> n (m a) -> n (m a)
forall a b. (a -> b) -> a -> b
$ do
    v' :: Compose (AnnUnit SrcSpan) NExprF (m a)
v'@(AnnF SrcSpan
span NExprF (m a)
x) <- NExprLocF (n (m a)) -> n (Compose (AnnUnit SrcSpan) NExprF (m a))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA NExprLocF (n (m a))
v
    m a -> n (m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m a -> n (m a)) -> m a -> n (m a)
forall a b. (a -> b) -> a -> b
$ do
      Options
opts <- m Options
forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
      let
        rendered :: Doc Any
rendered =
          Doc Any -> Doc Any -> Bool -> Doc Any
forall a. a -> a -> Bool -> a
bool
            (NExpr -> Doc Any
forall ann. NExpr -> Doc ann
prettyNix (NExpr -> Doc Any) -> NExpr -> Doc Any
forall a b. (a -> b) -> a -> b
$ NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (VarName -> NExprF NExpr
forall r. VarName -> NExprF r
NSym VarName
"?") NExpr -> NExprF (m a) -> NExprF NExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprF (m a)
x)
            (String -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc Any) -> String -> Doc Any
forall a b. (a -> b) -> a -> b
$ NExprF () -> String
forall a. Show a => a -> String
PS.ppShow (NExprF () -> String) -> NExprF () -> String
forall a b. (a -> b) -> a -> b
$ NExprF (m a) -> NExprF ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void NExprF (m a)
x)
            (Options -> Verbosity
getVerbosity Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Chatty)
        msg :: Doc Any -> Doc Any
msg Doc Any
x = String -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (String
"eval: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
depth Char
' ') Doc Any -> Doc Any -> Doc Any
forall a. Semigroup a => a -> a -> a
<> Doc Any
x
      Doc Any
loc <- SrcSpan -> Doc Any -> m (Doc Any)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
span (Doc Any -> m (Doc Any)) -> Doc Any -> m (Doc Any)
forall a b. (a -> b) -> a -> b
$ Doc Any -> Doc Any
msg Doc Any
rendered Doc Any -> Doc Any -> Doc Any
forall a. Semigroup a => a -> a -> a
<> Doc Any
" ...\n"
      String -> m ()
forall (m :: * -> *). MonadPutStr m => String -> m ()
putStr (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ Doc Any -> String
forall b a. (Show a, IsString b) => a -> b
show Doc Any
loc
      a
res <- Alg NExprLocF (m a)
k Compose (AnnUnit SrcSpan) NExprF (m a)
v'
      Doc Any -> m ()
forall (m :: * -> *) a. (MonadPutStr m, Show a) => a -> m ()
print (Doc Any -> m ()) -> Doc Any -> m ()
forall a b. (a -> b) -> a -> b
$ Doc Any -> Doc Any
msg Doc Any
rendered Doc Any -> Doc Any -> Doc Any
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 :: NExprLoc -> ReaderT Int m (m (NValue t f m))
evalWithTracingAndMetaInfo =
  Transform NExprLocF (ReaderT Int m (m (NValue t f m)))
-> Alg NExprLocF (ReaderT Int m (m (NValue t f m)))
-> NExprLoc
-> ReaderT Int m (m (NValue t f m))
forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi
    Transform NExprLocF (ReaderT Int m (m (NValue t f m)))
forall r a.
(NExprLoc -> ReaderT r m a) -> NExprLoc -> ReaderT r m a
addMetaInfo
    (Alg NExprLocF (m (NValue t f m))
-> Alg NExprLocF (ReaderT Int m (m (NValue t f m)))
forall e t (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
(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 Alg NExprLocF (m (NValue t f m))
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 :: (NExprLoc -> ReaderT r m a) -> NExprLoc -> ReaderT r m a
addMetaInfo = ((r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a)
-> (NExprLoc -> r -> m a) -> NExprLoc -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((NExprLoc -> r -> m a) -> NExprLoc -> ReaderT r m a)
-> ((NExprLoc -> ReaderT r m a) -> NExprLoc -> r -> m a)
-> (NExprLoc -> ReaderT r m a)
-> NExprLoc
-> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> NExprLoc -> m a) -> NExprLoc -> r -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((r -> NExprLoc -> m a) -> NExprLoc -> r -> m a)
-> ((NExprLoc -> ReaderT r m a) -> r -> NExprLoc -> m a)
-> (NExprLoc -> ReaderT r m a)
-> NExprLoc
-> r
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransformF NExprLoc (m a)
forall v (m :: * -> *) e a.
(Framed e m, Scoped v m, Has e SrcSpan, Typeable m, Typeable v) =>
TransformF NExprLoc (m a)
Eval.addMetaInfo TransformF NExprLoc (m a)
-> (r -> NExprLoc -> m a) -> r -> NExprLoc -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((r -> NExprLoc -> m a) -> r -> NExprLoc -> m a)
-> ((NExprLoc -> ReaderT r m a) -> r -> NExprLoc -> m a)
-> (NExprLoc -> ReaderT r m a)
-> r
-> NExprLoc
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprLoc -> r -> m a) -> r -> NExprLoc -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((NExprLoc -> r -> m a) -> r -> NExprLoc -> m a)
-> ((NExprLoc -> ReaderT r m a) -> NExprLoc -> r -> m a)
-> (NExprLoc -> ReaderT r m a)
-> r
-> NExprLoc
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT r m a -> r -> m a)
-> (NExprLoc -> ReaderT r m a) -> NExprLoc -> r -> m a
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 :: NExprLoc -> m (NValue t f m)
evalExprLoc NExprLoc
expr =
  do
    Options
opts <- m Options
forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
    let
      pTracedAdi :: NExprLoc -> m (NValue t f m)
pTracedAdi =
        (NExprLoc -> m (NValue t f m))
-> (NExprLoc -> m (NValue t f m))
-> Bool
-> NExprLoc
-> m (NValue t f m)
forall a. a -> a -> Bool -> a
bool
          NExprLoc -> m (NValue t f m)
forall e v (m :: * -> *).
(MonadNixEval v m, Framed e m, Has e SrcSpan, Typeable m,
 Typeable v) =>
NExprLoc -> m v
Eval.evalWithMetaInfo
          (m (m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (NValue t f m)) -> m (NValue t f m))
-> (NExprLoc -> m (m (NValue t f m)))
-> NExprLoc
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Int m (m (NValue t f m)) -> Int -> m (m (NValue t f m))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` (Int
0 :: Int)) (ReaderT Int m (m (NValue t f m)) -> m (m (NValue t f m)))
-> (NExprLoc -> ReaderT Int m (m (NValue t f m)))
-> NExprLoc
-> m (m (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLoc -> ReaderT Int m (m (NValue t f m))
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 :: [Text] -> m (NValue t f m)
exec [Text]
args = (ErrorCall -> m (NValue t f m))
-> (NExprLoc -> m (NValue t f m))
-> Either ErrorCall NExprLoc
-> m (NValue t f m)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError NExprLoc -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> m (NValue t f m)
evalExprLoc (Either ErrorCall NExprLoc -> m (NValue t f m))
-> m (Either ErrorCall NExprLoc) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Text] -> m (Either ErrorCall NExprLoc)
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 :: Text -> m (NValue t f m)
nixInstantiateExpr Text
s = (ErrorCall -> m (NValue t f m))
-> (NExprLoc -> m (NValue t f m))
-> Either ErrorCall NExprLoc
-> m (NValue t f m)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError NExprLoc -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> m (NValue t f m)
evalExprLoc (Either ErrorCall NExprLoc -> m (NValue t f m))
-> m (Either ErrorCall NExprLoc) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> m (Either ErrorCall NExprLoc)
forall (m :: * -> *).
MonadInstantiate m =>
Text -> m (Either ErrorCall NExprLoc)
instantiateExpr Text
s