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

More fixes to error reporting

This commit is contained in:
John Wiegley 2018-04-24 12:25:40 -07:00
parent 01bcb86d3f
commit 2de8c7cf84
7 changed files with 80 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
hnix.cabal
View File

@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 138c46bc62e1d1c2dd934c6ef0f57939f8d7926c09ea5e99d4591175823b5295
-- hash: 8971769062ef2575a8d02f06309664739b8a0099e5ad7ddf7caa4cd5363d8a8b
name: hnix
version: 0.5.0
@ -94,7 +94,6 @@ library
, directory
, exceptions
, filepath
, freer-simple
, hashable
, megaparsec
, monadlist

60
main/Main.hs
View File

@ -12,7 +12,6 @@ import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.ST
import Control.Monad.Trans.Reader
import qualified Data.Aeson.Encoding as A
import qualified Data.Aeson.Text as A
import Data.Functor.Compose
@ -33,22 +32,24 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
main :: IO ()
main = do
opts <- execParser nixOptionsInfo
case readFrom opts of
runLazyM opts $ case readFrom opts of
Just path -> do
let file = addExtension (dropExtension path) "nix"
process opts (Just file) =<< readCache path
process opts (Just file) =<< liftIO (readCache path)
Nothing -> case expression opts of
Just s -> handleResult opts Nothing (parseNixTextLoc s)
Nothing -> case fromFile opts of
Just "-" ->
mapM_ (processFile opts) =<< (lines <$> getContents)
mapM_ (processFile opts)
=<< (lines <$> liftIO getContents)
Just path ->
mapM_ (processFile opts) =<< (lines <$> readFile path)
mapM_ (processFile opts)
=<< (lines <$> liftIO (readFile path))
Nothing -> case filePaths opts of
[] -> Repl.shell (pure ())
[] -> liftIO $ Repl.shell (pure ())
["-"] ->
handleResult opts Nothing . parseNixTextLoc
=<< Text.getContents
=<< liftIO Text.getContents
paths ->
mapM_ (processFile opts) paths
where
@ -59,19 +60,24 @@ main = do
handleResult opts mpath = \case
Failure err ->
(if ignoreErrors opts
then hPutStrLn stderr
then liftIO . hPutStrLn stderr
else errorWithoutStackTrace) $ "Parse failed: " ++ show err
Success expr -> Exc.catch (process opts mpath expr) $ \case
NixException frames ->
errorWithoutStackTrace . show
=<< runReaderT (renderFrames frames) opts
Success expr -> do
when (check opts) $
liftIO $ putStrLn $ runST $
runLintM opts . renderSymbolic =<< lint opts expr
catch (process opts mpath expr) $ \case
NixException frames ->
errorWithoutStackTrace . show
=<< renderFrames frames
-- jww (2018-04-24): This shouldn't be in IO, or else it can't
-- share the environment with the evaluation done above.
when (repl opts) $ liftIO $ Repl.shell (pure ())
process opts mpath expr = do
when (check opts) $
putStrLn $ runST $
runLintM opts . renderSymbolic =<< lint opts expr
let printer :: (MonadNix e m, MonadIO m) => NValue m -> m ()
printer | xml opts =
liftIO . putStrLn . toXML <=< normalForm
@ -87,41 +93,41 @@ main = do
liftIO . print
if | evaluate opts, tracing opts ->
runLazyM opts $ evaluateExpression mpath
evaluateExpression mpath
Nix.nixTracingEvalExprLoc printer expr
| evaluate opts, Just path <- reduce opts ->
runLazyM opts $
evaluateExpression mpath (reduction path) printer expr
| evaluate opts, not (null (arg opts) && null (argstr opts)) ->
runLazyM opts $ evaluateExpression mpath
evaluateExpression mpath
Nix.nixEvalExprLoc printer expr
| evaluate opts -> runLazyM opts $
| evaluate opts ->
processResult printer =<< Nix.nixEvalExprLoc mpath expr
| xml opts ->
error "Rendering expression trees to XML is not yet implemented"
| json opts ->
TL.putStrLn $ A.encodeToLazyText (stripAnnotation expr)
liftIO $ TL.putStrLn $
A.encodeToLazyText (stripAnnotation expr)
| verbose opts >= DebugInfo -> print $ stripAnnotation expr
| verbose opts >= DebugInfo ->
liftIO $ print $ stripAnnotation expr
| cache opts, Just path <- mpath ->
writeCache (addExtension (dropExtension path) "nixc") expr
liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
| parseOnly opts -> void $ Exc.evaluate $ Deep.force expr
| parseOnly opts ->
void $ liftIO $ Exc.evaluate $ Deep.force expr
| otherwise ->
displayIO stdout
liftIO $ displayIO stdout
. renderPretty 0.4 80
. prettyNix
. stripAnnotation $ expr
when (repl opts) $ Repl.shell (pure ())
reduction path mp x = do
eres <- Nix.withNixContext mp $
Nix.reducingEvalExpr (Eval.eval . annotated . getCompose) mp x

