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 #-}
|
|
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
|
|
|
|
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
|
2018-05-07 21:06:56 +02:00
|
|
|
import Text.Megaparsec.Pos
|
2018-04-25 08:09:43 +02:00
|
|
|
import qualified Text.PrettyPrint.ANSI.Leijen as P
|
|
|
|
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
|
2018-05-09 01:40:56 +02:00
|
|
|
#if MIN_VERSION_pretty_show(1, 6, 16)
|
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-04-25 22:00:41 +02:00
|
|
|
renderFrames :: forall v e m.
|
|
|
|
(MonadReader e m, Has e Options,
|
|
|
|
MonadVar m, MonadFile m, Typeable m, Typeable v)
|
2018-04-24 20:12:20 +02:00
|
|
|
=> Frames -> m Doc
|
|
|
|
renderFrames [] = pure mempty
|
2018-04-25 22:00:41 +02:00
|
|
|
renderFrames (x:xs) = do
|
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
frames <-
|
|
|
|
if | verbose opts <= ErrorsOnly ->
|
|
|
|
renderFrame @v x
|
|
|
|
| verbose opts <= Informational -> do
|
|
|
|
f <- renderFrame @v x
|
|
|
|
pure $ concatMap go (reverse xs) ++ f
|
|
|
|
| otherwise ->
|
|
|
|
concat <$> mapM (renderFrame @v) (reverse (x:xs))
|
|
|
|
pure $ case frames of
|
|
|
|
[] -> mempty
|
|
|
|
_ -> foldr1 (P.<$>) frames
|
|
|
|
where
|
|
|
|
go :: NixFrame -> [Doc]
|
|
|
|
go f = case framePos @v @m f of
|
|
|
|
Just pos ->
|
|
|
|
[text "While evaluating at "
|
|
|
|
<> text (sourcePosPretty pos)
|
|
|
|
<> colon]
|
|
|
|
Nothing -> []
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2018-04-25 22:00:41 +02:00
|
|
|
framePos :: forall v (m :: * -> *). (Typeable m, Typeable v) => NixFrame
|
|
|
|
-> Maybe SourcePos
|
|
|
|
framePos (NixFrame _ f)
|
2018-05-02 02:33:17 +02:00
|
|
|
| Just (e :: EvalFrame m v) <- fromException f = case e of
|
2018-04-25 22:00:41 +02:00
|
|
|
EvaluatingExpr _ (Fix (Compose (Ann (SrcSpan beg _) _))) ->
|
|
|
|
Just beg
|
|
|
|
_ -> Nothing
|
|
|
|
| otherwise = Nothing
|
|
|
|
|
|
|
|
renderFrame :: forall v e m.
|
|
|
|
(MonadReader e m, Has e Options, MonadVar m,
|
|
|
|
MonadFile m, Typeable m, Typeable v)
|
|
|
|
=> NixFrame -> m [Doc]
|
2018-04-24 20:12:20 +02:00
|
|
|
renderFrame (NixFrame level f)
|
2018-05-02 02:33:17 +02:00
|
|
|
| Just (e :: EvalFrame m v) <- fromException f = renderEvalFrame level e
|
|
|
|
| Just (e :: ThunkLoop) <- fromException f = renderThunkLoop level e
|
|
|
|
| Just (e :: ValueFrame m) <- fromException f = renderValueFrame level e
|
|
|
|
| Just (_ :: NormalLoop m) <- fromException f =
|
2018-04-25 22:00:41 +02:00
|
|
|
pure [text "<<loop during normalization>>"]
|
2018-05-02 02:33:17 +02:00
|
|
|
| Just (e :: ExecFrame m) <- fromException f = renderExecFrame level e
|
|
|
|
| Just (e :: ErrorCall) <- fromException f = pure [text (show e)]
|
2018-04-24 20:12:20 +02:00
|
|
|
| otherwise = error $ "Unrecognized frame: " ++ show f
|
|
|
|
|
2018-04-25 08:09:43 +02:00
|
|
|
wrapExpr :: NExprF r -> NExpr
|
|
|
|
wrapExpr x = Fix (Fix (NSym "<?>") <$ x)
|
|
|
|
|
2018-04-24 20:12:20 +02:00
|
|
|
renderEvalFrame :: (MonadReader e m, Has e Options, MonadFile m)
|
2018-04-25 22:00:41 +02:00
|
|
|
=> NixLevel -> EvalFrame m v -> m [Doc]
|
2018-04-28 05:36:38 +02:00
|
|
|
renderEvalFrame level f = do
|
2018-04-25 22:00:41 +02:00
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
case f of
|
|
|
|
EvaluatingExpr _scope e@(Fix (Compose (Ann ann _))) ->
|
2018-04-28 05:36:38 +02:00
|
|
|
fmap (:[]) $ renderLocation ann
|
|
|
|
=<< renderExpr level "While evaluating" "Expression" e
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2018-04-25 22:00:41 +02:00
|
|
|
ForcingExpr _scope e@(Fix (Compose (Ann ann _)))
|
|
|
|
| thunks opts ->
|
2018-04-28 05:36:38 +02:00
|
|
|
fmap (:[]) $ renderLocation ann
|
|
|
|
=<< renderExpr level "While forcing thunk from"
|
|
|
|
"Forcing thunk" e
|
2018-05-06 09:35:21 +02:00
|
|
|
|
|
|
|
Calling name ann ->
|
|
|
|
fmap (:[]) $ renderLocation ann $
|
|
|
|
text "While calling builtins." <> text name
|
|
|
|
|
2018-04-25 22:00:41 +02:00
|
|
|
_ -> pure []
|
2018-04-28 05:36:38 +02:00
|
|
|
|
|
|
|
renderExpr :: (MonadReader e m, Has e Options, MonadFile m)
|
|
|
|
=> NixLevel -> String -> String -> NExprLoc -> m Doc
|
|
|
|
renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do
|
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
let rendered
|
|
|
|
| verbose opts >= DebugInfo =
|
2018-05-09 01:40:56 +02:00
|
|
|
#if MIN_VERSION_pretty_show(1, 6, 16)
|
2018-04-28 05:36:38 +02:00
|
|
|
text (PS.ppShow (stripAnnotation e))
|
2018-05-09 01:40:56 +02:00
|
|
|
#else
|
|
|
|
text (show (stripAnnotation e))
|
|
|
|
#endif
|
2018-04-28 05:36:38 +02:00
|
|
|
| verbose opts >= Chatty =
|
|
|
|
prettyNix (stripAnnotation e)
|
|
|
|
| otherwise =
|
|
|
|
prettyNix (Fix (Fix (NSym "<?>") <$ x))
|
|
|
|
pure $ if verbose opts >= Chatty
|
2018-04-25 22:00:41 +02:00
|
|
|
then text (longLabel ++ ":\n>>>>>>>>")
|
|
|
|
P.<$> indent 2 rendered
|
|
|
|
P.<$> text "<<<<<<<<"
|
|
|
|
else text shortLabel <> text ": " </> rendered
|
2018-04-24 20:12:20 +02:00
|
|
|
|
|
|
|
renderValueFrame :: (MonadReader e m, Has e Options, MonadFile m)
|
2018-04-25 22:00:41 +02:00
|
|
|
=> NixLevel -> ValueFrame m -> m [Doc]
|
|
|
|
renderValueFrame level = pure . (:[]) . \case
|
|
|
|
ForcingThunk -> text "ForcingThunk"
|
|
|
|
ConcerningValue _v -> text "ConcerningValue"
|
2018-04-29 00:01:12 +02:00
|
|
|
Comparison _ _ -> text "Comparing"
|
2018-04-29 00:22:28 +02:00
|
|
|
Addition _ _ -> text "Adding"
|
2018-04-29 00:01:12 +02:00
|
|
|
Division _ _ -> text "Dividing"
|
2018-04-29 20:43:06 +02:00
|
|
|
Multiplication _ _ -> text "Multiplying"
|
2018-04-24 20:12:20 +02:00
|
|
|
|
|
|
|
Coercion x y ->
|
2018-04-25 22:00:41 +02:00
|
|
|
text desc <> text (describeValue x)
|
2018-04-24 20:12:20 +02:00
|
|
|
<> text " to " <> text (describeValue y)
|
|
|
|
where
|
|
|
|
desc | level <= Error = "Cannot coerce "
|
|
|
|
| otherwise = "While coercing "
|
|
|
|
|
2018-04-25 22:00:41 +02:00
|
|
|
CoercionToJsonNF _v -> text "CoercionToJsonNF"
|
|
|
|
CoercionFromJson _j -> text "CoercionFromJson"
|
|
|
|
ExpectationNF _t _v -> text "ExpectationNF"
|
|
|
|
Expectation _t _v -> text "Expectation"
|
2018-04-24 20:12:20 +02:00
|
|
|
|
2018-04-28 05:36:38 +02:00
|
|
|
renderValue :: (MonadReader e m, Has e Options, MonadFile m, MonadVar m)
|
|
|
|
=> NixLevel -> String -> String -> NValue m -> m Doc
|
|
|
|
renderValue _level _longLabel _shortLabel v = do
|
|
|
|
opts :: Options <- asks (view hasLens)
|
|
|
|
if values opts
|
|
|
|
then prettyNValueProv v
|
|
|
|
else prettyNValue v
|
|
|
|
|
2018-04-24 21:25:40 +02:00
|
|
|
renderExecFrame :: (MonadReader e m, Has e Options, MonadVar m, MonadFile m)
|
2018-04-25 22:00:41 +02:00
|
|
|
=> NixLevel -> ExecFrame m -> m [Doc]
|
2018-04-28 05:36:38 +02:00
|
|
|
renderExecFrame level = \case
|
|
|
|
Assertion ann v ->
|
|
|
|
fmap (:[]) $ renderLocation ann
|
|
|
|
=<< ((text "Assertion failed:" </>)
|
|
|
|
<$> renderValue level "" "" v)
|
2018-04-24 20:12:20 +02:00
|
|
|
|
|
|
|
renderThunkLoop :: (MonadReader e m, Has e Options, MonadFile m)
|
2018-04-25 22:00:41 +02:00
|
|
|
=> NixLevel -> ThunkLoop -> m [Doc]
|
|
|
|
renderThunkLoop _level = pure . (:[]) . \case
|
|
|
|
ThunkLoop Nothing -> text "<<loop>>"
|
2018-04-24 20:12:20 +02:00
|
|
|
ThunkLoop (Just n) ->
|
2018-04-25 22:00:41 +02:00
|
|
|
text $ "<<loop forcing thunk #" ++ show n ++ ">>"
|