{-# language CPP #-}
{-# language AllowAmbiguousTypes #-}
{-# language ConstraintKinds #-}
{-# language MultiWayIf #-}
{-# language GADTs #-}
{-# language TypeFamilies #-}
module Nix.Render.Frame where
import Nix.Prelude hiding ( Comparison )
import GHC.Exception ( ErrorCall )
import Data.Fix ( Fix(..) )
import Nix.Eval hiding ( addMetaInfo )
import Nix.Exec
import Nix.Expr.Types
import Nix.Expr.Types.Annotated
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 xss :: Frames
xss@(NixFrame
x : Frames
xs) =
do
Options
opts <- m Options
forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
let
verbosity :: Verbosity
verbosity :: Verbosity
verbosity = Options -> Verbosity
getVerbosity Options
opts
[Doc ann]
renderedFrames <- if
| Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
ErrorsOnly -> NixFrame -> m [Doc ann]
forall ann1. NixFrame -> m [Doc ann1]
render1 NixFrame
x
| Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
Informational -> ((NixFrame -> [Doc ann]) -> Frames -> [Doc ann]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NixFrame -> [Doc ann]
renderPosition (Frames -> Frames
forall a. [a] -> [a]
reverse Frames
xs) [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
<$> NixFrame -> m [Doc ann]
forall ann1. NixFrame -> m [Doc ann1]
render1 NixFrame
x
| Bool
otherwise -> (NixFrame -> m [Doc ann]) -> Frames -> m [Doc ann]
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM NixFrame -> m [Doc ann]
forall ann1. NixFrame -> m [Doc ann1]
render1 (Frames -> Frames
forall a. [a] -> [a]
reverse Frames
xss)
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]
renderedFrames
where
render1 :: NixFrame -> m [Doc ann1]
render1 :: NixFrame -> m [Doc ann1]
render1 = 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
renderPosition :: NixFrame -> [Doc ann]
renderPosition :: NixFrame -> [Doc ann]
renderPosition =
(SourcePos -> [Doc ann]) -> Maybe SourcePos -> [Doc ann]
forall b a. Monoid b => (a -> b) -> Maybe a -> b
whenJust
(\ SourcePos
pos -> OneItem [Doc ann] -> [Doc ann]
forall x. One x => OneItem x -> x
one (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))
(Maybe SourcePos -> [Doc ann])
-> (NixFrame -> Maybe SourcePos) -> NixFrame -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Typeable m, Typeable v) => NixFrame -> Maybe SourcePos
forall v (m :: * -> *).
(Typeable m, Typeable v) =>
NixFrame -> Maybe SourcePos
framePos @v @m
framePos
:: forall v (m :: Type -> Type)
. (Typeable m, Typeable v)
=> NixFrame
-> Maybe SourcePos
framePos :: NixFrame -> Maybe SourcePos
framePos (NixFrame NixLevel
_ SomeException
f) =
(\case
EvaluatingExpr Scopes m v
_ (Ann (SrcSpan SourcePos
beg SourcePos
_) NExprF (Ann 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
)
(EvalFrame m v -> Maybe SourcePos)
-> Maybe (EvalFrame m v) -> Maybe SourcePos
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SomeException -> Maybe (EvalFrame m v)
forall e. Exception e => SomeException -> Maybe e
fromException @(EvalFrame m v) SomeException
f
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 ([Doc ann] -> m [Doc ann]) -> [Doc ann] -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$ OneItem [Doc ann] -> [Doc ann]
forall x. One x => OneItem x -> x
one (OneItem [Doc ann] -> [Doc ann]) -> OneItem [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ 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 ([Doc ann] -> m [Doc ann]) -> [Doc ann] -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$ OneItem [Doc ann] -> [Doc ann]
forall x. One x => OneItem x -> x
one (OneItem [Doc ann] -> [Doc ann]) -> OneItem [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ 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
:: forall e m v ann
. (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 <- m Options
forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
let
addMetaInfo :: ([Doc ann] -> [Doc ann]) -> SrcSpan -> Doc ann -> m [Doc ann]
addMetaInfo :: ([Doc ann] -> [Doc ann]) -> SrcSpan -> Doc ann -> m [Doc ann]
addMetaInfo [Doc ann] -> [Doc ann]
trans SrcSpan
loc = (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]
trans ([Doc ann] -> [Doc ann])
-> (Doc ann -> [Doc ann]) -> Doc ann -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann]
forall x. One x => OneItem x -> x
one) (m (Doc ann) -> m [Doc ann])
-> (Doc ann -> m (Doc ann)) -> Doc ann -> m [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Doc ann -> m (Doc ann)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
loc
case EvalFrame m v
f of
EvaluatingExpr Scopes m v
scope e :: Ann SrcSpan NExprF
e@(Ann SrcSpan
loc NExprF (Ann SrcSpan NExprF)
_) ->
([Doc ann] -> [Doc ann]) -> SrcSpan -> Doc ann -> m [Doc ann]
addMetaInfo
([Doc ann]
scopeInfo [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<>)
SrcSpan
loc
(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 -> Text -> Text -> Ann SrcSpan NExprF -> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel -> Text -> Text -> Ann SrcSpan NExprF -> m (Doc ann)
renderExpr NixLevel
level Text
"While evaluating" Text
"Expression" Ann SrcSpan NExprF
e
where
scopeInfo :: [Doc ann]
scopeInfo :: [Doc ann]
scopeInfo =
OneItem [Doc ann] -> [Doc ann]
forall x. One x => OneItem x -> x
one (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) [Doc ann] -> Bool -> [Doc ann]
forall a. Monoid a => a -> Bool -> a
`whenTrue` Options -> Bool
isShowScopes Options
opts
ForcingExpr Scopes m v
_scope e :: Ann SrcSpan NExprF
e@(Ann SrcSpan
loc NExprF (Ann SrcSpan NExprF)
_) | Options -> Bool
isThunks Options
opts ->
([Doc ann] -> [Doc ann]) -> SrcSpan -> Doc ann -> m [Doc ann]
addMetaInfo
[Doc ann] -> [Doc ann]
forall a. a -> a
id
SrcSpan
loc
(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 -> Text -> Text -> Ann SrcSpan NExprF -> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel -> Text -> Text -> Ann SrcSpan NExprF -> m (Doc ann)
renderExpr NixLevel
level Text
"While forcing thunk from" Text
"Forcing thunk" Ann SrcSpan NExprF
e
Calling VarName
name SrcSpan
loc ->
([Doc ann] -> [Doc ann]) -> SrcSpan -> Doc ann -> m [Doc ann]
addMetaInfo
[Doc ann] -> [Doc ann]
forall a. a -> a
id
SrcSpan
loc
(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 ann. VarName -> Doc ann
prettyVarName VarName
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"`"
SynHole SynHoleInfo m v
synfo ->
[m (Doc ann)] -> m [Doc ann]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ SrcSpan -> Doc ann -> m (Doc ann)
forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation SrcSpan
loc (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 -> Text -> Text -> Ann SrcSpan NExprF -> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel -> Text -> Text -> Ann SrcSpan NExprF -> m (Doc ann)
renderExpr NixLevel
level Text
"While evaluating" Text
"Syntactic Hole" Ann 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
]
where
e :: Ann SrcSpan NExprF
e@(Ann SrcSpan
loc NExprF (Ann SrcSpan NExprF)
_) = SynHoleInfo m v -> Ann SrcSpan NExprF
forall (m :: * -> *) v. SynHoleInfo m v -> Ann SrcSpan NExprF
_synHoleInfo_expr SynHoleInfo m v
synfo
ForcingExpr Scopes m v
_ Ann 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 -> Text -> Text -> Ann SrcSpan NExprF -> m (Doc ann)
renderExpr NixLevel
_level Text
longLabel Text
shortLabel e :: Ann SrcSpan NExprF
e@(Ann SrcSpan
_ NExprF (Ann SrcSpan NExprF)
x) =
do
Options
opts <- m Options
forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
let
verbosity :: Verbosity
verbosity :: Verbosity
verbosity = Options -> Verbosity
getVerbosity Options
opts
expr :: NExpr
expr :: NExpr
expr = Ann SrcSpan NExprF -> NExpr
forall (f :: * -> *) ann. Functor f => Ann ann f -> Fix f
stripAnnotation Ann SrcSpan NExprF
e
concise :: Doc ann
concise = NExpr -> Doc ann
forall ann. NExpr -> Doc ann
prettyNix (NExpr -> Doc ann) -> NExpr -> Doc ann
forall a b. (a -> b) -> a -> b
$ NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (VarName -> NExprF NExpr
forall r. VarName -> NExprF r
NSym VarName
"<?>") NExpr -> NExprF (Ann SrcSpan NExprF) -> NExprF NExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprF (Ann SrcSpan NExprF)
x
chatty :: Doc ann
chatty =
Doc ann -> Doc ann -> Bool -> Doc ann
forall a. a -> a -> Bool -> a
bool
(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
$ NExpr -> String
forall a. Show a => a -> String
PS.ppShow NExpr
expr)
(NExpr -> Doc ann
forall ann. NExpr -> Doc ann
prettyNix NExpr
expr)
(Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Chatty)
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
(Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
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
concise])
([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text
longLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n>>>>>>>>"), Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc ann
forall ann. Doc ann
chatty, Doc ann
"<<<<<<<<"])
(Verbosity
verbosity 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]
forall x. One x => OneItem x -> x
one (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 (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Doc ann
desc, Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ValueType -> Text
describeValue ValueType
x), Doc ann
" to ", Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ValueType -> Text
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
<$> 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) =>
NValue t f m -> m (Doc ann)
dumbRenderValue 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
<$> 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) =>
NValue t f m -> m (Doc ann)
dumbRenderValue 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
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ValueType -> Text
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 -> Text -> Text -> NValue t f m -> m (Doc ann)
renderValue NixLevel
_level Text
_longLabel Text
_shortLabel NValue t f m
v =
do
Options
opts <- m Options
forall e (m :: * -> *).
(MonadReader e m, Has e Options) =>
m Options
askOptions
(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
isValues 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
dumbRenderValue
:: forall e t f m ann
. (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
=> (NValue t f m -> m (Doc ann))
dumbRenderValue :: NValue t f m -> m (Doc ann)
dumbRenderValue = NixLevel -> Text -> Text -> 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 -> Text -> Text -> NValue t f m -> m (Doc ann)
renderValue NixLevel
Info Text
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty
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 (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]
forall x. One x => OneItem x -> x
one
(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 -> Doc ann) -> Doc ann -> m (Doc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc ann] -> Doc ann)
-> (Doc ann -> [Doc ann]) -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Doc ann] -> [Doc ann] -> [Doc ann])
-> (Doc ann -> [Doc ann]) -> Doc ann -> Doc ann -> [Doc ann]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
(<>) Doc ann -> [Doc ann]
forall x. One x => OneItem x -> x
one Doc ann
"Assertion failed:" (Doc ann -> m (Doc ann)) -> m (Doc ann) -> m (Doc ann)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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) =>
NValue t f m -> m (Doc ann)
dumbRenderValue NValue t f m
v
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 (ThunkLoop Text
n) =
[Doc ann] -> m [Doc ann]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Doc ann] -> m [Doc ann])
-> (Text -> [Doc ann]) -> Text -> m [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann]
forall x. One x => OneItem x -> x
one (Doc ann -> [Doc ann]) -> (Text -> Doc ann) -> Text -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> m [Doc ann]) -> Text -> m [Doc ann]
forall a b. (a -> b) -> a -> b
$ Text
"Infinite recursion in thunk " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 (NormalLoop NValue t f m
v) =
Doc ann -> [Doc ann]
forall x. One x => OneItem x -> x
one (Doc ann -> [Doc ann])
-> (Doc ann -> Doc ann) -> Doc ann -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
<$> 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) =>
NValue t f m -> m (Doc ann)
dumbRenderValue NValue t f m
v