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

Further improvements to error rendering, but not all done yet

This commit is contained in:
John Wiegley 2018-04-24 11:12:20 -07:00
parent 9864a8c7a5
commit 01bcb86d3f
15 changed files with 200 additions and 63 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: 469fd512cc13754d0cd6b72f0c771fc90d48e89283e3308e564335e6b31e5e39
-- hash: 138c46bc62e1d1c2dd934c6ef0f57939f8d7926c09ea5e99d4591175823b5295
name: hnix
version: 0.5.0
@ -60,6 +60,7 @@ library
Nix.Pretty
Nix.Reduce
Nix.Render
Nix.Render.Frame
Nix.Scope
Nix.Strings
Nix.TH

15
main/Main.hs
View File

@ -11,7 +11,8 @@ import qualified Control.Exception as Exc
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
-- import Control.Monad.ST
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
@ -21,7 +22,7 @@ import qualified Data.Text.Lazy.IO as TL
import Nix
import Nix.Convert
import qualified Nix.Eval as Eval
-- import Nix.Lint
import Nix.Lint
import Nix.Utils
import Options.Applicative hiding (ParserResult(..))
import qualified Repl
@ -62,12 +63,14 @@ main = do
else errorWithoutStackTrace) $ "Parse failed: " ++ show err
Success expr -> Exc.catch (process opts mpath expr) $ \case
NixException msg -> errorWithoutStackTrace "error" -- jww (2018-04-24): NYI msg
NixException frames ->
errorWithoutStackTrace . show
=<< runReaderT (renderFrames frames) opts
process opts mpath expr = do
-- when (check opts) $
-- putStrLn $ runST $
-- runLintM opts . renderSymbolic =<< lint opts expr
when (check opts) $
putStrLn $ runST $
runLintM opts . renderSymbolic =<< lint opts expr
let printer :: (MonadNix e m, MonadIO m) => NValue m -> m ()
printer | xml opts =

9
src/Nix.hs
View File

