{-# LANGUAGE CPP #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}


-- | Code for rendering/representation of the messages packaged with their context (Frames).
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)
#ifdef MIN_VERSION_pretty_show
import qualified Text.Show.Pretty          as PS
#endif

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 :: * -> *)
   . (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 (Compose (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
  | 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 (Compose (Ann SrcSpan) NExprF)
e@(AnnE SrcSpan
ann NExprF (Fix (Compose (Ann 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 (Compose (Ann SrcSpan) NExprF)
-> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel
-> VarName
-> VarName
-> Fix (Compose (Ann SrcSpan) NExprF)
-> m (Doc ann)
renderExpr NixLevel
level VarName
"While evaluating" VarName
"Expression" Fix (Compose (Ann SrcSpan) NExprF)
e

      ForcingExpr Scopes m v
_scope e :: Fix (Compose (Ann SrcSpan) NExprF)
e@(AnnE SrcSpan
ann NExprF (Fix (Compose (Ann 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 (Compose (Ann SrcSpan) NExprF)
-> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel
-> VarName
-> VarName
-> Fix (Compose (Ann SrcSpan) NExprF)
-> m (Doc ann)
renderExpr NixLevel
level VarName
"While forcing thunk from" VarName
"Forcing thunk" Fix (Compose (Ann 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 (Compose (Ann SrcSpan) NExprF)
e@(AnnE SrcSpan
ann NExprF (Fix (Compose (Ann SrcSpan) NExprF))
_) = SynHoleInfo m v -> Fix (Compose (Ann SrcSpan) NExprF)
forall (m :: * -> *) v.
SynHoleInfo m v -> Fix (Compose (Ann 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 (Compose (Ann SrcSpan) NExprF)
-> m (Doc ann)
forall e (m :: * -> *) ann.
(MonadReader e m, Has e Options, MonadFile m) =>
NixLevel
-> VarName
-> VarName
-> Fix (Compose (Ann SrcSpan) NExprF)
-> m (Doc ann)
renderExpr NixLevel
level VarName
"While evaluating" VarName
"Syntactic Hole" Fix (Compose (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
          ]

      ForcingExpr Scopes m v
_ Fix (Compose (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
-> VarName
-> VarName
-> Fix (Compose (Ann SrcSpan) NExprF)
-> m (Doc ann)
renderExpr NixLevel
_level VarName
longLabel VarName
shortLabel e :: Fix (Compose (Ann SrcSpan) NExprF)
e@(AnnE SrcSpan
_ NExprF (Fix (Compose (Ann 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 =
#ifdef MIN_VERSION_pretty_show
              String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (NExpr -> String
forall a. Show a => a -> String
PS.ppShow (Fix (Compose (Ann SrcSpan) NExprF) -> NExpr
forall (f :: * -> *) ann. Functor f => Fix (AnnF ann f) -> Fix f
stripAnnotation Fix (Compose (Ann SrcSpan) NExprF)
e))
#else
              pretty (show (stripAnnotation e))
#endif
          | 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 (Compose (Ann SrcSpan) NExprF) -> NExpr
forall (f :: * -> *) ann. Functor f => Fix (AnnF ann f) -> Fix f
stripAnnotation Fix (Compose (Ann 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 (Compose (Ann SrcSpan) NExprF)) -> NExprF NExpr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NExprF (Fix (Compose (Ann 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" -- 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 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 (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