{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Nix.Eval where

import           Control.Monad
import           Control.Monad.Fix
import           Control.Monad.Reader
import           Control.Monad.State.Strict
import           Data.Semialign.Indexed         ( ialignWith )
import           Data.Either                    ( isRight )
import           Data.Fix                       ( Fix(Fix) )
import           Data.HashMap.Lazy              ( HashMap )
import qualified Data.HashMap.Lazy             as M
import           Data.List                      ( partition )
import           Data.List.NonEmpty             ( NonEmpty(..) )
import           Data.Maybe                     ( fromMaybe
                                                , catMaybes
                                                )
import           Data.Text                      ( Text )
import           Data.These                     ( These(..) )
import           Data.Traversable               ( for )
import           Nix.Atoms
import           Nix.Convert
import           Nix.Expr
import           Nix.Expr.Strings               ( runAntiquoted )
import           Nix.Frames
import           Nix.String
import           Nix.Scope
import           Nix.Utils
import           Nix.Value.Monad

class (Show v, Monad m) => MonadEval v m where
  freeVariable    :: Text -> m v
  synHole         :: Text -> m v
  attrMissing     :: NonEmpty Text -> Maybe v -> m v
  evaledSym       :: Text -> v -> m v
  evalCurPos      :: m v
  evalConstant    :: NAtom -> m v
  evalString      :: NString (m v) -> m v
  evalLiteralPath :: FilePath -> m v
  evalEnvPath     :: FilePath -> 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 -> AttrSet SourcePos -> m v
  evalRecSetElem :: AttrSet (m v) -> Text -> m v -> m v
  evalRecSet     :: AttrSet v -> AttrSet SourcePos -> 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, AttrSet SourcePos) m v
  , FromValue (AttrSet v, AttrSet SourcePos) m v
  )

data EvalFrame m v
    = EvaluatingExpr (Scopes m v) NExprLoc
    | ForcingExpr (Scopes m v) NExprLoc
    | Calling String 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 "__curPos") = m v
forall v (m :: * -> *). MonadEval v m => m v
evalCurPos

eval (NSym var :: VarName
var       ) = do
  Maybe v
mres <- VarName -> m (Maybe v)
forall a (m :: * -> *). Scoped a m => VarName -> m (Maybe a)
lookupVar VarName
var
  case Maybe v
mres of
    Just x :: v
x  -> v -> (v -> m v) -> m v
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand v
x ((v -> m v) -> m v) -> (v -> m v) -> m v
forall a b. (a -> b) -> a -> b
$ VarName -> v -> m v
forall v (m :: * -> *). MonadEval v m => VarName -> v -> m v
evaledSym VarName
var
    Nothing -> VarName -> m v
forall v (m :: * -> *). MonadEval v m => VarName -> m v
freeVariable VarName
var

eval (NConstant    x :: NAtom
x      ) = NAtom -> m v
forall v (m :: * -> *). MonadEval v m => NAtom -> m v
evalConstant NAtom
x
eval (NStr         str :: 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 p :: String
p      ) = String -> m v
forall v (m :: * -> *). MonadEval v m => String -> m v
evalLiteralPath String
p
eval (NEnvPath     p :: String
p      ) = String -> m v
forall v (m :: * -> *). MonadEval v m => String -> m v
evalEnvPath String
p
eval (NUnary op :: NUnaryOp
op arg :: 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 NApp fun :: m v
fun arg :: m v
arg) = do
  Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes :: m (Scopes m v)
  m v
