mirror of
https://github.com/haskell-nix/hnix.git
synced 2024-11-10 13:29:37 +03:00
Preserve more information in __cur_file rather than __cwd
This commit is contained in:
parent
56440490f6
commit
c50bf1a9f6
39
Nix.hs
39
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)
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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 ->
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user