1
package.yaml
View File

@ -67,7 +67,6 @@ library:
- cryptohash
- deriving-compat >= 0.3 && < 0.5
- directory
- freer-simple
- hashable
- megaparsec
- monadlist

48
src/Nix/Pretty.hs
View File

@ -242,35 +242,33 @@ printNix = cata phi
phi (NVPathF fp) = fp
phi (NVBuiltinF name _) = "<<builtin " ++ name ++ ">>"
removeEffects :: Functor m => NValue m -> NValueNF m
removeEffects = Fix . fmap dethunk . baseValue
removeEffects :: Functor m => NValueF m (NThunk m) -> NValueNF m
removeEffects = Fix . fmap dethunk
where
dethunk (NThunk (Value v)) = removeEffects v
dethunk (NThunk (Value v)) = removeEffects (baseValue v)
dethunk (NThunk _) = Fix $ NVStrF "<thunk>" mempty
removeEffectsIO :: MonadVar m => NValue m -> m (NValueNF m)
removeEffectsIO = fmap Fix . traverse dethunk . baseValue
where
dethunk (NThunk (Value v)) = removeEffectsIO v
dethunk (NThunk (Thunk
removeEffectsM :: MonadVar m => NValueF m (NThunk m) -> m (NValueNF m)
removeEffectsM = fmap Fix . traverse dethunk
renderNValueF :: MonadVar m => NValueF m (NThunk m) -> m Doc
renderNValueF = fmap prettyNixValue . removeEffectsM
renderNValue :: MonadVar m => NValue m -> m Doc
renderNValue = \case
NValue Nothing v -> renderNValueF v
NValue (Just p) v -> do
v' <- renderNValueF v
-- jww (2018-04-23): Need to display the contextExpr as well.
pure $ v' </> (text " (from: " <> prettyOriginExpr (originExpr p) <> text ")")
dethunk :: MonadVar m => NThunk m -> m (NValueNF m)
dethunk = \case
NThunk (Value v) -> removeEffectsM (baseValue v)
NThunk (Thunk
#if ENABLE_TRACING
_
#endif
_ t)) = readVar t >>= \case
Computed v -> removeEffectsIO v
_ t) -> readVar t >>= \case
Computed v -> removeEffectsM (baseValue v)
_ -> pure $ Fix $ NVStrF "<thunk>" mempty
{-
instance Functor m => Show (NValueF m (NThunk m)) where
show = show . prettyNixValue . removeEffects . NValue Nothing
instance Functor m => Show (NValue m) where
show (NValue Nothing v) = show v
show (NValue (Just p) v) =
-- jww (2018-04-23): Need to display the contextExpr as well.
show v ++ " (from: " ++ show (prettyOriginExpr (originExpr p)) ++ ")"
instance Functor m => Show (NThunk m) where
show (NThunk (Value v)) = show v
show (NThunk _) = "<thunk>"
-}

28
src/Nix/Render/Frame.hs
View File

