From c50bf1a9f6165d31009af3fce0dda23477004e47 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 2 Apr 2018 19:57:05 -0700 Subject: [PATCH] Preserve more information in __cur_file rather than __cwd --- Nix.hs | 39 +++++++++++++++++---------------------- Nix/Monad/Instance.hs | 23 +++++++++++------------ main/Main.hs | 9 ++++----- tests/NixLanguageTests.hs | 2 +- 4 files changed, 33 insertions(+), 40 deletions(-) diff --git a/Nix.hs b/Nix.hs index 9e00b8f1..2c99babd 100644 --- a/Nix.hs +++ b/Nix.hs @@ -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) diff --git a/Nix/Monad/Instance.hs b/Nix/Monad/Instance.hs index 9b1f72d1..a03934e5 100644 --- a/Nix/Monad/Instance.hs +++ b/Nix/Monad/Instance.hs @@ -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) diff --git a/main/Main.hs b/main/Main.hs index 3afddf80..4d7bfa66 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -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 -> diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index c262a86c..e9c32e56 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -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