Preserve more information in __cur_file rather than __cwd

This commit is contained in:
John Wiegley 2018-04-02 19:57:05 -07:00
parent 56440490f6
commit c50bf1a9f6
4 changed files with 33 additions and 40 deletions

39
Nix.hs
View File

@ -28,35 +28,30 @@ import Nix.Utils
-- | Evaluate a nix expression in the default context
evalTopLevelExpr :: MonadBuiltins e m
=> Maybe FilePath -> NExprLoc -> m (NValueNF m)
evalTopLevelExpr mdir expr = do
evalTopLevelExpr mpath expr = do
base <- baseEnv
(normalForm =<<) $ pushScopes base $ case mdir of
(normalForm =<<) $ pushScopes base $ case mpath of
Nothing -> framedEvalExpr eval expr
Just dir -> do
traceM $ "Setting __cwd = " ++ show dir
ref <- valueThunk $ NVLiteralPath dir
pushScope (M.singleton "__cwd" ref)
Just path -> do
traceM $ "Setting __cur_file = " ++ show path
ref <- valueThunk $ NVLiteralPath path
pushScope (M.singleton "__cur_file" ref)
(framedEvalExpr eval expr)
evalTopLevelExprIO :: Maybe FilePath -> NExprLoc -> IO (NValueNF (Lazy IO))
evalTopLevelExprIO mdir = runLazyIO . evalTopLevelExpr mdir
-- informativeEvalTopLevelExprIO :: Maybe FilePath -> NExpr
-- -> IO (NValueNF (Lazy IO))
-- informativeEvalTopLevelExprIO mdir expr =
-- runReaderT (runLazy (evalTopLevelExpr mdir expr)) []
evalTopLevelExprIO mpath = runLazyIO . evalTopLevelExpr mpath
tracingEvalTopLevelExprIO :: Maybe FilePath -> NExprLoc
-> IO (NValueNF (Lazy IO))
tracingEvalTopLevelExprIO mdir expr = do
tracingEvalTopLevelExprIO mpath expr = do
traced <- tracingEvalExpr eval expr
case mdir of
case mpath of
Nothing ->
runLazyIO (normalForm =<< (`pushScopes` traced) =<< baseEnv)
Just dir -> do
traceM $ "Setting __cwd = " ++ show dir
ref <- runLazyIO (valueThunk $ NVLiteralPath dir)
let m = M.singleton "__cwd" ref
Just path -> do
traceM $ "Setting __cur_file = " ++ show path
ref <- runLazyIO (valueThunk $ NVLiteralPath path)
let m = M.singleton "__cur_file" ref
runLazyIO (baseEnv >>= (`pushScopes` pushScope m traced)
>>= normalForm)
@ -91,12 +86,12 @@ symbolicBaseEnv = return [Scope M.empty False]
lintExprIO :: NExprLoc -> IO (Symbolic (Lint IO))
lintExprIO expr =
runLintIO (symbolicBaseEnv
>>= (`pushScopes` lintExpr (stripAnnotation expr)))
runLintIO $ symbolicBaseEnv
>>= (`pushScopes` lintExpr (stripAnnotation expr))
tracingLintExprIO :: NExprLoc -> IO (Symbolic (Lint IO))
tracingLintExprIO expr = do
traced <- tracingEvalExpr lint expr
ref <- runLintIO $ sthunk $ mkSymbolic [TPath]
let m = M.singleton "__cwd" ref
runLintIO (symbolicBaseEnv >>= (`pushScopes` pushScope m traced))
let m = M.singleton "__cur_file" ref
runLintIO $ symbolicBaseEnv >>= (`pushScopes` pushScope m traced)

View File

