From 2de8c7cf8425acb091d6a0339aa4d8ae8ab5144d Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 24 Apr 2018 12:25:40 -0700 Subject: [PATCH] More fixes to error reporting --- hnix.cabal | 3 +- main/Main.hs | 60 +++++++++++++++++++++------------------ package.yaml | 1 - src/Nix/Pretty.hs | 48 +++++++++++++++---------------- src/Nix/Render/Frame.hs | 28 +++++++++--------- tests/Main.hs | 6 ++-- tests/NixLanguageTests.hs | 6 ++-- 7 files changed, 80 insertions(+), 72 deletions(-) diff --git a/hnix.cabal b/hnix.cabal index e4c8b60..fbde612 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -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 diff --git a/main/Main.hs b/main/Main.hs index 8ba5530..e4fa23e 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -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 diff --git a/package.yaml b/package.yaml index 218f26a..6c0192a 100644 --- a/package.yaml +++ b/package.yaml @@ -67,7 +67,6 @@ library: - cryptohash - deriving-compat >= 0.3 && < 0.5 - directory - - freer-simple - hashable - megaparsec - monadlist diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index 3d5a125..411e632 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -242,35 +242,33 @@ printNix = cata phi phi (NVPathF fp) = fp phi (NVBuiltinF 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 "" 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 "" 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 _) = "" --} diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index a5c80fc..2fb50e6 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -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 "<>" | 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 diff --git a/tests/Main.hs b/tests/Main.hs index 459ecc1..c77b59a 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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 diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index 39e019d..b92d2ef 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -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