{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Nix.Exec where

import           Prelude                 hiding ( putStr
                                                , putStrLn
                                                , print
                                                )

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Catch     hiding ( catchJust )
import           Control.Monad.Fix
import           Control.Monad.Reader
import           Data.Fix
import qualified Data.HashMap.Lazy             as M
import           Data.List
import qualified Data.List.NonEmpty            as NE
import           Data.Text                      ( Text )
import qualified Data.Text                     as Text
import           Data.Typeable
import           Nix.Atoms
import           Nix.Cited
import           Nix.Convert
import           Nix.Effects
import           Nix.Eval                      as Eval
import           Nix.Expr
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.Utils
import           Nix.Value
import           Nix.Value.Equal
import           Nix.Value.Monad
import           Prettyprinter
#ifdef MIN_VERSION_pretty_show
import qualified Text.Show.Pretty as PS
#endif

#ifdef MIN_VERSION_ghc_datasize
#if MIN_VERSION_ghc_datasize(0,2,0)
import           GHC.DataSize
#endif
#endif

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

nvConstantP
  :: MonadCited t f m => Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP :: Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP p :: Provenance m (NValue t f m)
p x :: 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 Provenance m (NValue t f m)
p (NAtom -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NAtom -> NValue t f m
nvConstant NAtom
x)

nvStrP
  :: MonadCited t f m
  => Provenance m (NValue t f m)
  -> NixString
  -> NValue t f m
nvStrP :: Provenance m (NValue t f m) -> NixString -> NValue t f m
nvStrP p :: Provenance m (NValue t f m)
p ns :: NixString
ns = 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)
p (NixString -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NixString -> NValue t f m
nvStr NixString
ns)

nvPathP
  :: MonadCited t f m => Provenance m (NValue t f m) -> FilePath -> NValue t f m
nvPathP :: Provenance m (NValue t f m) -> FilePath -> NValue t f m
nvPathP p :: Provenance m (NValue t f m)
p x :: FilePath
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 Provenance m (NValue t f m)
p (FilePath -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
FilePath -> NValue t f m
nvPath FilePath
x)

nvListP
  :: MonadCited t f m
  => Provenance m (NValue t f m)
  -> [NValue t f m]
  -> NValue t f m
nvListP :: Provenance m (NValue t f m) -> [NValue t f m] -> NValue t f m
nvListP p :: Provenance m (NValue t f m)
p l :: [NValue t f m]
l = 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)
p ([NValue t f m] -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
[NValue t f m] -> NValue t f m
nvList [NValue t f m]
l)

nvSetP
  :: MonadCited t f m
  => Provenance m (NValue t f m)
  -> AttrSet (NValue t f m)
  -> AttrSet SourcePos
  -> NValue t f m
nvSetP :: Provenance m (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
nvSetP p :: Provenance m (NValue t f m)
p s :: AttrSet (NValue t f m)
s x :: AttrSet SourcePos
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 Provenance m (NValue t f m)
p (AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
HashMap Text (NValue t f m) -> AttrSet SourcePos -> NValue t f m
nvSet AttrSet (NValue t f m)
s AttrSet SourcePos
x)

nvClosureP
  :: MonadCited t f m
  => Provenance m (NValue t f m)
  -> Params ()
  -> (NValue t f m -> m (NValue t f m))
  -> NValue t f m
nvClosureP :: Provenance m (NValue t f m)
-> Params () -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvClosureP p :: Provenance m (NValue t f m)
p x :: Params ()
x f :: 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 Provenance m (NValue t f m)
p (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
nvClosure Params ()
x NValue t f m -> m (NValue t f m)
f)

nvBuiltinP
  :: MonadCited t f m
  => Provenance m (NValue t f m)
  -> String
  -> (NValue t f m -> m (NValue t f m))
  -> NValue t f m
nvBuiltinP :: Provenance m (NValue t f m)
-> FilePath -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvBuiltinP p :: Provenance m (NValue t f m)
p name :: FilePath
name f :: 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 Provenance m (NValue t f m)
p (FilePath -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
forall (f :: * -> *) (m :: * -> *) t.
(Applicative f, Functor m) =>
FilePath -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvBuiltin FilePath
name NValue t f m -> m (NValue t f m)
f)

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 -> FilePath
(Int -> ExecFrame t f m -> ShowS)
-> (ExecFrame t f m -> FilePath)
-> ([ExecFrame t f m] -> ShowS)
-> Show (ExecFrame t f m)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([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 -> FilePath
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 -> FilePath
$cshow :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
ExecFrame t f m -> FilePath
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)

currentPos :: forall e m . (MonadReader e m, Has e SrcSpan) => m SrcSpan
currentPos :: m SrcSpan
currentPos = (e -> SrcSpan) -> m SrcSpan
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike SrcSpan e e SrcSpan SrcSpan -> e -> SrcSpan
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike SrcSpan e e SrcSpan SrcSpan
forall a b. Has a b => Lens' a b
hasLens)

wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc
wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc
wrapExprLoc span :: SrcSpan
span x :: NExprLocF r
x = Compose (Ann SrcSpan) NExprF NExprLoc -> NExprLoc
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Compose (Ann SrcSpan) NExprF NExprLoc -> NExprLoc
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SrcSpan -> Text -> Compose (Ann SrcSpan) NExprF NExprLoc
forall r. SrcSpan -> Text -> NExprLocF r
NSym_ SrcSpan
span "<?>") NExprLoc -> NExprLocF r -> Compose (Ann SrcSpan) NExprF NExprLoc
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprLocF r
x)