@ -8,6 +8,7 @@ module Nix (module Nix.Cache,
module Nix.Exec,
module Nix.Expr,
module Nix.Frames,
module Nix.Render.Frame,
module Nix.Normal,
module Nix.Options,
module Nix.Parser,
@ -23,11 +24,9 @@ module Nix (module Nix.Cache,
import Control.Applicative
import Control.Arrow (second)
import Control.Monad.Reader
-- import Control.Monad.Trans.Class
import Data.Fix
import Data.Functor.Compose
import qualified Data.HashMap.Lazy as M
-- import Data.Monoid
import qualified Data.Text as Text
import qualified Data.Text.Read as Text
import Nix.Builtins
@ -35,17 +34,15 @@ import Nix.Cache
import qualified Nix.Eval as Eval
import Nix.Exec
import Nix.Expr
-- import Nix.Expr.Shorthands
-- import Nix.Expr.Types
-- import Nix.Expr.Types.Annotated
import Nix.Frames
import Nix.Normal
import Nix.Options
import Nix.Parser
import Nix.Parser.Library (Result(..))
import Nix.Pretty
import Nix.Reduce
import Nix.Render.Frame
import Nix.Scope
import Nix.Frames
import Nix.Thunk
import Nix.Utils
import Nix.Value

8
src/Nix/Convert.hs
View File

@ -441,8 +441,10 @@ instance Applicative m => ToValue Bool m (NExprF r) where
instance Applicative m => ToValue () m (NExprF r) where
toValue _ = pure . NConstant $ NNull
whileForcingThunk :: (Framed e m, Frame s) => s -> m r -> m r
whileForcingThunk frame = withFrame Debug ForcingThunk . withFrame Debug frame
whileForcingThunk :: forall s e m r. (Framed e m, Frame s, Typeable m)
=> s -> m r -> m r
whileForcingThunk frame =
withFrame Debug (ForcingThunk @m) . withFrame Debug frame
instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)
=> ToValue A.Value m (NValue m) where
@ -450,7 +452,7 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)
A.Object m -> flip nvSet M.empty
<$> traverse (thunk . toValue @_ @_ @(NValue m)) m
A.Array l -> nvList <$>
traverse (\x -> thunk . whileForcingThunk (CoercionFromJson x)
traverse (\x -> thunk . whileForcingThunk (CoercionFromJson @m x)
. toValue $ x) (V.toList l)
A.String s -> pure $ nvStr s mempty
A.Number n -> pure $ nvConstant $ case floatingOrInteger n of

19
src/Nix/Eval.hs
View File

@ -81,7 +81,7 @@ class (Show v, Monad m) => MonadEval v m | v -> m where
evalLet :: m v -> m v
-}
evalError :: String -> m a
evalError :: Frame s => s -> m a
type MonadNixEval e v t m =
(MonadEval v m, Scoped e t m, MonadThunk v t m, MonadFix m,
@ -92,11 +92,12 @@ type MonadNixEval e v t m =
ToValue (AttrSet t, AttrSet SourcePos) m v,
FromValue (AttrSet t, AttrSet SourcePos) m v)
newtype ExprContext = ExprContext NExpr
newtype EvaluatingExpr = EvaluatingExpr NExprLoc
data EvalFrame
= ExprContext NExpr
| EvaluatingExpr NExprLoc
deriving (Show, Typeable)
instance Frame ExprContext
instance Frame EvaluatingExpr
instance Frame EvalFrame
wrapExpr :: NExprF (m v) -> NExpr
wrapExpr x = Fix (Fix (NSym "<?>") <$ x)
@ -203,7 +204,8 @@ attrSetAlter :: forall e v t m. MonadNixEval e v t m
-> AttrSet (m v)
-> m v
-> m (AttrSet (m v))
attrSetAlter [] _ _ = evalError @v "invalid selector with no components"
attrSetAlter [] _ _ =
evalError @v ("invalid selector with no components" :: String)
attrSetAlter (p:ps) m val = case M.lookup p m of
Nothing
| null ps -> go
@ -359,14 +361,15 @@ evalKeyNameStatic :: forall v m. MonadEval v m
evalKeyNameStatic = \case
StaticKey k p -> pure (k, p)
DynamicKey _ ->
evalError @v "dynamic attribute not allowed in this context"
evalError @v ("dynamic attribute not allowed in this context" :: String)
evalKeyNameDynamicNotNull
:: forall v m. (MonadEval v m, FromValue (Text, DList Text) m v)
=> NKeyName (m v) -> m (Text, Maybe SourcePos)
evalKeyNameDynamicNotNull = evalKeyNameDynamicNullable >=> \case
(Nothing, _) ->
evalError @v "value is null while a string was expected"
-- jww (2018-04-24): This should be of Coercion ValueFrame type
evalError @v $ ("value is null while a string was expected" :: String)
(Just k, p) -> pure (k, p)
-- | Evaluate a component of an attribute path in a context where we are

15
src/Nix/Exec.hs
View File

@ -75,7 +75,12 @@ type MonadNix e m =
(Scoped e (NThunk m) m, Framed e m, Typeable m, MonadVar m,
MonadEffects m, MonadFix m, MonadCatch m, Alternative m)
nverr :: forall e m a. MonadNix e m => String -> m a
data ExecFrame m = Assertion (NValue m)
deriving (Show, Typeable)
instance Typeable m => Frame (ExecFrame m)
nverr :: forall s e m a. (MonadNix e m, Frame s) => s -> m a
nverr = evalError @(NValue m)
instance MonadNix e m => MonadThunk (NValue m) (NThunk m) m where
@ -162,7 +167,7 @@ instance MonadNix e m => MonadEval (NValue m) m where
span <- currentPos
changeProvenance scope
(\b -> NAssert_ span (Just c) (Just b)) <$> body
else nverr $ "assertion failed: " ++ show c
else nverr $ Assertion c
evalApp f x = do
span <- currentPos
@ -258,8 +263,10 @@ execBinaryOp scope span op lval rarg = do
(NLte, l, r) -> toBool $ l <= r
(NGt, l, r) -> toBool $ l > r
(NGte, l, r) -> toBool $ l >= r
(NAnd, _, _) -> nverr "should be impossible: && is handled above"
(NOr, _, _) -> nverr "should be impossible: || is handled above"
(NAnd, _, _) ->
nverr @String "should be impossible: && is handled above"
(NOr, _, _) ->
nverr @String "should be impossible: || is handled above"
(NPlus, l, r) -> numBinOp bin (+) l r
(NMinus, l, r) -> numBinOp bin (-) l r
(NMult, l, r) -> numBinOp bin (*) l r

