picnoir/hnix
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Don't evaluate to normal form by default in the top level evaluators

Browse source
This commit is contained in:
John Wiegley 2018-04-13 19:29:18 -07:00
parent c5f001a7d4
commit 58b65d2ce1
10 changed files with 78 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
main/Main.hs
View file

@ -1,7 +1,10 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
@ -10,6 +13,7 @@ import Control.Arrow (second)
import Control.DeepSeq
import qualified Control.Exception as Exc
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.ST
import Data.Fix
import qualified Data.HashMap.Lazy as M
@ -26,6 +30,7 @@ import Nix.Options
import Nix.Parser
import Nix.Pretty
import Nix.Stack (NixException(..))
import qualified Nix.Thunk as T
import qualified Nix.Value as V
import qualified Repl
-- import Nix.TH
@ -78,8 +83,10 @@ main = do
let parseArg s = case parseNixText s of
Success x -> x
Failure err -> errorWithoutStackTrace (show err)
eval = runLazyM . (normalForm =<<)
. Nix.eval Nothing (include opts)
args <- traverse (traverse (Nix.eval Nothing (include opts))) $
args <- traverse (traverse eval) $
map (second parseArg) (arg opts) ++
map (second mkStr) (argstr opts)
@ -89,44 +96,47 @@ main = do
compute ev x p = do
f <- ev mpath (include opts) x
p =<< case f of
Fix (V.NVClosure _ g) ->
runLazyM $ normalForm =<< g argmap
V.NVClosure _ g -> g argmap
_ -> pure f
result :: forall e m. Nix.MonadNix e m
=> (V.NValue m -> m ()) -> V.NValue m -> m ()
result h = case attr opts of
Nothing -> h
Just (Text.splitOn "." -> keys) -> go keys
where
go :: [Text.Text] -> V.NValue m -> m ()
go [] v = h v
go ((Text.decimal -> Right (n,_)):ks) v = case v of
Fix (V.NVList xs) -> case ks of
[] -> h (xs !! n)
_ -> go ks (xs !! n)
go ((Text.decimal -> Right (n,"")):ks) v = case v of
V.NVList xs -> case ks of
[] -> T.force @(V.NValue m) @(V.NThunk m) (xs !! n) h
_ -> T.force (xs !! n) (go ks)
_ -> errorWithoutStackTrace $
"Expected a list for selector '" ++ show n
++ "', but got: " ++ show v
go (k:ks) v = case v of
Fix (V.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'
V.NVSet xs _ -> case M.lookup k xs of
Nothing ->
errorWithoutStackTrace $
"Set does not contain key '"
++ Text.unpack k ++ "'"
Just v' -> case ks of
[] -> T.force v' h
_ -> T.force v' (go ks)
_ -> errorWithoutStackTrace $
"Expected a set for selector '" ++ Text.unpack k
++ "', but got: " ++ show v
if | evaluate opts, debug opts ->
compute Nix.tracingEvalLoc expr (result print)
runLazyM $ compute Nix.tracingEvalLoc expr $
result (liftIO . print)
| evaluate opts, not (null args) ->
compute Nix.evalLoc expr (result (putStrLn . printNix))
runLazyM $ compute Nix.evalLoc expr $
result (liftIO . print)
| evaluate opts ->
result (putStrLn . printNix)
| evaluate opts -> runLazyM $
result (liftIO . print)
=<< Nix.evalLoc mpath (include opts) expr
| debug opts -> print $ stripAnnotation expr

2
main/Repl.hs
View file

@ -102,7 +102,7 @@ exec update source = do
(Eval.eval @_ @(NValue (Lazy IO))
@(NThunk (Lazy IO)) @(Lazy IO)))
Nothing [] expr
liftIO $ putStrLn $ printNix val
liftIO $ print val
cmd :: String -> Repl ()
cmd source = exec True (Text.pack source)

12
src/Nix/Convert.hs
View file

@ -190,14 +190,14 @@ instance (MonadThunk (NValue m) (NThunk m) m,
fromNixMay v = v >>= fromNixMay
instance (MonadCatch m, MonadFix m, MonadIO m,
FromNix a m (NValueNF m)) => FromNix a m NExprLoc where
fromNix = evalTopLevelExprLoc Nothing [] >=> fromNix
fromNixMay = evalTopLevelExprLoc Nothing [] >=> fromNixMay
FromNix a m (NValue m)) => FromNix a m NExprLoc where
fromNix = evalLoc Nothing [] >=> fromNix
fromNixMay = evalLoc Nothing [] >=> fromNixMay
instance (MonadCatch m, MonadFix m, MonadIO m,
FromNix a m (NValueNF m)) => FromNix a m NExpr where
fromNix = evalTopLevelExpr Nothing [] >=> fromNix
fromNixMay = evalTopLevelExpr Nothing [] >=> fromNixMay
FromNix a m (NValue m)) => FromNix a m NExpr where
fromNix = eval Nothing [] >=> fromNix
fromNixMay = eval Nothing [] >=> fromNixMay
toEncodingSorted :: A.Value -> A.Encoding
toEncodingSorted = \case