instance MonadNix e t f m => MonadEval (NValue t f m) m where
  freeVariable :: Text -> m (NValue t f m)
freeVariable var :: Text
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
$  FilePath -> ErrorCall
ErrorCall
      (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$  "Undefined variable '"
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
Text.unpack Text
var
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "'"

  synHole :: Text -> m (NValue t f m)
synHole name :: Text
name = do
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    Scopes m (NValue t f m)
scope <- m (Scopes m (NValue t f m))
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes
    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  = Compose (Ann SrcSpan) NExprF NExprLoc -> NExprLoc
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Compose (Ann SrcSpan) NExprF NExprLoc -> NExprLoc)
-> Compose (Ann SrcSpan) NExprF NExprLoc -> NExprLoc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Text -> Compose (Ann SrcSpan) NExprF NExprLoc
forall r. SrcSpan -> Text -> NExprLocF r
NSynHole_ SrcSpan
span Text
name
      , _synHoleInfo_scope :: Scopes m (NValue t f m)
_synHoleInfo_scope = Scopes m (NValue t f m)
scope
      }

  attrMissing :: NonEmpty Text -> Maybe (NValue t f m) -> m (NValue t f m)
attrMissing ks :: NonEmpty Text
ks Nothing =
    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
$  FilePath -> ErrorCall
ErrorCall
      (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$  "Inheriting unknown attribute: "
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "." ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
ks))

  attrMissing ks :: NonEmpty Text
ks (Just s :: NValue t f m
s) =
    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
$  FilePath -> ErrorCall
ErrorCall
      (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$  "Could not look up attribute "
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "." ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
ks))
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ " in "
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Doc Any -> FilePath
forall a. Show a => a -> FilePath
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)

  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)
currentScopes
    span :: SrcSpan
span@(SrcSpan delta :: SourcePos
delta _) <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    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 (SrcSpan -> Text -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> Text -> NExprLocF r
NSym_ SrcSpan
span "__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 :: Text -> NValue t f m -> m (NValue t f m)
evaledSym name :: Text
name val :: 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    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 (SrcSpan -> Text -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> Text -> NExprLocF r
NSym_ SrcSpan
span Text
name))
      NValue t f m
val

  evalConstant :: NAtom -> m (NValue t f m)
evalConstant c :: 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    pure $ Provenance m (NValue t f m) -> NAtom -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP (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 (SrcSpan -> NAtom -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> NAtom -> NExprLocF r
NConstant_ SrcSpan
span NAtom
c)) NAtom
c

  evalString :: NString (m (NValue t f m)) -> m (NValue t f m)
evalString = 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 (NString (m (NValue t f m)) -> m (Maybe NixString))
-> (Maybe NixString -> m (NValue t f m))
-> NString (m (NValue t f m))
-> m (NValue t f m)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    Just ns :: 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)
currentScopes
      SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
      pure $ Provenance m (NValue t f m) -> NixString -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NixString -> NValue t f m
nvStrP
        (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
          (SrcSpan
-> NString (Maybe (NValue t f m))
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> NString r -> NExprLocF r
NStr_ SrcSpan
span ([Antiquoted Text (Maybe (NValue t f m))]
-> NString (Maybe (NValue t f m))
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text (Maybe (NValue t f m))
forall v r. v -> Antiquoted v r
Plain (NixString -> Text
hackyStringIgnoreContext NixString
ns)]))
        )
        NixString
ns
    Nothing -> 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
$ FilePath -> ErrorCall
ErrorCall "Failed to assemble string"

  evalLiteralPath :: FilePath -> m (NValue t f m)
evalLiteralPath p :: FilePath
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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    Provenance m (NValue t f m) -> FilePath -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> FilePath -> NValue t f m
nvPathP (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 (SrcSpan -> FilePath -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> FilePath -> NExprLocF r
NLiteralPath_ SrcSpan
span FilePath
p))
      (FilePath -> NValue t f m) -> m FilePath -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
FilePath -> m FilePath
makeAbsolutePath @t @f @m FilePath
p

  evalEnvPath :: FilePath -> m (NValue t f m)