11
src/Nix/Frames.hs
View File

@ -5,7 +5,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Nix.Frames (NixLevel(..), Frames, Framed, Frame(..), NixFrame(..),
NixException(..), withFrame, throwError,
NixException(..), SomeFrame(..), withFrame, throwError,
module Data.Typeable,
module Control.Exception) where
@ -21,13 +21,17 @@ data NixLevel = Fatal | Error | Warning | Info | Debug
data SomeFrame = forall e. Frame e => SomeFrame e
class Typeable e => Frame e where
instance Show SomeFrame where
show (SomeFrame f) = show f
class (Typeable e, Show e) => Frame e where
toFrame :: e -> SomeFrame
fromFrame :: SomeFrame -> Maybe e
toFrame = SomeFrame
fromFrame (SomeFrame e) = cast e
-- jww (2018-04-24): These two are temporary instance for now.
instance Frame [Char]
instance Frame Doc
@ -37,7 +41,8 @@ data NixFrame = NixFrame
}
instance Show NixFrame where
show (NixFrame level _) = "Nix frame at level " ++ show level
show (NixFrame level f) =
"Nix frame at level " ++ show level ++ ": "++ show f
type Frames = [NixFrame]

8
src/Nix/Normal.hs
View File

@ -25,6 +25,7 @@ import Nix.Utils
import Nix.Value
newtype NormalLoop m = NormalLoop (NValue m)
deriving Show
instance Typeable m => Frame (NormalLoop m)
@ -70,7 +71,7 @@ embed (Fix x) = case x of
NVPathF fp -> return $ nvPath fp
NVBuiltinF name f -> return $ nvBuiltin name f
valueText :: forall e m. (Framed e m, MonadEffects m)
valueText :: forall e m. (Framed e m, MonadEffects m, Typeable m)
=> Bool -> NValueNF m -> m (Text, DList Text)
valueText addPathsToStore = cata phi
where
@ -94,7 +95,8 @@ valueText addPathsToStore = cata phi
phi v@(NVBuiltinF _ _) = coercionFailed v
coercionFailed v =
throwError $ Coercion (valueType v) TString
throwError $ Coercion @m (valueType v) TString
valueTextNoContext :: (Framed e m, MonadEffects m) => Bool -> NValueNF m -> m Text
valueTextNoContext :: (Framed e m, MonadEffects m, Typeable m)
=> Bool -> NValueNF m -> m Text
valueTextNoContext addPathsToStore = fmap fst . valueText addPathsToStore

2
src/Nix/Pretty.hs
View File

@ -260,6 +260,7 @@ removeEffectsIO = fmap Fix . traverse dethunk . baseValue
Computed v -> removeEffectsIO v
_ -> pure $ Fix $ NVStrF "<thunk>" mempty
{-
instance Functor m => Show (NValueF m (NThunk m)) where
show = show . prettyNixValue . removeEffects . NValue Nothing
@ -272,3 +273,4 @@ instance Functor m => Show (NValue m) where
instance Functor m => Show (NThunk m) where
show (NThunk (Value v)) = show v
show (NThunk _) = "<thunk>"
-}

98
src/Nix/Render/Frame.hs Normal file
View File

