{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Nix
  ( module Nix.Cache
  , module Nix.Exec
  , module Nix.Expr
  , module Nix.Frames
  , module Nix.Render.Frame
  , module Nix.Normal
  , module Nix.Options
  , module Nix.String
  , module Nix.Parser
  , module Nix.Pretty
  , module Nix.Reduce
  , module Nix.Thunk
  , module Nix.Value
  , module Nix.XML
  , withNixContext
  , nixEvalExpr
  , nixEvalExprLoc
  , nixTracingEvalExprLoc
  , evaluateExpression
  , processResult
  )
where

import           Relude.Unsafe                  ( (!!) )
import           GHC.Err                        ( errorWithoutStackTrace )
import           Data.Fix                       ( Fix )
import qualified Data.HashMap.Lazy             as M
import qualified Data.Text                     as Text
import qualified Data.Text.Read                as Text
import           Nix.Builtins
import           Nix.Cache
import qualified Nix.Eval                      as Eval
import           Nix.Exec
import           Nix.Expr
import           Nix.Frames
import           Nix.String
import           Nix.Normal
import           Nix.Options
import           Nix.Parser
import           Nix.Pretty
import           Nix.Reduce
import           Nix.Render.Frame
import           Nix.Thunk
import           Nix.Utils
import           Nix.Value
import           Nix.Value.Monad
import           Nix.XML

-- | 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 t f m, Has e Options, Functor g)
  => Transform g (m a)
  -> Alg g (m a)
  -> Maybe FilePath
  -> Fix g
  -> m a
nixEval :: forall e t (f :: * -> *) (m :: * -> *) (g :: * -> *) a.
(MonadNix e t f m, Has e Options, Functor g) =>
Transform g (m a) -> Alg g (m a) -> Maybe FilePath -> Fix g -> m a
nixEval Transform g (m a)
transform Alg g (m a)
alg Maybe FilePath
mpath = Maybe FilePath -> m a -> m a
forall e t (f :: * -> *) (m :: * -> *) r.
(MonadNix e t f m, Has e Options) =>
Maybe FilePath -> m r -> m r
withNixContext Maybe FilePath
mpath (m a -> m a) -> Transform g (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transform g (m a) -> Alg g (m a) -> Fix g -> m a
forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi Transform g (m a)
transform Alg g (m a)
alg

-- | Evaluate a nix expression in the default context
nixEvalExpr
  :: (MonadNix e t f m, Has e Options)
  => Maybe FilePath
  -> NExpr
  -> m (NValue t f m)
nixEvalExpr :: forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, Has e Options) =>
Maybe FilePath -> NExpr -> m (NValue t f m)
nixEvalExpr = Transform NExprF (m (NValue t f m))
-> Alg NExprF (m (NValue t f m))
-> Maybe FilePath
-> NExpr
-> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *) (g :: * -> *) a.
(MonadNix e t f m, Has e Options, Functor g) =>
Transform g (m a) -> Alg g (m a) -> Maybe FilePath -> Fix g -> m a
nixEval Transform NExprF (m (NValue t f m))
forall a. a -> a
id Alg NExprF (m (NValue t f m))
forall v (m :: * -> *). MonadNixEval v m => NExprF (m v) -> m v
Eval.eval

-- | Evaluate a nix expression in the default context
nixEvalExprLoc
  :: forall e t f m
   . (MonadNix e t f m, Has e Options)
  => Maybe FilePath
  -> NExprLoc
  -> m (NValue t f m)
nixEvalExprLoc :: forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, Has e Options) =>
Maybe FilePath -> NExprLoc -> m (NValue t f m)
nixEvalExprLoc =
  Transform NExprLocF (m (NValue t f m))
-> Alg NExprLocF (m (NValue t f m))
-> Maybe FilePath
-> NExprLoc
-> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *) (g :: * -> *) a.
(MonadNix e t f m, Has e Options, Functor g) =>
Transform g (m a) -> Alg g (m a) -> Maybe FilePath -> Fix g -> m a
nixEval
    Transform NExprLocF (m (NValue t f m))
forall v (m :: * -> *) e a.
(Framed e m, Scoped v m, Has e SrcSpan, Typeable m, Typeable v) =>
TransformF NExprLoc (m a)
Eval.addMetaInfo
    Alg NExprLocF (m (NValue t f m))
forall v (m :: * -> *) ann.
MonadNixEval v m =>
AnnF ann NExprF (m v) -> m v
Eval.evalContent

