{-# language AllowAmbiguousTypes #-}
{-# language ConstraintKinds #-}
{-# language RankNTypes #-}


module Nix.Eval where

import           Nix.Prelude
import           Relude.Extra                   ( set )
import           Control.Monad                  ( foldM )
import           Control.Monad.Fix              ( MonadFix )
import           GHC.Exception                  ( ErrorCall(ErrorCall) )
import           Data.Semialign.Indexed         ( ialignWith )
import qualified Data.HashMap.Lazy             as M
import           Data.List                      ( partition )
import           Data.These                     ( These(..) )
import           Nix.Atoms
import           Nix.Convert
import           Nix.Expr.Types
import           Nix.Expr.Types.Annotated
import           Nix.Expr.Strings               ( runAntiquoted )
import           Nix.Frames
import           Nix.String
import           Nix.Scope
import           Nix.Value.Monad

class (Show v, Monad m) => MonadEval v m where
  freeVariable    :: VarName -> m v
  synHole         :: VarName -> m v
  attrMissing     :: NonEmpty VarName -> Maybe v -> m v
  evaledSym       :: VarName -> v -> m v
  evalCurPos      :: m v
  evalConstant    :: NAtom -> m v
  evalString      :: NString (m v) -> m v
  evalLiteralPath :: Path -> m v
  evalEnvPath     :: Path -> m v
  evalUnary       :: NUnaryOp -> v -> m v
  evalBinary      :: NBinaryOp -> v -> m v -> m v
  -- ^ The second argument is an action because operators such as boolean &&
  -- and || may not evaluate the second argument.
  evalWith        :: m v -> m v -> m v
  evalIf          :: v -> m v -> m v -> m v
  evalAssert      :: v -> m v -> m v
  evalApp         :: v -> m v -> m v
  evalAbs         :: Params (m v)
                  -> ( forall a
                    . m v
                    -> ( AttrSet (m v)
                      -> m v
                      -> m (a, v)
                      )
                    -> m (a, v)
                    )
                  -> m v
{-
  evalSelect     :: v -> NonEmpty Text -> Maybe (m v) -> m v
  evalHasAttr    :: v -> NonEmpty Text -> m v

  -- | This and the following methods are intended to allow things like
  --   adding provenance information.
  evalListElem   :: [m v] -> Int -> m v -> m v
  evalList       :: [v] -> m v
  evalSetElem    :: AttrSet (m v) -> Text -> m v -> m v
  evalSet        :: AttrSet v -> PositionSet -> m v
  evalRecSetElem :: AttrSet (m v) -> Text -> m v -> m v
  evalRecSet     :: AttrSet v -> PositionSet -> m v
  evalLetElem    :: Text -> m v -> m v
  evalLet        :: m v -> m v
-}
  evalError :: Exception s => s -> m a

type MonadNixEval v m
  = ( MonadEval v m
  , Scoped v m
  , MonadValue v m
  , MonadFix m
  , ToValue Bool m v
  , ToValue [v] m v
  , FromValue NixString m v
  , ToValue (AttrSet v, PositionSet) m v
  , FromValue (AttrSet v, PositionSet) m v
  )

data EvalFrame m v
  = EvaluatingExpr (Scopes m v) NExprLoc
  | ForcingExpr (Scopes m v) NExprLoc
  | Calling VarName SrcSpan
  | SynHole (SynHoleInfo m v)
  deriving (Int -> EvalFrame m v -> ShowS
[EvalFrame m v] -> ShowS
EvalFrame m v -> String
(Int -> EvalFrame m v -> ShowS)
-> (EvalFrame m v -> String)
-> ([EvalFrame m v] -> ShowS)
-> Show (EvalFrame m v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) v. Int -> EvalFrame m v -> ShowS
forall (m :: * -> *) v. [EvalFrame m v] -> ShowS
forall (m :: * -> *) v. EvalFrame m v -> String
showList :: [EvalFrame m v] -> ShowS
$cshowList :: forall (m :: * -> *) v. [EvalFrame m v] -> ShowS
show :: EvalFrame m v -> String
$cshow :: forall (m :: * -> *) v. EvalFrame m v -> String
showsPrec :: Int -> EvalFrame m v -> ShowS
$cshowsPrec :: forall (m :: * -> *) v. Int -> EvalFrame m v -> ShowS
Show, Typeable)

instance (Typeable m, Typeable v) => Exception (EvalFrame m v)

data SynHoleInfo m v = SynHoleInfo
  { SynHoleInfo m v -> NExprLoc
_synHoleInfo_expr :: NExprLoc
  , SynHoleInfo m v -> Scopes m v
_synHoleInfo_scope :: Scopes m v
  }
  deriving (Int -> SynHoleInfo m v -> ShowS
[SynHoleInfo m v] -> ShowS
SynHoleInfo m v -> String
(Int -> SynHoleInfo m v -> ShowS)
-> (SynHoleInfo m v -> String)
-> ([SynHoleInfo m v] -> ShowS)
-> Show (SynHoleInfo m v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) v. Int -> SynHoleInfo m v -> ShowS
forall (m :: * -> *) v. [SynHoleInfo m v] -> ShowS
forall (m :: * -> *) v. SynHoleInfo m v -> String
showList :: [SynHoleInfo m v] -> ShowS
$cshowList :: forall (m :: * -> *) v. [SynHoleInfo m v] -> ShowS
show :: SynHoleInfo m v -> String
$cshow :: forall (m :: * -> *) v. SynHoleInfo m v -> String
showsPrec :: Int -> SynHoleInfo m v -> ShowS
$cshowsPrec :: forall (m :: * -> *) v. Int -> SynHoleInfo m v -> ShowS
Show, Typeable)

instance (Typeable m, Typeable v) => Exception (SynHoleInfo m v)

-- jww (2019-03-18): By deferring only those things which must wait until
-- context of us, this can be written as:
-- eval :: forall v m . MonadNixEval v m => NExprF v -> m v
eval :: forall v m . MonadNixEval v m => NExprF (m v) -> m v

eval :: NExprF (m v) -> m v
eval (NSym VarName
"__curPos") = m v
forall v (m :: * -> *). MonadEval v m => m v
evalCurPos

eval (NSym VarName
var       ) =
  do
    Maybe v
mVal <- VarName -> m (Maybe v)
forall a (m :: * -> *). Scoped a m => VarName -> m (Maybe a)
lookupVar VarName
var
    m v -> (v -> m v) -> Maybe v -> m v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (VarName -> m v
forall v (m :: * -> *). MonadEval v m => VarName -> m v
freeVariable VarName
var)
      (VarName -> v -> m v
forall v (m :: * -> *). MonadEval v m => VarName -> v -> m v
evaledSym VarName
var (v -> m v) -> (v -> m v) -> v -> m v
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< v -> m v
forall v (m :: * -> *). MonadValue v m => v -> m v
demand)
      Maybe v
mVal

eval (NConstant    NAtom
x      ) = NAtom -> m v
forall v (m :: * -> *). MonadEval v m => NAtom -> m v
evalConstant NAtom
x
eval (NStr         NString (m v)
str    ) = NString (m v) -> m v
forall v (m :: * -> *). MonadEval v m => NString (m v) -> m v
evalString NString (m v)
str
eval (NLiteralPath Path
p      ) = Path -> m v
forall v (m :: * -> *). MonadEval v m => Path -> m v
evalLiteralPath Path
p
eval (NEnvPath     Path
p      ) = Path -> m v
forall v (m :: * -> *). MonadEval v m => Path -> m v
evalEnvPath Path
p
eval (NUnary NUnaryOp
op m v
arg       ) = NUnaryOp -> v -> m v
forall v (m :: * -> *). MonadEval v m => NUnaryOp -> v -> m v
evalUnary NUnaryOp
op (v -> m v) -> m v -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m v
arg

eval (NBinary NBinaryOp
NApp m v
fun m v
arg) =
  do
    v
f <- m v
fun
    Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
    v -> m v -> m v
forall v (m :: * -> *). MonadEval v m => v -> m v -> m v
evalApp v
f (m v -> m v) -> m v -> m v
forall a b. (a -> b) -> a -> b
$ Scopes m v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
scope m v
arg

eval (NBinary NBinaryOp
op   m v
larg m v
rarg) =
  do
    v
lav <- m v
larg
    NBinaryOp -> v -> m v -> m v
forall v (m :: * -> *).
MonadEval v m =>
NBinaryOp -> v -> m v -> m v
evalBinary NBinaryOp
op v
lav m v
rarg

eval (NSelect Maybe (m v)
alt m v
aset NAttrPath (m v)
attr) =
  do
    let useAltOrReportMissing :: (v, NonEmpty VarName) -> m v
useAltOrReportMissing (v
s, NonEmpty VarName
ks) = m v -> Maybe (m v) -> m v
forall a. a -> Maybe a -> a
fromMaybe (NonEmpty VarName -> Maybe v -> m v
forall v (m :: * -> *).
MonadEval v m =>
NonEmpty VarName -> Maybe v -> m v
attrMissing NonEmpty VarName
ks (Maybe v -> m v) -> Maybe v -> m v
forall a b. (a -> b) -> a -> b
$ v -> Maybe v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
s) Maybe (m v)
alt

    Either (v, NonEmpty VarName) (m v)
eAttr <- m v -> NAttrPath (m v) -> m (Either (v, NonEmpty VarName) (m v))
forall v (m :: * -> *).
MonadNixEval v m =>
m v -> NAttrPath (m v) -> m (Either (v, NonEmpty VarName) (m v))
evalSelect m v
aset NAttrPath (m v)
attr
    ((v, NonEmpty VarName) -> m v)
-> (m v -> m v) -> Either (v, NonEmpty VarName) (m v) -> m v
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (v, NonEmpty VarName) -> m v
useAltOrReportMissing m v -> m v
forall a. a -> a
id (Either (v, NonEmpty VarName) (m v)
-> Either (v, NonEmpty VarName) (m v)
coerce Either (v, NonEmpty VarName) (m v)
eAttr)

eval (NHasAttr m v
aset NAttrPath (m v)
attr) =
  do
    Either (v, NonEmpty VarName) (m v)
eAttr <- m v -> NAttrPath (m v) -> m (Either (v, NonEmpty VarName) (m v))
forall v (m :: * -> *).
MonadNixEval v m =>
m v -> NAttrPath (m v) -> m (Either (v, NonEmpty VarName) (m v))
evalSelect m v
aset NAttrPath (m v)
attr
    Bool -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue (Bool -> m v) -> Bool -> m v
forall a b. (a -> b) -> a -> b
$ Either (v, NonEmpty VarName) (m v) -> Bool
forall a b. Either a b -> Bool
isRight Either (v, NonEmpty VarName) (m v)
eAttr

eval (NList [m v]
l           ) =
  do
    Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
    [v] -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue ([v] -> m v) -> m [v] -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (m v -> m v) -> [m v] -> m [v]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (MonadValue v m => m v -> m v
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer @v @m (m v -> m v) -> (m v -> m v) -> m v -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopes m v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes @v Scopes m v
scope) [m v]
l

eval (NSet Recursivity
r [Binding (m v)]
binds) =
  do
    (AttrSet v, PositionSet)
attrSet <- Bool -> [Binding (m v)] -> m (AttrSet v, PositionSet)
forall v (m :: * -> *).
MonadNixEval v m =>
Bool -> [Binding (m v)] -> m (AttrSet v, PositionSet)
evalBinds (Recursivity
r Recursivity -> Recursivity -> Bool
forall a. Eq a => a -> a -> Bool
== Recursivity
Recursive) ([Binding (m v)] -> m (AttrSet v, PositionSet))
-> [Binding (m v)] -> m (AttrSet v, PositionSet)
forall a b. (a -> b) -> a -> b
$ ([Binding (m v)] -> m v) -> [Binding (m v)] -> [Binding (m v)]
forall r. ([Binding r] -> r) -> [Binding r] -> [Binding r]
desugarBinds (NExprF (m v) -> m v
forall v (m :: * -> *). MonadNixEval v m => NExprF (m v) -> m v
eval (NExprF (m v) -> m v)
-> ([Binding (m v)] -> NExprF (m v)) -> [Binding (m v)] -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recursivity -> [Binding (m v)] -> NExprF (m v)
forall r. Recursivity -> [Binding r] -> NExprF r
NSet Recursivity
forall a. Monoid a => a
mempty) [Binding (m v)]
binds
    (AttrSet v, PositionSet) -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue (AttrSet v, PositionSet)
attrSet

eval (NLet [Binding (m v)]
binds m v
body    ) =
  do
    (AttrSet v
attrSet, PositionSet
_) <- Bool -> [Binding (m v)] -> m (AttrSet v, PositionSet)
forall v (m :: * -> *).
MonadNixEval v m =>
Bool -> [Binding (m v)] -> m (AttrSet v, PositionSet)
evalBinds Bool
True [Binding (m v)]
binds
    Scope v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scope a -> m r -> m r
pushScope (AttrSet v -> Scope v
coerce AttrSet v
attrSet) m v
body

eval (NIf m v
cond m v
t m v
f       ) =
  do
    v
v <- m v
cond
    v -> m v -> m v -> m v
forall v (m :: * -> *). MonadEval v m => v -> m v -> m v -> m v
evalIf v
v m v
t m v
f

eval (NWith   m v
scope  m v
body) = m v -> m v -> m v
forall v (m :: * -> *). MonadEval v m => m v -> m v -> m v
evalWith m v
scope m v
body

eval (NAssert m v
cond   m v
body) =
  do
    v
x <- m v
cond
    v -> m v -> m v
forall v (m :: * -> *). MonadEval v m => v -> m v -> m v
evalAssert v
x m v
body

eval (NAbs    Params (m v)
params m v
body) = do
  -- It is the environment at the definition site, not the call site, that
  -- needs to be used when evaluating the body and default arguments, hence we
  -- defer here so the present scope is restored when the parameters and body
  -- are forced during application.
  Scopes m v
curScope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
  let
    withCurScope :: m r -> m r
withCurScope = Scopes m v -> m r -> m r
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
curScope

    fun :: m v -> (AttrSet (m v) -> m v -> m r) -> m r
    fun :: m v -> (AttrSet (m v) -> m v -> m r) -> m r
fun m v
arg AttrSet (m v) -> m v -> m r
k =
      m r -> m r
forall r. m r -> m r
withCurScope (m r -> m r) -> m r -> m r
forall a b. (a -> b) -> a -> b
$
        do
          (AttrSet v -> Scope v
coerce -> Scope v
newScopeToAdd) <- Params (m v) -> m v -> m (AttrSet v)
forall v (m :: * -> *).
MonadNixEval v m =>
Params (m v) -> m v -> m (AttrSet v)
buildArgument Params (m v)
params m v
arg
          Scope v -> m r -> m r
forall a (m :: * -> *) r. Scoped a m => Scope a -> m r -> m r
pushScope
            Scope v
newScopeToAdd (m r -> m r) -> m r -> m r
forall a b. (a -> b) -> a -> b
$
            AttrSet (m v) -> m v -> m r
k
              (Scope (m v) -> AttrSet (m v)
coerce (Scope (m v) -> AttrSet (m v)) -> Scope (m v) -> AttrSet (m v)
forall a b. (a -> b) -> a -> b
$ m v -> m v
forall r. m r -> m r
withCurScope (m v -> m v) -> (v -> m v) -> v -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> m v
forall v (m :: * -> *). MonadValue v m => v -> m v
inform (v -> m v) -> Scope v -> Scope (m v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scope v
newScopeToAdd)
              m v
body

  Params (m v)
-> (forall a.
    m v -> (AttrSet (m v) -> m v -> m (a, v)) -> m (a, v))
-> m v
forall v (m :: * -> *).
MonadEval v m =>
Params (m v)
-> (forall a.
    m v -> (AttrSet (m v) -> m v -> m (a, v)) -> m (a, v))
-> m v
evalAbs
    Params (m v)
params
    forall r. m v -> (AttrSet (m v) -> m v -> m r) -> m r
forall a. m v -> (AttrSet (m v) -> m v -> m (a, v)) -> m (a, v)
fun

eval (NSynHole VarName
name) = VarName -> m v
forall v (m :: * -> *). MonadEval v m => VarName -> m v
synHole VarName
name

-- | If you know that the 'scope' action will result in an 'AttrSet v', then
--   this implementation may be used as an implementation for 'evalWith'.
evalWithAttrSet :: forall v m . MonadNixEval v m => m v -> m v -> m v
evalWithAttrSet :: m v -> m v -> m v
evalWithAttrSet m v
aset m v
body = do
  Scopes m v
scopes <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
  -- The scope is deliberately wrapped in a thunk here, since it is demanded
  -- each time a name is looked up within the weak scope, and we want to be
  -- sure the action it evaluates is to force a thunk, so its value is only
  -- computed once.
  v
deferredAset <- m v -> m v
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (m v -> m v) -> m v -> m v
forall a b. (a -> b) -> a -> b
$ Scopes m v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
scopes m v
aset
  let weakscope :: m (Scope v)
weakscope = AttrSet v -> Scope v
coerce (AttrSet v -> Scope v)
-> ((AttrSet v, PositionSet) -> AttrSet v)
-> (AttrSet v, PositionSet)
-> Scope v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrSet v, PositionSet) -> AttrSet v
forall a b. (a, b) -> a
fst ((AttrSet v, PositionSet) -> Scope v)
-> m (AttrSet v, PositionSet) -> m (Scope v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, PositionSet) m v =>
v -> m (AttrSet v, PositionSet)
fromValue @(AttrSet v, PositionSet) (v -> m (AttrSet v, PositionSet))
-> m v -> m (AttrSet v, PositionSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v -> m v
forall v (m :: * -> *). MonadValue v m => v -> m v
demand v
deferredAset)

  m (Scope v) -> m v -> m v
forall (m :: * -> *) a r.
(Functor m, Scoped a m) =>
m (Scope a) -> m r -> m r
pushWeakScope m (Scope v)
weakscope m v
body

attrSetAlter
  :: forall v m
   . MonadNixEval v m
  => [VarName]
  -> SourcePos
  -> AttrSet (m v)
  -> PositionSet
  -> m v
  -> m (AttrSet (m v), PositionSet)
attrSetAlter :: [VarName]
-> SourcePos
-> AttrSet (m v)
-> PositionSet
-> m v
-> m (AttrSet (m v), PositionSet)
attrSetAlter [VarName]
ks' SourcePos
pos AttrSet (m v)
m' PositionSet
p' m v
val =
  (PositionSet, AttrSet (m v)) -> (AttrSet (m v), PositionSet)
forall a b. (a, b) -> (b, a)
swap ((PositionSet, AttrSet (m v)) -> (AttrSet (m v), PositionSet))
-> m (PositionSet, AttrSet (m v)) -> m (AttrSet (m v), PositionSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionSet
-> AttrSet (m v) -> [VarName] -> m (PositionSet, AttrSet (m v))
go PositionSet
p' AttrSet (m v)
m' [VarName]
ks'
 where
  -- This `go` does traverse in disquise. Notice how it traverses `ks`.
  go
    :: PositionSet
    -> AttrSet (m v)
    -> [VarName]
    -> m (PositionSet, AttrSet (m v))
  go :: PositionSet
-> AttrSet (m v) -> [VarName] -> m (PositionSet, AttrSet (m v))
go PositionSet
_ AttrSet (m v)
_ [] = forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a. (MonadEval v m, Exception s) => s -> m a
evalError @v (ErrorCall -> m (PositionSet, AttrSet (m v)))
-> ErrorCall -> m (PositionSet, AttrSet (m v))
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"invalid selector with no components"
  go PositionSet
p AttrSet (m v)
m (VarName
k : [VarName]
ks) =
    m (PositionSet, AttrSet (m v))
-> m (PositionSet, AttrSet (m v))
-> Bool
-> m (PositionSet, AttrSet (m v))
forall a. a -> a -> Bool -> a
bool
      ((PositionSet, AttrSet (m v)) -> m (PositionSet, AttrSet (m v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PositionSet, AttrSet (m v)) -> m (PositionSet, AttrSet (m v)))
-> (PositionSet, AttrSet (m v)) -> m (PositionSet, AttrSet (m v))
forall a b. (a -> b) -> a -> b
$ m v -> (PositionSet, AttrSet (m v))
insertVal m v
val)
      (m (PositionSet, AttrSet (m v))
-> (m v -> m (PositionSet, AttrSet (m v)))
-> Maybe (m v)
-> m (PositionSet, AttrSet (m v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (PositionSet -> AttrSet (m v) -> m (PositionSet, AttrSet (m v))
recurse PositionSet
forall a. Monoid a => a
mempty AttrSet (m v)
forall a. Monoid a => a
mempty)
        (\m v
x ->
          do
            --  2021-10-12: NOTE: swapping sourcewide into (PositionSet, AttrSet) would optimize code and remove this `swap`
            ((AttrSet v, PositionSet) -> (PositionSet, AttrSet v)
forall a b. (a, b) -> (b, a)
swap -> (PositionSet
sp, AttrSet v
st)) <- forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, PositionSet) m v =>
v -> m (AttrSet v, PositionSet)
fromValue @(AttrSet v, PositionSet) (v -> m (AttrSet v, PositionSet))
-> m v -> m (AttrSet v, PositionSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m v
x
            PositionSet -> AttrSet (m v) -> m (PositionSet, AttrSet (m v))
recurse PositionSet
sp (AttrSet (m v) -> m (PositionSet, AttrSet (m v)))
-> AttrSet (m v) -> m (PositionSet, AttrSet (m v))
forall a b. (a -> b) -> a -> b
$ v -> m v
forall v (m :: * -> *). MonadValue v m => v -> m v
demand (v -> m v) -> AttrSet v -> AttrSet (m v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet v
st
        )
        ((VarName -> AttrSet (m v) -> Maybe (m v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`M.lookup` AttrSet (m v)
m) VarName
k)
      )
      (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [VarName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VarName]
ks)
   where
    insertVal :: m v -> (PositionSet, AttrSet (m v))
    insertVal :: m v -> (PositionSet, AttrSet (m v))
insertVal m v
v =
      ( PositionSet
insertPos
      , m v -> AttrSet (m v)
insertV m v
v
      )
     where
      insertV :: m v -> AttrSet (m v)
insertV m v
v' = VarName -> m v -> AttrSet (m v) -> AttrSet (m v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert VarName
k m v
v' AttrSet (m v)
m
      insertPos :: PositionSet
insertPos = VarName -> SourcePos -> PositionSet -> PositionSet
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert VarName
k SourcePos
pos PositionSet
p

    recurse
      :: PositionSet
      -> AttrSet (m v)
      -> m ( PositionSet
          , AttrSet (m v)
          )
    recurse :: PositionSet -> AttrSet (m v) -> m (PositionSet, AttrSet (m v))
recurse PositionSet
p'' AttrSet (m v)
m'' =
      m v -> (PositionSet, AttrSet (m v))
insertVal (m v -> (PositionSet, AttrSet (m v)))
-> ((PositionSet, AttrSet (m v)) -> m v)
-> (PositionSet, AttrSet (m v))
-> (PositionSet, AttrSet (m v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a (m :: * -> *) v. ToValue a m v => a -> m v
forall (m :: * -> *) v.
ToValue (AttrSet v, PositionSet) m v =>
(AttrSet v, PositionSet) -> m v
toValue @(AttrSet v, PositionSet)) ((AttrSet v, PositionSet) -> m v)
-> ((PositionSet, AttrSet (m v)) -> m (AttrSet v, PositionSet))
-> (PositionSet, AttrSet (m v))
-> m v
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ((,PositionSet
forall a. Monoid a => a
mempty) (AttrSet v -> (AttrSet v, PositionSet))
-> m (AttrSet v) -> m (AttrSet v, PositionSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (AttrSet v) -> m (AttrSet v, PositionSet))
-> ((PositionSet, AttrSet (m v)) -> m (AttrSet v))
-> (PositionSet, AttrSet (m v))
-> m (AttrSet v, PositionSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrSet (m v) -> m (AttrSet v)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (AttrSet (m v) -> m (AttrSet v))
-> ((PositionSet, AttrSet (m v)) -> AttrSet (m v))
-> (PositionSet, AttrSet (m v))
-> m (AttrSet v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PositionSet, AttrSet (m v)) -> AttrSet (m v)
forall a b. (a, b) -> b
snd) ((PositionSet, AttrSet (m v)) -> (PositionSet, AttrSet (m v)))
-> m (PositionSet, AttrSet (m v)) -> m (PositionSet, AttrSet (m v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionSet
-> AttrSet (m v) -> [VarName] -> m (PositionSet, AttrSet (m v))
go PositionSet
p'' AttrSet (m v)
m'' [VarName]
ks

desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r]
desugarBinds :: ([Binding r] -> r) -> [Binding r] -> [Binding r]
desugarBinds [Binding r] -> r
embed = (State (AttrSet (SourcePos, [Binding r])) [Binding r]
-> AttrSet (SourcePos, [Binding r]) -> [Binding r]
forall s a. State s a -> s -> a
`evalState` AttrSet (SourcePos, [Binding r])
forall a. Monoid a => a
mempty) (State (AttrSet (SourcePos, [Binding r])) [Binding r]
 -> [Binding r])
-> ([Binding r]
    -> State (AttrSet (SourcePos, [Binding r])) [Binding r])
-> [Binding r]
-> [Binding r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binding r
 -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> [Binding r]
-> State (AttrSet (SourcePos, [Binding r])) [Binding r]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Either VarName (Binding r)
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
findBinding (Either VarName (Binding r)
 -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> (Binding r
    -> StateT
         (AttrSet (SourcePos, [Binding r]))
         Identity
         (Either VarName (Binding r)))
-> Binding r
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Binding r
-> StateT
     (AttrSet (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
collect)
 where
  collect
    :: Binding r
    -> State
         (AttrSet (SourcePos, [Binding r]))
         (Either VarName (Binding r))
  collect :: Binding r
-> StateT
     (AttrSet (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
collect (NamedVar (StaticKey VarName
x :| NKeyName r
y : [NKeyName r]
ys) r
val SourcePos
oldPosition) =
    do
      (AttrSet (SourcePos, [Binding r])
 -> AttrSet (SourcePos, [Binding r]))
-> StateT (AttrSet (SourcePos, [Binding r])) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AttrSet (SourcePos, [Binding r])
-> AttrSet (SourcePos, [Binding r])
updateBindingInformation
      pure $ VarName -> Either VarName (Binding r)
forall a b. a -> Either a b
Left VarName
x
   where
    updateBindingInformation
      :: AttrSet (SourcePos, [Binding r])
      -> AttrSet (SourcePos, [Binding r])
    updateBindingInformation :: AttrSet (SourcePos, [Binding r])
-> AttrSet (SourcePos, [Binding r])
updateBindingInformation =
      VarName
-> (SourcePos, [Binding r])
-> AttrSet (SourcePos, [Binding r])
-> AttrSet (SourcePos, [Binding r])
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert VarName
x
        ((SourcePos, [Binding r])
 -> AttrSet (SourcePos, [Binding r])
 -> AttrSet (SourcePos, [Binding r]))
-> (AttrSet (SourcePos, [Binding r]) -> (SourcePos, [Binding r]))
-> AttrSet (SourcePos, [Binding r])
-> AttrSet (SourcePos, [Binding r])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SourcePos, [Binding r])
-> ((SourcePos, [Binding r]) -> (SourcePos, [Binding r]))
-> Maybe (SourcePos, [Binding r])
-> (SourcePos, [Binding r])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (SourcePos -> (SourcePos, [Binding r])
mkBindingSingleton SourcePos
oldPosition)
            (\ (SourcePos
foundPosition, [Binding r]
newBindings) -> ([Binding r] -> [Binding r])
-> (SourcePos, [Binding r]) -> (SourcePos, [Binding r])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([Binding r] -> [Binding r] -> [Binding r]
forall a. Semigroup a => a -> a -> a
<> [Binding r]
newBindings) ((SourcePos, [Binding r]) -> (SourcePos, [Binding r]))
-> (SourcePos, [Binding r]) -> (SourcePos, [Binding r])
forall a b. (a -> b) -> a -> b
$ SourcePos -> (SourcePos, [Binding r])
mkBindingSingleton SourcePos
foundPosition)
            (Maybe (SourcePos, [Binding r]) -> (SourcePos, [Binding r]))
-> (AttrSet (SourcePos, [Binding r])
    -> Maybe (SourcePos, [Binding r]))
-> AttrSet (SourcePos, [Binding r])
-> (SourcePos, [Binding r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName
-> AttrSet (SourcePos, [Binding r])
-> Maybe (SourcePos, [Binding r])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
x
    mkBindingSingleton :: SourcePos -> (SourcePos, [Binding r])
    mkBindingSingleton :: SourcePos -> (SourcePos, [Binding r])
mkBindingSingleton SourcePos
np = (SourcePos
np , OneItem [Binding r] -> [Binding r]
forall x. One x => OneItem x -> x
one (OneItem [Binding r] -> [Binding r])
-> OneItem [Binding r] -> [Binding r]
forall a b. (a -> b) -> a -> b
$ SourcePos -> Binding r
bindValAt SourcePos
np)
     where
      bindValAt :: SourcePos -> Binding r
      bindValAt :: SourcePos -> Binding r
bindValAt = NonEmpty (NKeyName r) -> r -> SourcePos -> Binding r
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar (NKeyName r
y NKeyName r -> [NKeyName r] -> NonEmpty (NKeyName r)
forall a. a -> [a] -> NonEmpty a
:| [NKeyName r]
ys) r
val
  collect Binding r
x = Either VarName (Binding r)
-> StateT
     (AttrSet (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either VarName (Binding r)
 -> StateT
      (AttrSet (SourcePos, [Binding r]))
      Identity
      (Either VarName (Binding r)))
-> Either VarName (Binding r)
-> StateT
     (AttrSet (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
forall a b. (a -> b) -> a -> b
$ Binding r -> Either VarName (Binding r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Binding r
x

  findBinding
    :: Either VarName (Binding r)
    -> State (AttrSet (SourcePos, [Binding r])) (Binding r)
  findBinding :: Either VarName (Binding r)
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
findBinding =
    (VarName
 -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> (Binding r
    -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> Either VarName (Binding r)
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (\ VarName
x ->
        StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
-> ((SourcePos, [Binding r])
    -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> Maybe (SourcePos, [Binding r])
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Text
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text
 -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> Text
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall a b. (a -> b) -> a -> b
$ Text
"No binding " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VarName -> Text
forall b a. (Show a, IsString b) => a -> b
show VarName
x)
          (\ (SourcePos
p, [Binding r]
v) -> Binding r
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Binding r
 -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> Binding r
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NKeyName r) -> r -> SourcePos -> Binding r
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar (OneItem (NonEmpty (NKeyName r)) -> NonEmpty (NKeyName r)
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty (NKeyName r)) -> NonEmpty (NKeyName r))
-> OneItem (NonEmpty (NKeyName r)) -> NonEmpty (NKeyName r)
forall a b. (a -> b) -> a -> b
$ VarName -> NKeyName r
forall r. VarName -> NKeyName r
StaticKey VarName
x) ([Binding r] -> r
embed [Binding r]
v) SourcePos
p)
          (Maybe (SourcePos, [Binding r])
 -> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r))
-> StateT
     (AttrSet (SourcePos, [Binding r]))
     Identity
     (Maybe (SourcePos, [Binding r]))
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (AttrSet (SourcePos, [Binding r])
 -> Maybe (SourcePos, [Binding r]))
-> StateT
     (AttrSet (SourcePos, [Binding r]))
     Identity
     (Maybe (SourcePos, [Binding r]))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName
-> AttrSet (SourcePos, [Binding r])
-> Maybe (SourcePos, [Binding r])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
x)
      )
      Binding r
-> StateT (AttrSet (SourcePos, [Binding r])) Identity (Binding r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

evalBinds
  :: forall v m
   . MonadNixEval v m
--  2021-07-19: NOTE: Recutsivity data type
  => Bool
  -> [Binding (m v)]
--  2021-07-19: NOTE: AttrSet is a Scope
  -> m (AttrSet v, PositionSet)
evalBinds :: Bool -> [Binding (m v)] -> m (AttrSet v, PositionSet)
evalBinds Bool
isRecursive [Binding (m v)]
binds =
  do
    Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes

    Scopes m v
-> [([VarName], SourcePos, m v)] -> m (AttrSet v, PositionSet)
buildResult Scopes m v
scope ([([VarName], SourcePos, m v)] -> m (AttrSet v, PositionSet))
-> ([[([VarName], SourcePos, m v)]]
    -> [([VarName], SourcePos, m v)])
-> [[([VarName], SourcePos, m v)]]
-> m (AttrSet v, PositionSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[([VarName], SourcePos, m v)]] -> [([VarName], SourcePos, m v)]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([[([VarName], SourcePos, m v)]] -> m (AttrSet v, PositionSet))
-> m [[([VarName], SourcePos, m v)]] -> m (AttrSet v, PositionSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Binding (m v) -> m [([VarName], SourcePos, m v)])
-> [Binding (m v)] -> m [[([VarName], SourcePos, m v)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [Binding (m v)] -> [Binding (m v)]
forall r. [Binding r] -> [Binding r]
moveOverridesLast [Binding (m v)]
binds) (Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]
applyBindToAdt Scopes m v
scope)

 where
  buildResult
    :: Scopes m v
    -> [([VarName], SourcePos, m v)]
    -> m (AttrSet v, PositionSet)
  buildResult :: Scopes m v
-> [([VarName], SourcePos, m v)] -> m (AttrSet v, PositionSet)
buildResult Scopes m v
scopes [([VarName], SourcePos, m v)]
bindings =
    do
      (AttrSet (m v) -> Scope (m v)
coerce -> Scope (m v)
scope, PositionSet
p) <- ((AttrSet (m v), PositionSet)
 -> ([VarName], SourcePos, m v) -> m (AttrSet (m v), PositionSet))
-> (AttrSet (m v), PositionSet)
-> [([VarName], SourcePos, m v)]
-> m (AttrSet (m v), PositionSet)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (AttrSet (m v), PositionSet)
-> ([VarName], SourcePos, m v) -> m (AttrSet (m v), PositionSet)
forall v (m :: * -> *).
(MonadEval v m, Scoped v m, MonadValue v m, MonadFix m,
 ToValue (AttrSet v, PositionSet) m v, ToValue [v] m v,
 ToValue Bool m v, FromValue (AttrSet v, PositionSet) m v,
 FromValue NixString m v) =>
(AttrSet (m v), PositionSet)
-> ([VarName], SourcePos, m v) -> m (AttrSet (m v), PositionSet)
insert (AttrSet (m v), PositionSet)
forall a. Monoid a => a
mempty [([VarName], SourcePos, m v)]
bindings
      Scope v
res <-
        (Scope (m v) -> m (Scope v))
-> (Scope (m v) -> m (Scope v))
-> Bool
-> Scope (m v)
-> m (Scope v)
forall a. a -> a -> Bool -> a
bool
          ((m v -> m v) -> Scope (m v) -> m (Scope v)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse m v -> m v
mkThunk)
          (Scope (Scope v -> m v) -> m (Scope v)
forall (m :: * -> *) (t :: * -> *) a.
(MonadFix m, Traversable t) =>
t (t a -> m a) -> m (t a)
loebM (Scope (Scope v -> m v) -> m (Scope v))
-> (Scope (m v) -> Scope (Scope v -> m v))
-> Scope (m v)
-> m (Scope v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m v -> Scope v -> m v) -> Scope (m v) -> Scope (Scope v -> m v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m v -> Scope v -> m v
forall a. Scoped a m => m v -> Scope a -> m v
encapsulate)
          Bool
isRecursive
          Scope (m v)
scope

      pure (Scope v -> AttrSet v
coerce Scope v
res, PositionSet
p)

   where
    insert :: (AttrSet (m v), PositionSet)
-> ([VarName], SourcePos, m v) -> m (AttrSet (m v), PositionSet)
insert (AttrSet (m v)
m, PositionSet
p) ([VarName]
path, SourcePos
pos, m v
value) = [VarName]
-> SourcePos
-> AttrSet (m v)
-> PositionSet
-> m v
-> m (AttrSet (m v), PositionSet)
forall v (m :: * -> *).
MonadNixEval v m =>
[VarName]
-> SourcePos
-> AttrSet (m v)
-> PositionSet
-> m v
-> m (AttrSet (m v), PositionSet)
attrSetAlter [VarName]
path SourcePos
pos AttrSet (m v)
m PositionSet
p m v
value

    mkThunk :: m v -> m v
mkThunk = m v -> m v
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (m v -> m v) -> (m v -> m v) -> m v -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopes m v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
scopes

    encapsulate :: m v -> Scope a -> m v
encapsulate m v
f Scope a
attrs = m v -> m v
mkThunk (m v -> m v) -> m v -> m v
forall a b. (a -> b) -> a -> b
$ Scope a -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scope a -> m r -> m r
pushScope Scope a
attrs m v
f

  applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]
  applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]
applyBindToAdt Scopes m v
_ (NamedVar (StaticKey VarName
"__overrides" :| []) m v
finalValue SourcePos
pos) =
    do
      (AttrSet v
o', PositionSet
p') <- v -> m (AttrSet v, PositionSet)
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue (v -> m (AttrSet v, PositionSet))
-> m v -> m (AttrSet v, PositionSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m v
finalValue
      -- jww (2018-05-09): What to do with the key position here?
      [([VarName], SourcePos, m v)] -> m [([VarName], SourcePos, m v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([([VarName], SourcePos, m v)] -> m [([VarName], SourcePos, m v)])
-> [([VarName], SourcePos, m v)] -> m [([VarName], SourcePos, m v)]
forall a b. (a -> b) -> a -> b
$
        (\ (VarName
k, v
v) ->
          ( OneItem [VarName] -> [VarName]
forall x. One x => OneItem x -> x
one OneItem [VarName]
VarName
k
          , SourcePos -> Maybe SourcePos -> SourcePos
forall a. a -> Maybe a -> a
fromMaybe SourcePos
pos (Maybe SourcePos -> SourcePos) -> Maybe SourcePos -> SourcePos
forall a b. (a -> b) -> a -> b
$ VarName -> PositionSet -> Maybe SourcePos
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
k PositionSet
p'
          , v -> m v
forall v (m :: * -> *). MonadValue v m => v -> m v
demand v
v
          )
        ) ((VarName, v) -> ([VarName], SourcePos, m v))
-> [(VarName, v)] -> [([VarName], SourcePos, m v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet v -> [(VarName, v)]
forall k v. HashMap k v -> [(k, v)]
M.toList AttrSet v
o'

  applyBindToAdt Scopes m v
_ (NamedVar NonEmpty (NKeyName (m v))
pathExpr m v
finalValue SourcePos
pos) =
    (\case
      -- When there are no path segments, e.g. `${null} = 5;`, we don't
      -- bind anything
      ([], SourcePos
_, m v
_) -> [([VarName], SourcePos, m v)]
forall a. Monoid a => a
mempty
      ([VarName], SourcePos, m v)
result     -> OneItem [([VarName], SourcePos, m v)]
-> [([VarName], SourcePos, m v)]
forall x. One x => OneItem x -> x
one ([VarName], SourcePos, m v)
OneItem [([VarName], SourcePos, m v)]
result
    ) (([VarName], SourcePos, m v) -> [([VarName], SourcePos, m v)])
-> m ([VarName], SourcePos, m v) -> m [([VarName], SourcePos, m v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (NKeyName (m v)) -> m ([VarName], SourcePos, m v)
processAttrSetKeys NonEmpty (NKeyName (m v))
pathExpr

   where
    processAttrSetKeys :: NAttrPath (m v) -> m ([VarName], SourcePos, m v)
    processAttrSetKeys :: NonEmpty (NKeyName (m v)) -> m ([VarName], SourcePos, m v)
processAttrSetKeys (NKeyName (m v)
h :| [NKeyName (m v)]
t) =
      m ([VarName], SourcePos, m v)
-> (VarName -> m ([VarName], SourcePos, m v))
-> Maybe VarName
-> m ([VarName], SourcePos, m v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        -- Empty attrset - return a stub.
        (([VarName], SourcePos, m v) -> m ([VarName], SourcePos, m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VarName]
forall a. Monoid a => a
mempty, SourcePos
nullPos, (AttrSet v, PositionSet) -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue @(AttrSet v, PositionSet) (AttrSet v, PositionSet)
forall a. Monoid a => a
mempty) )
        (\ VarName
k ->
          m ([VarName], SourcePos, m v)
-> ([NKeyName (m v)] -> m ([VarName], SourcePos, m v))
-> [NKeyName (m v)]
-> m ([VarName], SourcePos, m v)
forall (t :: * -> *) b a. Foldable t => b -> (t a -> b) -> t a -> b
list
            -- No more keys in the attrset - return the result
            (([VarName], SourcePos, m v) -> m ([VarName], SourcePos, m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( OneItem [VarName] -> [VarName]
forall x. One x => OneItem x -> x
one OneItem [VarName]
VarName
k, SourcePos
pos, m v
finalValue ) )
            -- There are unprocessed keys in attrset - recurse appending the results
            (\ (NKeyName (m v)
x : [NKeyName (m v)]
xs) ->
              do
                ([VarName]
restOfPath, SourcePos
_, m v
v) <- NonEmpty (NKeyName (m v)) -> m ([VarName], SourcePos, m v)
processAttrSetKeys (NKeyName (m v)
x NKeyName (m v) -> [NKeyName (m v)] -> NonEmpty (NKeyName (m v))
forall a. a -> [a] -> NonEmpty a
:| [NKeyName (m v)]
xs)
                ([VarName], SourcePos, m v) -> m ([VarName], SourcePos, m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( VarName
k VarName -> [VarName] -> [VarName]
forall a. a -> [a] -> [a]
: [VarName]
restOfPath, SourcePos
pos, m v
v )
            )
            [NKeyName (m v)]
t
        )
        (Maybe VarName -> m ([VarName], SourcePos, m v))
-> m (Maybe VarName) -> m ([VarName], SourcePos, m v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NKeyName (m v) -> m (Maybe VarName)
forall v (m :: * -> *).
(MonadEval v m, FromValue NixString m v) =>
NKeyName (m v) -> m (Maybe VarName)
evalSetterKeyName NKeyName (m v)
h

  applyBindToAdt Scopes m v
scopes (Inherit Maybe (m v)
ms [VarName]
names SourcePos
pos) =
    [([VarName], SourcePos, m v)] -> m [([VarName], SourcePos, m v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([([VarName], SourcePos, m v)] -> m [([VarName], SourcePos, m v)])
-> [([VarName], SourcePos, m v)] -> m [([VarName], SourcePos, m v)]
forall a b. (a -> b) -> a -> b
$ VarName -> ([VarName], SourcePos, m v)
processScope (VarName -> ([VarName], SourcePos, m v))
-> [VarName] -> [([VarName], SourcePos, m v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarName]
names
   where
    processScope
      :: VarName
      -> ([VarName], SourcePos, m v)
    processScope :: VarName -> ([VarName], SourcePos, m v)
processScope VarName
var =
      ( OneItem [VarName] -> [VarName]
forall x. One x => OneItem x -> x
one OneItem [VarName]
VarName
var
      , SourcePos
pos
      , m v -> (v -> m v) -> Maybe v -> m v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (NonEmpty VarName -> Maybe v -> m v
forall v (m :: * -> *).
MonadEval v m =>
NonEmpty VarName -> Maybe v -> m v
attrMissing (OneItem (NonEmpty VarName) -> NonEmpty VarName
forall x. One x => OneItem x -> x
one OneItem (NonEmpty VarName)
VarName
var) Maybe v
forall a. Maybe a
Nothing)
          v -> m v
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
          (Maybe v -> m v) -> m (Maybe v) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe v) -> (m v -> m (Maybe v)) -> Maybe (m v) -> m (Maybe v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              (Scopes m v -> m (Maybe v) -> m (Maybe v)
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
scopes (m (Maybe v) -> m (Maybe v)) -> m (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ VarName -> m (Maybe v)
forall a (m :: * -> *). Scoped a m => VarName -> m (Maybe a)
lookupVar VarName
var)
              (\ m v
s ->
                do
                  (AttrSet v -> Scope v
coerce -> Scope v
scope, PositionSet
_) <- forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, PositionSet) m v =>
v -> m (AttrSet v, PositionSet)
fromValue @(AttrSet v, PositionSet) (v -> m (AttrSet v, PositionSet))
-> m v -> m (AttrSet v, PositionSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m v
s

                  m (Maybe v) -> m (Maybe v)
forall a (m :: * -> *) r. Scoped a m => m r -> m r
clearScopes (m (Maybe v) -> m (Maybe v)) -> m (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ Scope v -> m (Maybe v) -> m (Maybe v)
forall a (m :: * -> *) r. Scoped a m => Scope a -> m r -> m r
pushScope @v Scope v
scope (m (Maybe v) -> m (Maybe v)) -> m (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ VarName -> m (Maybe v)
forall a (m :: * -> *). Scoped a m => VarName -> m (Maybe a)
lookupVar VarName
var
              )
              Maybe (m v)
ms
      )

  moveOverridesLast :: [Binding r] -> [Binding r]
moveOverridesLast = ([Binding r] -> [Binding r] -> [Binding r])
-> ([Binding r], [Binding r]) -> [Binding r]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Binding r] -> [Binding r] -> [Binding r]
forall a. Semigroup a => a -> a -> a
(<>) (([Binding r], [Binding r]) -> [Binding r])
-> ([Binding r] -> ([Binding r], [Binding r]))
-> [Binding r]
-> [Binding r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binding r -> Bool) -> [Binding r] -> ([Binding r], [Binding r])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition
    (\case
      NamedVar (StaticKey VarName
"__overrides" :| []) r
_ SourcePos
_ -> Bool
False
      Binding r
_ -> Bool
True
    )

evalSelect
  :: forall v m
   . MonadNixEval v m
  => m v
  -> NAttrPath (m v)
  -> m (Either (v, NonEmpty VarName) (m v))
evalSelect :: m v -> NAttrPath (m v) -> m (Either (v, NonEmpty VarName) (m v))
evalSelect m v
aset NAttrPath (m v)
attr =
  do
    v
s    <- m v
aset
    NonEmpty VarName
path <- (NKeyName (m v) -> m VarName)
-> NAttrPath (m v) -> m (NonEmpty VarName)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NKeyName (m v) -> m VarName
forall v (m :: * -> *).
(MonadEval v m, FromValue NixString m v) =>
NKeyName (m v) -> m VarName
evalGetterKeyName NAttrPath (m v)
attr

    NonEmpty VarName -> v -> m (Either (v, NonEmpty VarName) (m v))
extract NonEmpty VarName
path v
s

 where
  extract :: NonEmpty VarName -> v -> m (Either (v, NonEmpty VarName) (m v))
  extract :: NonEmpty VarName -> v -> m (Either (v, NonEmpty VarName) (m v))
extract path :: NonEmpty VarName
path@(VarName
k :| [VarName]
ks) v
x =
    m (Either (v, NonEmpty VarName) (m v))
-> ((HashMap VarName v, PositionSet)
    -> m (Either (v, NonEmpty VarName) (m v)))
-> Maybe (HashMap VarName v, PositionSet)
-> m (Either (v, NonEmpty VarName) (m v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      m (Either (v, NonEmpty VarName) (m v))
forall b. m (Either (v, NonEmpty VarName) b)
left
      (m (Either (v, NonEmpty VarName) (m v))
-> (v -> m (Either (v, NonEmpty VarName) (m v)))
-> Maybe v
-> m (Either (v, NonEmpty VarName) (m v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        m (Either (v, NonEmpty VarName) (m v))
forall b. m (Either (v, NonEmpty VarName) b)
left
        ((m v -> m (Either (v, NonEmpty VarName) (m v)))
-> ([VarName] -> m v -> m (Either (v, NonEmpty VarName) (m v)))
-> [VarName]
-> m v
-> m (Either (v, NonEmpty VarName) (m v))
forall (t :: * -> *) b a. Foldable t => b -> (t a -> b) -> t a -> b
list
          (Either (v, NonEmpty VarName) (m v)
-> m (Either (v, NonEmpty VarName) (m v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (v, NonEmpty VarName) (m v)
 -> m (Either (v, NonEmpty VarName) (m v)))
-> (m v -> Either (v, NonEmpty VarName) (m v))
-> m v
-> m (Either (v, NonEmpty VarName) (m v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m v -> Either (v, NonEmpty VarName) (m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
          (\ (VarName
y : [VarName]
ys) -> (NonEmpty VarName -> v -> m (Either (v, NonEmpty VarName) (m v))
extract (VarName
y VarName -> [VarName] -> NonEmpty VarName
forall a. a -> [a] -> NonEmpty a
:| [VarName]
ys) (v -> m (Either (v, NonEmpty VarName) (m v)))
-> m v -> m (Either (v, NonEmpty VarName) (m v))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<))
          [VarName]
ks
          (m v -> m (Either (v, NonEmpty VarName) (m v)))
-> (v -> m v) -> v -> m (Either (v, NonEmpty VarName) (m v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> m v
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
        )
        (Maybe v -> m (Either (v, NonEmpty VarName) (m v)))
-> ((HashMap VarName v, PositionSet) -> Maybe v)
-> (HashMap VarName v, PositionSet)
-> m (Either (v, NonEmpty VarName) (m v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> HashMap VarName v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
k (HashMap VarName v -> Maybe v)
-> ((HashMap VarName v, PositionSet) -> HashMap VarName v)
-> (HashMap VarName v, PositionSet)
-> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap VarName v, PositionSet) -> HashMap VarName v
forall a b. (a, b) -> a
fst
      )
      (Maybe (HashMap VarName v, PositionSet)
 -> m (Either (v, NonEmpty VarName) (m v)))
-> m (Maybe (HashMap VarName v, PositionSet))
-> m (Either (v, NonEmpty VarName) (m v))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v -> m (Maybe (HashMap VarName v, PositionSet))
forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
fromValueMay @(AttrSet v, PositionSet) v
x
   where
    left :: m (Either (v, NonEmpty VarName) b)
    left :: m (Either (v, NonEmpty VarName) b)
left = Either (v, NonEmpty VarName) b
-> m (Either (v, NonEmpty VarName) b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (v, NonEmpty VarName) b
 -> m (Either (v, NonEmpty VarName) b))
-> Either (v, NonEmpty VarName) b
-> m (Either (v, NonEmpty VarName) b)
forall a b. (a -> b) -> a -> b
$ (v, NonEmpty VarName) -> Either (v, NonEmpty VarName) b
forall a b. a -> Either a b
Left (v
x, NonEmpty VarName
path)

-- | Evaluate a component of an attribute path in a context where we are
-- *retrieving* a value
evalGetterKeyName
  :: forall v m
   . (MonadEval v m, FromValue NixString m v)
  => NKeyName (m v)
  -> m VarName
evalGetterKeyName :: NKeyName (m v) -> m VarName
evalGetterKeyName =
  m VarName -> (VarName -> m VarName) -> Maybe VarName -> m VarName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a. (MonadEval v m, Exception s) => s -> m a
evalError @v (ErrorCall -> m VarName) -> ErrorCall -> m VarName
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"value is null while a string was expected")
    VarName -> m VarName
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe VarName -> m VarName)
-> (NKeyName (m v) -> m (Maybe VarName))
-> NKeyName (m v)
-> m VarName
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NKeyName (m v) -> m (Maybe VarName)
forall v (m :: * -> *).
(MonadEval v m, FromValue NixString m v) =>
NKeyName (m v) -> m (Maybe VarName)
evalSetterKeyName

-- | Evaluate a component of an attribute path in a context where we are
-- *binding* a value
evalSetterKeyName
  :: (MonadEval v m, FromValue NixString m v)
  => NKeyName (m v)
  -> m (Maybe VarName)
evalSetterKeyName :: NKeyName (m v) -> m (Maybe VarName)
evalSetterKeyName =
  \case
    StaticKey VarName
k -> Maybe VarName -> m (Maybe VarName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe VarName -> m (Maybe VarName))
-> Maybe VarName -> m (Maybe VarName)
forall a b. (a -> b) -> a -> b
$ VarName -> Maybe VarName
forall (f :: * -> *) a. Applicative f => a -> f a
pure VarName
k
    DynamicKey Antiquoted (NString (m v)) (m v)
k ->
      Text -> VarName
coerce (Text -> VarName) -> (NixString -> Text) -> NixString -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> Text
ignoreContext (NixString -> VarName) -> m (Maybe NixString) -> m (Maybe VarName)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> NString (m v)
-> (NString (m v) -> m (Maybe NixString))
-> (m v -> m (Maybe NixString))
-> Antiquoted (NString (m v)) (m v)
-> m (Maybe NixString)
forall v a r. v -> (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted NString (m v)
"\n" NString (m v) -> m (Maybe NixString)
forall v (m :: * -> *).
(MonadEval v m, FromValue NixString m v) =>
NString (m v) -> m (Maybe NixString)
assembleString (v -> m (Maybe NixString)
forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
fromValueMay (v -> m (Maybe NixString)) -> m v -> m (Maybe NixString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) Antiquoted (NString (m v)) (m v)
k

assembleString
  :: forall v m
   . (MonadEval v m, FromValue NixString m v)
  => NString (m v)
  -> m (Maybe NixString)
assembleString :: NString (m v) -> m (Maybe NixString)
assembleString = [Antiquoted Text (m v)] -> m (Maybe NixString)
fromParts ([Antiquoted Text (m v)] -> m (Maybe NixString))
-> (NString (m v) -> [Antiquoted Text (m v)])
-> NString (m v)
-> m (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NString (m v) -> [Antiquoted Text (m v)]
forall r. NString r -> [Antiquoted Text r]
stringParts
 where
  fromParts :: [Antiquoted Text (m v)] -> m (Maybe NixString)
  fromParts :: [Antiquoted Text (m v)] -> m (Maybe NixString)
fromParts [Antiquoted Text (m v)]
xs = [NixString] -> NixString
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([NixString] -> NixString)
-> m (Maybe [NixString]) -> m (Maybe NixString)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> (Antiquoted Text (m v) -> m (Maybe NixString))
-> [Antiquoted Text (m v)] -> m (Maybe [NixString])
forall (m :: * -> *) (n :: * -> *) (t :: * -> *) a b.
(Applicative m, Applicative n, Traversable t) =>
(a -> m (n b)) -> t a -> m (n (t b))
traverse2 Antiquoted Text (m v) -> m (Maybe NixString)
fun [Antiquoted Text (m v)]
xs

  fun :: Antiquoted Text (m v) -> m (Maybe NixString)
  fun :: Antiquoted Text (m v) -> m (Maybe NixString)
fun =
    Text
-> (Text -> m (Maybe NixString))
-> (m v -> m (Maybe NixString))
-> Antiquoted Text (m v)
-> m (Maybe NixString)
forall v a r. v -> (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted
      Text
"\n"
      (Maybe NixString -> m (Maybe NixString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NixString -> m (Maybe NixString))
-> (Text -> Maybe NixString) -> Text -> m (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> Maybe NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> Maybe NixString)
-> (Text -> NixString) -> Text -> Maybe NixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NixString
mkNixStringWithoutContext)
      (v -> m (Maybe NixString)
forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
fromValueMay (v -> m (Maybe NixString)) -> m v -> m (Maybe NixString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)

buildArgument
  :: forall v m . MonadNixEval v m => Params (m v) -> m v -> m (AttrSet v)
buildArgument :: Params (m v) -> m v -> m (AttrSet v)
buildArgument Params (m v)
params m v
arg =
  do
    Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes
    let
      argThunk :: m v
argThunk = m v -> m v
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (m v -> m v) -> m v -> m v
forall a b. (a -> b) -> a -> b
$ Scopes m v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
scope m v
arg
    case Params (m v)
params of
      Param VarName
name -> (VarName, v) -> AttrSet v
forall x. One x => OneItem x -> x
one ((VarName, v) -> AttrSet v)
-> (v -> (VarName, v)) -> v -> AttrSet v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarName
name,) (v -> AttrSet v) -> m v -> m (AttrSet v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
argThunk
      ParamSet Maybe VarName
mname Variadic
variadic ParamSet (m v)
pset ->
        do
          (AttrSet v
args, PositionSet
_) <- forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, PositionSet) m v =>
v -> m (AttrSet v, PositionSet)
fromValue @(AttrSet v, PositionSet) (v -> m (AttrSet v, PositionSet))
-> m v -> m (AttrSet v, PositionSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m v
arg
          let
            inject :: HashMap VarName (b -> m v) -> HashMap VarName (b -> m v)
inject =
              (HashMap VarName (b -> m v) -> HashMap VarName (b -> m v))
-> (VarName
    -> HashMap VarName (b -> m v) -> HashMap VarName (b -> m v))
-> Maybe VarName
-> HashMap VarName (b -> m v)
-> HashMap VarName (b -> m v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                HashMap VarName (b -> m v) -> HashMap VarName (b -> m v)
forall a. a -> a
id
                (VarName
-> (b -> m v)
-> HashMap VarName (b -> m v)
-> HashMap VarName (b -> m v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
`M.insert` m v -> b -> m v
forall a b. a -> b -> a
const m v
argThunk) -- why insert into const? Thunk value getting magic point?
                Maybe VarName
mname
          HashMap VarName (AttrSet v -> m v) -> m (AttrSet v)
forall (m :: * -> *) (t :: * -> *) a.
(MonadFix m, Traversable t) =>
t (t a -> m a) -> m (t a)
loebM (HashMap VarName (AttrSet v -> m v) -> m (AttrSet v))
-> HashMap VarName (AttrSet v -> m v) -> m (AttrSet v)
forall a b. (a -> b) -> a -> b
$
            HashMap VarName (AttrSet v -> m v)
-> HashMap VarName (AttrSet v -> m v)
forall b. HashMap VarName (b -> m v) -> HashMap VarName (b -> m v)
inject (HashMap VarName (AttrSet v -> m v)
 -> HashMap VarName (AttrSet v -> m v))
-> HashMap VarName (AttrSet v -> m v)
-> HashMap VarName (AttrSet v -> m v)
forall a b. (a -> b) -> a -> b
$
              (Maybe (AttrSet v -> m v) -> Maybe (AttrSet v -> m v))
-> HashMap VarName (Maybe (AttrSet v -> m v))
-> HashMap VarName (AttrSet v -> m v)
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
M.mapMaybe
                Maybe (AttrSet v -> m v) -> Maybe (AttrSet v -> m v)
forall a. a -> a
id
                (HashMap VarName (Maybe (AttrSet v -> m v))
 -> HashMap VarName (AttrSet v -> m v))
-> HashMap VarName (Maybe (AttrSet v -> m v))
-> HashMap VarName (AttrSet v -> m v)
forall a b. (a -> b) -> a -> b
$ (VarName -> These v (Maybe (m v)) -> Maybe (AttrSet v -> m v))
-> AttrSet v
-> HashMap VarName (Maybe (m v))
-> HashMap VarName (Maybe (AttrSet v -> m v))
forall i (f :: * -> *) a b c.
SemialignWithIndex i f =>
(i -> These a b -> c) -> f a -> f b -> f c
ialignWith
                    (Scopes m v
-> Variadic
-> VarName
-> These v (Maybe (m v))
-> Maybe (AttrSet v -> m v)
assemble Scopes m v
scope Variadic
variadic)
                    AttrSet v
args
                    (HashMap VarName (Maybe (m v))
 -> HashMap VarName (Maybe (AttrSet v -> m v)))
-> HashMap VarName (Maybe (m v))
-> HashMap VarName (Maybe (AttrSet v -> m v))
forall a b. (a -> b) -> a -> b
$ ParamSet (m v) -> HashMap VarName (Maybe (m v))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ParamSet (m v)
pset
 where
  assemble
    :: Scopes m v
    -> Variadic
    -> VarName
    -> These v (Maybe (m v))
    -> Maybe (AttrSet v -> m v)
  assemble :: Scopes m v
-> Variadic
-> VarName
-> These v (Maybe (m v))
-> Maybe (AttrSet v -> m v)
assemble Scopes m v
_ Variadic
Variadic VarName
_ (This v
_) = Maybe (AttrSet v -> m v)
forall a. Maybe a
Nothing
  assemble Scopes m v
scope Variadic
_ VarName
k These v (Maybe (m v))
t =
    (AttrSet v -> m v) -> Maybe (AttrSet v -> m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AttrSet v -> m v) -> Maybe (AttrSet v -> m v))
-> (AttrSet v -> m v) -> Maybe (AttrSet v -> m v)
forall a b. (a -> b) -> a -> b
$
      case These v (Maybe (m v))
t of
        That Maybe (m v)
Nothing -> m v -> AttrSet v -> m v
forall a b. a -> b -> a
const (m v -> AttrSet v -> m v) -> m v -> AttrSet v -> m v
forall a b. (a -> b) -> a -> b
$ forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a. (MonadEval v m, Exception s) => s -> m a
evalError @v (ErrorCall -> m v) -> ErrorCall -> m v
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Missing value for parameter: ''" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VarName -> String
forall b a. (Show a, IsString b) => a -> b
show VarName
k
        That (Just m v
f) -> (Scope v -> m v) -> AttrSet v -> m v
coerce ((Scope v -> m v) -> AttrSet v -> m v)
-> (Scope v -> m v) -> AttrSet v -> m v
forall a b. (a -> b) -> a -> b
$ m v -> m v
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (m v -> m v) -> (Scope v -> m v) -> Scope v -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scopes m v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
scope (m v -> m v) -> (Scope v -> m v) -> Scope v -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scope v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => Scope a -> m r -> m r
`pushScope` m v
f)
        This v
_ -> m v -> AttrSet v -> m v
forall a b. a -> b -> a
const (m v -> AttrSet v -> m v) -> m v -> AttrSet v -> m v
forall a b. (a -> b) -> a -> b
$ forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a. (MonadEval v m, Exception s) => s -> m a
evalError @v (ErrorCall -> m v) -> ErrorCall -> m v
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"Unexpected parameter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VarName -> String
forall b a. (Show a, IsString b) => a -> b
show VarName
k
        These v
x Maybe (m v)
_ -> m v -> AttrSet v -> m v
forall a b. a -> b -> a
const (m v -> AttrSet v -> m v) -> m v -> AttrSet v -> m v
forall a b. (a -> b) -> a -> b
$ v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
x

-- | Add source positions to @NExprLoc@.
--
-- Takes @NExprLoc@, by itself takes source position informatoin, does transformation,
-- returns @NExprLoc@ with source positions.
--
-- Actually:
--
-- > => (NExprLoc -> m a)
-- > -> NExprLoc -> m a
addSourcePositions
  :: (MonadReader e m, Has e SrcSpan) => Transform NExprLocF (m a)
addSourcePositions :: Transform NExprLocF (m a)
addSourcePositions NExprLoc -> m a
f (v :: NExprLoc
v@(Ann SrcSpan
ann NExprF NExprLoc
_) :: NExprLoc) =
  (e -> e) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Lens' e SrcSpan -> SrcSpan -> e -> e
forall s a. Lens' s a -> a -> s -> s
set forall a b. Has a b => Lens' a b
Lens' e SrcSpan
hasLens SrcSpan
ann) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ NExprLoc -> m a
f NExprLoc
v

addStackFrames
  :: forall v e m a
   . (Scoped v m, Framed e m, Typeable v, Typeable m)
  => TransformF NExprLoc (m a)
addStackFrames :: TransformF NExprLoc (m a)
addStackFrames NExprLoc -> m a
f NExprLoc
v =
  do
    Scopes m v
scopes <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
askScopes

    -- sectioning gives GHC optimization
    -- If opimization question would arrive again, check the @(`withFrameInfo` f v) $ EvaluatingExpr scopes v@
    -- for possible @scopes@ implementation @v@ type arguments sharing between runs.
    (EvalFrame m v -> m a -> m a
forall a. EvalFrame m v -> m a -> m a
`withFrameInfo` NExprLoc -> m a
f NExprLoc
v) (EvalFrame m v -> m a) -> EvalFrame m v -> m a
forall a b. (a -> b) -> a -> b
$ (Scopes m v -> NExprLoc -> EvalFrame m v
forall (m :: * -> *) v. Scopes m v -> NExprLoc -> EvalFrame m v
`EvaluatingExpr` NExprLoc
v) Scopes m v
scopes
 where
  withFrameInfo :: EvalFrame m v -> m a -> m a
withFrameInfo = NixLevel -> EvalFrame m v -> m a -> m a
forall s e (m :: * -> *) a.
(Framed e m, Exception s) =>
NixLevel -> s -> m a -> m a
withFrame NixLevel
Info

evalWithMetaInfo
  :: forall e v m
  . (MonadNixEval v m, Framed e m, Has e SrcSpan, Typeable m, Typeable v)
  => NExprLoc
  -> m v
evalWithMetaInfo :: NExprLoc -> m v
evalWithMetaInfo =
  Transform NExprLocF (m v) -> Alg NExprLocF (m v) -> NExprLoc -> m v
forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi Transform NExprLocF (m v)
forall v (m :: * -> *) e a.
(Framed e m, Scoped v m, Has e SrcSpan, Typeable m, Typeable v) =>
TransformF NExprLoc (m a)
addMetaInfo Alg NExprLocF (m v)
forall v (m :: * -> *) ann.
MonadNixEval v m =>
AnnF ann NExprF (m v) -> m v
evalContent

-- | Add source positions & frame context system.
addMetaInfo
  :: forall v m e a
  . (Framed e m, Scoped v m, Has e SrcSpan, Typeable m, Typeable v)
  => TransformF NExprLoc (m a)
addMetaInfo :: TransformF NExprLoc (m a)
addMetaInfo = forall v e (m :: * -> *) a.
(Scoped v m, Framed e m, Typeable v, Typeable m) =>
TransformF NExprLoc (m a)
forall e (m :: * -> *) a.
(Scoped v m, Framed e m, Typeable v, Typeable m) =>
TransformF NExprLoc (m a)
addStackFrames @v TransformF NExprLoc (m a)
-> TransformF NExprLoc (m a) -> TransformF NExprLoc (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransformF NExprLoc (m a)
forall e (m :: * -> *) a.
(MonadReader e m, Has e SrcSpan) =>
Transform NExprLocF (m a)
addSourcePositions

-- | Takes annotated expression. Strip from annotation. Evaluate.
evalContent
  :: MonadNixEval v m
  => AnnF ann NExprF (m v)
  -> m v
evalContent :: AnnF ann NExprF (m v) -> m v
evalContent = NExprF (m v) -> m v
forall v (m :: * -> *). MonadNixEval v m => NExprF (m v) -> m v
eval (NExprF (m v) -> m v)
-> (AnnF ann NExprF (m v) -> NExprF (m v))
-> AnnF ann NExprF (m v)
-> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnF ann NExprF (m v) -> NExprF (m v)
forall ann (f :: * -> *) r. AnnF ann f r -> f r
stripAnnF