@ -12,7 +12,6 @@ module Nix.Render.Frame where
import Control.Monad.Reader
import Data.Fix
import Data.Functor.Compose
import Data.List (intercalate)
import Data.Typeable
import Nix.Eval
import Nix.Exec
@ -28,12 +27,14 @@ import Nix.Utils
import Nix.Value
import Text.PrettyPrint.ANSI.Leijen as P
renderFrames :: (MonadReader e m, Has e Options, MonadFile m, Typeable m)
renderFrames :: (MonadReader e m, Has e Options,
MonadVar m, MonadFile m, Typeable m)
=> Frames -> m Doc
renderFrames [] = pure mempty
renderFrames xs = fmap (foldr1 (P.<$>)) $ mapM renderFrame $ reverse xs
renderFrame :: forall e m. (MonadReader e m, Has e Options, MonadFile m, Typeable m)
renderFrame :: forall e m. (MonadReader e m, Has e Options, MonadVar m,
MonadFile m, Typeable m)
=> NixFrame -> m Doc
renderFrame (NixFrame level f)
| Just (e :: EvalFrame) <- fromFrame f = renderEvalFrame level e
@ -42,7 +43,7 @@ renderFrame (NixFrame level f)
| Just (_ :: NormalLoop m) <- fromFrame f =
pure $ text "<<loop during normalization>>"
| Just (e :: ExecFrame m) <- fromFrame f = renderExecFrame level e
| Just (e :: [Char]) <- fromFrame f = pure $ text e
| Just (e :: String) <- fromFrame f = pure $ text e
| Just (e :: Doc) <- fromFrame f = pure e
| otherwise = error $ "Unrecognized frame: " ++ show f
@ -54,16 +55,16 @@ renderEvalFrame _level = \case
EvaluatingExpr e@(Fix (Compose (Ann ann x))) -> do
opts :: Options <- asks (view hasLens)
let rendered = show $ prettyNix $
let rendered = prettyNix $
if verbose opts >= Chatty
then stripAnnotation e
else Fix (Fix (NSym "<?>") <$ x)
msg = if verbose opts >= Chatty
then "While evaluating:\n>>>>>>>>\n"
++ intercalate " \n" (lines rendered)
++ "\n<<<<<<<<"
else "Expression: " ++ rendered
renderLocation ann (text msg)
then text "While evaluating:\n>>>>>>>>"
P.<$> indent 2 rendered
P.<$> text "<<<<<<<<"
else "Expression: " </> rendered
renderLocation ann msg
renderValueFrame :: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel -> ValueFrame m -> m Doc
@ -83,12 +84,13 @@ renderValueFrame level = \case
ExpectationNF _t _v -> pure $ text "ExpectationNF"
Expectation _t _v -> pure $ text "Expectation"
renderExecFrame :: (MonadReader e m, Has e Options, MonadFile m)
renderExecFrame :: (MonadReader e m, Has e Options, MonadVar m, MonadFile m)
=> NixLevel -> ExecFrame m -> m Doc
renderExecFrame _level = \case
Assertion v ->
Assertion v -> do
v' <- renderNValue v
-- jww (2018-04-24): Render values nicely based on the verbosity.
pure $ text $ "Assertion failed: " ++ show v
pure $ text "Assertion failed: " </> v'
renderThunkLoop :: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel -> ThunkLoop -> m Doc

6
tests/Main.hs
View File

@ -76,8 +76,10 @@ ensureNixpkgsCanParse =
"Parsing " ++ path ++ " failed: " ++ show err
Success expr -> Exc.catch (k expr) $ \case
NixException frames ->
errorWithoutStackTrace . show
=<< runReaderT (renderFrames frames) defaultOptions
-- errorWithoutStackTrace . show
-- =<< runReaderT (renderFrames frames) defaultOptions
-- jww (2018-04-24):
errorWithoutStackTrace "FAILED"
main :: IO ()
main = do

6
tests/NixLanguageTests.hs
View File

@ -109,8 +109,10 @@ assertLangOkXml opts file = do
assertEval :: Options -> [FilePath] -> Assertion
assertEval opts files = catch go $ \case
NixException frames -> do
msg <- runReaderT (renderFrames frames) opts
error $ "Evaluation error: " ++ show msg
-- msg <- runReaderT (renderFrames frames) opts
-- error $ "Evaluation error: " ++ show msg
-- jww (2018-04-24): NYI
error "Evaluation error"
where
go = case delete ".nix" $ sort $ map takeExtensions files of
[] -> assertLangOkXml defaultOptions name