evalEnvPath p :: FilePath
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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    Provenance m (NValue t f m) -> FilePath -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> FilePath -> NValue t f m
nvPathP (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 (SrcSpan -> FilePath -> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> FilePath -> NExprLocF r
NEnvPath_ SrcSpan
span FilePath
p)) (FilePath -> NValue t f m) -> m FilePath -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
FilePath -> m FilePath
findEnvPath @t @f @m FilePath
p

  evalUnary :: NUnaryOp -> NValue t f m -> m (NValue t f m)
evalUnary op :: NUnaryOp
op arg :: 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    Scopes m (NValue t f m)
-> SrcSpan -> NUnaryOp -> NValue t f m -> m (NValue t f m)
forall e (m :: * -> *) t (f :: * -> *).
(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 op :: NBinaryOp
op larg :: NValue t f m
larg rarg :: 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    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 c :: m (NValue t f m)
c b :: 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    (\b :: NValue t f m
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 (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 (SrcSpan
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> r -> r -> NExprLocF r
NWith_ SrcSpan
span Maybe (NValue t f m)
forall a. Maybe a
Nothing (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
b))) NValue t f m
b)
      (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 c :: NValue t f m
c t :: m (NValue t f m)
t f :: m (NValue t f m)
f = 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
c m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: Bool
b -> if Bool
b
      then
        (\t :: NValue t f m
t -> 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 (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
NIf_ SrcSpan
span (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
c) (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
t) Maybe (NValue t f m)
forall a. Maybe a
Nothing))
            NValue t f m
t
          )
          (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)
t
      else
        (\f :: 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)
scope (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
NIf_ SrcSpan
span (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
c) Maybe (NValue t f m)
forall a. Maybe a
Nothing (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
f)))
            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)
f

  evalAssert :: NValue t f m -> m (NValue t f m) -> m (NValue t f m)
evalAssert c :: NValue t f m
c body :: m (NValue t f m)
body = NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
c m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: Bool
b -> do
    SrcSpan
span <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    if Bool
b
      then 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)
