2018-05-09 01:40:56 +02:00
|
|
|
{-# LANGUAGE CPP #-}
|
2018-04-25 22:00:41 +02:00
|
|
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
2018-04-24 20:12:20 +02:00
|
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
{-# LANGUAGE LambdaCase #-}
|
2018-04-25 22:00:41 +02:00
|
|
|
{-# LANGUAGE MultiWayIf #-}
|
2018-04-24 20:12:20 +02:00
|
|
|
{-# LANGUAGE GADTs #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2018-04-25 22:00:41 +02:00
|
|
|
{-# LANGUAGE TypeApplications #-}
|
2018-04-24 20:12:20 +02:00
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
|
|
|
|
module Nix.Render.Frame where
|
|
|
|
|
2018-04-25 08:09:43 +02:00
|
|
|
import Control.Monad.Reader
|
|
|
|
import Data.Fix
|
|
|
|
import Data.Typeable
|
|
|
|
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.Utils
|
|
|
|
import Nix.Value
|
2020-08-04 06:25:57 +02:00
|
|
|
import Prettyprinter
|
2018-05-07 21:06:56 +02:00
|
|
|
import Text.Megaparsec.Pos
|
2018-05-13 23:17:55 +02:00
|
|
|
#ifdef MIN_VERSION_pretty_show
|
2018-04-25 22:00:41 +02:00
|
|
|
import qualified Text.Show.Pretty as PS
|
2018-05-09 01:40:56 +02:00
|
|
|
#endif
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2018-11-17 05:51:18 +01:00
|
|
|
renderFrames
|
2019-03-15 20:59:13 +01:00
|
|
|
:: forall v t f e m ann
|
2019-03-17 22:47:38 +01:00
|
|
|
. ( MonadReader e m
|
2019-03-15 20:59:13 +01:00
|
|
|
, Has e Options
|
|
|
|
, MonadFile m
|
|
|
|
, MonadCitedThunks t f m
|
|
|
|
, Typeable v
|
|
|
|
)
|
2019-03-17 22:47:38 +01:00
|
|
|
=> Frames
|
|
|
|
-> m (Doc ann)
|
|
|
|
renderFrames [] = pure mempty
|
|
|
|
renderFrames (x : xs) = do
|
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
frames <- if
|
|
|
|
| verbose opts <= ErrorsOnly -> renderFrame @v @t @f x
|
|
|
|
| verbose opts <= Informational -> do
|
|
|
|
f <- renderFrame @v @t @f x
|
|
|
|
pure $ concatMap go (reverse xs) ++ f
|
|
|
|
| otherwise -> concat <$> mapM (renderFrame @v @t @f) (reverse (x : xs))
|
|
|
|
pure $ case frames of
|
|
|
|
[] -> mempty
|
|
|
|
_ -> vsep frames
|
|
|
|
where
|
|
|
|
go :: NixFrame -> [Doc ann]
|
|
|
|
go f = case framePos @v @m f of
|
|
|
|
Just pos ->
|
|
|
|
["While evaluating at " <> pretty (sourcePosPretty pos) <> colon]
|
|
|
|
Nothing -> []
|
|
|
|
|
|
|
|
framePos
|
|
|
|
:: forall v (m :: * -> *)
|
|
|
|
. (Typeable m, Typeable v)
|
|
|
|
=> NixFrame
|
|
|
|
-> Maybe SourcePos
|
2018-04-25 22:00:41 +02:00
|
|
|
framePos (NixFrame _ f)
|
2019-03-17 22:47:38 +01:00
|
|
|
| Just (e :: EvalFrame m v) <- fromException f = case e of
|
|
|
|
EvaluatingExpr _ (Fix (Compose (Ann (SrcSpan beg _) _))) -> Just beg
|
|
|
|
_ -> Nothing
|
|
|
|
| otherwise = Nothing
|
2018-04-25 22:00:41 +02:00
|
|
|
|
2019-03-15 20:59:13 +01:00
|
|
|
renderFrame
|
2019-03-17 22:47:38 +01:00
|
|
|
:: 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]
|
2018-04-24 20:12:20 +02:00
|
|
|
renderFrame (NixFrame level f)
|
2019-03-17 22:47:38 +01:00
|
|
|
| Just (e :: EvalFrame m v) <- fromException f = renderEvalFrame level e
|
|
|
|
| Just (e :: ThunkLoop) <- fromException f = renderThunkLoop level e
|
|
|
|
| Just (e :: ValueFrame t f m) <- fromException f = renderValueFrame level e
|
|
|
|
| Just (e :: NormalLoop t f m) <- fromException f = renderNormalLoop level e
|
|
|
|
| Just (e :: ExecFrame t f m) <- fromException f = renderExecFrame level e
|
|
|
|
| Just (e :: ErrorCall) <- fromException f = pure [pretty (show e)]
|
|
|
|
| Just (e :: SynHoleInfo m v) <- fromException f = pure [pretty (show e)]
|
|
|
|
| otherwise = error $ "Unrecognized frame: " ++ show f
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2018-04-25 08:09:43 +02:00
|
|
|
wrapExpr :: NExprF r -> NExpr
|
|
|
|
wrapExpr x = Fix (Fix (NSym "<?>") <$ x)
|
|
|
|
|
2019-03-17 22:47:38 +01:00
|
|
|
renderEvalFrame
|
|
|
|
:: (MonadReader e m, Has e Options, MonadFile m)
|
|
|
|
=> NixLevel
|
|
|
|
-> EvalFrame m v
|
|
|
|
-> m [Doc ann]
|
2018-04-28 05:36:38 +02:00
|
|
|
renderEvalFrame level f = do
|
2019-03-17 22:47:38 +01:00
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
case f of
|
|
|
|
EvaluatingExpr scope e@(Fix (Compose (Ann ann _))) -> do
|
|
|
|
let scopeInfo | scopes opts = [pretty $ show scope]
|
|
|
|
| otherwise = []
|
|
|
|
fmap (\x -> scopeInfo ++ [x])
|
|
|
|
$ renderLocation ann
|
|
|
|
=<< renderExpr level "While evaluating" "Expression" e
|
|
|
|
|
|
|
|
ForcingExpr _scope e@(Fix (Compose (Ann ann _))) | thunks opts ->
|
|
|
|
fmap (: [])
|
|
|
|
$ renderLocation ann
|
|
|
|
=<< renderExpr level "While forcing thunk from" "Forcing thunk" e
|
|
|
|
|
|
|
|
Calling name ann ->
|
|
|
|
fmap (: [])
|
|
|
|
$ renderLocation ann
|
|
|
|
$ "While calling builtins."
|
|
|
|
<> pretty name
|
|
|
|
|
|
|
|
SynHole synfo ->
|
|
|
|
sequence
|
|
|
|
$ let e@(Fix (Compose (Ann ann _))) = _synHoleInfo_expr synfo
|
|
|
|
in [ renderLocation ann
|
|
|
|
=<< renderExpr level "While evaluating" "Syntactic Hole" e
|
|
|
|
, pure $ pretty $ show (_synHoleInfo_scope synfo)
|
|
|
|
]
|
|
|
|
|
|
|
|
ForcingExpr _ _ -> pure []
|
|
|
|
|
|
|
|
|
|
|
|
renderExpr
|
|
|
|
:: (MonadReader e m, Has e Options, MonadFile m)
|
|
|
|
=> NixLevel
|
|
|
|
-> String
|
|
|
|
-> String
|
|
|
|
-> NExprLoc
|
|
|
|
-> m (Doc ann)
|
2018-04-28 05:36:38 +02:00
|
|
|
renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do
|
2019-03-17 22:47:38 +01:00
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
let rendered
|
|
|
|
| verbose opts >= DebugInfo =
|
2018-05-13 23:17:55 +02:00
|
|
|
#ifdef MIN_VERSION_pretty_show
|
2018-11-17 05:51:18 +01:00
|
|
|
pretty (PS.ppShow (stripAnnotation e))
|
2018-05-09 01:40:56 +02:00
|
|
|
#else
|
2018-11-17 05:51:18 +01:00
|
|
|
pretty (show (stripAnnotation e))
|
2018-05-09 01:40:56 +02:00
|
|
|
#endif
|
2019-03-17 22:47:38 +01:00
|
|
|
| verbose opts >= Chatty = prettyNix (stripAnnotation e)
|
|
|
|
| otherwise = prettyNix (Fix (Fix (NSym "<?>") <$ x))
|
|
|
|
pure $ if verbose opts >= Chatty
|
|
|
|
then
|
|
|
|
vsep
|
|
|
|
$ [pretty (longLabel ++ ":\n>>>>>>>>"), indent 2 rendered, "<<<<<<<<"]
|
|
|
|
else pretty shortLabel <> fillSep [": ", rendered]
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2019-03-15 20:59:13 +01:00
|
|
|
renderValueFrame
|
2019-03-19 05:34:04 +01:00
|
|
|
:: forall e t f m ann
|
2019-03-19 05:47:43 +01:00
|
|
|
. (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
|
2019-03-17 22:47:38 +01:00
|
|
|
=> NixLevel
|
|
|
|
-> ValueFrame t f m
|
|
|
|
-> m [Doc ann]
|
|
|
|
renderValueFrame level = fmap (: []) . \case
|
2019-03-19 05:47:43 +01:00
|
|
|
ForcingThunk _t -> pure "ForcingThunk" -- jww (2019-03-18): NYI
|
2019-03-17 22:47:38 +01:00
|
|
|
ConcerningValue _v -> pure "ConcerningValue"
|
|
|
|
Comparison _ _ -> pure "Comparing"
|
|
|
|
Addition _ _ -> pure "Adding"
|
|
|
|
Division _ _ -> pure "Dividing"
|
|
|
|
Multiplication _ _ -> pure "Multiplying"
|
|
|
|
|
|
|
|
Coercion x y -> pure
|
|
|
|
$ mconcat [desc, pretty (describeValue x), " to ", pretty (describeValue y)]
|
|
|
|
where
|
|
|
|
desc | level <= Error = "Cannot coerce "
|
|
|
|
| otherwise = "While coercing "
|
|
|
|
|
|
|
|
CoercionToJson v -> do
|
|
|
|
v' <- renderValue level "" "" v
|
|
|
|
pure $ "CoercionToJson " <> v'
|
|
|
|
CoercionFromJson _j -> pure "CoercionFromJson"
|
2019-03-27 05:21:12 +01:00
|
|
|
Expectation t v -> do
|
|
|
|
v' <- renderValue @_ @t @f @m level "" "" v
|
|
|
|
pure $ "Saw " <> v' <> " but expected " <> pretty (describeValue t)
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2019-03-15 20:59:13 +01:00
|
|
|
renderValue
|
2019-03-19 05:34:04 +01:00
|
|
|
:: forall e t f m ann
|
2019-03-19 05:47:43 +01:00
|
|
|
. (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
|
2019-03-17 22:47:38 +01:00
|
|
|
=> NixLevel
|
|
|
|
-> String
|
|
|
|
-> String
|
|
|
|
-> NValue t f m
|
|
|
|
-> m (Doc ann)
|
2018-04-28 05:36:38 +02:00
|
|
|
renderValue _level _longLabel _shortLabel v = do
|
2019-03-17 22:47:38 +01:00
|
|
|
opts :: Options <- asks (view hasLens)
|
2019-03-27 05:21:12 +01:00
|
|
|
(if values opts
|
|
|
|
then prettyNValueProv
|
|
|
|
else prettyNValue) <$> removeEffects v
|
2018-04-28 05:36:38 +02:00
|
|
|
|
2019-03-15 20:59:13 +01:00
|
|
|
renderExecFrame
|
2019-03-17 22:47:38 +01:00
|
|
|
:: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
|
|
|
|
=> NixLevel
|
|
|
|
-> ExecFrame t f m
|
|
|
|
-> m [Doc ann]
|
2018-04-28 05:36:38 +02:00
|
|
|
renderExecFrame level = \case
|
2019-03-17 22:47:38 +01:00
|
|
|
Assertion ann v ->
|
|
|
|
fmap (: [])
|
|
|
|
$ renderLocation ann
|
|
|
|
=<< ( (\d -> fillSep ["Assertion failed:", d])
|
|
|
|
<$> renderValue level "" "" v
|
|
|
|
)
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2019-03-17 00:23:40 +01:00
|
|
|
renderThunkLoop
|
2019-03-17 22:47:38 +01:00
|
|
|
:: (MonadReader e m, Has e Options, MonadFile m, Show (ThunkId m))
|
|
|
|
=> NixLevel
|
|
|
|
-> ThunkLoop
|
|
|
|
-> m [Doc ann]
|
|
|
|
renderThunkLoop _level = pure . (: []) . \case
|
|
|
|
ThunkLoop n -> pretty $ "Infinite recursion in thunk " ++ n
|
2018-08-05 21:48:52 +02:00
|
|
|
|
2019-03-15 20:59:13 +01:00
|
|
|
renderNormalLoop
|
2019-03-17 22:47:38 +01:00
|
|
|
:: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
|
|
|
|
=> NixLevel
|
|
|
|
-> NormalLoop t f m
|
|
|
|
-> m [Doc ann]
|
|
|
|
renderNormalLoop level = fmap (: []) . \case
|
|
|
|
NormalLoop v -> do
|
|
|
|
v' <- renderValue level "" "" v
|
|
|
|
pure $ "Infinite recursion during normalization forcing " <> v'
|