-- | 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.
nixTracingEvalExprLoc
  :: (MonadNix e t f m, Has e Options, MonadIO m, Alternative m)
  => Maybe FilePath
  -> NExprLoc
  -> m (NValue t f m)
nixTracingEvalExprLoc :: forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, Has e Options, MonadIO m, Alternative m) =>
Maybe FilePath -> NExprLoc -> m (NValue t f m)
nixTracingEvalExprLoc Maybe FilePath
mpath = Maybe FilePath -> m (NValue t f m) -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *) r.
(MonadNix e t f m, Has e Options) =>
Maybe FilePath -> m r -> m r
withNixContext Maybe FilePath
mpath (m (NValue t f m) -> m (NValue t f m))
-> (NExprLoc -> m (NValue t f m)) -> NExprLoc -> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLoc -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> m (NValue t f m)
evalExprLoc

evaluateExpression
  :: (MonadNix e t f m, Has e Options)
  => Maybe FilePath
  -> (Maybe FilePath -> NExprLoc -> m (NValue t f m))
  -> (NValue t f m -> m a)
  -> NExprLoc
  -> m a
evaluateExpression :: forall e t (f :: * -> *) (m :: * -> *) a.
(MonadNix e t f m, Has e Options) =>
Maybe FilePath
-> (Maybe FilePath -> NExprLoc -> m (NValue t f m))
-> (NValue t f m -> m a)
-> NExprLoc
-> m a
evaluateExpression Maybe FilePath
mpath Maybe FilePath -> NExprLoc -> m (NValue t f m)
evaluator NValue t f m -> m a
handler NExprLoc
expr =
  do
    Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((e -> Options) -> m Options) -> (e -> Options) -> m Options
forall a b. (a -> b) -> a -> b
$ FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens
    [(Text, NValue t f m)]
