hnix/src/Nix.hs

{-# 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 mpath xform alg = withNixContext mpath . adi alg 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 mpath = nixEval mpath id 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 mpath = nixEval
  mpath
  (Eval.addStackFrames . Eval.addSourcePositions)
  (Eval.eval . annotated . 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 mpath = withNixContext mpath . 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 mpath evaluator handler expr = do
  opts :: Options <- asks (view hasLens)
  args <- traverse (traverse eval') $ map (second parseArg) (arg opts) ++ map
    (second mkStr)
    (argstr opts)
  evaluator mpath expr >>= \f -> demand f $ \f' ->
    processResult handler =<< case f' of
      NVClosure _ g -> g (argmap args)
      _             -> pure f
 where
  parseArg s = case parseNixText s of
    Success x   -> x
    Failure err -> errorWithoutStackTrace (show err)

  eval' = normalForm <=< nixEvalExpr mpath

  argmap args = nvSet (M.fromList args) 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 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 t f m -> m a
  go [] v = h v
  go ((Text.decimal -> Right (n,"")) : ks) v = demand v $ \case
    NVList xs -> case ks of
      [] -> h (xs !! n)
      _  -> go ks (xs !! n)
    _ ->
      errorWithoutStackTrace
        $  "Expected a list for selector '"
        ++ show n
        ++ "', but got: "
        ++ show v
  go (k : ks) v = demand v $ \case
    NVSet xs _ -> case M.lookup k xs of
      Nothing ->
        errorWithoutStackTrace
          $  "Set does not contain key '"
          ++ Text.unpack k
          ++ "'"
      Just v' -> case ks of
        [] -> h v'
        _  -> go ks v'
    _ ->
      errorWithoutStackTrace
        $  "Expected a set for selector '"
        ++ Text.unpack k
        ++ "', but got: "
        ++ show v