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

Various fixes, and make imports local to their containing file

Browse source
This commit is contained in:
John Wiegley 2018-03-30 01:50:19 -07:00
parent b456eba4d6
commit 71b4bf5e8a
5 changed files with 82 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
Nix/Builtins.hs
View file

@ -24,22 +24,39 @@ import Nix.Eval
import Nix.Expr (NExpr)
import Nix.Parser
import Nix.Utils
import System.Process (readProcessWithExitCode)
import System.Exit (ExitCode (ExitSuccess))
import System.FilePath
import System.Process (readProcessWithExitCode)
-- | Evaluate a nix expression in the default context
evalTopLevelExpr :: MonadNix m => NExpr -> m (NValueNF m)
evalTopLevelExpr expr = do
base <- baseEnv
evalTopLevelExpr :: MonadNix m => Maybe FilePath -> NExpr -> m (NValueNF m)
evalTopLevelExpr mdir expr = do
base <- do
base <- baseEnv
case mdir of
Nothing -> return base
Just dir -> do
ref <- valueRef $ Fix $ NVLiteralPath dir
let m = Map.singleton "__cwd" ref
traceM $ "Setting __cwd = " ++ show dir
return $ extendMap m base
normalForm =<< pushScopes base (evalExpr expr)
evalTopLevelExprIO :: NExpr -> IO (NValueNF (Cyclic IO))
evalTopLevelExprIO expr =
runReaderT (runCyclic (evalTopLevelExpr expr)) emptyMap
evalTopLevelExprIO :: Maybe FilePath -> NExpr -> IO (NValueNF (Cyclic IO))
evalTopLevelExprIO mdir expr =
runReaderT (runCyclic (evalTopLevelExpr mdir expr)) emptyMap
tracingEvalTopLevelExprIO :: NExpr -> IO (NValueNF (Cyclic IO))
tracingEvalTopLevelExprIO expr = do
base <- run baseEnv emptyMap
tracingEvalTopLevelExprIO :: Maybe FilePath -> NExpr
-> IO (NValueNF (Cyclic IO))
tracingEvalTopLevelExprIO mdir expr = do
base <- case mdir of
Nothing -> run baseEnv emptyMap
Just dir -> do
ref <- run (valueRef $ Fix $ NVLiteralPath dir) emptyMap
let m = Map.singleton "__cwd" ref
traceM $ "Setting __cwd = " ++ show dir
base <- run baseEnv emptyMap
return $ extendMap m base
expr' <- tracingExprEval expr
thnk <- run expr' base
run (normalForm thnk) base
@ -64,7 +81,7 @@ newtype Cyclic m a = Cyclic
deriving (Functor, Applicative, Monad, MonadFix, MonadIO)
data Deferred m
= DeferredAction (NestedMap (NThunk m)) (m (NThunk m))
= DeferredAction (m (NThunk m))
-- ^ This is closure over the environment where it was created.
| ComputedValue (NValue m)
@ -83,14 +100,31 @@ instance MonadNix (Cyclic IO) where
lookupVar k = Cyclic $ nestedLookup k <$> ask
-- jww (2018-03-29): Cache which files have been read in.
importFile path = forceThunk path >>= \case
NVLiteralPath path -> Cyclic $ do
traceM $ "Importing file " ++ path
eres <- parseNixFile path
importFile path = normalForm path >>= \case
Fix (NVLiteralPath path) -> do
mres <- lookupVar "__cwd"
path' <- case mres of
Nothing -> do
traceM "No known current directory"
return path
Just dir -> normalForm dir >>= \case
Fix (NVLiteralPath dir') -> do
traceM $ "Current directory for import is: "
++ show dir'
return $ dir' </> path
x -> error $ "How can the current directory be: " ++ show x
traceM $ "Importing file " ++ path'
eres <- Cyclic $ parseNixFile path'
case eres of
Failure err -> error $ "Parse failed: " ++ show err
Success expr -> runCyclic $ evalExpr expr
p -> error $ "Unexpected argument to import: " ++ show (() <$ p)
Success expr -> do
ref <- valueRef $ Fix $ NVLiteralPath $ takeDirectory path'
-- Use this cookie so that when we evaluate the next
-- import, we'll remember which directory its containing
-- file was in.
pushScope (Map.singleton "__cwd" ref)
(evalExpr expr)
p -> error $ "Unexpected argument to import: " ++ show p
addPath path = liftIO $ do
(exitCode, out, _) <-
@ -108,9 +142,8 @@ instance MonadNix (Cyclic IO) where
buildThunk action =
liftIO $ NThunkIO . Right <$> newIORef (ComputedValue action)
defer scope action = do
traceM $ "Deferring action in scope: " ++ show (() <$ scope)
liftIO $ NThunkIO . Right <$> newIORef (DeferredAction scope action)
defer action =
liftIO $ NThunkIO . Right <$> newIORef (DeferredAction action)
forceThunk (NThunkIO (Left value)) =
return $ NThunkIO . Left <$> unFix value
@ -119,12 +152,10 @@ instance MonadNix (Cyclic IO) where
eres <- liftIO $ readIORef ref
case eres of
ComputedValue value -> return value
DeferredAction scope action -> do
DeferredAction action -> do
scope <- currentScope
traceM $ "Forcing thunk in scope: " ++ show scope
value <- Cyclic
$ local (`combineMaps` scope)
$ runCyclic
$ forceThunk =<< action
value <- forceThunk =<< action
traceM $ "Forcing thunk computed: " ++ show (() <$ value)
liftIO $ writeIORef ref (ComputedValue value)
return value

21
Nix/Eval.hs
View file

@ -158,12 +158,16 @@ class MonadFix m => MonadNix m where
valueRef :: NValueNF m -> m (NThunk m)
buildThunk :: NValue m -> m (NThunk m)
forceThunk :: NThunk m -> m (NValue m)
defer :: NestedMap (NThunk m) -> m (NThunk m) -> m (NThunk m)
defer :: m (NThunk m) -> m (NThunk m)
-- | Import a path into the nix store, and return the resulting path
addPath :: FilePath -> m StorePath
importFile :: NThunk m -> m (NThunk m)
deferInScope :: MonadNix m
=> NestedMap (NThunk m) -> m (NThunk m) -> m (NThunk m)
deferInScope scope = defer . clearScopes . pushScopes scope
buildArgument :: forall m. MonadNix m
=> Params (m (NThunk m)) -> NThunk m -> m (ValueSet m)
buildArgument params arg = case params of
@ -196,10 +200,10 @@ buildArgument params arg = case params of
That (Just f) -> \args -> do
scope <- currentScope
traceM $ "Deferring default argument in scope: " ++ show scope
defer scope $ do
defer $ clearScopes $ do
traceM $ "Evaluating default argument with args: "
++ show (NestedMap [args])
pushScope args f
pushScopes (extendMap args scope) f
This x | isVariadic -> const (pure x)
| otherwise -> error $ "Unexpected parameter: " ++ show k
These x _ -> const (pure x)
@ -299,7 +303,7 @@ eval (NHasAttr aset attr) = aset >>= forceThunk >>= \case
eval (NList l) = do
scope <- currentScope
buildThunk . NVList =<< traverse (defer scope) l
buildThunk . NVList =<< traverse (deferInScope scope) l
eval (NSet binds) = do
traceM "NSet..1"
@ -354,7 +358,8 @@ eval (NAbs params body) = do
-- body are forced during application.
scope <- currentScope
traceM $ "Creating lambda abstraction in scope: " ++ show scope
buildThunk $ NVFunction (defer scope <$> params) (defer scope body)
buildThunk $ NVFunction (deferInScope scope <$> params)
(deferInScope scope body)
tracingExprEval :: MonadNix m => NExpr -> IO (m (NThunk m))
tracingExprEval =
@ -409,7 +414,7 @@ attrSetAlter (p:ps) m val = case Map.lookup p m of
scope <- currentScope
return $ Map.insert p (embed scope m') m
where
embed scope m' = buildThunk . NVSet =<< traverse (defer scope) m'
embed scope m' = buildThunk . NVSet =<< traverse (deferInScope scope) m'
evalBinds :: forall m. MonadNix m
=> Bool
@ -430,9 +435,9 @@ evalBinds allowDynamic recursive = buildResult . concat <=< mapM go
scope <- currentScope
if recursive
then loebM (encapsulate scope <$> s)
else traverse (defer scope) s
else traverse (deferInScope scope) s
encapsulate scope f attrs = defer scope $ pushScope attrs f
encapsulate scope f attrs = deferInScope (extendMap attrs scope) f
insert m (path, value) = attrSetAlter path m value

2
default.nix
View file

@ -20,7 +20,7 @@ let
libraryHaskellDepends = [
ansi-wl-pprint base containers data-fix deepseq deriving-compat
parsers regex-tdfa regex-tdfa-text semigroups text transformers
trifecta unordered-containers these process
trifecta unordered-containers these process directory filepath
];
executableHaskellDepends = [
ansi-wl-pprint base containers data-fix deepseq optparse-applicative

3
hnix.cabal
View file

@ -63,6 +63,8 @@ Library
, data-fix
, deepseq
, process
, directory
, filepath
, semigroups >= 0.18 && < 0.19
, regex-tdfa
, regex-tdfa-text
@ -103,6 +105,7 @@ Executable hnix
, optparse-applicative
, text
, transformers
, filepath
Ghc-options: -Wall -threaded
Test-suite hnix-tests

16
main/Main.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TupleSections #-}
module Main where
@ -7,6 +8,7 @@ import Nix.Builtins
import Nix.Parser
import Nix.Pretty
import Options.Applicative hiding (ParserResult(..))
import System.FilePath
import System.IO
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
@ -47,21 +49,21 @@ mainOptions = Options
main :: IO ()
main = do
opts <- execParser optsDef
eres <- case expression opts of
Just s -> return $ parseNixString s
(eres, mdir) <- case expression opts of
Just s -> return (parseNixString s, Nothing)
Nothing -> case filePath opts of
Nothing -> parseNixString <$> getContents
Just "-" -> parseNixString <$> getContents
Just path -> parseNixFile path
Nothing -> (, Nothing) . parseNixString <$> getContents
Just "-" -> (, Nothing) . parseNixString <$> getContents
Just path -> (, Just (takeDirectory path)) <$> parseNixFile path
case eres of
Failure err -> hPutStrLn stderr $ "Parse failed: " ++ show err
Success expr -> do
when (check opts) $ lintExpr expr
if | evaluate opts, debug opts ->
print =<< tracingEvalTopLevelExprIO expr
print =<< tracingEvalTopLevelExprIO mdir expr
| evaluate opts ->
putStrLn . printNix =<< evalTopLevelExprIO expr
putStrLn . printNix =<< evalTopLevelExprIO mdir expr
| debug opts ->
print expr
| otherwise ->