{-# LANGUAGE CPP #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Nix.Render.Frame where
import Prelude hiding ( Comparison )
import Nix.Utils
import Data.Fix ( Fix(..) )
import Nix.Eval
import Nix.Exec
import Nix.Expr
import Nix.Frames
import Nix.Normal
import Nix.Options
import Nix.Pretty
import Nix.Render
import Nix.Thunk
import Nix.Value
import Prettyprinter hiding ( list )
import qualified Text.Show as Text
import Text.Megaparsec.Pos ( sourcePosPretty)
import qualified Text.Show.Pretty as PS
renderFrames
:: forall v t f e m ann
. ( MonadReader e m
, Has e Options
, MonadFile m
, MonadCitedThunks t f m
, Typeable v
)
=> Frames
-> m (Doc ann)
renderFrames :: Frames -> m (Doc ann)
renderFrames [] = m (Doc ann)
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
renderFrames (NixFrame
x : Frames
xs) = do
Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens)
[Doc ann]
frames <- if
| Options -> Verbosity
verbose Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
ErrorsOnly -> NixFrame -> m [Doc ann]
forall v t (f :: * -> *) e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m, Typeable v) =>
NixFrame -> m [Doc ann]
renderFrame @v @t @f NixFrame
x
| Options -> Verbosity
verbose Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
Informational -> do
[Doc ann]
f <- NixFrame -> m [Doc ann]
forall v t (f :: * -> *) e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m, Typeable v) =>
NixFrame -> m [Doc ann]
renderFrame @v @t @f NixFrame
x
pure $ (NixFrame -> [Doc ann]) -> Frames -> [Doc ann]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NixFrame -> [Doc ann]
go (Frames -> Frames
forall a. [a] -> [a]
reverse Frames
xs) [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann]
f
| Bool
otherwise -> [[Doc ann]] -> [Doc ann]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Doc ann]] -> [Doc ann]) -> m [[Doc ann]] -> m [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NixFrame -> m [Doc ann]) -> Frames -> m [[Doc ann]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall v t (f :: * -> *) e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m, Typeable v) =>
NixFrame -> m [Doc ann]
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m, Typeable v) =>
NixFrame -> m [Doc ann]
renderFrame @v @t @f) (Frames -> Frames
forall a. [a] -> [a]
reverse (NixFrame
x NixFrame -> Frames -> Frames
forall a. a -> [a] -> [a]
: Frames
xs))
pure $
Doc ann -> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) b a. Foldable t => b -> (t a -> b) -> t a -> b
list
Doc ann
forall a. Monoid a => a
mempty
[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[Doc ann]
frames
where
go :: NixFrame -> [Doc ann]
go :: NixFrame -> [Doc ann]
go NixFrame
f =
[Doc ann]
-> (SourcePos -> [Doc ann]) -> Maybe SourcePos -> [Doc ann]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[Doc ann]
forall a. Monoid a => a
mempty
(\ SourcePos
pos -> [Doc ann
"While evaluating at " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SourcePos -> String
sourcePosPretty SourcePos
pos) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon])
(NixFrame -> Maybe SourcePos
forall v (m :: * -> *).
(Typeable m, Typeable v) =>
NixFrame -> Maybe SourcePos
framePos @v @m NixFrame
f)
framePos
:: forall v (m :: Type -> Type)
. (Typeable m, Typeable v)
=> NixFrame
-> Maybe SourcePos
framePos :: NixFrame -> Maybe SourcePos
framePos (NixFrame NixLevel
_ SomeException
f)
| Just (EvalFrame m v
e :: EvalFrame m v) <- SomeException -> Maybe (EvalFrame m v)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = case EvalFrame m v
e of
EvaluatingExpr Scopes m v
_ (AnnE (SrcSpan SourcePos
beg SourcePos
_) NExprF (Fix (AnnF SrcSpan NExprF))
_) -> SourcePos -> Maybe SourcePos
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourcePos
beg
EvalFrame m v
_ -> Maybe SourcePos
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe SourcePos
forall a. Maybe a
Nothing
renderFrame
:: forall v t f e m ann
. ( MonadReader e m
, Has e Options
, MonadFile m
, MonadCitedThunks t f m
, Typeable v
)
=> NixFrame
-> m [Doc ann]
renderFrame :: NixFrame -> m [Doc ann]
renderFrame (NixFrame NixLevel
level SomeException
f)
| Just (EvalFrame m v
e :: EvalFrame m v) <- SomeException -> Maybe (EvalFrame m v)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = NixLevel -> EvalFrame m v -> m [Doc ann]
forall e (m :: * -> *) v ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel -> EvalFrame m v -> m [Doc ann]
renderEvalFrame NixLevel
level EvalFrame m v
e
| Just (ThunkLoop
e :: ThunkLoop ) <- SomeException -> Maybe ThunkLoop
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = NixLevel -> ThunkLoop -> m [Doc ann]
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m, Show (ThunkId m)) =>
NixLevel -> ThunkLoop -> m [Doc ann]
renderThunkLoop NixLevel
level ThunkLoop
e
| Just (ValueFrame t f m
e :: ValueFrame t f m ) <- SomeException -> Maybe (ValueFrame t f m)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = NixLevel -> ValueFrame t f m -> m [Doc ann]
forall e t (f :: * -> *) (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m) =>
NixLevel -> ValueFrame t f m -> m [Doc ann]
renderValueFrame NixLevel
level ValueFrame t f m
e
| Just (NormalLoop t f m
e :: NormalLoop t f m ) <- SomeException -> Maybe (NormalLoop t f m)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = NixLevel -> NormalLoop t f m -> m [Doc ann]
forall e (m :: * -> *) t (f :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m) =>
NixLevel -> NormalLoop t f m -> m [Doc ann]
renderNormalLoop NixLevel
level NormalLoop t f m
e
| Just (ExecFrame t f m
e :: ExecFrame t f m ) <- SomeException -> Maybe (ExecFrame t f m)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = NixLevel -> ExecFrame t f m -> m [Doc ann]
forall e (m :: * -> *) t (f :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m) =>
NixLevel -> ExecFrame t f m -> m [Doc ann]
renderExecFrame NixLevel
level ExecFrame t f m
e
| Just (ErrorCall
e :: ErrorCall ) <- SomeException -> Maybe ErrorCall
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = [Doc ann] -> m [Doc ann]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ErrorCall -> String
forall a. Show a => a -> String
Text.show ErrorCall
e)]
| Just (SynHoleInfo m v
e :: SynHoleInfo m v) <- SomeException -> Maybe (SynHoleInfo m v)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
f = [Doc ann] -> m [Doc ann]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SynHoleInfo m v -> String
forall a. Show a => a -> String
Text.show SynHoleInfo m v
e)]
| Bool
otherwise = String -> m [Doc ann]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m [Doc ann]) -> String -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized frame: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall b a. (Show a, IsString b) => a -> b
show SomeException
f
wrapExpr :: NExprF r -> NExpr
wrapExpr :: NExprF r -> NExpr
wrapExpr NExprF r
x = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (VarName -> NExprF NExpr
forall r. VarName -> NExprF r
NSym VarName
"<?>") NExpr -> NExprF r -> NExprF NExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprF r
x)
renderEvalFrame
:: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel
-> EvalFrame m v
-> m [Doc ann]
renderEvalFrame :: NixLevel -> EvalFrame m v -> m [Doc ann]
renderEvalFrame NixLevel
level EvalFrame m v
f =
do
Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens)
case EvalFrame m v
f of
EvaluatingExpr Scopes m v
scope e :: Fix (AnnF SrcSpan NExprF)
e@(AnnE SrcSpan
ann NExprF (Fix (AnnF SrcSpan NExprF))
_) ->
do
let
scopeInfo :: [Doc ann]
scopeInfo =
[Doc ann] -> [Doc ann] -> Bool -> [Doc ann]
forall a. a -> a -> Bool -> a
bool
[Doc ann]
forall a. Monoid a => a
mempty
[String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ Scopes m v -> String
forall a. Show a => a -> String
Text.show Scopes m v
scope]
(Options -> Bool
showScopes Options
opts)
(Doc ann -> [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\Doc ann
x -> [Doc ann]
scopeInfo [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann
x])
(m (Doc ann) -> m [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Doc ann -> m (Doc ann)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
ann (Doc ann -> m (Doc ann)) -> m (Doc ann) -> m (Doc ann)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
NixLevel
-> VarName -> VarName -> Fix (AnnF SrcSpan NExprF) -> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel
-> VarName -> VarName -> Fix (AnnF SrcSpan NExprF) -> m (Doc ann)
renderExpr NixLevel
level VarName
"While evaluating" VarName
"Expression" Fix (AnnF SrcSpan NExprF)
e
ForcingExpr Scopes m v
_scope e :: Fix (AnnF SrcSpan NExprF)
e@(AnnE SrcSpan
ann NExprF (Fix (AnnF SrcSpan NExprF))
_) | Options -> Bool
thunks Options
opts ->
(Doc ann -> [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall a. Monoid a => a
mempty)
(m (Doc ann) -> m [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Doc ann -> m (Doc ann)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
ann (Doc ann -> m (Doc ann)) -> m (Doc ann) -> m (Doc ann)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
NixLevel
-> VarName -> VarName -> Fix (AnnF SrcSpan NExprF) -> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel
-> VarName -> VarName -> Fix (AnnF SrcSpan NExprF) -> m (Doc ann)
renderExpr NixLevel
level VarName
"While forcing thunk from" VarName
"Forcing thunk" Fix (AnnF SrcSpan NExprF)
e
Calling VarName
name SrcSpan
ann ->
(Doc ann -> [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall a. Monoid a => a
mempty)
(m (Doc ann) -> m [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Doc ann -> m (Doc ann)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
ann (Doc ann -> m (Doc ann)) -> Doc ann -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$
Doc ann
"While calling builtins." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> VarName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty VarName
name
SynHole SynHoleInfo m v
synfo ->
[m (Doc ann)] -> m [Doc ann]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m (Doc ann)] -> m [Doc ann]) -> [m (Doc ann)] -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$
let e :: Fix (AnnF SrcSpan NExprF)
e@(AnnE SrcSpan
ann NExprF (Fix (AnnF SrcSpan NExprF))
_) = SynHoleInfo m v -> Fix (AnnF SrcSpan NExprF)
forall (m :: * -> *) v.
SynHoleInfo m v -> Fix (AnnF SrcSpan NExprF)
_synHoleInfo_expr SynHoleInfo m v
synfo in
[ SrcSpan -> Doc ann -> m (Doc ann)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
ann (Doc ann -> m (Doc ann)) -> m (Doc ann) -> m (Doc ann)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
NixLevel
-> VarName -> VarName -> Fix (AnnF SrcSpan NExprF) -> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel
-> VarName -> VarName -> Fix (AnnF SrcSpan NExprF) -> m (Doc ann)
renderExpr NixLevel
level VarName
"While evaluating" VarName
"Syntactic Hole" Fix (AnnF SrcSpan NExprF)
e
, Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc ann -> m (Doc ann)) -> Doc ann -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ Scopes m v -> String
forall a. Show a => a -> String
Text.show (Scopes m v -> String) -> Scopes m v -> String
forall a b. (a -> b) -> a -> b
$ SynHoleInfo m v -> Scopes m v
forall (m :: * -> *) v. SynHoleInfo m v -> Scopes m v
_synHoleInfo_scope SynHoleInfo m v
synfo
]
ForcingExpr Scopes m v
_ Fix (AnnF SrcSpan NExprF)
_ -> m [Doc ann]
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
renderExpr
:: (MonadReader e m, Has e Options, MonadFile m)
=> NixLevel
-> Text
-> Text
-> NExprLoc
-> m (Doc ann)
renderExpr :: NixLevel
-> VarName -> VarName -> Fix (AnnF SrcSpan NExprF) -> m (Doc ann)
renderExpr NixLevel
_level VarName
longLabel VarName
shortLabel e :: Fix (AnnF SrcSpan NExprF)
e@(AnnE SrcSpan
_ NExprF (Fix (AnnF SrcSpan NExprF))
x) = do
Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens)
let rendered :: Doc ann
rendered
| Options -> Verbosity
verbose Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
DebugInfo =
String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (NExpr -> String
forall a. Show a => a -> String
PS.ppShow (Fix (AnnF SrcSpan NExprF) -> NExpr
forall (f :: * -> *) ann. Functor f => Fix (AnnF ann f) -> Fix f
stripAnnotation Fix (AnnF SrcSpan NExprF)
e))
| Options -> Verbosity
verbose Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Chatty = NExpr -> Doc ann
forall ann. NExpr -> Doc ann
prettyNix (Fix (AnnF SrcSpan NExprF) -> NExpr
forall (f :: * -> *) ann. Functor f => Fix (AnnF ann f) -> Fix f
stripAnnotation Fix (AnnF SrcSpan NExprF)
e)
| Bool
otherwise = NExpr -> Doc ann
forall ann. NExpr -> Doc ann
prettyNix (NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (VarName -> NExprF NExpr
forall r. VarName -> NExprF r
NSym VarName
"<?>") NExpr -> NExprF (Fix (AnnF SrcSpan NExprF)) -> NExprF NExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprF (Fix (AnnF SrcSpan NExprF))
x))
Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc ann -> m (Doc ann)) -> Doc ann -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$
Doc ann -> Doc ann -> Bool -> Doc ann
forall a. a -> a -> Bool -> a
bool
(VarName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty VarName
shortLabel Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep [Doc ann
": ", Doc ann
rendered])
([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [VarName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (VarName
longLabel VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
":\n>>>>>>>>"), Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc ann
rendered, Doc ann
"<<<<<<<<"])
(Options -> Verbosity
verbose Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Chatty)
renderValueFrame
:: forall e t f m ann
. (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
=> NixLevel
-> ValueFrame t f m
-> m [Doc ann]
renderValueFrame :: NixLevel -> ValueFrame t f m -> m [Doc ann]
renderValueFrame NixLevel
level = (Doc ann -> [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall a. Monoid a => a
mempty) (m (Doc ann) -> m [Doc ann])
-> (ValueFrame t f m -> m (Doc ann))
-> ValueFrame t f m
-> m [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
ForcingThunk t
_t -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc ann
"ForcingThunk"
ConcerningValue NValue t f m
_v -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc ann
"ConcerningValue"
Comparison NValue t f m
_ NValue t f m
_ -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc ann
"Comparing"
Addition NValue t f m
_ NValue t f m
_ -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc ann
"Adding"
Division NValue t f m
_ NValue t f m
_ -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc ann
"Dividing"
Multiplication NValue t f m
_ NValue t f m
_ -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc ann
"Multiplying"
Coercion ValueType
x ValueType
y -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Doc ann -> m (Doc ann)) -> Doc ann -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat [Doc ann
desc, VarName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ValueType -> VarName
describeValue ValueType
x), Doc ann
" to ", VarName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ValueType -> VarName
describeValue ValueType
y)]
where
desc :: Doc ann
desc =
Doc ann -> Doc ann -> Bool -> Doc ann
forall a. a -> a -> Bool -> a
bool
Doc ann
"While coercing "
Doc ann
"Cannot coerce "
(NixLevel
level NixLevel -> NixLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= NixLevel
Error)
CoercionToJson NValue t f m
v ->
(Doc ann
"CoercionToJson " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) (Doc ann -> Doc ann) -> m (Doc ann) -> m (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
forall e t (f :: * -> *) (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m) =>
NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
renderValue NixLevel
level VarName
"" VarName
"" NValue t f m
v
CoercionFromJson Value
_j -> Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc ann
"CoercionFromJson"
Expectation ValueType
t NValue t f m
v ->
(Doc ann
msg Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) (Doc ann -> Doc ann) -> m (Doc ann) -> m (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
forall e t (f :: * -> *) (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m) =>
NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
renderValue @_ @t @f @m NixLevel
level VarName
"" VarName
"" NValue t f m
v
where
msg :: Doc ann
msg = Doc ann
"Expected " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> VarName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ValueType -> VarName
describeValue ValueType
t) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", but saw "
renderValue
:: forall e t f m ann
. (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
=> NixLevel
-> Text
-> Text
-> NValue t f m
-> m (Doc ann)
renderValue :: NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
renderValue NixLevel
_level VarName
_longLabel VarName
_shortLabel NValue t f m
v = do
Options
opts :: Options <- (e -> Options) -> m Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((e -> Options) -> m Options) -> (e -> Options) -> m Options
forall a b. (a -> b) -> a -> b
$ FoldLike Options e e Options Options -> e -> Options
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike Options e e Options Options
forall a b. Has a b => Lens' a b
hasLens
(NValue t f m -> Doc ann)
-> (NValue t f m -> Doc ann) -> Bool -> NValue t f m -> Doc ann
forall a. a -> a -> Bool -> a
bool
NValue t f m -> Doc ann
forall t (f :: * -> *) (m :: * -> *) ann.
MonadDataContext f m =>
NValue t f m -> Doc ann
prettyNValue
NValue t f m -> Doc ann
forall t (f :: * -> *) (m :: * -> *) ann.
(HasCitations m (NValue t f m) t, HasCitations1 m (NValue t f m) f,
MonadThunk t m (NValue t f m), MonadDataContext f m) =>
NValue t f m -> Doc ann
prettyNValueProv
(Options -> Bool
values Options
opts)
(NValue t f m -> Doc ann) -> m (NValue t f m) -> m (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NValue t f m -> m (NValue t f m)
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
NValue t f m -> m (NValue t f m)
removeEffects NValue t f m
v
renderExecFrame
:: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
=> NixLevel
-> ExecFrame t f m
-> m [Doc ann]
renderExecFrame :: NixLevel -> ExecFrame t f m -> m [Doc ann]
renderExecFrame NixLevel
level =
\case
Assertion SrcSpan
ann NValue t f m
v ->
(Doc ann -> [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall a. Monoid a => a
mempty)
(do
Doc ann
d <- NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
forall e t (f :: * -> *) (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m) =>
NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
renderValue NixLevel
level VarName
"" VarName
"" NValue t f m
v
SrcSpan -> Doc ann -> m (Doc ann)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
ann (Doc ann -> m (Doc ann)) -> Doc ann -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep [Doc ann
"Assertion failed:", Doc ann
d]
)
renderThunkLoop
:: (MonadReader e m, Has e Options, MonadFile m, Show (ThunkId m))
=> NixLevel
-> ThunkLoop
-> m [Doc ann]
renderThunkLoop :: NixLevel -> ThunkLoop -> m [Doc ann]
renderThunkLoop NixLevel
_level = [Doc ann] -> m [Doc ann]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Doc ann] -> m [Doc ann])
-> (ThunkLoop -> [Doc ann]) -> ThunkLoop -> m [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall a. Monoid a => a
mempty) (Doc ann -> [Doc ann])
-> (ThunkLoop -> Doc ann) -> ThunkLoop -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
ThunkLoop VarName
n -> VarName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (VarName -> Doc ann) -> VarName -> Doc ann
forall a b. (a -> b) -> a -> b
$ VarName
"Infinite recursion in thunk " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
n
renderNormalLoop
:: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
=> NixLevel
-> NormalLoop t f m
-> m [Doc ann]
renderNormalLoop :: NixLevel -> NormalLoop t f m -> m [Doc ann]
renderNormalLoop NixLevel
level =
(Doc ann -> [Doc ann]) -> m (Doc ann) -> m [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall a. Monoid a => a
mempty)
(m (Doc ann) -> m [Doc ann])
-> (NormalLoop t f m -> m (Doc ann))
-> NormalLoop t f m
-> m [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
NormalLoop NValue t f m
v ->
(Doc ann
"Infinite recursion during normalization forcing " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) (Doc ann -> Doc ann) -> m (Doc ann) -> m (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
forall e t (f :: * -> *) (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m,
MonadCitedThunks t f m) =>
NixLevel -> VarName -> VarName -> NValue t f m -> m (Doc ann)
renderValue NixLevel
level VarName
"" VarName
"" NValue t f m
v