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

Several improvements to error reporting; add new --thunks option

Browse source
This commit is contained in:
John Wiegley 2018-04-25 13:00:41 -07:00
parent 910b1a8316
commit 05ca87a732
15 changed files with 203 additions and 157 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: 8971769062ef2575a8d02f06309664739b8a0099e5ad7ddf7caa4cd5363d8a8b
-- hash: f2849e05edde8ddd3f02ee010be0fa0e7ee673392948670ced6209113f5b5e7f
name: hnix
version: 0.5.0
@ -99,6 +99,7 @@ library
, monadlist
, mtl
, optparse-applicative
, pretty-show
, process
, regex-tdfa
, regex-tdfa-text

4
main/Main.hs
View file

@ -3,6 +3,7 @@
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Main where
@ -14,7 +15,6 @@ import Control.Monad.IO.Class
import Control.Monad.ST
import qualified Data.Aeson.Encoding as A
import qualified Data.Aeson.Text as A
import Data.Functor.Compose
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Lazy.IO as TL
@ -71,7 +71,7 @@ main = do
catch (process opts mpath expr) $ \case
NixException frames ->
errorWithoutStackTrace . show
=<< renderFrames frames
=<< renderFrames @(NThunk (Lazy IO)) frames
-- jww (2018-04-24): This shouldn't be in IO, or else it can't
-- share the environment with the evaluation done above.

1
package.yaml
View file

@ -70,6 +70,7 @@ library:
- hashable
- megaparsec
- monadlist
- pretty-show
- process
- regex-tdfa
- regex-tdfa-text

6
src/Nix.hs
View file

@ -25,7 +25,6 @@ import Control.Applicative
import Control.Arrow (second)
import Control.Monad.Reader
import Data.Fix
import Data.Functor.Compose
import qualified Data.HashMap.Lazy as M
import qualified Data.Text as Text
import qualified Data.Text.Read as Text
@ -78,10 +77,11 @@ nixEvalExpr :: forall e m. (MonadNix e m, Has e Options)
nixEvalExpr mpath = nixEval mpath id Eval.eval
-- | Evaluate a nix expression in the default context
nixEvalExprLoc :: (MonadNix e m, Has e Options)
nixEvalExprLoc :: forall e m. (MonadNix e m, Has e Options)
=> Maybe FilePath -> NExprLoc -> m (NValue m)
nixEvalExprLoc mpath =
nixEval mpath Eval.addStackFrames (Eval.eval . annotated . getCompose)
nixEval mpath (Eval.addStackFrames @(NThunk m) . Eval.addSourcePositions)
(Eval.eval . annotated . getCompose)
-- | Evaluate a nix expression with tracing in the default context. Note that
-- this function doesn't do any tracing itself, but 'evalExprLoc' will be

13
src/Nix/Context.hs
View file

@ -8,21 +8,26 @@ import Nix.Options
import Nix.Scope
import Nix.Frames
import Nix.Utils
import Nix.Expr.Types.Annotated (SrcSpan, nullSpan)
data Context m v = Context
{ scopes :: Scopes m v
, source :: SrcSpan
, frames :: Frames
, options :: Options
}
instance Has (Context m v) (Scopes m v) where
hasLens f (Context x y z) = (\x' -> Context x' y z) <$> f x
hasLens f (Context x y z w) = (\x' -> Context x' y z w) <$> f x
instance Has (Context m v) SrcSpan where
hasLens f (Context x y z w) = (\y' -> Context x y' z w) <$> f y
instance Has (Context m v) Frames where
hasLens f (Context x y z) = (\y' -> Context x y' z) <$> f y
hasLens f (Context x y z w) = (\z' -> Context x y z' w) <$> f z
instance Has (Context m v) Options where
hasLens f (Context x y z) = (\z' -> Context x y z') <$> f z
hasLens f (Context x y z w) = (\w' -> Context x y z w') <$> f w
newContext :: Options -> Context m v
newContext = Context emptyScopes []
newContext = Context emptyScopes nullSpan []

85
src/Nix/Eval.hs
View file