@ -0,0 +1,98 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
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
import Nix.Expr
import Nix.Frames
import Nix.Normal
import Nix.Options
import Nix.Parser.Library
import Nix.Pretty
import Nix.Render
import Nix.Thunk
import Nix.Utils
import Nix.Value
import Text.PrettyPrint.ANSI.Leijen as P
renderFrames :: (MonadReader e m, Has e Options, 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)
=> NixFrame -> m Doc
renderFrame (NixFrame level f)
| Just (e :: EvalFrame) <- fromFrame f = renderEvalFrame level e
| Just (e :: ThunkLoop) <- fromFrame f = renderThunkLoop level e
| Just (e :: ValueFrame m) <- fromFrame f = renderValueFrame level e
| 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 :: Doc) <- fromFrame f = pure e
| otherwise = error $ "Unrecognized frame: " ++ show f
renderEvalFrame :: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel -> EvalFrame -> m Doc
renderEvalFrame _level = \case
ExprContext e ->
pure $ text "While forcing thunk for: " </> prettyNix e
EvaluatingExpr e@(Fix (Compose (Ann ann x))) -> do
opts :: Options <- asks (view hasLens)
let rendered = show $ 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)
renderValueFrame :: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel -> ValueFrame m -> m Doc
renderValueFrame level = \case
ForcingThunk -> pure $ text "ForcingThunk"
ConcerningValue _v -> pure $ text "ConcerningValue"
Coercion x y ->
pure $ text desc <> text (describeValue x)
<> text " to " <> text (describeValue y)
where
desc | level <= Error = "Cannot coerce "
| otherwise = "While coercing "
CoercionToJsonNF _v -> pure $ text "CoercionToJsonNF"
CoercionFromJson _j -> pure $ text "CoercionFromJson"
ExpectationNF _t _v -> pure $ text "ExpectationNF"
Expectation _t _v -> pure $ text "Expectation"
renderExecFrame :: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel -> ExecFrame m -> m Doc
renderExecFrame _level = \case
Assertion v ->
-- jww (2018-04-24): Render values nicely based on the verbosity.
pure $ text $ "Assertion failed: " ++ show v
renderThunkLoop :: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel -> ThunkLoop -> m Doc
renderThunkLoop _level = \case
ThunkLoop Nothing -> pure $ text "<<loop>>"
ThunkLoop (Just n) ->
pure $ text $ "<<loop forcing thunk #" ++ show n ++ ">>"

7
src/Nix/Thunk.hs
View File