@ -82,13 +82,13 @@ instance MonadNix (Lazy IO) where
makeAbsolutePath origPath = do
absPath <- if isAbsolute origPath then pure origPath else do
cwd <- do
mres <- lookupVar @_ @(NThunk (Lazy IO)) "__cwd"
mres <- lookupVar @_ @(NThunk (Lazy IO)) "__cur_file"
case mres of
Nothing -> liftIO getCurrentDirectory
Just (NThunk v) -> forceThunk v >>= \case
NVLiteralPath s -> return s
NVLiteralPath s -> return $ takeDirectory s
v -> throwError $ "when resolving relative path,"
++ " __cwd is in scope,"
++ " __cur_file is in scope,"
++ " but is not a path; it is: "
++ show (void v)
pure $ cwd </> origPath
@ -114,16 +114,16 @@ instance MonadNixEnv (Lazy IO) where
-- jww (2018-03-29): Cache which files have been read in.
importFile = forceThunk . getNThunk >=> \case
NVLiteralPath path -> do
mres <- lookupVar @(Context (NThunk (Lazy IO))) "__cwd"
mres <- lookupVar @(Context (NThunk (Lazy IO))) "__cur_file"
path' <- case mres of
Nothing -> do
traceM "No known current directory"
return path
Just (NThunk dir) -> forceThunk dir >>= normalForm >>= \case
Fix (NVLiteralPath dir') -> do
traceM $ "Current directory for import is: "
++ show dir'
return $ dir' </> path
Just (NThunk p) -> forceThunk p >>= normalForm >>= \case
Fix (NVLiteralPath p') -> do
traceM $ "Current file being evaluated is: "
++ show p'
return $ takeDirectory p' </> path
x -> error $ "How can the current directory be: " ++ show x
traceM $ "Importing file " ++ path'
withStringContext ("While importing file " ++ show path') $ do
@ -131,12 +131,11 @@ instance MonadNixEnv (Lazy IO) where
case eres of
Failure err -> error $ "Parse failed: " ++ show err
Success expr -> do
ref <- fmap NThunk $ buildThunk $ return $
NVLiteralPath $ takeDirectory path'
ref <- NThunk <$> valueRef (NVLiteralPath path')
-- Use this cookie so that when we evaluate the next
-- import, we'll remember which directory its containing
-- file was in.
pushScope (M.singleton "__cwd" ref)
pushScope (M.singleton "__cur_file" ref)
(framedEvalExpr eval expr)
p -> error $ "Unexpected argument to import: " ++ show (void p)

View File

@ -10,7 +10,6 @@ import Nix.Lint
import Nix.Parser
import Nix.Pretty
import Options.Applicative hiding (ParserResult(..))
import System.FilePath
import System.IO
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
@ -51,12 +50,12 @@ mainOptions = Options
main :: IO ()
main = do
opts <- execParser optsDef
(eres, mdir) <- case expression opts of
(eres, mpath) <- case expression opts of
Just s -> return (parseNixStringLoc s, Nothing)
Nothing -> case filePath opts of
Nothing -> (, Nothing) . parseNixStringLoc <$> getContents
Just "-" -> (, Nothing) . parseNixStringLoc <$> getContents
Just path -> (, Just (takeDirectory path)) <$> parseNixFileLoc path
Just path -> (, Just path) <$> parseNixFileLoc path
case eres of
Failure err -> hPutStrLn stderr $ "Parse failed: " ++ show err
@ -65,9 +64,9 @@ main = do
sym <- lintExprIO expr
putStrLn =<< runLintIO (renderSymbolic sym)
if | evaluate opts, debug opts ->
print =<< tracingEvalTopLevelExprIO mdir expr
print =<< tracingEvalTopLevelExprIO mpath expr
| evaluate opts ->
putStrLn . printNix =<< evalTopLevelExprIO mdir expr
putStrLn . printNix =<< evalTopLevelExprIO mpath expr
| debug opts ->
print expr
| otherwise ->

View File

@ -123,4 +123,4 @@ nixEvalFile file = do
error $ "Parsing failed for file `" ++ file ++ "`.\n" ++ show err
Success expression -> do
setEnv "TEST_VAR" "foo"
evalTopLevelExprIO (Just (takeDirectory file)) expression
evalTopLevelExprIO (Just file) expression