{-# language CPP #-}
{-# language AllowAmbiguousTypes #-}
{-# language ConstraintKinds #-}
{-# language MultiWayIf #-}
{-# language GADTs #-}
{-# language TypeFamilies #-}


-- | Code for rendering/representation of the messages packaged with their context (Frames).
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
      --  2021-10-22: NOTE: List reverse is completely conterproductive. `reverse` of list famously neest to traverse the whole list to take the last element
        | 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" -- jww (2019-03-18): NYI
  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 "

--  2021-10-28: NOTE: notice it ignores `level`, `longlabel` & `shortlabel`, to underline that `dumbRenderValue` synonym was created
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