@ -27,9 +27,7 @@ counter = unsafePerformIO $ newIORef 0
{-# NOINLINE counter #-}
#endif
data Deferred m v
= Deferred (m v)
| Computed v
data Deferred m v = Deferred (m v) | Computed v
deriving (Functor, Foldable, Traversable)
class Monad m => MonadVar m where
@ -39,7 +37,7 @@ class Monad m => MonadVar m where
writeVar :: Var m a -> a -> m ()
atomicModifyVar :: Var m a -> (a -> (a, b)) -> m b
class Monad m => MonadThunk v t m | v -> m, v -> t, t -> v where
class Monad m => MonadThunk v t m | v -> m, v -> t, t -> m, t -> v where
thunk :: m v -> m t
force :: t -> (v -> m r) -> m r
value :: v -> t
@ -53,6 +51,7 @@ data Thunk m v
(Var m Bool) (Var m (Deferred m v))
newtype ThunkLoop = ThunkLoop (Maybe Int)
deriving (Show, Typeable)
instance Frame ThunkLoop

4
src/Nix/Utils.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
@ -104,6 +105,9 @@ over l f = runIdentity . l (Identity . f)
class Has a b where
hasLens :: MonoLens a b
instance Has a a where
hasLens f = f
toEncodingSorted :: A.Value -> A.Encoding
toEncodingSorted = \case
A.Object m ->

35
src/Nix/Value.hs
View File

@ -279,18 +279,25 @@ describeValue = \case
TPath -> "a path"
TBuiltin -> "a builtin function"
data ForcingThunk = ForcingThunk
data ConcerningValue m = ConcerningValue (NValue m)
data Coercion = Coercion ValueType ValueType
data CoercionToJsonNF m = CoercionToJsonNF (NValueNF m)
data CoercionFromJson = CoercionFromJson A.Value
data ExpectationNF m = ExpectationNF ValueType (NValueNF m)
data Expectation m = Expectation ValueType (NValue m)
instance Show (NValueF m (NThunk m)) where
show = show . describeValue . valueType
instance Frame ForcingThunk
instance Typeable m => Frame (ConcerningValue m)
instance Frame Coercion
instance Typeable m => Frame (CoercionToJsonNF m)
instance Frame CoercionFromJson
instance Typeable m => Frame (ExpectationNF m)
instance Typeable m => Frame (Expectation m)
instance Show (NValue m) where
show (NValue Nothing v) = show v
show (NValue (Just _) v) = show v
instance Show (NThunk m) where
show (NThunk (Value v)) = show v
show (NThunk _) = "<thunk>"
data ValueFrame m
= ForcingThunk
| ConcerningValue (NValue m)
| Coercion ValueType ValueType
| CoercionToJsonNF (NValueNF m)
| CoercionFromJson A.Value
| ExpectationNF ValueType (NValueNF m)
| Expectation ValueType (NValue m)
deriving (Show, Typeable)
instance Typeable m => Frame (ValueFrame m)

6
tests/Main.hs
View File

@ -7,6 +7,7 @@ module Main where
import Control.DeepSeq
import qualified Control.Exception as Exc
import Control.Monad
import Control.Monad.Trans.Reader
import Data.Fix
import Data.List (isInfixOf)
import Data.Maybe (isJust)
@ -19,6 +20,7 @@ import Nix.Expr.Types
import Nix.Frames
import Nix.Options
import Nix.Parser
import Nix.Render.Frame
import Nix.Value
import qualified NixLanguageTests
import qualified ParserTests
@ -73,7 +75,9 @@ ensureNixpkgsCanParse =
Failure err -> errorWithoutStackTrace $
"Parsing " ++ path ++ " failed: " ++ show err
Success expr -> Exc.catch (k expr) $ \case
NixException msg -> errorWithoutStackTrace "error! NYI!" -- jww (2018-04-24): msg
NixException frames ->
errorWithoutStackTrace . show
=<< runReaderT (renderFrames frames) defaultOptions
main :: IO ()
main = do

23
tests/NixLanguageTests.hs
View File

@ -8,6 +8,7 @@ import Control.Arrow ((&&&))
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Control.Monad.Trans.Reader
import Data.List (delete, sort)
import Data.List.Split (splitOn)
import Data.Map (Map)
@ -20,6 +21,7 @@ import Nix.Lint
import Nix.Options
import Nix.Parser
import Nix.Pretty
import Nix.Render.Frame
import Nix.Utils
import Nix.XML
import qualified Options.Applicative as Opts
@ -70,8 +72,8 @@ genTests = do
testCase (takeFileName basename) $ case kind of
["parse", "okay"] -> assertParse defaultOptions $ the files
["parse", "fail"] -> assertParseFail defaultOptions $ the files
["eval", "okay"] -> assertEval files
["eval", "fail"] -> assertEvalFail $ the files
["eval", "okay"] -> assertEval defaultOptions files
["eval", "fail"] -> assertEvalFail $ the files
_ -> error $ "Unexpected: " ++ show kind
assertParse :: Options -> FilePath -> Assertion
@ -104,10 +106,11 @@ assertLangOkXml opts file = do
expected <- Text.readFile $ file ++ ".exp.xml"
assertEqual "" expected $ Text.pack actual
assertEval :: [FilePath] -> Assertion
assertEval files = catch go $ \case
NixException frames -> error $ "Evaluation error: NYI rendering NYI"
-- NixException frames -> error $ "Evaluation error: " ++ str
assertEval :: Options -> [FilePath] -> Assertion
assertEval opts files = catch go $ \case
NixException frames -> do
msg <- runReaderT (renderFrames frames) opts
error $ "Evaluation error: " ++ show msg
where
go = case delete ".nix" $ sort $ map takeExtensions files of
[] -> assertLangOkXml defaultOptions name
@ -123,11 +126,11 @@ assertEval files = catch go $ \case
Opts.Failure err -> errorWithoutStackTrace $
"Error parsing flags from " ++ name ++ ".flags: "
++ show err
Opts.Success opts ->
Opts.Success opts' ->
assertLangOk
(opts { include = include opts ++
[ "nix=../../../../data/nix/corepkgs"
, "lang/dir4" ] })
(opts' { include = include opts' ++
[ "nix=../../../../data/nix/corepkgs"
, "lang/dir4" ] })
name
Opts.CompletionInvoked _ -> error "unused"
_ -> assertFailure $ "Unknown test type " ++ show files