2018-04-21 07:36:40 +02:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
|
|
|
|
module Nix (module Nix.Cache,
|
|
|
|
module Nix.Exec,
|
|
|
|
module Nix.Expr,
|
|
|
|
module Nix.Normal,
|
|
|
|
module Nix.Options,
|
|
|
|
module Nix.Parser,
|
|
|
|
module Nix.Pretty,
|
|
|
|
module Nix.Reduce,
|
|
|
|
module Nix.Stack,
|
|
|
|
module Nix.Thunk,
|
|
|
|
module Nix.Value,
|
|
|
|
module Nix.XML,
|
|
|
|
withNixContext,
|
|
|
|
nixEvalExpr, nixEvalExprLoc, nixTracingEvalExprLoc,
|
|
|
|
evaluateExpression, processResult) where
|
|
|
|
|
|
|
|
import Control.Applicative
|
|
|
|
import Control.Arrow (second)
|
|
|
|
import Control.Monad.Reader
|
|
|
|
-- import Control.Monad.Trans.Class
|
|
|
|
import Data.Fix
|
|
|
|
import Data.Functor.Compose
|
|
|
|
import qualified Data.HashMap.Lazy as M
|
|
|
|
-- import Data.Monoid
|
|
|
|
import qualified Data.Text as Text
|
|
|
|
import qualified Data.Text.Read as Text
|
|
|
|
import Nix.Builtins
|
|
|
|
import Nix.Cache
|
2018-04-21 19:10:22 +02:00
|
|
|
import qualified Nix.Eval as Eval
|
2018-04-21 07:36:40 +02:00
|
|
|
import Nix.Exec
|
|
|
|
import Nix.Expr
|
|
|
|
-- import Nix.Expr.Shorthands
|
|
|
|
-- import Nix.Expr.Types
|
|
|
|
-- import Nix.Expr.Types.Annotated
|
|
|
|
import Nix.Normal
|
|
|
|
import Nix.Options
|
|
|
|
import Nix.Parser
|
|
|
|
import Nix.Parser.Library (Result(..))
|
|
|
|
import Nix.Pretty
|
|
|
|
import Nix.Reduce
|
|
|
|
import Nix.Scope
|
|
|
|
import Nix.Stack hiding (readFile)
|
|
|
|
import Nix.Thunk
|
|
|
|
import Nix.Utils
|
|
|
|
import Nix.Value
|
|
|
|
import Nix.XML
|
|
|
|
|
|
|
|
-- | Evaluate a nix expression in the default context
|
|
|
|
withNixContext :: forall e m r. MonadNix e m => Maybe FilePath -> m r -> m r
|
|
|
|
withNixContext mpath action = do
|
2018-04-21 19:36:24 +02:00
|
|
|
base <- builtins
|
2018-04-21 07:36:40 +02:00
|
|
|
opts :: Options <- asks (view hasLens)
|
2018-04-22 23:32:55 +02:00
|
|
|
let i = value @(NValue m) @(NThunk m) @m $ nvList $
|
2018-04-21 07:36:40 +02:00
|
|
|
map (value @(NValue m) @(NThunk m) @m
|
2018-04-22 23:32:55 +02:00
|
|
|
. flip nvStr mempty . Text.pack) (include opts)
|
2018-04-21 07:36:40 +02:00
|
|
|
pushScope (M.singleton "__includes" i) $
|
|
|
|
pushScopes base $ case mpath of
|
|
|
|
Nothing -> action
|
|
|
|
Just path -> do
|
|
|
|
traceM $ "Setting __cur_file = " ++ show path
|
2018-04-22 23:32:55 +02:00
|
|
|
let ref = value @(NValue m) @(NThunk m) @m $ nvPath path
|
2018-04-21 07:36:40 +02:00
|
|
|
pushScope (M.singleton "__cur_file" ref) action
|
|
|
|
|
|
|
|
-- | This is the entry point for all evaluations, whatever the expression tree
|
|
|
|
-- type. It sets up the common Nix environment and applies the
|
|
|
|
-- transformations, allowing them to be easily composed.
|
|
|
|
nixEval :: (MonadNix e m, Functor f)
|
|
|
|
=> Maybe FilePath -> Transform f (m a) -> Alg f (m a) -> Fix f -> m a
|
|
|
|
nixEval mpath xform alg = withNixContext mpath . adi alg xform
|
|
|
|
|
|
|
|
-- | Evaluate a nix expression in the default context
|
|
|
|
nixEvalExpr :: forall e m. MonadNix e m
|
|
|
|
=> Maybe FilePath -> NExpr -> m (NValue m)
|
2018-04-21 19:10:22 +02:00
|
|
|
nixEvalExpr mpath = nixEval mpath id Eval.eval
|
2018-04-21 07:36:40 +02:00
|
|
|
|
|
|
|
-- | Evaluate a nix expression in the default context
|
|
|
|
nixEvalExprLoc :: MonadNix e m
|
|
|
|
=> Maybe FilePath -> NExprLoc -> m (NValue m)
|
|
|
|
nixEvalExprLoc mpath =
|
2018-04-21 19:10:22 +02:00
|
|
|
nixEval mpath Eval.addStackFrames (Eval.eval . annotated . getCompose)
|
2018-04-21 07:36:40 +02:00
|
|
|
|
2018-04-21 19:36:24 +02:00
|
|
|
-- | Evaluate a nix expression with tracing in the default context. Note that
|
|
|
|
-- this function doesn't do any tracing itself, but 'evalExprLoc' will be
|
|
|
|
-- 'tracing' is set to 'True' in the Options structure (accessible through
|
|
|
|
-- 'MonadNix'). All this function does is provide the right type class
|
|
|
|
-- context.
|
2018-04-21 07:36:40 +02:00
|
|
|
nixTracingEvalExprLoc :: forall e m. (MonadNix e m, MonadIO m, Alternative m)
|
|
|
|
=> Maybe FilePath -> NExprLoc -> m (NValue m)
|
2018-04-21 19:36:24 +02:00
|
|
|
nixTracingEvalExprLoc mpath = withNixContext mpath . evalExprLoc
|
2018-04-21 07:36:40 +02:00
|
|
|
|
|
|
|
evaluateExpression
|
|
|
|
:: MonadNix e m
|
|
|
|
=> Maybe FilePath
|
|
|
|
-> (Maybe FilePath -> NExprLoc -> m (NValue m))
|
|
|
|
-> (NValue m -> m a)
|
|
|
|
-> NExprLoc
|
|
|
|
-> m a
|
|
|
|
evaluateExpression mpath evaluator handler expr = do
|
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
args <- traverse (traverse eval') $
|
|
|
|
map (second parseArg) (arg opts) ++
|
|
|
|
map (second mkStr) (argstr opts)
|
|
|
|
compute evaluator expr (argmap args) handler
|
|
|
|
where
|
|
|
|
parseArg s = case parseNixText s of
|
|
|
|
Success x -> x
|
|
|
|
Failure err -> errorWithoutStackTrace (show err)
|
|
|
|
|
|
|
|
eval' = (normalForm =<<) . nixEvalExpr mpath
|
|
|
|
|
2018-04-22 23:32:55 +02:00
|
|
|
argmap args = embed $ Fix $ NVSetF (M.fromList args) mempty
|
2018-04-21 07:36:40 +02:00
|
|
|
|
|
|
|
compute ev x args p = do
|
|
|
|
f <- ev mpath x
|
|
|
|
processResult p =<< case f of
|
|
|
|
NVClosure _ g -> g args
|
|
|
|
_ -> pure f
|
|
|
|
|
|
|
|
processResult :: forall e m a. MonadNix e m
|
|
|
|
=> (NValue m -> m a) -> NValue m -> m a
|
|
|
|
processResult h val = do
|
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
case attr opts of
|
|
|
|
Nothing -> h val
|
|
|
|
Just (Text.splitOn "." -> keys) -> go keys val
|
|
|
|
where
|
|
|
|
go :: [Text.Text] -> NValue m -> m a
|
|
|
|
go [] v = h v
|
|
|
|
go ((Text.decimal -> Right (n,"")):ks) v = case v of
|
|
|
|
NVList xs -> case ks of
|
|
|
|
[] -> force @(NValue m) @(NThunk m) (xs !! n) h
|
|
|
|
_ -> force (xs !! n) (go ks)
|
|
|
|
_ -> errorWithoutStackTrace $
|
|
|
|
"Expected a list for selector '" ++ show n
|
|
|
|
++ "', but got: " ++ show v
|
|
|
|
go (k:ks) v = case v of
|
|
|
|
NVSet xs _ -> case M.lookup k xs of
|
|
|
|
Nothing ->
|
|
|
|
errorWithoutStackTrace $
|
|
|
|
"Set does not contain key '"
|
|
|
|
++ Text.unpack k ++ "'"
|
|
|
|
Just v' -> case ks of
|
|
|
|
[] -> force v' h
|
|
|
|
_ -> force v' (go ks)
|
|
|
|
_ -> errorWithoutStackTrace $
|
|
|
|
"Expected a set for selector '" ++ Text.unpack k
|
|
|
|
++ "', but got: " ++ show v
|