args <-
      (((Text, NExpr) -> m (Text, NValue t f m))
-> [(Text, NExpr)] -> m [(Text, NValue t f m)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((Text, NExpr) -> m (Text, NValue t f m))
 -> [(Text, NExpr)] -> m [(Text, NValue t f m)])
-> ((NExpr -> m (NValue t f m))
    -> (Text, NExpr) -> m (Text, NValue t f m))
-> (NExpr -> m (NValue t f m))
-> [(Text, NExpr)]
-> m [(Text, NValue t f m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExpr -> m (NValue t f m))
-> (Text, NExpr) -> m (Text, NValue t f m)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
        NExpr -> m (NValue t f m)
eval'
        ([(Text, NExpr)] -> m [(Text, NValue t f m)])
-> [(Text, NExpr)] -> m [(Text, NValue t f m)]
forall a b. (a -> b) -> a -> b
$  ((Text -> NExpr) -> (Text, Text) -> (Text, NExpr)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> NExpr
parseArg ((Text, Text) -> (Text, NExpr))
-> [(Text, Text)] -> [(Text, NExpr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> [(Text, Text)]
arg    Options
opts)
        [(Text, NExpr)] -> [(Text, NExpr)] -> [(Text, NExpr)]
forall a. Semigroup a => a -> a -> a
<> ((Text -> NExpr) -> (Text, Text) -> (Text, NExpr)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> NExpr
mkStr    ((Text, Text) -> (Text, NExpr))
-> [(Text, Text)] -> [(Text, NExpr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> [(Text, Text)]
argstr Options
opts)
    NValue t f m
f <- Maybe FilePath -> NExprLoc -> m (NValue t f m)
evaluator Maybe FilePath
mpath NExprLoc
expr
    NValue t f m
f' <- NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
f
    NValue t f m
val <-
      case NValue t f m
f' of
        NVClosure Params ()
_ NValue t f m -> m (NValue t f m)
g -> NValue t f m -> m (NValue t f m)
g (NValue t f m -> m (NValue t f m))
-> NValue t f m -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ [(Text, NValue t f m)] -> NValue t f m
forall {f :: * -> *} {t} {m :: * -> *}.
Applicative f =>
[(Text, NValue t f m)] -> NValue t f m
argmap [(Text, NValue t f m)]
args
        NValue t f m
_             -> NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
f
    (NValue t f m -> m a) -> NValue t f m -> m a
forall e t (f :: * -> *) (m :: * -> *) a.
(MonadNix e t f m, Has e Options) =>
(NValue t f m -> m a) -> NValue t f m -> m a
processResult NValue t f m -> m a
handler NValue t f m
val
 where
  parseArg :: Text -> NExpr
parseArg Text
s =
    (Doc Void -> NExpr)
-> (NExpr -> NExpr) -> Either (Doc Void) NExpr -> NExpr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (FilePath -> NExpr
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> NExpr) -> (Doc Void -> FilePath) -> Doc Void -> NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Void -> FilePath
forall b a. (Show a, IsString b) => a -> b
show)
      NExpr -> NExpr
forall a. a -> a
id
      (Text -> Either (Doc Void) NExpr
parseNixText Text
s)

  eval' :: NExpr -> m (NValue t f m)
eval' = NValue t f m -> m (NValue t f m)
forall e (m :: * -> *) t (f :: * -> *).
(Framed e m, MonadThunk t m (NValue t f m),
 MonadDataErrorContext t f m, HasCitations m (NValue t f m) t,
 HasCitations1 m (NValue t f m) f, Ord (ThunkId m)) =>
NValue t f m -> m (NValue t f m)
normalForm (NValue t f m -> m (NValue t f m))
-> (NExpr -> m (NValue t f m)) -> NExpr -> m (NValue t f m)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe FilePath -> NExpr -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, Has e Options) =>
Maybe FilePath -> NExpr -> m (NValue t f m)
nixEvalExpr Maybe FilePath
mpath

  argmap :: [(Text, NValue t f m)] -> NValue t f m
argmap [(Text, NValue t f m)]
args = AttrSet SourcePos -> AttrSet (NValue t f m) -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
AttrSet SourcePos -> AttrSet (NValue t f m) -> NValue t f m
nvSet AttrSet SourcePos
forall a. Monoid a => a
mempty (AttrSet (NValue t f m) -> NValue t f m)
-> AttrSet (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$ [(Text, NValue t f m)] -> AttrSet (NValue t f m)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Text, NValue t f m)]
args

processResult
  :: forall e t f m a
   . (MonadNix e t f m, Has e Options)
  => (NValue t f m -> m a)
  -> NValue t f m
  -> m a
processResult :: forall e t (f :: * -> *) (m :: * -> *) a.
(MonadNix e t f m, Has e Options) =>
(NValue t f m -> m a) -> NValue t f m -> m a
processResult NValue t f m -> m a
h NValue t f m
val = do
  Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((e -> Options) -> m Options) -> (e -> Options) -> m Options
forall a b. (a -> b) -> a -> b
$ FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens
  m a -> (Text -> m a) -> Maybe Text -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (NValue t f m -> m a
h NValue t f m
val)
    (\ (Text -> Text -> [Text]
Text.splitOn Text
"." -> [Text]
keys) -> [Text] -> NValue t f m -> m a
processKeys [Text]
keys NValue t f m
val)
    (Options -> Maybe Text
attr Options
opts)
 where
  processKeys :: [Text] -> NValue t f m -> m a
  processKeys :: [Text] -> NValue t f m -> m a
processKeys [Text]
kys NValue t f m
v =
    m a -> ([Text] -> m a) -> [Text] -> m a
forall (t :: * -> *) b a. Foldable t => b -> (t a -> b) -> t a -> b
list
      (NValue t f m -> m a
h NValue t f m
v)
      (\ (Text
k : [Text]
ks) ->
        do
          NValue t f m
v' <- NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
v
          case (Text
k, NValue t f m
v') of
            (Reader Int
forall a. Integral a => Reader a
Text.decimal -> Right (Int
n,Text
""), NVList [NValue t f m]
xs) -> [Text] -> NValue t f m -> m a
processKeys [Text]
ks (NValue t f m -> m a) -> NValue t f m -> m a
forall a b. (a -> b) -> a -> b
$ [NValue t f m]
xs [NValue t f m] -> Int -> NValue t f m
forall a. [a] -> Int -> a
!! Int
n
            (Text
_,         NVSet AttrSet (NValue t f m)
xs AttrSet SourcePos
_) ->
              m a -> (NValue t f m -> m a) -> Maybe (NValue t f m) -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (FilePath -> m a
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
"Set does not contain key '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
                ([Text] -> NValue t f m -> m a
processKeys [Text]
ks)
                (Text -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
k AttrSet (NValue t f m)
xs)
            (Text
_, NValue t f m
_) -> FilePath -> m a
forall a. FilePath -> a
errorWithoutStackTrace (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
"Expected a set or list for selector '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"', but got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> Text
forall b a. (Show a, IsString b) => a -> b
show NValue t f m
v
      )
      [Text]
kys