{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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           Control.Applicative
import           Control.Arrow                  ( second )
import           Control.Monad.Reader
import           Data.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)
  => Maybe FilePath
  -> Transform g (m a)
  -> Alg g (m a)
  -> Fix g
  -> m a
nixEval :: Maybe FilePath -> Transform g (m a) -> Alg g (m a) -> Fix g -> m a
nixEval mpath :: Maybe FilePath
mpath xform :: Transform g (m a)
xform alg :: Alg g (m a)
alg = 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
. Alg g (m a) -> Transform g (m a) -> Fix g -> m a
forall (f :: * -> *) a.
Functor f =>
(f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
adi Alg g (m a)
alg Transform g (m a)
xform

-- | 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 :: Maybe FilePath -> NExpr -> m (NValue t f m)
nixEvalExpr mpath :: Maybe FilePath
mpath = Maybe FilePath
-> Transform NExprF (m (NValue t f m))
-> Alg NExprF (m (NValue t f m))
-> NExpr
-> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *) (g :: * -> *) a.
(MonadNix e t f m, Has e Options, Functor g) =>
Maybe FilePath -> Transform g (m a) -> Alg g (m a) -> Fix g -> m a
nixEval Maybe FilePath
mpath 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 :: Maybe FilePath -> NExprLoc -> m (NValue t f m)
nixEvalExprLoc mpath :: Maybe FilePath
mpath = Maybe FilePath
-> Transform NExprLocF (m (NValue t f m))
-> Alg NExprLocF (m (NValue t f m))
-> NExprLoc
-> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *) (g :: * -> *) a.
(MonadNix e t f m, Has e Options, Functor g) =>
Maybe FilePath -> Transform g (m a) -> Alg g (m a) -> Fix g -> m a
nixEval
  Maybe FilePath