@ -22,9 +22,10 @@ module Nix.Eval where
import Control.Arrow (first)
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Reader
import Control.Monad.State
import Data.Align.Key
import Data.Functor.Compose
import Data.Fix
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as M
import Data.List (intercalate, partition, foldl')
@ -83,23 +84,20 @@ class (Show v, Monad m) => MonadEval v m | v -> m where
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,
Framed e m, MonadVar m,
(MonadEval v m, Scoped e t m, MonadThunk v t m,
Framed e m, Has e SrcSpan, MonadVar m, MonadFix m,
ToValue Bool m v, ToValue [t] m v,
FromValue (Text, DList Text) m v,
ToValue (AttrSet t) m v, FromValue (AttrSet t) m v,
ToValue (AttrSet t, AttrSet SourcePos) m v,
FromValue (AttrSet t, AttrSet SourcePos) m v)
data EvalFrame
= ExprContext (NExprF ())
| EvaluatingExpr NExprLoc
data EvalFrame m v
= EvaluatingExpr (Scopes m v) NExprLoc
| ForcingExpr (Scopes m v) NExprLoc
deriving (Show, Typeable)
instance Frame EvalFrame
exprFContext :: Framed e m => NExprF (m v) -> m r -> m r
exprFContext = withFrame Debug . ExprContext . void
instance (Typeable m, Typeable v) => Frame (EvalFrame m v)
eval :: forall e v t m. MonadNixEval e v t m => NExprF (m v) -> m v
@ -135,27 +133,27 @@ eval (NSelect aset attr alt) = do
eval (NHasAttr aset attr) =
toValue . either (const False) (const True) =<< evalSelect aset attr
eval e@(NList l) = do
eval (NList l) = do
scope <- currentScopes
toValue =<< for l (exprFContext e . thunk . withScopes @t scope)
toValue =<< for l (thunk . withScopes @t scope)
eval e@(NSet binds) = do
eval (NSet binds) = do
traceM "NSet..1"
(s, p) <- evalBinds e True False binds
(s, p) <- evalBinds True False binds
traceM $ "NSet..2: s = " ++ show (void s)
traceM $ "NSet..2: p = " ++ show (void p)
toValue (s, p)
eval e@(NRecSet binds) = do
eval (NRecSet binds) = do
traceM "NRecSet..1"
(s, p) <- evalBinds e True True (desugarBinds (eval . NRecSet) binds)
(s, p) <- evalBinds True True (desugarBinds (eval . NRecSet) binds)
traceM $ "NRecSet..2: s = " ++ show (void s)
traceM $ "NRecSet..2: p = " ++ show (void p)
toValue (s, p)
eval e@(NLet binds body) = do
eval (NLet binds body) = do
traceM "Let..1"
(s, _) <- evalBinds e True True binds
(s, _) <- evalBinds True True binds
traceM $ "Let..2: s = " ++ show (void s)
pushScope s body
@ -165,7 +163,7 @@ eval (NWith scope body) = evalWith scope body
eval (NAssert cond body) = cond >>= evalAssert ?? body
eval e@(NAbs params body) = do
eval (NAbs params body) = do
-- It is the environment at the definition site, not the call site, that
-- needs to be used when evaluating the body and default arguments, hence
-- we defer here so the present scope is restored when the parameters and
@ -175,7 +173,7 @@ eval e@(NAbs params body) = do
-- jww (2018-04-17): We need to use the bound library here, so that
-- the body is only evaluated once.
withScopes @t scope $ do
args <- buildArgument e params arg
args <- buildArgument params arg
pushScope args body
where
clearDefaults :: Params r -> Params Void
@ -191,9 +189,7 @@ evalWithAttrSet scope body = do
-- we want to be sure the action it evaluates is to force a thunk, so
-- its value is only computed once.
cur <- currentScopes @_ @t
s <- exprFContext (NWith scope body)
$ thunk
$ withScopes cur scope
s <- thunk $ withScopes cur scope
pushWeakScope ?? body $ force s $ fromValue @(AttrSet t)
attrSetAlter :: forall e v t m. MonadNixEval e v t m
@ -242,12 +238,11 @@ desugarBinds embed binds = evalState (mapM (go <=< collect) binds) M.empty
pure $ NamedVar (StaticKey x p :| []) (embed v)
evalBinds :: forall e v t m. MonadNixEval e v t m
=> NExprF (m v)
-> Bool
=> Bool
-> Bool
-> [Binding (m v)]
-> m (AttrSet t, AttrSet SourcePos)
evalBinds e allowDynamic recursive binds = do
evalBinds allowDynamic recursive binds = do
scope <- currentScopes @_ @t
buildResult scope . concat =<< mapM (go scope) (moveOverridesLast binds)
where
@ -299,7 +294,7 @@ evalBinds e allowDynamic recursive binds = do
s <- foldM insert M.empty bindings
res <- if recursive
then loebM (encapsulate <$> s)
else traverse (exprFContext e . thunk . withScopes scope) s
else traverse (thunk . withScopes scope) s
return (res, foldl' go M.empty bindings)
where
-- jww (2018-04-13): Need to record positions for attr paths as well
@ -307,10 +302,7 @@ evalBinds e allowDynamic recursive binds = do
go m _ = m
encapsulate f attrs =
exprFContext e
. thunk
. withScopes scope
. pushScope attrs $ f
thunk . withScopes scope . pushScope attrs $ f
insert m (path, _, value) = attrSetAlter path m value
@ -401,18 +393,18 @@ assembleString = \case
fromParts parts = mconcat <$> mapM go parts
buildArgument :: forall e v t m. MonadNixEval e v t m
=> NExprF (m v) -> Params (m v) -> m v -> m (AttrSet t)
buildArgument e params arg = do
=> Params (m v) -> m v -> m (AttrSet t)
buildArgument params arg = do
scope <- currentScopes @_ @t
case params of
Param name -> M.singleton name
<$> exprFContext e (thunk (withScopes scope arg))
<$> thunk (withScopes scope arg)
ParamSet s isVariadic m ->
arg >>= fromValue >>= \args -> do
let inject = case m of
Nothing -> id
Just n -> M.insert n $ const $
exprFContext e (thunk (withScopes scope arg))
thunk (withScopes scope arg)
loebM (inject $ alignWithKey (assemble scope isVariadic)
args (M.fromList s))
where
@ -426,17 +418,24 @@ buildArgument e params arg = do
That Nothing ->
const $ evalError @v $ "Missing value for parameter: " ++ show k
That (Just f) -> \args ->
exprFContext e
$ thunk
$ withScopes scope
$ pushScope args f
thunk $ withScopes scope $ pushScope args f
This x | isVariadic -> const (pure x)
| otherwise ->
const $ evalError @v $ "Unexpected parameter: " ++ show k
These x _ -> const (pure x)
addStackFrames :: Framed e m => Transform NExprLocF (m a)
addStackFrames f v = withFrame Info (EvaluatingExpr v) (f v)
addSourcePositions :: (MonadReader e m, Has e SrcSpan)
=> Transform NExprLocF (m a)
addSourcePositions f v@(Fix (Compose (Ann ann _))) =
local (set hasLens ann) (f v)
framedEvalExprLoc :: forall e v t m. MonadNixEval e v t m => NExprLoc -> m v
framedEvalExprLoc = adi (eval . annotated . getCompose) addStackFrames
addStackFrames :: forall t e m a. (Scoped e t m, Framed e m, Typeable t, Typeable m)
=> Transform NExprLocF (m a)
addStackFrames f v = do
scopes <- currentScopes @e @t
withFrame Info (EvaluatingExpr scopes v) (f v)
framedEvalExprLoc :: forall t e v m. (MonadNixEval e v t m, Typeable t, Typeable m)
=> NExprLoc -> m v
framedEvalExprLoc = adi (eval . annotated . getCompose)
(addStackFrames @t . addSourcePositions)

58
src/Nix/Exec.hs
View file

@ -35,13 +35,11 @@ import Control.Monad.Trans.Reader (ReaderT(..))
import qualified Data.ByteString as BS
import Data.Coerce
import Data.Fix
import Data.Functor.Compose
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as M
import Data.IORef
import Data.List
import Data.List.Split
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable
@ -72,8 +70,9 @@ import System.Process (readProcessWithExitCode)
import Text.PrettyPrint.ANSI.Leijen (text)
type MonadNix e m =
(Scoped e (NThunk m) m, Framed e m, Typeable m, MonadVar m,
MonadEffects m, MonadFix m, MonadCatch m, Alternative m)
(Scoped e (NThunk m) m, Framed e m, Has e SrcSpan,
Typeable m, MonadVar m, MonadEffects m, MonadFix m,
MonadCatch m, Alternative m)
data ExecFrame m = Assertion (NValue m)
deriving (Show, Typeable)
@ -83,46 +82,43 @@ instance Typeable m => Frame (ExecFrame m)
nverr :: forall s e m a. (MonadNix e m, Frame s) => s -> m a
nverr = evalError @(NValue m)
currentPos :: forall e m. (MonadReader e m, Has e SrcSpan) => m SrcSpan
currentPos = asks (view @e @SrcSpan hasLens)
wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc
wrapExprLoc span x = Fix (Fix (NSym_ span "<?>") <$ x)
instance MonadNix e m => MonadThunk (NValue m) (NThunk m) m where
thunk mv = do
scope <- currentScopes
span <- currentPos
frames <- asks (view @_ @Frames hasLens)
let p = case mapMaybe ((fromFrame :: SomeFrame -> Maybe EvalFrame)
. frame) frames of
ExprContext e : _ ->
let e' = Compose (Ann span (Nothing <$ e))
in [Provenance scope e']
_ -> []
fmap (NThunk p . coerce) . buildThunk $ mv
force (NThunk ps t) f = do
span <- currentPos
foldr (\(Provenance _scope e) ->
withFrame Info (EvaluatingExpr (wrapExprLoc span e)))
(forceThunk t f) ps
-- Gather the current evaluation context at the time of thunk
-- creation, and record it along with the thunk.
let go (fromFrame -> Just (EvaluatingExpr scope
(Fix (Compose (Ann span e))))) =
let e' = Compose (Ann span (Nothing <$ e))
in [Provenance scope e']
go _ = []
ps = concatMap (go . frame) frames
fmap (NThunk ps . coerce) . buildThunk $ mv
force (NThunk ps t) f = case ps of
[] -> forceThunk t f
-- jww (2018-04-25): Only report the inner-most layer for now.
Provenance scope e@(Compose (Ann span _)):_ ->
withFrame Info (ForcingExpr scope (wrapExprLoc span e))
(forceThunk t f)
value = NThunk [] . coerce . valueRef
currentPos :: Framed e m => m SrcSpan
currentPos = do
frames <- asks (view @_ @Frames hasLens)
pure $ case mapMaybe ((fromFrame :: SomeFrame -> Maybe EvalFrame)
. frame) frames of
EvaluatingExpr (Fix (Compose (Ann span _))) : _ -> span
_ -> nullAnn
instance MonadNix e m => MonadEval (NValue m) m where
freeVariable var =
nverr $ "Undefined variable '" ++ Text.unpack var ++ "'"
evalCurPos = do
scope <- currentScopes
span <- currentPos
SrcSpan delta _ <- currentPos
span@(SrcSpan delta _) <- currentPos
addProvenance (\_ -> Provenance scope (NSym_ span "__curPos"))
<$> toValue delta
@ -637,8 +633,10 @@ evalExprLoc expr = do
opts :: Options <- asks (view hasLens)
if tracing opts
then join . (`runReaderT` (0 :: Int)) $
adi (addTracing phi) (raise addStackFrames) expr
else adi phi addStackFrames expr
adi (addTracing phi)
(raise (addStackFrames @(NThunk m) . addSourcePositions))
expr
else adi phi (addStackFrames @(NThunk m) . addSourcePositions) expr
where
phi = Eval.eval @_ @(NValue m) @(NThunk m) @m . annotated . getCompose
raise k f x = ReaderT $ \e -> k (\t -> runReaderT (f t) e) x

10
src/Nix/Expr/Types/Annotated.hs
View file

@ -16,7 +16,9 @@
--
module Nix.Expr.Types.Annotated
( module Nix.Expr.Types.Annotated
, SourcePos(..), unPos
, module Data.Functor.Compose
, module Nix.Parser.Library
, SourcePos(..), unPos, mkPos
)where
import Codec.Serialise
@ -149,10 +151,10 @@ deltaInfo :: SourcePos -> (Text, Int, Int)
deltaInfo (SourcePos fp l c) = (pack fp, unPos l, unPos c)
nNull :: NExprLoc
nNull = Fix (Compose (Ann nullAnn (NConstant NNull)))
nNull = Fix (Compose (Ann nullSpan (NConstant NNull)))
nullAnn :: SrcSpan
nullAnn = SrcSpan nullPos nullPos
nullSpan :: SrcSpan
nullSpan = SrcSpan nullPos nullPos
nullPos :: SourcePos
nullPos = SourcePos "<string>" (mkPos 1) (mkPos 1)

5
src/Nix/Lint.hs
View file

@ -415,4 +415,7 @@ symbolicBaseEnv = return emptyScopes
lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))
lint opts expr = runLintM opts $
symbolicBaseEnv >>= (`pushScopes` Eval.framedEvalExprLoc expr)
symbolicBaseEnv
>>= (`pushScopes`
adi (Eval.eval . annotated . getCompose)
Eval.addSourcePositions expr)

5
src/Nix/Options.hs
View file

@ -11,6 +11,7 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
data Options = Options
{ verbose :: Verbosity
, tracing :: Bool
, thunks :: Bool
, reduce :: Maybe FilePath
, reduceSets :: Bool
, reduceLists :: Bool
@ -41,6 +42,7 @@ defaultOptions :: Options
defaultOptions = Options
{ verbose = ErrorsOnly
, tracing = False
, thunks = False
, reduce = Nothing
, reduceSets = False
, reduceLists = False
@ -104,6 +106,9 @@ nixOptions = Options
<*> switch
( long "trace"
<> help "Enable tracing code (even more can be seen if built with --flags=tracing)")
<*> switch
( long "thunks"
<> help "Enable reporting of thunk tracing as well as regular evaluation")
<*> optional (strOption
( long "reduce"
<> help "When done evaluating, output the evaluated part of the expression to FILE"))

10
src/Nix/Pretty.hs
View file

@ -13,7 +13,6 @@ module Nix.Pretty where
import Control.Monad
import Data.Fix
import Data.Functor.Compose
import Data.HashMap.Lazy (toList)
import qualified Data.HashMap.Lazy as M
import qualified Data.HashSet as HashSet
@ -265,7 +264,14 @@ renderNValue = \case
NValue ps v -> do
v' <- renderNValueF v
pure $ v' </> indent 2 (parens (mconcat
(text ("from: ") : map (prettyOriginExpr . originExpr) ps)))
(text "from: " : map (prettyOriginExpr . originExpr) ps)))
renderNThunk :: MonadVar m => NThunk m -> m Doc
renderNThunk = \case
t@(NThunk ps _) -> do
v' <- fmap prettyNixValue (dethunk t)
pure $ v' </> indent 2 (parens (mconcat
(text "thunk from: " : map (prettyOriginExpr . originExpr) ps)))
dethunk :: MonadVar m => NThunk m -> m (NValueNF m)
dethunk = \case