39
src/Nix/Entry.hs
View file

@ -17,10 +17,8 @@ import qualified Data.Text as Text
import Nix.Builtins
import Nix.Effects
import qualified Nix.Eval as Eval
import Nix.Exec
import Nix.Expr.Types (NExpr)
import Nix.Expr.Types.Annotated (NExprLoc)
import Nix.Normal
import Nix.Scope
import Nix.Stack
import Nix.Thunk
@ -35,14 +33,14 @@ type MonadNix e m =
evalTopLevelExprGen
:: forall e m a. MonadNix e m
=> (a -> m (NValue m)) -> Maybe FilePath -> [String] -> a
-> m (NValueNF m)
-> m (NValue m)
evalTopLevelExprGen cont mpath incls expr = do
base <- baseEnv
let i = value @(NValue m) @(NThunk m) @m $ NVList $
map (value @(NValue m) @(NThunk m) @m
. flip NVStr mempty . Text.pack) incls
pushScope (M.singleton "__includes" i) $
(normalForm =<<) $ pushScopes base $ case mpath of
pushScopes base $ case mpath of
Nothing -> cont expr
Just path -> do
traceM $ "Setting __cur_file = " ++ show path
@ -50,31 +48,22 @@ evalTopLevelExprGen cont mpath incls expr = do
pushScope (M.singleton "__cur_file" ref) $ cont expr
-- | Evaluate a nix expression in the default context
evalTopLevelExpr :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExpr -> m (NValueNF m)
evalTopLevelExpr = evalTopLevelExprGen $
eval :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExpr -> m (NValue m)
eval = evalTopLevelExprGen $
Eval.evalExpr @_ @(NValue m) @(NThunk m) @m
eval :: (MonadFix m, MonadThrow m, MonadCatch m, MonadIO m)
=> Maybe FilePath -> [String] -> NExpr -> m (NValueNF (Lazy m))
eval mpath incls = runLazyM . evalTopLevelExpr mpath incls
-- | Evaluate a nix expression in the default context
evalTopLevelExprLoc :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValueNF m)
evalTopLevelExprLoc = evalTopLevelExprGen $
evalLoc :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValue m)
evalLoc = evalTopLevelExprGen $
Eval.framedEvalExpr (Eval.eval @_ @(NValue m) @(NThunk m) @m)
evalLoc :: (MonadFix m, MonadThrow m, MonadCatch m, MonadIO m)
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValueNF (Lazy m))
evalLoc mpath incls = runLazyM . evalTopLevelExprLoc mpath incls
tracingEvalLoc
:: forall m. (MonadFix m, MonadThrow m, MonadCatch m,
Alternative m, MonadIO m)
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValueNF (Lazy m))
:: forall e m. (MonadNix e m, Alternative m, MonadIO m)
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValue m)
tracingEvalLoc mpath incls expr =
runLazyM . evalTopLevelExprGen id mpath incls
=<< Eval.tracingEvalExpr @_ @(Lazy m) @_ @(NValue (Lazy m))
(Eval.eval @_ @(NValue (Lazy m))
@(NThunk (Lazy m)) @(Lazy m)) expr
evalTopLevelExprGen id mpath incls
=<< Eval.tracingEvalExpr @_ @m @_ @(NValue m)
(Eval.eval @_ @(NValue m)
@(NThunk m) @m) expr

17
src/Nix/Entry.hs-boot
View file

@ -6,8 +6,10 @@
module Nix.Entry where
import Control.Applicative (Alternative)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Nix.Effects (MonadEffects)
import Nix.Expr.Types (NExpr)
import Nix.Expr.Types.Annotated (NExprLoc)
@ -23,11 +25,14 @@ type MonadNix e m =
evalTopLevelExprGen
:: forall e m a. MonadNix e m
=> (a -> m (NValue m)) -> Maybe FilePath -> [String] -> a
-> m (NValueNF m)
-> m (NValue m)
-- | Evaluate a nix expression in the default context
evalTopLevelExpr :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExpr -> m (NValueNF m)
eval :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExpr -> m (NValue m)
evalTopLevelExprLoc :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValueNF m)
evalLoc :: forall e m. MonadNix e m
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValue m)
tracingEvalLoc
:: forall e m. (MonadNix e m, Alternative m, MonadIO m)
=> Maybe FilePath -> [String] -> NExprLoc -> m (NValue m)