mpath
  (Transform NExprLocF (m (NValue t f m))
forall v e (m :: * -> *) a.
(Scoped v m, Framed e m, Typeable v, Typeable m) =>
Transform NExprLocF (m a)
Eval.addStackFrames Transform NExprLocF (m (NValue t f m))
-> Transform NExprLocF (m (NValue t f m))
-> Transform NExprLocF (m (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transform NExprLocF (m (NValue t f m))
forall e (m :: * -> *) a.
(MonadReader e m, Has e SrcSpan) =>
Transform NExprLocF (m a)
Eval.addSourcePositions)
  (NExprF (m (NValue t f m)) -> m (NValue t f m)
forall v (m :: * -> *). MonadNixEval v m => NExprF (m v) -> m v
Eval.eval (NExprF (m (NValue t f m)) -> m (NValue t f m))
-> (Compose (Ann SrcSpan) NExprF (m (NValue t f m))
    -> NExprF (m (NValue t f m)))
-> Alg NExprLocF (m (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann SrcSpan (NExprF (m (NValue t f m)))
-> NExprF (m (NValue t f m))
forall ann a. Ann ann a -> a
annotated (Ann SrcSpan (NExprF (m (NValue t f m)))
 -> NExprF (m (NValue t f m)))
-> (Compose (Ann SrcSpan) NExprF (m (NValue t f m))
    -> Ann SrcSpan (NExprF (m (NValue t f m))))
-> Compose (Ann SrcSpan) NExprF (m (NValue t f m))
-> NExprF (m (NValue t f m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Ann SrcSpan) NExprF (m (NValue t f m))
-> Ann SrcSpan (NExprF (m (NValue t f m)))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)

-- | 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 :: Maybe FilePath -> NExprLoc -> m (NValue t f m)
nixTracingEvalExprLoc mpath :: 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 :: Maybe FilePath
-> (Maybe FilePath -> NExprLoc -> m (NValue t f m))
-> (NValue t f m -> m a)
-> NExprLoc
-> m a
evaluateExpression mpath :: Maybe FilePath
mpath evaluator :: Maybe FilePath -> NExprLoc -> m (NValue t f m)
evaluator handler :: NValue t f m -> m a
handler expr :: NExprLoc
expr = do
  Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens)
  [(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 ((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, Text) -> (Text, NExpr))
-> [(Text, Text)] -> [(Text, NExpr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> NExpr) -> (Text, Text) -> (Text, NExpr)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> NExpr
parseArg) (Options -> [(Text, Text)]
arg Options
opts) [(Text, NExpr)] -> [(Text, NExpr)] -> [(Text, NExpr)]
forall a. [a] -> [a] -> [a]
++ ((Text, Text) -> (Text, NExpr))
-> [(Text, Text)] -> [(Text, NExpr)]
forall a b. (a -> b) -> [a] -> [b]
map
    ((Text -> NExpr) -> (Text, Text) -> (Text, NExpr)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> NExpr
mkStr)
    (Options -> [(Text, Text)]
argstr Options
opts)
  Maybe FilePath -> NExprLoc -> m (NValue t f m)
evaluator Maybe FilePath
mpath NExprLoc
expr m (NValue t f m) -> (NValue t f m -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \f :: NValue t f m
f -> NValue t f m -> (NValue t f m -> m a) -> m a
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
f ((NValue t f m -> m a) -> m a) -> (NValue t f m -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \f' :: 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 -> m a) -> m (NValue t f m) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case NValue t f m
f' of
      NVClosure _ g :: NValue t f m -> m (NValue t f m)
g -> NValue t f m -> m (NValue t f m)
g ([(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 -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
f
 where
  parseArg :: Text -> NExpr
parseArg s :: Text
s = case Text -> Result NExpr
parseNixText Text
s of
    Success x :: NExpr
x   -> NExpr
x
    Failure err :: Doc Void
err -> FilePath -> NExpr
forall a. FilePath -> a
errorWithoutStackTrace (Doc Void -> FilePath
forall a. Show a => a -> FilePath
show Doc Void
err)

  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))
-> m (NValue t f m) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (m (NValue t f m) -> m (NValue t f m))
-> (NExpr -> m (NValue t f m)) -> NExpr -> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> 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 args :: [(Text, NValue t f m)]
args = HashMap Text (NValue t f m)
-> HashMap Text SourcePos -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
HashMap Text (NValue t f m)
-> HashMap Text SourcePos -> NValue t f m
nvSet ([(Text, NValue t f m)] -> HashMap Text (NValue t f m)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Text, NValue t f m)]
args) HashMap Text SourcePos
forall a. Monoid a => a
mempty

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) -> NValue t f m -> m a
processResult h :: NValue t f m -> m a
h val :: 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 (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)
  case Options -> Maybe Text
attr Options
opts of
    Nothing                         -> NValue t f m -> m a
h NValue t f m
val
    Just (Text -> Text -> [Text]
Text.splitOn "." -> [Text]
keys) -> [Text] -> NValue t f m -> m a
go [Text]
keys NValue t f m
val
 where
  go :: [Text.Text] -> NValue t f m -> m a
  go :: [Text] -> NValue t f m -> m a
go [] v :: NValue t f m
v = NValue t f m -> m a
h NValue t f m
v
  go ((Reader Int
forall a. Integral a => Reader a
Text.decimal -> Right (n :: Int
n,"")) : ks :: [Text]
ks) v :: NValue t f m
v = NValue t f m -> (NValue t f m -> m a) -> m a
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
v ((NValue t f m -> m a) -> m a) -> (NValue t f m -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \case
    NVList xs :: [NValue t f m]
xs -> case [Text]
ks of
      [] -> NValue t f m -> m a
h ([NValue t f m]
xs [NValue t f m] -> Int -> NValue t f m
forall a. [a] -> Int -> a
!! Int
n)
      _  -> [Text] -> NValue t f m -> m a
go [Text]
ks ([NValue t f m]
xs [NValue t f m] -> Int -> NValue t f m
forall a. [a] -> Int -> a
!! Int
n)
    _ ->
      FilePath -> m a
forall a. FilePath -> a
errorWithoutStackTrace
        (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$  "Expected a list for selector '"
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "', but got: "
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NValue t f m -> FilePath
forall a. Show a => a -> FilePath
show NValue t f m
v
  go (k :: Text
k : ks :: [Text]
ks) v :: NValue t f m
v = NValue t f m -> (NValue t f m -> m a) -> m a
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
v ((NValue t f m -> m a) -> m a) -> (NValue t f m -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \case
    NVSet xs :: AttrSet (NValue t f m)
xs _ -> case 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 of
      Nothing ->
        FilePath -> m a
forall a. FilePath -> a
errorWithoutStackTrace
          (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$  "Set does not contain key '"
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
Text.unpack Text
k
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'"
      Just v' :: NValue t f m
v' -> case [Text]
ks of
        [] -> NValue t f m -> m a
h NValue t f m
v'
        _  -> [Text] -> NValue t f m -> m a
go [Text]
ks NValue t f m
v'
    _ ->
      FilePath -> m a
forall a. FilePath -> a
errorWithoutStackTrace
        (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$  "Expected a set for selector '"
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
Text.unpack Text
k
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "', but got: "
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NValue t f m -> FilePath
forall a. Show a => a -> FilePath
show NValue t f m
v