2
src/Nix/Reduce.hs
View file

@ -43,7 +43,6 @@ import Control.Monad.State
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
import Data.Fix
import Data.Functor.Compose
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as M
import Data.IORef
@ -61,7 +60,6 @@ import Nix.Scope
import Nix.Utils
import System.Directory
import System.FilePath
import Text.Megaparsec.Pos
newtype Reducer m a = Reducer
{ runReducer :: ReaderT (Maybe FilePath, Scopes (Reducer m) NExprLoc)

17
src/Nix/Render.hs
View file

@ -34,20 +34,6 @@ renderLocation (SrcSpan beg@(SourcePos path _ _) _) msg = do
return $ text $ parseErrorPretty' contents (posAndMsg beg msg)
{-
renderFrame :: MonadFile m => Either String NExprLoc -> m String
renderFrame (Left str) = return str
renderFrame (Right expr@(Fix (Compose (Ann ann x)))) = do
opts :: Options <- asks (view hasLens)
let rendered = show $ prettyNix $
if verbose opts >= Chatty
then stripAnnotation expr
else Fix (Fix (NSym "<?>") <$ x)
msg = if verbose opts >= Chatty
then "While evaluating:\n>>>>>>>>\n"
++ intercalate " \n" (lines rendered)
++ "\n<<<<<<<<"
else "Expression: " ++ rendered
show <$> renderLocation ann (text msg)
-}
{-
@ -60,9 +46,6 @@ throwError str = do
_ | verbose opts >= Talkative ->
mapM renderFrame $
filter noAsserts (init context) ++ [last context]
| verbose opts >= Informational ->
return [sourcePosStackPretty
(NE.fromList (concatMap justPos (reverse context)))]
| otherwise ->
return []
traceM "throwing error"

139
src/Nix/Render/Frame.hs
View file

@ -1,9 +1,12 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
@ -11,7 +14,6 @@ module Nix.Render.Frame where
import Control.Monad.Reader
import Data.Fix
import Data.Functor.Compose
import Data.Typeable
import Nix.Eval
import Nix.Exec
@ -19,7 +21,7 @@ import Nix.Expr
import Nix.Frames
import Nix.Normal
import Nix.Options
import Nix.Parser.Library
import Nix.Parser.Library hiding (colon)
import Nix.Pretty
import Nix.Render
import Nix.Thunk
@ -27,77 +29,120 @@ import Nix.Utils
import Nix.Value
import qualified Text.PrettyPrint.ANSI.Leijen as P
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
import qualified Text.Show.Pretty as PS
renderFrames :: (MonadReader e m, Has e Options,
MonadVar m, MonadFile m, Typeable m)
renderFrames :: forall v e m.
(MonadReader e m, Has e Options,
MonadVar m, MonadFile m, Typeable m, Typeable v)
=> Frames -> m Doc
renderFrames [] = pure mempty
renderFrames xs = fmap (foldr1 (P.<$>)) $ mapM renderFrame $ reverse xs
renderFrames (x:xs) = do
opts :: Options <- asks (view hasLens)
frames <-
if | verbose opts <= ErrorsOnly ->
renderFrame @v x
| verbose opts <= Informational -> do
f <- renderFrame @v x
pure $ concatMap go (reverse xs) ++ f
| otherwise ->
concat <$> mapM (renderFrame @v) (reverse (x:xs))
pure $ case frames of
[] -> mempty
_ -> foldr1 (P.<$>) frames
where
go :: NixFrame -> [Doc]
go f = case framePos @v @m f of
Just pos ->
[text "While evaluating at "
<> text (sourcePosPretty pos)
<> colon]
Nothing -> []
renderFrame :: forall e m. (MonadReader e m, Has e Options, MonadVar m,
MonadFile m, Typeable m)
=> NixFrame -> m Doc
framePos :: forall v (m :: * -> *). (Typeable m, Typeable v) => NixFrame
-> Maybe SourcePos
framePos (NixFrame _ f)
| Just (e :: EvalFrame m v) <- fromFrame f = case e of
EvaluatingExpr _ (Fix (Compose (Ann (SrcSpan beg _) _))) ->
Just beg
_ -> Nothing
| otherwise = Nothing
renderFrame :: forall v e m.
(MonadReader e m, Has e Options, MonadVar m,
MonadFile m, Typeable m, Typeable v)
=> 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 :: String) <- fromFrame f = pure $ text e
| Just (e :: Doc) <- fromFrame f = pure e
| Just (e :: EvalFrame m v) <- 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 :: String) <- fromFrame f = pure [text e]
| Just (e :: Doc) <- fromFrame f = pure [e]
| otherwise = error $ "Unrecognized frame: " ++ show f
wrapExpr :: NExprF r -> NExpr
wrapExpr x = Fix (Fix (NSym "<?>") <$ x)
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 (wrapExpr e)
=> NixLevel -> EvalFrame m v -> m [Doc]
renderEvalFrame _level f = do
opts :: Options <- asks (view hasLens)
case f of
EvaluatingExpr _scope e@(Fix (Compose (Ann ann _))) ->
(:[]) <$> renderLocation ann
(render opts "While evaluating" "Expression" e)
EvaluatingExpr e@(Fix (Compose (Ann ann x))) -> do
opts :: Options <- asks (view hasLens)
let rendered = prettyNix $
if verbose opts >= Chatty
then stripAnnotation e
else Fix (Fix (NSym "<?>") <$ x)
msg = if verbose opts >= Chatty
then text "While evaluating:\n>>>>>>>>"
P.<$> indent 2 rendered
P.<$> text "<<<<<<<<"
else "Expression: " </> rendered
renderLocation ann msg
ForcingExpr _scope e@(Fix (Compose (Ann ann _)))
| thunks opts ->
(:[]) <$> renderLocation ann
(render opts "While forcing thunk from"
"Forcing thunk" e)
_ -> pure []
where
render opts longLabel shortLabel e@(Fix (Compose (Ann _ x))) =
let rendered
| verbose opts >= DebugInfo =
text (PS.ppShow (stripAnnotation e))
| verbose opts >= Chatty =
prettyNix (stripAnnotation e)
| otherwise =
prettyNix (Fix (Fix (NSym "<?>") <$ x))
in if verbose opts >= Chatty
then text (longLabel ++ ":\n>>>>>>>>")
P.<$> indent 2 rendered
P.<$> text "<<<<<<<<"
else text shortLabel <> text ": " </> rendered
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"
=> NixLevel -> ValueFrame m -> m [Doc]
renderValueFrame level = pure . (:[]) . \case
ForcingThunk -> text "ForcingThunk"
ConcerningValue _v -> text "ConcerningValue"
Coercion x y ->
pure $ text desc <> text (describeValue x)
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"
CoercionToJsonNF _v -> text "CoercionToJsonNF"
CoercionFromJson _j -> text "CoercionFromJson"
ExpectationNF _t _v -> text "ExpectationNF"
Expectation _t _v -> text "Expectation"
renderExecFrame :: (MonadReader e m, Has e Options, MonadVar m, MonadFile m)
=> NixLevel -> ExecFrame m -> m Doc
renderExecFrame _level = \case
=> NixLevel -> ExecFrame m -> m [Doc]
renderExecFrame _level = fmap (:[]) . \case
Assertion v ->
-- jww (2018-04-24): Render values nicely based on the verbosity.
(text "Assertion failed:" </>) <$> renderNValue v
renderThunkLoop :: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel -> ThunkLoop -> m Doc
renderThunkLoop _level = \case
ThunkLoop Nothing -> pure $ text "<<loop>>"
=> NixLevel -> ThunkLoop -> m [Doc]
renderThunkLoop _level = pure . (:[]) . \case
ThunkLoop Nothing -> text "<<loop>>"
ThunkLoop (Just n) ->
pure $ text $ "<<loop forcing thunk #" ++ show n ++ ">>"
text $ "<<loop forcing thunk #" ++ show n ++ ">>"

2
tests/files/loop.nix
View file

@ -439,7 +439,7 @@ in { localSystem ? builtins.intersectAttrs {
let
stdenvBootstappingAndPlatforms = self: super: { inherit stdenv; };
allPackages = pkgs: super: {
inherit pkgs;
pkgs = pkgs;
darwin = pkgs.darwin; # THUNK FORCE LOOPS: self-reference
fetchzip = null;
fetchurlBoot = null;