8
src/Nix/Exec.hs
View file

@ -25,6 +25,7 @@
module Nix.Exec where
import Control.Applicative
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Fix
@ -65,7 +66,7 @@ import System.FilePath
import qualified System.Info
import System.Posix.Files
import System.Process (readProcessWithExitCode)
import {-# SOURCE #-} Nix.Entry
import {-# SOURCE #-} Nix.Entry as Entry
nverr :: forall e m a. MonadNix e m => String -> m a
nverr = evalError @(NValue m)
@ -340,7 +341,8 @@ execBinaryOp op larg rarg = do
newtype Lazy m a = Lazy
{ runLazy :: ReaderT (Context (Lazy m) (NThunk (Lazy m))) m a }
deriving (Functor, Applicative, Monad, MonadFix, MonadIO,
deriving (Functor, Applicative, Alternative, Monad, MonadPlus,
MonadFix, MonadIO,
MonadReader (Context (Lazy m) (NThunk (Lazy m))))
instance MonadIO m => MonadVar (Lazy m) where
@ -447,7 +449,7 @@ instance (MonadFix m, MonadCatch m, MonadThrow m, MonadIO m)
Failure err ->
throwError $ "Error parsing output of nix-instantiate: "
++ show err
Success v -> framedEvalExpr eval v
Success v -> framedEvalExpr Eval.eval v
err -> throwError $ "nix-instantiate failed: " ++ show err
runLazyM :: MonadIO m => Lazy m a -> m a

1
src/Nix/Stack.hs
View file

@ -66,6 +66,7 @@ throwError str = do
[] -> return []
_ -> mapM renderFrame $
filter noAsserts (init context) ++ [last context]
traceM "throwing error"
throwM $ NixEvalException $ unlines $ infos ++ [str]
where
noAsserts (Right (Compose (Ann _ (NAssert _ _)))) = False

6
tests/EvalTests.hs
View file

@ -11,7 +11,9 @@ module EvalTests (tests, genEvalCompareTests) where
import Data.String.Interpolate.IsString
import Data.Text (Text)
import Nix
import Nix.Exec
import Nix.Expr
import Nix.Normal
import Nix.Parser
import Nix.Value
import qualified System.Directory as D
@ -100,9 +102,9 @@ instance (Show r, Show (NValueF m r), Eq r) => Eq (NValueF m r) where
constantEqual :: NExprLoc -> NExprLoc -> Assertion
constantEqual a b = do
-- putStrLn =<< lint (stripAnnotation a)
a' <- evalLoc Nothing [] a
a' <- runLazyM $ normalForm =<< evalLoc Nothing [] a
-- putStrLn =<< lint (stripAnnotation b)
b' <- evalLoc Nothing [] b
b' <- runLazyM $ normalForm =<< evalLoc Nothing [] b
assertEqual "" a' b'
constantEqualText :: Text -> Text -> Assertion

3
tests/Main.hs
View file

@ -13,6 +13,7 @@ import Data.String.Interpolate.IsString
import Data.Text (unpack)
import qualified EvalTests
import qualified Nix
import Nix.Exec
import Nix.Expr.Types
import Nix.Parser
import Nix.Stack
@ -54,7 +55,7 @@ ensureNixpkgsCanParse =
url = "https://github.com/NixOS/nixpkgs/archive/#{rev}.tar.gz";
sha256 = "#{sha256}";
}|]) $ \expr -> do
Fix (NVStr dir _) <- Nix.evalLoc Nothing [] expr
NVStr dir _ <- runLazyM $ Nix.evalLoc Nothing [] expr
files <- globDir1 (compile "**/*.nix") (unpack dir)
forM_ files $ \file ->
-- Parse and deepseq the resulting expression tree, to ensure the

6
tests/TestCommon.hs
View file

@ -3,6 +3,7 @@ module TestCommon where
import Data.Text (Text, unpack)
import Nix
import Nix.Exec
import Nix.Normal
import Nix.Parser
import Nix.Pretty
import Nix.Value
@ -21,14 +22,15 @@ hnixEvalFile file incls = do
error $ "Parsing failed for file `" ++ file ++ "`.\n" ++ show err
Success expression -> do
setEnv "TEST_VAR" "foo"
evalLoc (Just file) incls expression
runLazyM $ normalForm =<< evalLoc (Just file) incls expression
hnixEvalText :: Text -> [String] -> IO (NValueNF (Lazy IO))
hnixEvalText expr incls = case parseNixText expr of
Failure err ->
error $ "Parsing failed for expressien `"
++ unpack expr ++ "`.\n" ++ show err
Success expression -> eval Nothing incls expression
Success expression ->
runLazyM $ normalForm =<< eval Nothing incls expression
nixEvalString :: String -> IO String
nixEvalString expr = do