currentScopes
        (\b :: NValue t f m
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 (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 (SrcSpan
-> Maybe (NValue t f m)
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> r -> r -> NExprLocF r
NAssert_ SrcSpan
span (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
c) (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
b))) NValue t f m
b
          )
          (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
      else 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

  evalApp :: NValue t f m -> m (NValue t f m) -> m (NValue t f m)
evalApp f :: NValue t f m
f x :: 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    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 (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
NBinary_ SrcSpan
span NBinaryOp
NApp (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just 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 p :: Params (m (NValue t f m))
p k :: 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)
currentScopes
    SrcSpan
span  <- m SrcSpan
forall e (m :: * -> *).
(MonadReader e m, Has e SrcSpan) =>
m SrcSpan
currentPos
    pure $ Provenance m (NValue t f m)
-> Params () -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m)
-> Params () -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvClosureP (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 (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
NAbs_ SrcSpan
span (Maybe (NValue t f m)
forall a. Maybe a
Nothing Maybe (NValue t f m)
-> Params (m (NValue t f m)) -> Params (Maybe (NValue t f m))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Params (m (NValue t f m))
p) Maybe (NValue t f m)
forall a. Maybe a
Nothing))
                      (Params (m (NValue t f m)) -> Params ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Params (m (NValue t f m))
p)
                      (\arg :: NValue t f m
arg -> ((), NValue t f m) -> NValue t f m
forall a b. (a, b) -> b
snd (((), 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)
-> (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 (NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
arg) (\_ b :: m (NValue t f m)
b -> ((), ) (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)
b))

  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 fun :: NValue t f m
fun arg :: NValue t f m
arg = NValue t f m
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
fun ((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ \fun' :: NValue t f m
fun' -> do
  Frames
frames :: Frames <- (e -> Frames) -> m Frames
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike Frames e e Frames Frames -> e -> Frames
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Frames e e Frames Frames
forall a b. Has a b => Lens' a b
hasLens)
  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
> 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
$ FilePath -> ErrorCall
ErrorCall
    "Function call stack exhausted"
  case NValue t f m
fun' of
    NVClosure _params :: Params ()
_params f :: NValue t f m -> m (NValue t f m)
f -> do
      NValue t f m -> m (NValue t f m)
f NValue t f m
arg
    NVBuiltin name :: FilePath
name f :: 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
currentPos
      NixLevel -> EvalFrame m t -> 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 (FilePath -> SrcSpan -> EvalFrame m t
forall (m :: * -> *) v. FilePath -> SrcSpan -> EvalFrame m v
Calling @m @t FilePath
name SrcSpan
span) (NValue t f m -> m (NValue t f m)
f NValue t f m
arg)
    s :: NValue t f m
s@(NVSet m :: AttrSet (NValue t f m)
m _) | Just f :: NValue t f m
f <- Text -> 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 "__functor" AttrSet (NValue t f m)
m -> do
      NValue t f m
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
f ((NValue t f m -> m (NValue t f m)) -> m (NValue t f 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 -> 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
s) (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 (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (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)
    x :: 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
$ FilePath -> ErrorCall
ErrorCall (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$ "Attempt to call non-function: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NValue t f m -> FilePath
forall a. Show a => a -> FilePath
show NValue t f m
x

execUnaryOp
  :: (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 scope :: Scopes m (NValue t f m)
scope span :: SrcSpan
span op :: NUnaryOp
op arg :: NValue t f m
arg = do
  case NValue t f m
arg of
    NVConstant c :: NAtom
c -> case (NUnaryOp
op, NAtom
c) of
      (NNeg, NInt i :: Integer
i  ) -> NAtom -> m (NValue t f m)
unaryOp (NAtom -> m (NValue t f m)) -> NAtom -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Integer -> NAtom
NInt (-Integer
i)
      (NNeg, NFloat f :: Float
f) -> NAtom -> m (NValue t f m)
unaryOp (NAtom -> m (NValue t f m)) -> NAtom -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Float -> NAtom
NFloat (-Float
f)
      (NNot, NBool b :: Bool
b ) -> NAtom -> m (NValue t f m)
unaryOp (NAtom -> m (NValue t f m)) -> NAtom -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Bool -> NAtom
NBool (Bool -> Bool
not Bool
b)
      _ ->
        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
$  FilePath -> ErrorCall
ErrorCall
          (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$  "unsupported argument type for unary operator "
          FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NUnaryOp -> FilePath
forall a. Show a => a -> FilePath
show NUnaryOp
op
    x :: 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
$  FilePath -> ErrorCall
ErrorCall
        (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$  "argument to unary operator"
        FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ " must evaluate to an atomic type: "
        FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NValue t f m -> FilePath
forall a. Show a => a -> FilePath
show NValue t f m
x
 where
  unaryOp :: NAtom -> m (NValue t f m)
unaryOp = 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
. Provenance m (NValue t f m) -> NAtom -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP (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 (SrcSpan
-> NUnaryOp
-> Maybe (NValue t f m)
-> NExprLocF (Maybe (NValue t f m))
forall r. SrcSpan -> NUnaryOp -> r -> NExprLocF r
NUnary_ SrcSpan
span NUnaryOp
op (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
arg)))

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 scope :: Scopes m (NValue t f m)
scope span :: SrcSpan
span op :: NBinaryOp
op lval :: NValue t f m
lval rarg :: m (NValue t f m)
rarg = case NBinaryOp
op of
  NEq   -> m (NValue t f m)
rarg m (NValue t f m)
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \rval :: NValue t f m
rval -> NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(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 m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval
  NNEq  -> m (NValue t f m)
rarg m (NValue t f m)
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \rval :: NValue t f m
rval -> NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(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 m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval (Bool -> m (NValue t f m))
-> (Bool -> Bool) -> Bool -> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
  NOr   -> NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
lval m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \l :: Bool
l -> if Bool
l
             then Bool -> m (NValue t f m)
bypass Bool
True
             else m (NValue t f m)
rarg m (NValue t f m)
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \rval :: NValue t f m
rval -> NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
rval m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval
  NAnd  -> NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
lval m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \l :: Bool
l -> if Bool
l
             then m (NValue t f m)
rarg m (NValue t f m)
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \rval :: NValue t f m
rval -> NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
rval m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval
             else Bool -> m (NValue t f m)
bypass Bool
False
  NImpl -> NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
lval m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \l :: Bool
l -> if Bool
l
             then m (NValue t f m)
rarg m (NValue t f m)
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \rval :: NValue t f m
rval -> NValue t f m -> m Bool
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
rval m Bool -> (Bool -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NValue t f m -> Bool -> m (NValue t f m)
boolOp NValue t f m
rval
             else Bool -> m (NValue t f m)
bypass Bool
True
  _     -> m (NValue t f m)
rarg m (NValue t f m)
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \rval :: NValue t f m
rval ->
             NValue t f m
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
rval ((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ \rval' :: NValue t f m
rval' ->
               NValue t f m
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
lval ((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ \lval' :: 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
  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 r :: Maybe (NValue t f m)
r b :: 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
$ Provenance m (NValue t f m) -> NAtom -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP
    (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 (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
NBinary_ SrcSpan
span NBinaryOp
op (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
lval) Maybe (NValue t f m)
r))
    (Bool -> NAtom
NBool Bool
b)
  boolOp :: NValue t f m -> Bool -> m (NValue t f m)
boolOp rval :: NValue t f m
rval = Maybe (NValue t f m) -> Bool -> m (NValue t f m)
toBoolOp (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just 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


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 scope :: Scopes m (NValue t f m)
scope span :: SrcSpan
span op :: NBinaryOp
op lval :: NValue t f m
lval rval :: NValue t f m
rval = case NBinaryOp
op of
  NLt  -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
compare forall a. Ord a => a -> a -> Bool
(<)
  NLte -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
compare forall a. Ord a => a -> a -> Bool
(<=)
  NGt  -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
compare forall a. Ord a => a -> a -> Bool
(>)
  NGte -> (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
compare forall a. Ord a => a -> a -> Bool
(>=)
  NMinus -> (forall a. Num a => a -> a -> a) -> m (NValue t f m)
numBinOp (-)
  NMult  -> (forall a. Num a => a -> a -> a) -> m (NValue t f m)
numBinOp forall a. Num a => a -> a -> a
(*)
  NDiv   -> (Integer -> Integer -> Integer)
-> (Float -> Float -> Float) -> m (NValue t f m)
numBinOp' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Float -> Float -> Float
forall a. Fractional a => a -> a -> a
(/)
  NConcat -> case (NValue t f m
lval, NValue t f m
rval) of
    (NVList ls :: [NValue t f m]
ls, NVList rs :: [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
$ Provenance m (NValue t f m) -> [NValue t f m] -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> [NValue t f m] -> NValue t f m
nvListP Provenance m (NValue t f m)
prov ([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. [a] -> [a] -> [a]
++ [NValue t f m]
rs
    _ -> m (NValue t f m)
unsupportedTypes

  NUpdate -> case (NValue t f m
lval, NValue t f m
rval) of
    (NVSet ls :: AttrSet (NValue t f m)
ls lp :: AttrSet SourcePos
lp, NVSet rs :: AttrSet (NValue t f m)
rs rp :: AttrSet SourcePos
rp) -> 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
$ Provenance m (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
nvSetP Provenance m (NValue t f m)
prov (AttrSet (NValue t f m)
rs AttrSet (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet (NValue t f m)
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`M.union` AttrSet (NValue t f m)
ls) (AttrSet SourcePos
rp AttrSet SourcePos -> AttrSet SourcePos -> AttrSet SourcePos
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`M.union` AttrSet SourcePos
lp)
    (NVSet ls :: AttrSet (NValue t f m)
ls lp :: AttrSet SourcePos
lp, NVConstant 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
$ Provenance m (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
nvSetP Provenance m (NValue t f m)
prov AttrSet (NValue t f m)
ls AttrSet SourcePos
lp
    (NVConstant NNull, NVSet rs :: AttrSet (NValue t f m)
rs rp :: AttrSet SourcePos
rp) -> 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
$ Provenance m (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m)
-> AttrSet (NValue t f m) -> AttrSet SourcePos -> NValue t f m
nvSetP Provenance m (NValue t f m)
prov AttrSet (NValue t f m)
rs AttrSet SourcePos
rp
    _ -> m (NValue t f m)
unsupportedTypes

  NPlus -> case (NValue t f m
lval, NValue t f m
rval) of
    (NVConstant _, NVConstant _) -> (forall a. Num a => a -> a -> a) -> m (NValue t f m)
numBinOp forall a. Num a => a -> a -> a
(+)

    (NVStr ls :: NixString
ls, NVStr rs :: 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
$ Provenance m (NValue t f m) -> NixString -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NixString -> NValue t f m
nvStrP Provenance m (NValue t f m)
prov (NixString
ls NixString -> NixString -> NixString
`principledStringMappend` NixString
rs)
    (NVStr ls :: NixString
ls, rs :: NValue t f m
rs@NVPath{}) ->
      (\rs2 :: NixString
rs2 -> Provenance m (NValue t f m) -> NixString -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NixString -> NValue t f m
nvStrP Provenance m (NValue t f m)
prov (NixString
ls NixString -> NixString -> NixString
`principledStringMappend` NixString
rs2))
        (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 -> CoercionLevel -> NValue t f m -> m NixString
forall e (m :: * -> *) t (f :: * -> *).
(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 -> CoercionLevel -> NValue t f m -> m NixString
coerceToString 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
CopyToStore CoercionLevel
CoerceStringy NValue t f m
rs
    (NVPath ls :: FilePath
ls, NVStr rs :: NixString
rs) -> case NixString -> Maybe Text
principledGetStringNoContext NixString
rs of
      Just rs2 :: Text
rs2 -> Provenance m (NValue t f m) -> FilePath -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> FilePath -> NValue t f m
nvPathP Provenance m (NValue t f m)
prov (FilePath -> NValue t f m) -> m FilePath -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
FilePath -> m FilePath
makeAbsolutePath @t @f (FilePath
ls FilePath -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` Text -> FilePath
Text.unpack Text
rs2)
      Nothing -> 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
$ FilePath -> ErrorCall
ErrorCall (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$
        -- data/nix/src/libexpr/eval.cc:1412
        "A string that refers to a store path cannot be appended to a path."
    (NVPath ls :: FilePath
ls, NVPath rs :: FilePath
rs) -> Provenance m (NValue t f m) -> FilePath -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> FilePath -> NValue t f m
nvPathP Provenance m (NValue t f m)
prov (FilePath -> NValue t f m) -> m FilePath -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
FilePath -> m FilePath
makeAbsolutePath @t @f (FilePath
ls FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
rs)

    (ls :: NValue t f m
ls@NVSet{}, NVStr rs :: NixString
rs) ->
      (\ls2 :: NixString
ls2 -> Provenance m (NValue t f m) -> NixString -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NixString -> NValue t f m
nvStrP Provenance m (NValue t f m)
prov (NixString
ls2 NixString -> NixString -> NixString
`principledStringMappend` 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 -> CoercionLevel -> NValue t f m -> m NixString
forall e (m :: * -> *) t (f :: * -> *).
(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 -> CoercionLevel -> NValue t f m -> m NixString
coerceToString 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 CoercionLevel
CoerceStringy NValue t f m
ls
    (NVStr ls :: NixString
ls, rs :: NValue t f m
rs@NVSet{}) ->
      (\rs2 :: NixString
rs2 -> Provenance m (NValue t f m) -> NixString -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NixString -> NValue t f m
nvStrP Provenance m (NValue t f m)
prov (NixString
ls NixString -> NixString -> NixString
`principledStringMappend` NixString
rs2))
        (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 -> CoercionLevel -> NValue t f m -> m NixString
forall e (m :: * -> *) t (f :: * -> *).
(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 -> CoercionLevel -> NValue t f m -> m NixString
coerceToString 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 CoercionLevel
CoerceStringy NValue t f m
rs
    _ -> m (NValue t f m)
unsupportedTypes

  NEq   -> m (NValue t f m)
alreadyHandled
  NNEq  -> m (NValue t f m)
alreadyHandled
  NAnd  -> m (NValue t f m)
alreadyHandled
  NOr   -> m (NValue t f m)
alreadyHandled
  NImpl -> m (NValue t f m)
alreadyHandled
  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
$ FilePath -> ErrorCall
ErrorCall (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$ "NApp should be handled by evalApp"

 where
  prov :: Provenance m (NValue t f m)
  prov :: Provenance m (NValue t f m)
prov = 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 (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
NBinary_ SrcSpan
span NBinaryOp
op (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
lval) (NValue t f m -> Maybe (NValue t f m)
forall a. a -> Maybe a
Just NValue t f m
rval))

  toBool :: Bool -> m (NValue t f m)
toBool = 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
. Provenance m (NValue t f m) -> NAtom -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP Provenance m (NValue t f m)
prov (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
  compare :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
  compare :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)
compare op :: forall a. Ord a => a -> a -> Bool
op = case (NValue t f m
lval, NValue t f m
rval) of
    (NVConstant l :: NAtom
l, NVConstant r :: NAtom
r) -> Bool -> m (NValue t f m)
toBool (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 l :: NixString
l, NVStr r :: NixString
r) -> Bool -> m (NValue t f m)
toBool (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
    _ -> m (NValue t f m)
unsupportedTypes

  toInt :: Integer -> m (NValue t f m)
toInt = 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
. Provenance m (NValue t f m) -> NAtom -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP Provenance m (NValue t f m)
prov (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
  toFloat :: Float -> m (NValue t f m)
toFloat = 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
. Provenance m (NValue t f m) -> NAtom -> NValue t f m
forall t (f :: * -> *) (m :: * -> *).
MonadCited t f m =>
Provenance m (NValue t f m) -> NAtom -> NValue t f m
nvConstantP Provenance m (NValue t f m)
prov (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

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

  numBinOp'
    :: (Integer -> Integer -> Integer)
    -> (Float -> Float -> Float)
    -> m (NValue t f m)

  numBinOp' :: (Integer -> Integer -> Integer)
-> (Float -> Float -> Float) -> m (NValue t f m)
numBinOp' intOp :: Integer -> Integer -> Integer
intOp floatOp :: Float -> Float -> Float
floatOp = case (NValue t f m
lval, NValue t f m
rval) of
    (NVConstant l :: NAtom
l, NVConstant r :: NAtom
r) -> case (NAtom
l, NAtom
r) of
      (NInt   li :: Integer
li, NInt   ri :: Integer
ri) -> Integer -> m (NValue t f m)
toInt (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   li :: Integer
li, NFloat rf :: Float
rf) -> Float -> m (NValue t f m)
toFloat (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 lf :: Float
lf, NInt   ri :: Integer
ri) -> Float -> m (NValue t f m)
toFloat (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 lf :: Float
lf, NFloat rf :: Float
rf) -> Float -> m (NValue t f m)
toFloat (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
      _ -> m (NValue t f m)
unsupportedTypes
    _ -> 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
$ FilePath -> ErrorCall
ErrorCall (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$
    "Unsupported argument types for binary operator "
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NBinaryOp -> FilePath
forall a. Show a => a -> FilePath
show NBinaryOp
op
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ": "
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NValue t f m -> FilePath
forall a. Show a => a -> FilePath
show NValue t f m
lval
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ", "
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NValue t f m -> FilePath
forall a. Show a => a -> FilePath
show NValue t f m
rval

  alreadyHandled :: m (NValue t f m)
alreadyHandled = 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
$ FilePath -> ErrorCall
ErrorCall (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$
    "This cannot happen: operator "
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NBinaryOp -> FilePath
forall a. Show a => a -> FilePath
show NBinaryOp
op
      FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ " 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 ns :: NixString
ns = case NixString -> Maybe Text
principledGetStringNoContext NixString
ns of
  Just str :: Text
str -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
str
  Nothing  -> 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
$ FilePath -> ErrorCall
ErrorCall (FilePath -> ErrorCall) -> FilePath -> ErrorCall
forall a b. (a -> b) -> a -> b
$ "expected string with no context, but got " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ NixString -> FilePath
forall a. Show a => a -> FilePath
show NixString
ns

addTracing
  :: (MonadNix e t f m, Has e Options, MonadReader Int n, Alternative n)
  => Alg NExprLocF (m a)
  -> Alg NExprLocF (n (m a))
addTracing :: Alg NExprLocF (m a) -> Alg NExprLocF (n (m a))
addTracing k :: Alg NExprLocF (m a)
k v :: 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 (Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 (Ann SrcSpan) NExprF (m a)
v'@(Compose (Ann span :: SrcSpan
span x :: NExprF (m a)
x)) <- NExprLocF (n (m a)) -> n (Compose (Ann SrcSpan) NExprF (m a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence 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 :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens)
      let rendered :: Doc Any
rendered = if Options -> Verbosity
verbose Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Chatty
#ifdef MIN_VERSION_pretty_show
                     then FilePath -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (FilePath -> Doc Any) -> FilePath -> Doc Any
forall a b. (a -> b) -> a -> b
$ NExprF () -> FilePath
forall a. Show a => a -> FilePath
PS.ppShow (NExprF (m a) -> NExprF ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void NExprF (m a)
x)
#else
            then pretty $ show (void x)
#endif
            else NExpr -> Doc Any
forall ann. NExpr -> Doc ann
prettyNix (NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Text -> NExprF NExpr
forall r. Text -> NExprF r
NSym "?") NExpr -> NExprF (m a) -> NExprF NExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprF (m a)
x))
          msg :: Doc Any -> Doc Any
msg x :: Doc Any
x = FilePath -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty ("eval: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
depth ' ') 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 -> Doc Any
msg Doc Any
rendered Doc Any -> Doc Any -> Doc Any
forall a. Semigroup a => a -> a -> a
<> " ...\n")
      FilePath -> m ()
forall (m :: * -> *). MonadPutStr m => FilePath -> m ()
putStr (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ Doc Any -> FilePath
forall a. Show a => a -> FilePath
show Doc Any
loc
      a
res <- Alg NExprLocF (m a)
k Compose (Ann 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
<> " ...done"
      pure a
res

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 expr :: NExprLoc
expr = do
  Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens)
  if Options -> Bool
tracing Options
opts
    then 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))
-> (ReaderT Int m (m (NValue t f m)) -> m (m (NValue t f m)))
-> ReaderT Int m (m (NValue t f m))
-> 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` (0 :: Int)) (ReaderT Int m (m (NValue t f m)) -> m (NValue t f m))
-> ReaderT Int m (m (NValue t f m)) -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ (Compose (Ann SrcSpan) NExprF (ReaderT Int m (m (NValue t f m)))
 -> ReaderT Int m (m (NValue t f m)))
-> ((NExprLoc -> ReaderT Int m (m (NValue t f m)))
    -> NExprLoc -> ReaderT Int m (m (NValue t f m)))
-> NExprLoc
-> ReaderT Int m (m (NValue t f m))
forall (f :: * -> *) a.
Functor f =>
(f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
adi
      (Alg NExprLocF (m (NValue t f m))
-> Compose (Ann SrcSpan) NExprF (ReaderT Int m (m (NValue t f m)))
-> ReaderT Int m (m (NValue t f m))
forall e t (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
(MonadNix e t f m, Has e Options, MonadReader Int n,
 Alternative n) =>
Alg NExprLocF (m a) -> Alg NExprLocF (n (m a))
addTracing Alg NExprLocF (m (NValue t f m))
forall ann.
Compose (Ann ann) NExprF (m (NValue t f m)) -> m (NValue t f m)
phi)
      (((NExprLoc -> m (m (NValue t f m)))
 -> NExprLoc -> m (m (NValue t f m)))
-> (NExprLoc -> ReaderT Int m (m (NValue t f m)))
-> NExprLoc
-> ReaderT Int m (m (NValue t f m))
forall t (m :: * -> *) a t (m :: * -> *) a r.
((t -> m a) -> t -> m a)
-> (t -> ReaderT r m a) -> t -> ReaderT r m a
raise (forall v e (m :: * -> *) a.
(Scoped v m, Framed e m, Typeable v, Typeable m) =>
Transform NExprLocF (m a)
forall e (m :: * -> *) a.
(Scoped (NValue t f m) m, Framed e m, Typeable (NValue t f m),
 Typeable m) =>
Transform NExprLocF (m a)
addStackFrames @(NValue t f m) ((NExprLoc -> m (m (NValue t f m)))
 -> NExprLoc -> m (m (NValue t f m)))
-> ((NExprLoc -> m (m (NValue t f m)))
    -> NExprLoc -> m (m (NValue t f m)))
-> (NExprLoc -> m (m (NValue t f m)))
-> NExprLoc
-> m (m (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprLoc -> m (m (NValue t f m)))
-> NExprLoc -> m (m (NValue t f m))
forall e (m :: * -> *) a.
(MonadReader e m, Has e SrcSpan) =>
Transform NExprLocF (m a)
addSourcePositions))
      NExprLoc
expr
    else Alg NExprLocF (m (NValue t f m))
-> ((NExprLoc -> m (NValue t f m)) -> NExprLoc -> m (NValue t f m))
-> NExprLoc
-> m (NValue t f m)
forall (f :: * -> *) a.
Functor f =>
(f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
adi Alg NExprLocF (m (NValue t f m))
forall ann.
Compose (Ann ann) NExprF (m (NValue t f m)) -> m (NValue t f m)
phi (forall v e (m :: * -> *) a.
(Scoped v m, Framed e m, Typeable v, Typeable m) =>
Transform NExprLocF (m a)
forall e (m :: * -> *) a.
(Scoped (NValue t f m) m, Framed e m, Typeable (NValue t f m),
 Typeable m) =>
Transform NExprLocF (m a)
addStackFrames @(NValue t f m) ((NExprLoc -> m (NValue t f m)) -> NExprLoc -> m (NValue t f m))
-> ((NExprLoc -> m (NValue t f m)) -> NExprLoc -> m (NValue t f m))
-> (NExprLoc -> m (NValue t f m))
-> NExprLoc
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprLoc -> m (NValue t f m)) -> NExprLoc -> m (NValue t f m)
forall e (m :: * -> *) a.
(MonadReader e m, Has e SrcSpan) =>
Transform NExprLocF (m a)
addSourcePositions) NExprLoc
expr
 where
  phi :: Compose (Ann ann) NExprF (m (NValue t f m)) -> m (NValue t f m)
phi = NExprF (m (NValue t f m)) -> m (NValue t f m)
forall v (m :: * -> *). MonadNixEval v m => NExprF (m v) -> m v
Eval.eval (NExprF (m (NValue t f m)) -> m (NValue t f m))
-> (Compose (Ann ann) NExprF (m (NValue t f m))
    -> NExprF (m (NValue t f m)))
-> Compose (Ann ann) NExprF (m (NValue t f m))
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann ann (NExprF (m (NValue t f m))) -> NExprF (m (NValue t f m))
forall ann a. Ann ann a -> a
annotated (Ann ann (NExprF (m (NValue t f m))) -> NExprF (m (NValue t f m)))
-> (Compose (Ann ann) NExprF (m (NValue t f m))
    -> Ann ann (NExprF (m (NValue t f m))))
-> Compose (Ann ann) NExprF (m (NValue t f m))
-> NExprF (m (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Ann ann) NExprF (m (NValue t f m))
-> Ann ann (NExprF (m (NValue t f m)))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  raise :: ((t -> m a) -> t -> m a)
-> (t -> ReaderT r m a) -> t -> ReaderT r m a
raise k :: (t -> m a) -> t -> m a
k f :: t -> ReaderT r m a
f x :: t
x = (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) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \e :: r
e -> (t -> m a) -> t -> m a
k (\t :: t
t -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (t -> ReaderT r m a
f t
t) r
e) t
x

exec :: (MonadNix e t f m, MonadInstantiate m) => [String] -> m (NValue t f m)
exec :: [FilePath] -> m (NValue t f m)
exec args :: [FilePath]
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
=<< [FilePath] -> m (Either ErrorCall NExprLoc)
forall (m :: * -> *).
MonadExec m =>
[FilePath] -> m (Either ErrorCall NExprLoc)
exec' [FilePath]
args

nixInstantiateExpr
  :: (MonadNix e t f m, MonadInstantiate m) => String -> m (NValue t f m)
nixInstantiateExpr :: FilePath -> m (NValue t f m)
nixInstantiateExpr s :: FilePath
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
=<< FilePath -> m (Either ErrorCall NExprLoc)
forall (m :: * -> *).
MonadInstantiate m =>
FilePath -> m (Either ErrorCall NExprLoc)
instantiateExpr FilePath
s