fun m v -> (v -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (v -> m v -> m v
forall v (m :: * -> *). MonadEval v m => v -> m v -> m v
`evalApp` 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 op :: NBinaryOp
op   larg :: m v
larg rarg :: m v
rarg) = m v
larg m v -> (v -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NBinaryOp -> v -> m v -> m v
forall v (m :: * -> *).
MonadEval v m =>
NBinaryOp -> v -> m v -> m v
evalBinary NBinaryOp
op (v -> m v -> m v) -> m v -> v -> m v
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? m v
rarg

eval (NSelect aset :: m v
aset attr :: NAttrPath (m v)
attr alt :: Maybe (m v)
alt ) = 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 m (Either (v, NonEmpty VarName) (m v))
-> (Either (v, NonEmpty VarName) (m v) -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((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
go m v -> m v
forall a. a -> a
id
  where go :: (v, NonEmpty VarName) -> m v
go (s :: v
s, ks :: 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 (v -> Maybe v
forall a. a -> Maybe a
Just v
s)) Maybe (m v)
alt

eval (NHasAttr aset :: m v
aset attr :: NAttrPath (m v)
attr) = 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 m (Either (v, NonEmpty VarName) (m v))
-> (Either (v, NonEmpty VarName) (m v) -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue (Bool -> m v)
-> (Either (v, NonEmpty VarName) (m v) -> Bool)
-> Either (v, NonEmpty VarName) (m v)
-> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (v, NonEmpty VarName) (m v) -> Bool
forall a b. Either a b -> Bool
isRight

eval (NList l :: [m v]
l           ) = do
  Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes
  [m v] -> (m v -> m v) -> m [v]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [m v]
l (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] -> ([v] -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [v] -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue

eval (NSet NNonRecursive binds :: [Binding (m v)]
binds) =
  Bool -> [Binding (m v)] -> m (AttrSet v, AttrSet SourcePos)
forall v (m :: * -> *).
MonadNixEval v m =>
Bool -> [Binding (m v)] -> m (AttrSet v, AttrSet SourcePos)
evalBinds Bool
False (([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
. NRecordType -> [Binding (m v)] -> NExprF (m v)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive) [Binding (m v)]
binds) m (AttrSet v, AttrSet SourcePos)
-> ((AttrSet v, AttrSet SourcePos) -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AttrSet v, AttrSet SourcePos) -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue

eval (NSet NRecursive binds :: [Binding (m v)]
binds) =
  Bool -> [Binding (m v)] -> m (AttrSet v, AttrSet SourcePos)
forall v (m :: * -> *).
MonadNixEval v m =>
Bool -> [Binding (m v)] -> m (AttrSet v, AttrSet SourcePos)
evalBinds Bool
True (([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
. NRecordType -> [Binding (m v)] -> NExprF (m v)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive) [Binding (m v)]
binds) m (AttrSet v, AttrSet SourcePos)
-> ((AttrSet v, AttrSet SourcePos) -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AttrSet v, AttrSet SourcePos) -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue

eval (NLet binds :: [Binding (m v)]
binds body :: m v
body    ) = Bool -> [Binding (m v)] -> m (AttrSet v, AttrSet SourcePos)
forall v (m :: * -> *).
MonadNixEval v m =>
Bool -> [Binding (m v)] -> m (AttrSet v, AttrSet SourcePos)
evalBinds Bool
True [Binding (m v)]
binds m (AttrSet v, AttrSet SourcePos)
-> ((AttrSet v, AttrSet SourcePos) -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AttrSet v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => AttrSet a -> m r -> m r
pushScope (AttrSet v -> m v -> m v) -> m v -> AttrSet v -> m v
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? m v
body) (AttrSet v -> m v)
-> ((AttrSet v, AttrSet SourcePos) -> AttrSet v)
-> (AttrSet v, AttrSet SourcePos)
-> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrSet v, AttrSet SourcePos) -> AttrSet v
forall a b. (a, b) -> a
fst

eval (NIf cond :: m v
cond t :: m v
t f :: m v
f       ) = m v
cond m v -> (v -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \v :: v
v -> 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   scope :: m v
scope  body :: 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 cond :: m v
cond   body :: m v
body) = m v
cond m v -> (v -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> m v -> m v
forall v (m :: * -> *). MonadEval v m => v -> m v -> m v
evalAssert (v -> m v -> m v) -> m v -> v -> m v
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? m v
body

eval (NAbs    params :: Params (m v)
params body :: 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
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes :: m (Scopes m v)
  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 a. m v -> (AttrSet (m v) -> m v -> m (a, v)) -> m (a, v))
 -> m v)
-> (forall a.
    m v -> (AttrSet (m v) -> m v -> m (a, v)) -> m (a, v))
-> m v
forall a b. (a -> b) -> a -> b
$ \arg :: m v
arg k :: AttrSet (m v) -> m v -> m (a, v)
k -> Scopes m v -> m (a, v) -> m (a, v)
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m v
scope (m (a, v) -> m (a, v)) -> m (a, v) -> m (a, v)
forall a b. (a -> b) -> a -> b
$ do
    AttrSet v
args <- 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
    AttrSet v -> m (a, v) -> m (a, v)
forall a (m :: * -> *) r. Scoped a m => AttrSet a -> m r -> m r
pushScope AttrSet v
args (AttrSet (m v) -> m v -> m (a, v)
k ((v -> m v) -> AttrSet v -> AttrSet (m v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> (m v -> m v) -> m v
forall v (m :: * -> *). MonadValue v m => v -> (m v -> m v) -> m v
inform (v -> (m v -> m v) -> m v) -> (m v -> m v) -> v -> m v
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f 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) AttrSet v
args) m v
body)

eval (NSynHole name :: 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 aset :: m v
aset body :: m v
body = do
  -- 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.
  Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes :: m (Scopes m v)
  v
s     <- 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
aset
  let s' :: m (AttrSet v)
s' = v -> (v -> m (AttrSet v)) -> m (AttrSet v)
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand v
s ((v -> m (AttrSet v)) -> m (AttrSet v))
-> (v -> m (AttrSet v)) -> m (AttrSet v)
forall a b. (a -> b) -> a -> b
$ ((AttrSet v, AttrSet SourcePos) -> AttrSet v)
-> m (AttrSet v, AttrSet SourcePos) -> m (AttrSet v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AttrSet v, AttrSet SourcePos) -> AttrSet v
forall a b. (a, b) -> a
fst (m (AttrSet v, AttrSet SourcePos) -> m (AttrSet v))
-> (v -> m (AttrSet v, AttrSet SourcePos)) -> v -> m (AttrSet v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, AttrSet SourcePos) m v =>
v -> m (AttrSet v, AttrSet SourcePos)
fromValue @(AttrSet v, AttrSet SourcePos)
  m (AttrSet v) -> m v -> m v
forall (m :: * -> *) a r.
(Functor m, Scoped a m) =>
m (AttrSet a) -> m r -> m r
pushWeakScope m (AttrSet v)
s' m v
body

attrSetAlter
  :: forall v m
   . MonadNixEval v m
  => [Text]
  -> SourcePos
  -> AttrSet (m v)
  -> AttrSet SourcePos
  -> m v
  -> m (AttrSet (m v), AttrSet SourcePos)
attrSetAlter :: [VarName]
-> SourcePos
-> AttrSet (m v)
-> AttrSet SourcePos
-> m v
-> m (AttrSet (m v), AttrSet SourcePos)
attrSetAlter [] _ _ _ _ =
  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 (AttrSet (m v), AttrSet SourcePos))
-> ErrorCall -> m (AttrSet (m v), AttrSet SourcePos)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall "invalid selector with no components"

attrSetAlter (k :: VarName
k : ks :: [VarName]
ks) pos :: SourcePos
pos m :: AttrSet (m v)
m p :: AttrSet SourcePos
p val :: m v
val = case VarName -> AttrSet (m v) -> Maybe (m v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
k AttrSet (m v)
m of
  Nothing | [VarName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VarName]
ks   -> m (AttrSet (m v), AttrSet SourcePos)
go
          | Bool
otherwise -> AttrSet (m v)
-> AttrSet SourcePos -> m (AttrSet (m v), AttrSet SourcePos)
recurse AttrSet (m v)
forall k v. HashMap k v
M.empty AttrSet SourcePos
forall k v. HashMap k v
M.empty
  Just x :: m v
x
    | [VarName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VarName]
ks
    -> m (AttrSet (m v), AttrSet SourcePos)
go
    | Bool
otherwise
    -> m v
x m v
-> (v -> m (AttrSet v, AttrSet SourcePos))
-> m (AttrSet v, AttrSet SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, AttrSet SourcePos) m v =>
v -> m (AttrSet v, AttrSet SourcePos)
fromValue @(AttrSet v, AttrSet SourcePos) m (AttrSet v, AttrSet SourcePos)
-> ((AttrSet v, AttrSet SourcePos)
    -> m (AttrSet (m v), AttrSet SourcePos))
-> m (AttrSet (m v), AttrSet SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(st :: AttrSet v
st, sp :: AttrSet SourcePos
sp) ->
      AttrSet (m v)
-> AttrSet SourcePos -> m (AttrSet (m v), AttrSet SourcePos)
recurse (v -> (v -> m v) -> m v
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand (v -> (v -> m v) -> m v) -> (v -> m v) -> v -> m v
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> m v) -> AttrSet v -> AttrSet (m v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet v
st) AttrSet SourcePos
sp
 where
  go :: m (AttrSet (m v), AttrSet SourcePos)
go = (AttrSet (m v), AttrSet SourcePos)
-> m (AttrSet (m v), AttrSet SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
val AttrSet (m v)
m, VarName -> SourcePos -> AttrSet SourcePos -> AttrSet SourcePos
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert VarName
k SourcePos
pos AttrSet SourcePos
p)

  recurse :: AttrSet (m v)
-> AttrSet SourcePos -> m (AttrSet (m v), AttrSet SourcePos)
recurse st :: AttrSet (m v)
st sp :: AttrSet SourcePos
sp = [VarName]
-> SourcePos
-> AttrSet (m v)
-> AttrSet SourcePos
-> m v
-> m (AttrSet (m v), AttrSet SourcePos)
forall v (m :: * -> *).
MonadNixEval v m =>
[VarName]
-> SourcePos
-> AttrSet (m v)
-> AttrSet SourcePos
-> m v
-> m (AttrSet (m v), AttrSet SourcePos)
attrSetAlter [VarName]
ks SourcePos
pos AttrSet (m v)
st AttrSet SourcePos
sp m v
val m (AttrSet (m v), AttrSet SourcePos)
-> ((AttrSet (m v), AttrSet SourcePos)
    -> (AttrSet (m v), AttrSet SourcePos))
-> m (AttrSet (m v), AttrSet SourcePos)
forall (f :: * -> *) a c. Functor f => f a -> (a -> c) -> f c
<&> \(st' :: AttrSet (m v)
st', _) ->
    ( 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
      (forall a (m :: * -> *) v. ToValue a m v => a -> m v
forall (m :: * -> *) v.
ToValue (AttrSet v, AttrSet SourcePos) m v =>
(AttrSet v, AttrSet SourcePos) -> m v
toValue @(AttrSet v, AttrSet SourcePos) ((AttrSet v, AttrSet SourcePos) -> m v)
-> m (AttrSet v, AttrSet SourcePos) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (, AttrSet SourcePos
forall a. Monoid a => a
mempty) (AttrSet v -> (AttrSet v, AttrSet SourcePos))
-> m (AttrSet v) -> m (AttrSet v, AttrSet SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet (m v) -> m (AttrSet v)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence AttrSet (m v)
st')
      AttrSet (m v)
m
    , VarName -> SourcePos -> AttrSet SourcePos -> AttrSet SourcePos
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert VarName
k SourcePos
pos AttrSet SourcePos
p
    )

desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r]
desugarBinds :: ([Binding r] -> r) -> [Binding r] -> [Binding r]
desugarBinds embed :: [Binding r] -> r
embed binds :: [Binding r]
binds = State (HashMap VarName (SourcePos, [Binding r])) [Binding r]
-> HashMap VarName (SourcePos, [Binding r]) -> [Binding r]
forall s a. State s a -> s -> a
evalState ((Binding r
 -> StateT
      (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r))
-> [Binding r]
-> State (HashMap VarName (SourcePos, [Binding r])) [Binding r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Either VarName (Binding r)
-> StateT
     (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r)
go (Either VarName (Binding r)
 -> StateT
      (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r))
-> (Binding r
    -> StateT
         (HashMap VarName (SourcePos, [Binding r]))
         Identity
         (Either VarName (Binding r)))
-> Binding r
-> StateT
     (HashMap VarName (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
     (HashMap VarName (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
collect) [Binding r]
binds) HashMap VarName (SourcePos, [Binding r])
forall k v. HashMap k v
M.empty
 where
  collect
    :: Binding r
    -> State
         (HashMap VarName (SourcePos, [Binding r]))
         (Either VarName (Binding r))
  collect :: Binding r
-> StateT
     (HashMap VarName (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
collect (NamedVar (StaticKey x :: VarName
x :| y :: NKeyName r
y : ys :: [NKeyName r]
ys) val :: r
val p :: SourcePos
p) = do
    HashMap VarName (SourcePos, [Binding r])
m <- StateT
  (HashMap VarName (SourcePos, [Binding r]))
  Identity
  (HashMap VarName (SourcePos, [Binding r]))
forall s (m :: * -> *). MonadState s m => m s
get
    HashMap VarName (SourcePos, [Binding r])
-> StateT (HashMap VarName (SourcePos, [Binding r])) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (HashMap VarName (SourcePos, [Binding r])
 -> StateT (HashMap VarName (SourcePos, [Binding r])) Identity ())
-> HashMap VarName (SourcePos, [Binding r])
-> StateT (HashMap VarName (SourcePos, [Binding r])) Identity ()
forall a b. (a -> b) -> a -> b
$ VarName
-> (SourcePos, [Binding r])
-> HashMap VarName (SourcePos, [Binding r])
-> HashMap VarName (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])
 -> HashMap VarName (SourcePos, [Binding r])
 -> HashMap VarName (SourcePos, [Binding r]))
-> HashMap VarName (SourcePos, [Binding r])
-> (SourcePos, [Binding r])
-> HashMap VarName (SourcePos, [Binding r])
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? HashMap VarName (SourcePos, [Binding r])
m ((SourcePos, [Binding r])
 -> HashMap VarName (SourcePos, [Binding r]))
-> (SourcePos, [Binding r])
-> HashMap VarName (SourcePos, [Binding r])
forall a b. (a -> b) -> a -> b
$ case VarName
-> HashMap VarName (SourcePos, [Binding r])
-> Maybe (SourcePos, [Binding r])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
x HashMap VarName (SourcePos, [Binding r])
m of
      Nothing     -> (SourcePos
p, [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 SourcePos
p])
      Just (q :: SourcePos
q, v :: [Binding r]
v) -> (SourcePos
q, 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 SourcePos
q Binding r -> [Binding r] -> [Binding r]
forall a. a -> [a] -> [a]
: [Binding r]
v)
    Either VarName (Binding r)
-> StateT
     (HashMap VarName (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either VarName (Binding r)
 -> StateT
      (HashMap VarName (SourcePos, [Binding r]))
      Identity
      (Either VarName (Binding r)))
-> Either VarName (Binding r)
-> StateT
     (HashMap VarName (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
forall a b. (a -> b) -> a -> b
$ VarName -> Either VarName (Binding r)
forall a b. a -> Either a b
Left VarName
x
  collect x :: Binding r
x = Either VarName (Binding r)
-> StateT
     (HashMap VarName (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either VarName (Binding r)
 -> StateT
      (HashMap VarName (SourcePos, [Binding r]))
      Identity
      (Either VarName (Binding r)))
-> Either VarName (Binding r)
-> StateT
     (HashMap VarName (SourcePos, [Binding r]))
     Identity
     (Either VarName (Binding r))
forall a b. (a -> b) -> a -> b
$ Binding r -> Either VarName (Binding r)
forall a b. b -> Either a b
Right Binding r
x

  go
    :: Either VarName (Binding r)
    -> State (HashMap VarName (SourcePos, [Binding r])) (Binding r)
  go :: Either VarName (Binding r)
-> StateT
     (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r)
go (Right x :: Binding r
x) = Binding r
-> StateT
     (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Binding r
x
  go (Left  x :: VarName
x) = do
    Maybe (SourcePos, [Binding r])
maybeValue <- (HashMap VarName (SourcePos, [Binding r])
 -> Maybe (SourcePos, [Binding r]))
-> StateT
     (HashMap VarName (SourcePos, [Binding r]))
     Identity
     (Maybe (SourcePos, [Binding r]))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName
-> HashMap VarName (SourcePos, [Binding r])
-> Maybe (SourcePos, [Binding r])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
x)
    case Maybe (SourcePos, [Binding r])
maybeValue of
      Nothing     -> String
-> StateT
     (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r)
forall a. HasCallStack => String -> a
error ("No binding " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
forall a. Show a => a -> String
show VarName
x)
      Just (p :: SourcePos
p, v :: [Binding r]
v) -> Binding r
-> StateT
     (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Binding r
 -> StateT
      (HashMap VarName (SourcePos, [Binding r])) Identity (Binding r))
-> Binding r
-> StateT
     (HashMap VarName (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 (VarName -> NKeyName r
forall r. VarName -> NKeyName r
StaticKey VarName
x NKeyName r -> [NKeyName r] -> NonEmpty (NKeyName r)
forall a. a -> [a] -> NonEmpty a
:| []) ([Binding r] -> r
embed [Binding r]
v) SourcePos
p

evalBinds
  :: forall v m
   . MonadNixEval v m
  => Bool
  -> [Binding (m v)]
  -> m (AttrSet v, AttrSet SourcePos)
evalBinds :: Bool -> [Binding (m v)] -> m (AttrSet v, AttrSet SourcePos)
evalBinds recursive :: Bool
recursive binds :: [Binding (m v)]
binds = do
  Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes :: m (Scopes m v)
  Scopes m v
-> [([VarName], SourcePos, m v)]
-> m (AttrSet v, AttrSet SourcePos)
buildResult Scopes m v
scope ([([VarName], SourcePos, m v)] -> m (AttrSet v, AttrSet SourcePos))
-> ([[([VarName], SourcePos, m v)]]
    -> [([VarName], SourcePos, m v)])
-> [[([VarName], SourcePos, m v)]]
-> m (AttrSet v, AttrSet SourcePos)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[([VarName], SourcePos, m v)]] -> [([VarName], SourcePos, m v)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[([VarName], SourcePos, m v)]]
 -> m (AttrSet v, AttrSet SourcePos))
-> m [[([VarName], SourcePos, m v)]]
-> m (AttrSet v, AttrSet SourcePos)
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 :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]
go Scopes m v
scope) ([Binding (m v)] -> [Binding (m v)]
forall r. [Binding r] -> [Binding r]
moveOverridesLast [Binding (m v)]
binds)
 where
  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. [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 "__overrides" :| []) _ _pos :: SourcePos
_pos -> Bool
False
      _ -> Bool
True
    )

  go :: Scopes m v -> Binding (m v) -> m [([Text], SourcePos, m v)]
  go :: Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]
go _ (NamedVar (StaticKey "__overrides" :| []) finalValue :: m v
finalValue pos :: SourcePos
pos) =
    m v
finalValue m v
-> (v -> m (AttrSet v, AttrSet SourcePos))
-> m (AttrSet v, AttrSet SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> m (AttrSet v, AttrSet SourcePos)
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue m (AttrSet v, AttrSet SourcePos)
-> ((AttrSet v, AttrSet SourcePos)
    -> m [([VarName], SourcePos, m v)])
-> m [([VarName], SourcePos, m v)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(o' :: AttrSet v
o', p' :: AttrSet SourcePos
p') ->
          -- jww (2018-05-09): What to do with the key position here?
                                              [([VarName], SourcePos, m v)] -> m [([VarName], SourcePos, m v)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([([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, v) -> ([VarName], SourcePos, m v))
-> [(VarName, v)] -> [([VarName], SourcePos, m v)]
forall a b. (a -> b) -> [a] -> [b]
map
      (\(k :: VarName
k, v :: v
v) -> ([VarName
k], SourcePos -> Maybe SourcePos -> SourcePos
forall a. a -> Maybe a -> a
fromMaybe SourcePos
pos (VarName -> AttrSet SourcePos -> Maybe SourcePos
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
k AttrSet SourcePos
p'), v -> (v -> m v) -> m v
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand v
v v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure))
      (AttrSet v -> [(VarName, v)]
forall k v. HashMap k v -> [(k, v)]
M.toList AttrSet v
o')

  go _ (NamedVar pathExpr :: NonEmpty (NKeyName (m v))
pathExpr finalValue :: m v
finalValue pos :: SourcePos
pos) = do
    let go :: NAttrPath (m v) -> m ([Text], SourcePos, m v)
        go :: NonEmpty (NKeyName (m v)) -> m ([VarName], SourcePos, m v)
go = \case
          h :: NKeyName (m v)
h :| t :: [NKeyName (m v)]
t -> 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 m (Maybe VarName)
-> (Maybe VarName -> m ([VarName], SourcePos, m v))
-> m ([VarName], SourcePos, m v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Nothing ->
              ([VarName], SourcePos, m v) -> m ([VarName], SourcePos, m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                ( []
                , SourcePos
nullPos
                , (AttrSet v, AttrSet SourcePos) -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue @(AttrSet v, AttrSet SourcePos) (AttrSet v
forall a. Monoid a => a
mempty, AttrSet SourcePos
forall a. Monoid a => a
mempty)
                )
            Just k :: VarName
k -> case [NKeyName (m v)]
t of
              []     -> ([VarName], SourcePos, m v) -> m ([VarName], SourcePos, m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VarName
k], SourcePos
pos, m v
finalValue)
              x :: NKeyName (m v)
x : xs :: [NKeyName (m v)]
xs -> do
                (restOfPath :: [VarName]
restOfPath, _, v :: m v
v) <- NonEmpty (NKeyName (m v)) -> m ([VarName], SourcePos, m v)
go (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)
    NonEmpty (NKeyName (m v)) -> m ([VarName], SourcePos, m v)
go NonEmpty (NKeyName (m v))
pathExpr m ([VarName], SourcePos, m v)
-> (([VarName], SourcePos, m v) -> [([VarName], SourcePos, m v)])
-> m [([VarName], SourcePos, m v)]
forall (f :: * -> *) a c. Functor f => f a -> (a -> c) -> f c
<&> \case
        -- When there are no path segments, e.g. `${null} = 5;`, we don't
        -- bind anything
      ([], _, _) -> []
      result :: ([VarName], SourcePos, m v)
result     -> [([VarName], SourcePos, m v)
result]

  go scope :: Scopes m v
scope (Inherit ms :: Maybe (m v)
ms names :: [NKeyName (m v)]
names pos :: SourcePos
pos) =
    ([Maybe ([VarName], SourcePos, m v)]
 -> [([VarName], SourcePos, m v)])
-> m [Maybe ([VarName], SourcePos, m v)]
-> m [([VarName], SourcePos, m v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ([VarName], SourcePos, m v)]
-> [([VarName], SourcePos, m v)]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ([VarName], SourcePos, m v)]
 -> m [([VarName], SourcePos, m v)])
-> m [Maybe ([VarName], SourcePos, m v)]
-> m [([VarName], SourcePos, m v)]
forall a b. (a -> b) -> a -> b
$ [NKeyName (m v)]
-> (NKeyName (m v) -> m (Maybe ([VarName], SourcePos, m v)))
-> m [Maybe ([VarName], SourcePos, m v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [NKeyName (m v)]
names ((NKeyName (m v) -> m (Maybe ([VarName], SourcePos, m v)))
 -> m [Maybe ([VarName], SourcePos, m v)])
-> (NKeyName (m v) -> m (Maybe ([VarName], SourcePos, m v)))
-> m [Maybe ([VarName], SourcePos, m v)]
forall a b. (a -> b) -> a -> 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) -> m (Maybe VarName))
-> (Maybe VarName -> m (Maybe ([VarName], SourcePos, m v)))
-> NKeyName (m v)
-> m (Maybe ([VarName], SourcePos, m v))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
      Nothing  -> Maybe ([VarName], SourcePos, m v)
-> m (Maybe ([VarName], SourcePos, m v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ([VarName], SourcePos, m v)
forall a. Maybe a
Nothing
      Just key :: VarName
key -> Maybe ([VarName], SourcePos, m v)
-> m (Maybe ([VarName], SourcePos, m v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ([VarName], SourcePos, m v)
 -> m (Maybe ([VarName], SourcePos, m v)))
-> Maybe ([VarName], SourcePos, m v)
-> m (Maybe ([VarName], SourcePos, m v))
forall a b. (a -> b) -> a -> b
$ ([VarName], SourcePos, m v) -> Maybe ([VarName], SourcePos, m v)
forall a. a -> Maybe a
Just
        ( [VarName
key]
        , SourcePos
pos
        , do
          Maybe v
mv <- case Maybe (m v)
ms of
            Nothing -> 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
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
key
            Just s :: m v
s ->
              m v
s m v
-> (v -> m (AttrSet v, AttrSet SourcePos))
-> m (AttrSet v, AttrSet SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, AttrSet SourcePos) m v =>
v -> m (AttrSet v, AttrSet SourcePos)
fromValue @(AttrSet v, AttrSet SourcePos) m (AttrSet v, AttrSet SourcePos)
-> ((AttrSet v, AttrSet SourcePos) -> m (Maybe v)) -> m (Maybe v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(s :: AttrSet v
s, _) ->
                forall a (m :: * -> *) r. Scoped a m => m r -> m r
forall (m :: * -> *) r. Scoped v m => m r -> m r
clearScopes @v (m (Maybe v) -> m (Maybe v)) -> m (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ AttrSet v -> m (Maybe v) -> m (Maybe v)
forall a (m :: * -> *) r. Scoped a m => AttrSet a -> m r -> m r
pushScope AttrSet v
s (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
key
          case Maybe v
mv of
            Nothing -> NonEmpty VarName -> Maybe v -> m v
forall v (m :: * -> *).
MonadEval v m =>
NonEmpty VarName -> Maybe v -> m v
attrMissing (VarName
key VarName -> [VarName] -> NonEmpty VarName
forall a. a -> [a] -> NonEmpty a
:| []) Maybe v
forall a. Maybe a
Nothing
            Just v :: v
v  -> v -> (v -> m v) -> m v
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand v
v v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        )

  buildResult
    :: Scopes m v
    -> [([Text], SourcePos, m v)]
    -> m (AttrSet v, AttrSet SourcePos)
  buildResult :: Scopes m v
-> [([VarName], SourcePos, m v)]
-> m (AttrSet v, AttrSet SourcePos)
buildResult scope :: Scopes m v
scope bindings :: [([VarName], SourcePos, m v)]
bindings = do
    (s :: AttrSet (m v)
s, p :: AttrSet SourcePos
p) <- ((AttrSet (m v), AttrSet SourcePos)
 -> ([VarName], SourcePos, m v)
 -> m (AttrSet (m v), AttrSet SourcePos))
-> (AttrSet (m v), AttrSet SourcePos)
-> [([VarName], SourcePos, m v)]
-> m (AttrSet (m v), AttrSet SourcePos)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (AttrSet (m v), AttrSet SourcePos)
-> ([VarName], SourcePos, m v)
-> m (AttrSet (m v), AttrSet SourcePos)
forall v (m :: * -> *).
(MonadEval v m, Scoped v m, MonadValue v m, MonadFix m,
 ToValue (AttrSet v, AttrSet SourcePos) m v, ToValue [v] m v,
 ToValue Bool m v, FromValue (AttrSet v, AttrSet SourcePos) m v,
 FromValue NixString m v) =>
(AttrSet (m v), AttrSet SourcePos)
-> ([VarName], SourcePos, m v)
-> m (AttrSet (m v), AttrSet SourcePos)
insert (AttrSet (m v)
forall k v. HashMap k v
M.empty, AttrSet SourcePos
forall k v. HashMap k v
M.empty) [([VarName], SourcePos, m v)]
bindings
    AttrSet v
res <- if Bool
recursive then 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 (m v -> AttrSet v -> m v
forall a. Scoped a m => m v -> AttrSet a -> m v
encapsulate (m v -> AttrSet v -> m v)
-> AttrSet (m v) -> HashMap VarName (AttrSet v -> m v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet (m v)
s) else (m v -> m v) -> AttrSet (m v) -> m (AttrSet v)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse m v -> m v
mkThunk AttrSet (m v)
s
    (AttrSet v, AttrSet SourcePos) -> m (AttrSet v, AttrSet SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrSet v
res, AttrSet SourcePos
p)
   where
    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
scope

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

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

evalSelect
  :: forall v m
   . MonadNixEval v m
  => m v
  -> NAttrPath (m v)
  -> m (Either (v, NonEmpty Text) (m v))
evalSelect :: m v -> NAttrPath (m v) -> m (Either (v, NonEmpty VarName) (m v))
evalSelect aset :: m v
aset attr :: 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
  v -> NonEmpty VarName -> m (Either (v, NonEmpty VarName) (m v))
forall (m :: * -> *) (m :: * -> *).
(Monad m, FromValue (AttrSet v, AttrSet SourcePos) m v,
 Applicative m, MonadValue v m, MonadValue v m,
 ToValue (AttrSet v, AttrSet SourcePos) m v) =>
v -> NonEmpty VarName -> m (Either (v, NonEmpty VarName) (m v))
extract v
s NonEmpty VarName
path
 where
  extract :: v -> NonEmpty VarName -> m (Either (v, NonEmpty VarName) (m v))
extract x :: v
x path :: NonEmpty VarName
path@(k :: VarName
k :| ks :: [VarName]
ks) = v -> m (Maybe (AttrSet v, AttrSet SourcePos))
forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
fromValueMay v
x m (Maybe (AttrSet v, AttrSet SourcePos))
-> (Maybe (AttrSet v, AttrSet SourcePos)
    -> m (Either (v, NonEmpty VarName) (m v)))
-> m (Either (v, NonEmpty VarName) (m v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (AttrSet v
s :: AttrSet v, AttrSet SourcePos
p :: AttrSet SourcePos)
      | Just t :: v
t <- VarName -> AttrSet v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
k AttrSet v
s -> case [VarName]
ks of
        []     -> 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)))
-> Either (v, NonEmpty VarName) (m v)
-> m (Either (v, NonEmpty VarName) (m v))
forall a b. (a -> b) -> a -> b
$ m v -> Either (v, NonEmpty VarName) (m v)
forall a b. b -> Either a b
Right (m v -> Either (v, NonEmpty VarName) (m v))
-> m v -> Either (v, NonEmpty VarName) (m v)
forall a b. (a -> b) -> a -> b
$ v -> (v -> m v) -> m v
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand v
t v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        y :: VarName
y : ys :: [VarName]
ys -> v
-> (v -> m (Either (v, NonEmpty VarName) (m v)))
-> m (Either (v, NonEmpty VarName) (m v))
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand v
t ((v -> m (Either (v, NonEmpty VarName) (m v)))
 -> m (Either (v, NonEmpty VarName) (m v)))
-> (v -> m (Either (v, NonEmpty VarName) (m v)))
-> m (Either (v, NonEmpty VarName) (m v))
forall a b. (a -> b) -> a -> b
$ v -> NonEmpty VarName -> m (Either (v, NonEmpty VarName) (m v))
extract (v -> NonEmpty VarName -> m (Either (v, NonEmpty VarName) (m v)))
-> NonEmpty VarName -> v -> m (Either (v, NonEmpty VarName) (m v))
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? (VarName
y VarName -> [VarName] -> NonEmpty VarName
forall a. a -> [a] -> NonEmpty a
:| [VarName]
ys)
      | Bool
otherwise -> (v, NonEmpty VarName) -> Either (v, NonEmpty VarName) (m v)
forall a b. a -> Either a b
Left ((v, NonEmpty VarName) -> Either (v, NonEmpty VarName) (m v))
-> (v -> (v, NonEmpty VarName))
-> v
-> Either (v, NonEmpty VarName) (m v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, NonEmpty VarName
path) (v -> Either (v, NonEmpty VarName) (m v))
-> m v -> m (Either (v, NonEmpty VarName) (m v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AttrSet v, AttrSet SourcePos) -> m v
forall a (m :: * -> *) v. ToValue a m v => a -> m v
toValue (AttrSet v
s, AttrSet SourcePos
p)
    Nothing -> Either (v, NonEmpty VarName) (m v)
-> m (Either (v, NonEmpty VarName) (m v))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (v, NonEmpty VarName) (m v)
 -> m (Either (v, NonEmpty VarName) (m v)))
-> Either (v, NonEmpty VarName) (m v)
-> m (Either (v, NonEmpty VarName) (m v))
forall a b. (a -> b) -> a -> b
$ (v, NonEmpty VarName) -> Either (v, NonEmpty VarName) (m v)
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 Text
evalGetterKeyName :: NKeyName (m v) -> m VarName
evalGetterKeyName = 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) -> m (Maybe VarName))
-> (Maybe VarName -> m VarName) -> NKeyName (m v) -> m VarName
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
  Just k :: VarName
k -> VarName -> m VarName
forall (f :: * -> *) a. Applicative f => a -> f a
pure VarName
k
  Nothing ->
    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 "value is null while a string was expected"

-- | 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 Text)
evalSetterKeyName :: NKeyName (m v) -> m (Maybe VarName)
evalSetterKeyName = \case
  StaticKey k :: VarName
k -> Maybe VarName -> m (Maybe VarName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarName -> Maybe VarName
forall a. a -> Maybe a
Just VarName
k)
  DynamicKey k :: Antiquoted (NString (m v)) (m v)
k ->
    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 "\n" NString (m v) -> m (Maybe NixString)
forall v (m :: * -> *).
(MonadEval v m, FromValue NixString m v) =>
NString (m v) -> m (Maybe NixString)
assembleString (m v -> (v -> m (Maybe NixString)) -> m (Maybe NixString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> m (Maybe NixString)
forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
fromValueMay) Antiquoted (NString (m v)) (m v)
k m (Maybe NixString)
-> (Maybe NixString -> Maybe VarName) -> m (Maybe VarName)
forall (f :: * -> *) a c. Functor f => f a -> (a -> c) -> f c
<&> \case
      Just ns :: NixString
ns -> VarName -> Maybe VarName
forall a. a -> Maybe a
Just (NixString -> VarName
hackyStringIgnoreContext NixString
ns)
      _       -> Maybe VarName
forall a. Maybe a
Nothing

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 = \case
  Indented _ parts :: [Antiquoted VarName (m v)]
parts   -> [Antiquoted VarName (m v)] -> m (Maybe NixString)
fromParts [Antiquoted VarName (m v)]
parts
  DoubleQuoted parts :: [Antiquoted VarName (m v)]
parts -> [Antiquoted VarName (m v)] -> m (Maybe NixString)
fromParts [Antiquoted VarName (m v)]
parts
 where
  fromParts :: [Antiquoted VarName (m v)] -> m (Maybe NixString)
fromParts = ([Maybe NixString] -> Maybe NixString)
-> m [Maybe NixString] -> m (Maybe NixString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([NixString] -> NixString) -> Maybe [NixString] -> Maybe NixString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NixString] -> NixString
principledStringMConcat (Maybe [NixString] -> Maybe NixString)
-> ([Maybe NixString] -> Maybe [NixString])
-> [Maybe NixString]
-> Maybe NixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe NixString] -> Maybe [NixString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence) (m [Maybe NixString] -> m (Maybe NixString))
-> ([Antiquoted VarName (m v)] -> m [Maybe NixString])
-> [Antiquoted VarName (m v)]
-> m (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Antiquoted VarName (m v) -> m (Maybe NixString))
-> [Antiquoted VarName (m v)] -> m [Maybe NixString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Antiquoted VarName (m v) -> m (Maybe NixString)
go

  go :: Antiquoted VarName (m v) -> m (Maybe NixString)
go = VarName
-> (VarName -> m (Maybe NixString))
-> (m v -> m (Maybe NixString))
-> Antiquoted VarName (m v)
-> m (Maybe NixString)
forall v a r. v -> (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted "\n"
                     (Maybe NixString -> m (Maybe NixString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NixString -> m (Maybe NixString))
-> (VarName -> Maybe NixString) -> VarName -> m (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> Maybe NixString
forall a. a -> Maybe a
Just (NixString -> Maybe NixString)
-> (VarName -> NixString) -> VarName -> Maybe NixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> NixString
principledMakeNixStringWithoutContext)
                     (m v -> (v -> m (Maybe NixString)) -> m (Maybe NixString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> m (Maybe NixString)
forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
fromValueMay)

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 :: Params (m v)
params arg :: m v
arg = do
  Scopes m v
scope <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes :: m (Scopes m v)
  case Params (m v)
params of
    Param name :: VarName
name -> VarName -> v -> AttrSet v
forall k v. Hashable k => k -> v -> HashMap k v
M.singleton VarName
name (v -> AttrSet v) -> m v -> m (AttrSet v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v -> m v
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (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)
    ParamSet s :: ParamSet (m v)
s isVariadic :: Bool
isVariadic m :: Maybe VarName
m ->
      m v
arg m v
-> (v -> m (AttrSet v, AttrSet SourcePos))
-> m (AttrSet v, AttrSet SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue (AttrSet v, AttrSet SourcePos) m v =>
v -> m (AttrSet v, AttrSet SourcePos)
fromValue @(AttrSet v, AttrSet SourcePos) m (AttrSet v, AttrSet SourcePos)
-> ((AttrSet v, AttrSet SourcePos) -> m (AttrSet v))
-> m (AttrSet v)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(args :: AttrSet v
args, _) -> do
        let inject :: HashMap VarName (b -> m v) -> HashMap VarName (b -> m v)
inject = case Maybe VarName
m of
              Nothing -> HashMap VarName (b -> m v) -> HashMap VarName (b -> m v)
forall a. a -> a
id
              Just n :: VarName
n  -> 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 VarName
n ((b -> m v)
 -> HashMap VarName (b -> m v) -> HashMap VarName (b -> m v))
-> (b -> m v)
-> HashMap VarName (b -> m v)
-> HashMap VarName (b -> m v)
forall a b. (a -> b) -> a -> b
$ m v -> b -> m v
forall a b. a -> b -> a
const (m v -> b -> m v) -> m v -> b -> m v
forall a b. (a -> b) -> a -> b
$ m v -> m v
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (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)
        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)
-> 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
-> Bool
-> VarName
-> These v (Maybe (m v))
-> Maybe (AttrSet v -> m v)
assemble Scopes m v
scope Bool
isVariadic)
                                               AttrSet v
args
                                               (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)
s)
          )
 where
  assemble
    :: Scopes m v
    -> Bool
    -> Text
    -> These v (Maybe (m v))
    -> Maybe (AttrSet v -> m v)
  assemble :: Scopes m v
-> Bool
-> VarName
-> These v (Maybe (m v))
-> Maybe (AttrSet v -> m v)
assemble scope :: Scopes m v
scope isVariadic :: Bool
isVariadic k :: VarName
k = \case
    That Nothing ->
      (AttrSet v -> m v) -> Maybe (AttrSet v -> m v)
forall a. a -> Maybe a
Just
        ((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
$  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
$  "Missing value for parameter: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
forall a. Show a => a -> String
show VarName
k
    That (Just f :: m v
f) ->
      (AttrSet v -> m v) -> Maybe (AttrSet v -> m v)
forall a. a -> Maybe a
Just ((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
$ \args :: AttrSet v
args -> 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 -> m v) -> m v -> m v
forall a b. (a -> b) -> a -> b
$ AttrSet v -> m v -> m v
forall a (m :: * -> *) r. Scoped a m => AttrSet a -> m r -> m r
pushScope AttrSet v
args m v
f
    This _
      | Bool
isVariadic
      -> Maybe (AttrSet v -> m v)
forall a. Maybe a
Nothing
      | Bool
otherwise
      -> (AttrSet v -> m v) -> Maybe (AttrSet v -> m v)
forall a. a -> Maybe a
Just
        ((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
$  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
$  "Unexpected parameter: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
forall a. Show a => a -> String
show VarName
k
    These x :: v
x _ -> (AttrSet v -> m v) -> Maybe (AttrSet v -> m v)
forall a. a -> Maybe a
Just (m v -> AttrSet v -> m v
forall a b. a -> b -> a
const (v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
x))

addSourcePositions
  :: (MonadReader e m, Has e SrcSpan) => Transform NExprLocF (m a)
addSourcePositions :: Transform NExprLocF (m a)
addSourcePositions f :: NExprLoc -> m a
f v :: NExprLoc
v@(Fix (Compose (Ann ann :: SrcSpan
ann _))) =
  (e -> e) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Setter e e SrcSpan SrcSpan -> SrcSpan -> e -> e
forall s t a b. Setter s t a b -> b -> s -> t
set forall a b. Has a b => Lens' a b
Setter e e SrcSpan SrcSpan
hasLens SrcSpan
ann) (NExprLoc -> m a
f NExprLoc
v)

addStackFrames
  :: forall v e m a
   . (Scoped v m, Framed e m, Typeable v, Typeable m)
  => Transform NExprLocF (m a)
addStackFrames :: Transform NExprLocF (m a)
addStackFrames f :: NExprLoc -> m a
f v :: NExprLoc
v = do
  Scopes m v
scopes <- m (Scopes m v)
forall a (m :: * -> *). Scoped a m => m (Scopes m a)
currentScopes :: m (Scopes m v)
  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 (Scopes m v -> NExprLoc -> EvalFrame m v
forall (m :: * -> *) v. Scopes m v -> NExprLoc -> EvalFrame m v
EvaluatingExpr Scopes m v
scopes NExprLoc
v) (NExprLoc -> m a
f NExprLoc
v)

framedEvalExprLoc
  :: forall e v m
   . (MonadNixEval v m, Framed e m, Has e SrcSpan, Typeable m, Typeable v)
  => NExprLoc
  -> m v
framedEvalExprLoc :: NExprLoc -> m v
framedEvalExprLoc =
  (Compose (Ann SrcSpan) NExprF (m v) -> m v)
-> ((NExprLoc -> m v) -> NExprLoc -> m v) -> NExprLoc -> m v
forall (f :: * -> *) a.
Functor f =>
(f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
adi (NExprF (m v) -> m v
forall v (m :: * -> *). MonadNixEval v m => NExprF (m v) -> m v
eval (NExprF (m v) -> m v)
-> (Compose (Ann SrcSpan) NExprF (m v) -> NExprF (m v))
-> Compose (Ann SrcSpan) NExprF (m v)
-> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann SrcSpan (NExprF (m v)) -> NExprF (m v)
forall ann a. Ann ann a -> a
annotated (Ann SrcSpan (NExprF (m v)) -> NExprF (m v))
-> (Compose (Ann SrcSpan) NExprF (m v)
    -> Ann SrcSpan (NExprF (m v)))
-> Compose (Ann SrcSpan) NExprF (m v)
-> NExprF (m v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Ann SrcSpan) NExprF (m v) -> Ann SrcSpan (NExprF (m v))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (forall v e (m :: * -> *) a.
(Scoped v m, Framed e m, Typeable v, Typeable m) =>
Transform NExprLocF (m a)
forall e (m :: * -> *) a.
(Scoped v m, Framed e m, Typeable v, Typeable m) =>
Transform NExprLocF (m a)
addStackFrames @v ((NExprLoc -> m v) -> NExprLoc -> m v)
-> ((NExprLoc -> m v) -> NExprLoc -> m v)
-> (NExprLoc -> m v)
-> NExprLoc
-> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprLoc -> m v) -> NExprLoc -> m v
forall e (m :: * -> *) a.
(MonadReader e m, Has e SrcSpan) =>
Transform NExprLocF (m a)
addSourcePositions)