Switch to prettyprinter
This commit is contained in:
John Ericson
parent
a34dddb669
commit
04abd357bd
11
hnix.cabal
11
hnix.cabal
|
|
@ -2,7 +2,7 @@
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 7e613ce82a3337411d625301abd33a6d7f1c400edadbd602287027f2af1e4fdf
|
||||
-- hash: 0e0438f43eaffbbd952e85bc24499b40e17f276ec7488f3a483e7d848ea1075d
|
||||
|
||||
cabal-version: >= 1.10
|
||||
name: hnix
|
||||
|
|
@ -486,7 +486,6 @@ library
|
|||
ghc-options: -Wall
|
||||
build-depends:
|
||||
aeson
|
||||
, ansi-wl-pprint
|
||||
, array >=0.4 && <0.6
|
||||
, base >=4.9 && <5
|
||||
, binary
|
||||
|
|
@ -510,6 +509,7 @@ library
|
|||
, monadlist
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, prettyprinter
|
||||
, process
|
||||
, regex-tdfa
|
||||
, regex-tdfa-text
|
||||
|
|
@ -574,7 +574,6 @@ executable hnix
|
|||
ghc-options: -Wall
|
||||
build-depends:
|
||||
aeson
|
||||
, ansi-wl-pprint
|
||||
, base >=4.9 && <5
|
||||
, bytestring
|
||||
, containers
|
||||
|
|
@ -588,6 +587,7 @@ executable hnix
|
|||
, mtl
|
||||
, optparse-applicative
|
||||
, pretty-show
|
||||
, prettyprinter
|
||||
, repline
|
||||
, template-haskell
|
||||
, text
|
||||
|
|
@ -633,7 +633,6 @@ test-suite hnix-tests
|
|||
build-depends:
|
||||
Diff
|
||||
, Glob
|
||||
, ansi-wl-pprint
|
||||
, base >=4.9 && <5
|
||||
, bytestring
|
||||
, containers
|
||||
|
|
@ -651,6 +650,7 @@ test-suite hnix-tests
|
|||
, mtl
|
||||
, optparse-applicative
|
||||
, pretty-show
|
||||
, prettyprinter
|
||||
, process
|
||||
, split
|
||||
, tasty
|
||||
|
|
@ -696,8 +696,7 @@ benchmark hnix-benchmarks
|
|||
benchmarks
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
ansi-wl-pprint
|
||||
, base >=4.9 && <5
|
||||
base >=4.9 && <5
|
||||
, bytestring
|
||||
, containers
|
||||
, criterion
|
||||
|
|
|
|||
|
|
@ -24,6 +24,8 @@ import qualified Data.Text as Text
|
|||
import qualified Data.Text.IO as Text
|
||||
import qualified Data.Text.Lazy.Encoding as TL
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Text.Prettyprint.Doc.Render.Text
|
||||
import Nix
|
||||
import Nix.Convert
|
||||
import qualified Nix.Eval as Eval
|
||||
|
|
@ -36,7 +38,6 @@ import Options.Applicative hiding (ParserResult(..))
|
|||
import qualified Repl
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
|
||||
import qualified Text.Show.Pretty as PS
|
||||
|
||||
main :: IO ()
|
||||
|
|
@ -127,8 +128,8 @@ main = do
|
|||
void $ liftIO $ Exc.evaluate $ Deep.force expr
|
||||
|
||||
| otherwise =
|
||||
liftIO $ displayIO stdout
|
||||
. renderPretty 0.4 80
|
||||
liftIO $ renderIO stdout
|
||||
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
|
||||
. prettyNix
|
||||
. stripAnnotation $ expr
|
||||
where
|
||||
|
|
|
|||
|
|
@ -55,7 +55,6 @@ ghc-options:
|
|||
|
||||
dependencies:
|
||||
- base >= 4.9 && < 5
|
||||
- ansi-wl-pprint
|
||||
- bytestring
|
||||
- containers
|
||||
- data-fix
|
||||
|
|
@ -98,7 +97,6 @@ library:
|
|||
source-dirs: src
|
||||
dependencies:
|
||||
- aeson
|
||||
- ansi-wl-pprint
|
||||
- array >= 0.4 && < 0.6
|
||||
- binary
|
||||
- deriving-compat >= 0.3 && < 0.6
|
||||
|
|
@ -112,6 +110,7 @@ library:
|
|||
- logict
|
||||
- megaparsec >= 6.5 && < 7.0
|
||||
- monadlist
|
||||
- prettyprinter
|
||||
- process
|
||||
- regex-tdfa
|
||||
- regex-tdfa-text
|
||||
|
|
@ -158,6 +157,7 @@ executables:
|
|||
- hnix
|
||||
- aeson
|
||||
- pretty-show
|
||||
- prettyprinter
|
||||
- repline
|
||||
- haskeline
|
||||
when:
|
||||
|
|
@ -193,6 +193,7 @@ tests:
|
|||
- megaparsec
|
||||
- tasty-quickcheck
|
||||
- pretty-show
|
||||
- prettyprinter
|
||||
when:
|
||||
- condition: "impl(ghcjs)"
|
||||
then:
|
||||
|
|
|
|||
|
|
@ -45,9 +45,10 @@ import Data.List
|
|||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.List.Split
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Monoid
|
||||
import Data.Semigroup
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Typeable
|
||||
import GHC.IO.Exception (IOErrorType(..))
|
||||
import Network.HTTP.Client
|
||||
|
|
@ -81,8 +82,6 @@ import qualified System.Info
|
|||
import System.IO.Error
|
||||
import System.Posix.Files
|
||||
import System.Process (readProcessWithExitCode)
|
||||
import Text.PrettyPrint.ANSI.Leijen (text)
|
||||
import qualified Text.PrettyPrint.ANSI.Leijen as P
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
import qualified Text.Show.Pretty as PS
|
||||
#endif
|
||||
|
|
@ -558,8 +557,10 @@ instance (MonadFix m, MonadCatch m, MonadIO m, Alternative m,
|
|||
eres <- Lazy $ parseNixFileLoc path
|
||||
case eres of
|
||||
Failure err ->
|
||||
throwError $ ErrorCall . show $
|
||||
text "Parse during import failed:" P.</> err
|
||||
throwError $ ErrorCall . show $ fillSep $
|
||||
[ "Parse during import failed:"
|
||||
, err
|
||||
]
|
||||
Success expr -> do
|
||||
Lazy $ ReaderT $ const $
|
||||
modify (M.insert path expr)
|
||||
|
|
@ -781,16 +782,16 @@ addTracing k v = do
|
|||
let rendered =
|
||||
if verbose opts >= Chatty
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
then text $ PS.ppShow (void x)
|
||||
then pretty $ PS.ppShow (void x)
|
||||
#else
|
||||
then text $ show (void x)
|
||||
then pretty $ show (void x)
|
||||
#endif
|
||||
else prettyNix (Fix (Fix (NSym "?") <$ x))
|
||||
msg x = text ("eval: " ++ replicate depth ' ') <> x
|
||||
loc <- renderLocation span (msg rendered <> text " ...\n")
|
||||
msg x = pretty ("eval: " ++ replicate depth ' ') <> x
|
||||
loc <- renderLocation span (msg rendered <> " ...\n")
|
||||
liftIO $ putStr $ show loc
|
||||
res <- k v'
|
||||
liftIO $ print $ msg rendered <> text " ...done"
|
||||
liftIO $ print $ msg rendered <> " ...done"
|
||||
return res
|
||||
|
||||
evalExprLoc :: forall e m. (MonadNix e m, Has e Options, MonadIO m)
|
||||
|
|
|
|||
|
|
@ -5,10 +5,10 @@ import Data.Char (isDigit)
|
|||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Time
|
||||
import Nix.Options
|
||||
import Options.Applicative hiding (ParserResult(..))
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
|
||||
|
||||
decodeVerbosity :: Int -> Verbosity
|
||||
decodeVerbosity 0 = ErrorsOnly
|
||||
|
|
|
|||
|
|
@ -62,6 +62,7 @@ import qualified Data.List.NonEmpty as NE
|
|||
import qualified Data.Map as Map
|
||||
import Data.Text (Text)
|
||||
import Data.Text hiding (map, foldr1, concat, concatMap, zipWith)
|
||||
import Data.Text.Prettyprint.Doc (Doc, pretty)
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Void
|
||||
|
|
@ -72,7 +73,6 @@ import Text.Megaparsec
|
|||
import Text.Megaparsec.Char
|
||||
import qualified Text.Megaparsec.Char.Lexer as L
|
||||
import Text.Megaparsec.Expr
|
||||
import Text.PrettyPrint.ANSI.Leijen (Doc, text)
|
||||
|
||||
infixl 3 <+>
|
||||
(<+>) :: MonadPlus m => m a -> m a -> m a
|
||||
|
|
@ -437,17 +437,17 @@ reservedNames = HashSet.fromList
|
|||
|
||||
type Parser = ParsecT Void Text Identity
|
||||
|
||||
data Result a = Success a | Failure Doc deriving (Show, Functor)
|
||||
data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
|
||||
|
||||
parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a)
|
||||
parseFromFileEx p path = do
|
||||
txt <- liftIO (T.readFile path)
|
||||
return $ either (Failure . text . parseErrorPretty' txt) Success
|
||||
return $ either (Failure . pretty . parseErrorPretty' txt) Success
|
||||
$ parse p path txt
|
||||
|
||||
parseFromText :: Parser a -> Text -> Result a
|
||||
parseFromText p txt =
|
||||
either (Failure . text . parseErrorPretty' txt) Success $
|
||||
either (Failure . pretty . parseErrorPretty' txt) Success $
|
||||
parse p "<string>" txt
|
||||
|
||||
{- Parser.Operators -}
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@ import qualified Data.List.NonEmpty as NE
|
|||
import Data.Maybe (isJust, fromMaybe)
|
||||
import Data.Text (pack, unpack, replace, strip)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Nix.Atoms
|
||||
import Nix.Expr
|
||||
import Nix.Parser
|
||||
|
|
@ -37,13 +38,12 @@ import Nix.Utils hiding ((<$>))
|
|||
#endif
|
||||
import Nix.Value
|
||||
import Prelude hiding ((<$>))
|
||||
import Text.PrettyPrint.ANSI.Leijen
|
||||
|
||||
-- | This type represents a pretty printed nix expression
|
||||
-- together with some information about the expression.
|
||||
data NixDoc = NixDoc
|
||||
data NixDoc ann = NixDoc
|
||||
{ -- | The rendered expression, without any parentheses.
|
||||
withoutParens :: Doc
|
||||
withoutParens :: Doc ann
|
||||
|
||||
-- | The root operator is the operator at the root of
|
||||
-- the expression tree. For example, in '(a * b) + c', '+' would be the root
|
||||
|
|
@ -54,16 +54,16 @@ data NixDoc = NixDoc
|
|||
-- we can add brackets appropiately
|
||||
}
|
||||
|
||||
mkNixDoc :: Doc -> OperatorInfo -> NixDoc
|
||||
mkNixDoc :: Doc ann -> OperatorInfo -> NixDoc ann
|
||||
mkNixDoc d o = NixDoc { withoutParens = d, rootOp = o, wasPath = False }
|
||||
|
||||
-- | A simple expression is never wrapped in parentheses. The expression
|
||||
-- behaves as if its root operator had a precedence higher than all
|
||||
-- other operators (including function application).
|
||||
simpleExpr :: Doc -> NixDoc
|
||||
simpleExpr :: Doc ann -> NixDoc ann
|
||||
simpleExpr d = mkNixDoc d (OperatorInfo minBound NAssocNone "simple expr")
|
||||
|
||||
pathExpr :: Doc -> NixDoc
|
||||
pathExpr :: Doc ann -> NixDoc ann
|
||||
pathExpr d = (simpleExpr d) { wasPath = True }
|
||||
|
||||
-- | An expression that behaves as if its root operator had a precedence lower
|
||||
|
|
@ -71,7 +71,7 @@ pathExpr d = (simpleExpr d) { wasPath = True }
|
|||
-- parantheses in almost always, but it's still rendered without parentheses
|
||||
-- in cases where parentheses are never required (such as in the LHS of a
|
||||
-- binding).
|
||||
leastPrecedence :: Doc -> NixDoc
|
||||
leastPrecedence :: Doc ann -> NixDoc ann
|
||||
leastPrecedence =
|
||||
flip mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"
|
||||
|
||||
|
|
@ -87,7 +87,7 @@ selectOp = getSpecialOperator NSelectOp
|
|||
hasAttrOp :: OperatorInfo
|
||||
hasAttrOp = getSpecialOperator NHasAttrOp
|
||||
|
||||
wrapParens :: OperatorInfo -> NixDoc -> Doc
|
||||
wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann
|
||||
wrapParens op sub
|
||||
| precedence (rootOp sub) < precedence op = withoutParens sub
|
||||
| precedence (rootOp sub) == precedence op
|
||||
|
|
@ -97,104 +97,117 @@ wrapParens op sub
|
|||
|
||||
-- Used in the selector case to print a path in a selector as
|
||||
-- "${./abc}"
|
||||
wrapPath :: OperatorInfo -> NixDoc -> Doc
|
||||
wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann
|
||||
wrapPath op sub =
|
||||
if wasPath sub then dquotes (text "$" <> braces (withoutParens sub))
|
||||
else wrapParens op sub
|
||||
if wasPath sub
|
||||
then dquotes $ "$" <> braces (withoutParens sub)
|
||||
else wrapParens op sub
|
||||
|
||||
prettyString :: NString NixDoc -> Doc
|
||||
prettyString :: NString (NixDoc ann)-> Doc ann
|
||||
prettyString (DoubleQuoted parts) = dquotes . hcat . map prettyPart $ parts
|
||||
where prettyPart (Plain t) = text . concatMap escape . unpack $ t
|
||||
prettyPart EscapedNewline = text "''\\n"
|
||||
prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)
|
||||
where prettyPart (Plain t) = pretty . concatMap escape . unpack $ t
|
||||
prettyPart EscapedNewline = "''\\n"
|
||||
prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
|
||||
escape '"' = "\\\""
|
||||
escape x = maybe [x] (('\\':) . (:[])) $ toEscapeCode x
|
||||
prettyString (Indented _ parts)
|
||||
= group $ nest 2 (squote <> squote <$$> content) <$$> squote <> squote
|
||||
= group $ nest 2 $ vcat [dsquote, content, dsquote]
|
||||
where
|
||||
dsquote = squote <> squote
|
||||
content = vsep . map prettyLine . stripLastIfEmpty . splitLines $ parts
|
||||
stripLastIfEmpty = reverse . f . reverse where
|
||||
f ([Plain t] : xs) | Text.null (strip t) = xs
|
||||
f xs = xs
|
||||
prettyLine = hcat . map prettyPart
|
||||
prettyPart (Plain t) = text . unpack . replace "${" "''${" . replace "''" "'''" $ t
|
||||
prettyPart EscapedNewline = text "\\n"
|
||||
prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)
|
||||
prettyPart (Plain t) = pretty . unpack . replace "${" "''${" . replace "''" "'''" $ t
|
||||
prettyPart EscapedNewline = "\\n"
|
||||
prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
|
||||
|
||||
prettyParams :: Params NixDoc -> Doc
|
||||
prettyParams (Param n) = text $ unpack n
|
||||
prettyParams :: Params (NixDoc ann) -> Doc ann
|
||||
prettyParams (Param n) = pretty $ unpack n
|
||||
prettyParams (ParamSet s v mname) = prettyParamSet s v <> case mname of
|
||||
Nothing -> empty
|
||||
Just name | Text.null name -> empty
|
||||
| otherwise -> text "@" <> text (unpack name)
|
||||
Nothing -> mempty
|
||||
Just name | Text.null name -> mempty
|
||||
| otherwise -> "@" <> pretty (unpack name)
|
||||
|
||||
prettyParamSet :: ParamSet NixDoc -> Bool -> Doc
|
||||
prettyParamSet :: ParamSet (NixDoc ann) -> Bool -> Doc ann
|
||||
prettyParamSet args var =
|
||||
encloseSep (lbrace <> space) (align (space <> rbrace)) sep (map prettySetArg args ++ prettyVariadic)
|
||||
where
|
||||
prettySetArg (n, maybeDef) = case maybeDef of
|
||||
Nothing -> text (unpack n)
|
||||
Just v -> text (unpack n) <+> text "?" <+> withoutParens v
|
||||
prettyVariadic = [text "..." | var]
|
||||
Nothing -> pretty (unpack n)
|
||||
Just v -> pretty (unpack n) <+> "?" <+> withoutParens v
|
||||
prettyVariadic = ["..." | var]
|
||||
sep = align (comma <> space)
|
||||
|
||||
prettyBind :: Binding NixDoc -> Doc
|
||||
prettyBind :: Binding (NixDoc ann) -> Doc ann
|
||||
prettyBind (NamedVar n v _p) =
|
||||
prettySelector n <+> equals <+> withoutParens v <> semi
|
||||
prettyBind (Inherit s ns _p)
|
||||
= text "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi
|
||||
where scope = maybe empty ((<> space) . parens . withoutParens) s
|
||||
= "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi
|
||||
where scope = maybe mempty ((<> space) . parens . withoutParens) s
|
||||
|
||||
prettyKeyName :: NKeyName NixDoc -> Doc
|
||||
prettyKeyName (StaticKey "") = dquotes $ text ""
|
||||
prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann
|
||||
prettyKeyName (StaticKey "") = dquotes ""
|
||||
prettyKeyName (StaticKey key)
|
||||
| HashSet.member key reservedNames = dquotes $ text $ unpack key
|
||||
prettyKeyName (StaticKey key) = text . unpack $ key
|
||||
| HashSet.member key reservedNames = dquotes $ pretty $ unpack key
|
||||
prettyKeyName (StaticKey key) = pretty . unpack $ key
|
||||
prettyKeyName (DynamicKey key) =
|
||||
runAntiquoted (DoubleQuoted [Plain "\n"])
|
||||
prettyString ((text "$" <>) . braces . withoutParens) key
|
||||
prettyString (("$" <>) . braces . withoutParens) key
|
||||
|
||||
prettySelector :: NAttrPath NixDoc -> Doc
|
||||
prettySelector :: NAttrPath (NixDoc ann) -> Doc ann
|
||||
prettySelector = hcat . punctuate dot . map prettyKeyName . NE.toList
|
||||
|
||||
prettyAtom :: NAtom -> NixDoc
|
||||
prettyAtom atom = simpleExpr $ text $ unpack $ atomText atom
|
||||
prettyAtom :: NAtom -> NixDoc ann
|
||||
prettyAtom atom = simpleExpr $ pretty $ unpack $ atomText atom
|
||||
|
||||
prettyNix :: NExpr -> Doc
|
||||
prettyNix :: NExpr -> Doc ann
|
||||
prettyNix = withoutParens . cata exprFNixDoc
|
||||
|
||||
prettyOriginExpr :: NExprLocF (Maybe (NValue m)) -> Doc
|
||||
prettyOriginExpr :: NExprLocF (Maybe (NValue m)) -> Doc ann
|
||||
prettyOriginExpr = withoutParens . go
|
||||
where
|
||||
go = exprFNixDoc . annotated . getCompose . fmap render
|
||||
|
||||
render Nothing = simpleExpr $ text "_"
|
||||
render Nothing = simpleExpr $ "_"
|
||||
render (Just (NValue (reverse -> p:_) _)) = go (_originExpr p)
|
||||
render (Just (NValue _ _)) = simpleExpr $ text "?"
|
||||
-- simpleExpr $ foldr ((<$>) . parens . indent 2 . withoutParens
|
||||
render (Just (NValue _ _)) = simpleExpr "?"
|
||||
-- simpleExpr $ foldr ((\x y -> vsep [x, y]) . parens . indent 2 . withoutParens
|
||||
-- . go . originExpr)
|
||||
-- mempty (reverse ps)
|
||||
|
||||
exprFNixDoc :: NExprF NixDoc -> NixDoc
|
||||
exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann
|
||||
exprFNixDoc = \case
|
||||
NConstant atom -> prettyAtom atom
|
||||
NStr str -> simpleExpr $ prettyString str
|
||||
NList [] -> simpleExpr $ lbracket <> rbracket
|
||||
NList xs -> simpleExpr $ group $
|
||||
nest 2 (vsep $ lbracket : map (wrapParens appOpNonAssoc) xs) <$> rbracket
|
||||
NList xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
|
||||
[ [lbracket]
|
||||
, map (wrapParens appOpNonAssoc) xs
|
||||
, [rbracket]
|
||||
]
|
||||
NSet [] -> simpleExpr $ lbrace <> rbrace
|
||||
NSet xs -> simpleExpr $ group $
|
||||
nest 2 (vsep $ lbrace : map prettyBind xs) <$> rbrace
|
||||
NSet xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
|
||||
[ [lbrace]
|
||||
, map prettyBind xs
|
||||
, [rbrace]
|
||||
]
|
||||
NRecSet [] -> simpleExpr $ recPrefix <> lbrace <> rbrace
|
||||
NRecSet xs -> simpleExpr $ group $
|
||||
nest 2 (vsep $ recPrefix <> lbrace : map prettyBind xs) <$> rbrace
|
||||
NAbs args body -> leastPrecedence $
|
||||
nest 2 ((prettyParams args <> colon) <$> withoutParens body)
|
||||
NRecSet xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
|
||||
[ [recPrefix <> lbrace]
|
||||
, map prettyBind xs
|
||||
, [rbrace]
|
||||
]
|
||||
NAbs args body -> leastPrecedence $ nest 2 $ vsep $
|
||||
[ prettyParams args <> colon
|
||||
, withoutParens body
|
||||
]
|
||||
NBinary NApp fun arg ->
|
||||
mkNixDoc (wrapParens appOp fun <+> wrapParens appOpNonAssoc arg) appOp
|
||||
NBinary op r1 r2 -> flip mkNixDoc opInfo $ hsep
|
||||
[ wrapParens (f NAssocLeft) r1
|
||||
, text $ unpack $ operatorName opInfo
|
||||
, pretty $ unpack $ operatorName opInfo
|
||||
, wrapParens (f NAssocRight) r2
|
||||
]
|
||||
where
|
||||
|
|
@ -202,18 +215,18 @@ exprFNixDoc = \case
|
|||
f x | associativity opInfo /= x = opInfo { associativity = NAssocNone }
|
||||
| otherwise = opInfo
|
||||
NUnary op r1 ->
|
||||
mkNixDoc (text (unpack (operatorName opInfo)) <> wrapParens opInfo r1) opInfo
|
||||
mkNixDoc (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1) opInfo
|
||||
where opInfo = getUnaryOperator op
|
||||
NSelect r' attr o ->
|
||||
(if isJust o then leastPrecedence else flip mkNixDoc selectOp) $
|
||||
wrapPath selectOp r <> dot <> prettySelector attr <> ordoc
|
||||
where
|
||||
r = flip mkNixDoc selectOp $ wrapParens appOpNonAssoc r'
|
||||
ordoc = maybe empty (((space <> text "or") <+>) . wrapParens appOpNonAssoc) o
|
||||
ordoc = maybe mempty (((space <> "or") <+>) . wrapParens appOpNonAssoc) o
|
||||
NHasAttr r attr ->
|
||||
mkNixDoc (wrapParens hasAttrOp r <+> text "?" <+> prettySelector attr) hasAttrOp
|
||||
NEnvPath p -> simpleExpr $ text ("<" ++ p ++ ">")
|
||||
NLiteralPath p -> pathExpr $ text $ case p of
|
||||
mkNixDoc (wrapParens hasAttrOp r <+> "?" <+> prettySelector attr) hasAttrOp
|
||||
NEnvPath p -> simpleExpr $ pretty ("<" ++ p ++ ">")
|
||||
NLiteralPath p -> pathExpr $ pretty $ case p of
|
||||
"./" -> "./."
|
||||
"../" -> "../."
|
||||
".." -> "../."
|
||||
|
|
@ -222,20 +235,28 @@ exprFNixDoc = \case
|
|||
| "./" `isPrefixOf` txt -> txt
|
||||
| "../" `isPrefixOf` txt -> txt
|
||||
| otherwise -> "./" ++ txt
|
||||
NSym name -> simpleExpr $ text (unpack name)
|
||||
NLet binds body -> leastPrecedence $ group $ text "let" <$> indent 2 (
|
||||
vsep (map prettyBind binds)) <$> text "in" <+> withoutParens body
|
||||
NSym name -> simpleExpr $ pretty (unpack name)
|
||||
NLet binds body -> leastPrecedence $ group $ vsep $
|
||||
[ "let"
|
||||
, indent 2 (vsep (map prettyBind binds))
|
||||
, "in" <+> withoutParens body
|
||||
]
|
||||
NIf cond trueBody falseBody -> leastPrecedence $
|
||||
group $ nest 2 $ (text "if" <+> withoutParens cond) <$>
|
||||
( align (text "then" <+> withoutParens trueBody)
|
||||
<$> align (text "else" <+> withoutParens falseBody)
|
||||
)
|
||||
NWith scope body -> leastPrecedence $
|
||||
text "with" <+> withoutParens scope <> semi <$> align (withoutParens body)
|
||||
NAssert cond body -> leastPrecedence $
|
||||
text "assert" <+> withoutParens cond <> semi <$> align (withoutParens body)
|
||||
group $ nest 2 $ vsep $
|
||||
[ "if" <+> withoutParens cond
|
||||
, align ("then" <+> withoutParens trueBody)
|
||||
, align ("else" <+> withoutParens falseBody)
|
||||
]
|
||||
NWith scope body -> leastPrecedence $ vsep $
|
||||
[ "with" <+> withoutParens scope <> semi
|
||||
, align $ withoutParens body
|
||||
]
|
||||
NAssert cond body -> leastPrecedence $ vsep $
|
||||
[ "assert" <+> withoutParens cond <> semi
|
||||
, align $ withoutParens body
|
||||
]
|
||||
where
|
||||
recPrefix = text "rec" <> space
|
||||
recPrefix = "rec" <> space
|
||||
|
||||
fixate :: Functor f => (a -> f (Fix f)) -> Free f a -> Fix f
|
||||
fixate g = Fix . go
|
||||
|
|
@ -243,7 +264,7 @@ fixate g = Fix . go
|
|||
go (Pure a) = g a
|
||||
go (Free f) = fmap (Fix . go) f
|
||||
|
||||
prettyNValueNF :: Functor m => NValueNF m -> Doc
|
||||
prettyNValueNF :: Functor m => NValueNF m -> Doc ann
|
||||
prettyNValueNF = prettyNix . valueToExpr
|
||||
where
|
||||
check :: NValueNF m -> Fix (NValueF m)
|
||||
|
|
@ -288,27 +309,33 @@ removeEffects = Free . fmap dethunk
|
|||
removeEffectsM :: MonadVar m => NValueF m (NThunk m) -> m (NValueNF m)
|
||||
removeEffectsM = fmap Free . traverse dethunk
|
||||
|
||||
prettyNValueF :: MonadVar m => NValueF m (NThunk m) -> m Doc
|
||||
prettyNValueF :: MonadVar m => NValueF m (NThunk m) -> m (Doc ann)
|
||||
prettyNValueF = fmap prettyNValueNF . removeEffectsM
|
||||
|
||||
prettyNValue :: MonadVar m => NValue m -> m Doc
|
||||
prettyNValue :: MonadVar m => NValue m -> m (Doc ann)
|
||||
prettyNValue (NValue _ v) = prettyNValueF v
|
||||
|
||||
prettyNValueProv :: MonadVar m => NValue m -> m Doc
|
||||
prettyNValueProv :: MonadVar m => NValue m -> m (Doc ann)
|
||||
prettyNValueProv = \case
|
||||
NValue [] v -> prettyNValueF v
|
||||
NValue ps v -> do
|
||||
v' <- prettyNValueF v
|
||||
pure $ v' </> indent 2 (parens (mconcat
|
||||
(text "from: " : map (prettyOriginExpr . _originExpr) ps)))
|
||||
|
||||
prettyNThunk :: MonadVar m => NThunk m -> m Doc
|
||||
pure $ fillSep $
|
||||
[ v'
|
||||
, indent 2 $ parens $ mconcat
|
||||
$ "from: "
|
||||
: map (prettyOriginExpr . _originExpr) ps
|
||||
]
|
||||
prettyNThunk :: MonadVar m => NThunk m -> m (Doc ann)
|
||||
prettyNThunk = \case
|
||||
t@(NThunk ps _) -> do
|
||||
v' <- fmap prettyNValueNF (dethunk t)
|
||||
pure $ v' </> indent 2 (parens (mconcat
|
||||
(text "thunk from: " : map (prettyOriginExpr . _originExpr) ps)))
|
||||
|
||||
pure $ fillSep $
|
||||
[ v'
|
||||
, indent 2 $ parens $ mconcat
|
||||
$ "thunk from: "
|
||||
: map (prettyOriginExpr . _originExpr) ps
|
||||
]
|
||||
dethunk :: MonadVar m => NThunk m -> m (NValueNF m)
|
||||
dethunk = \case
|
||||
NThunk _ (Value v) -> removeEffectsM (_baseValue v)
|
||||
|
|
@ -322,4 +349,4 @@ dethunk = \case
|
|||
Computed v -> removeEffectsM (_baseValue v)
|
||||
_ -> pure $ Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
|
||||
_ <- atomicModifyVar active (False,)
|
||||
return res
|
||||
return res
|
||||
|
|
|
|||
|
|
@ -12,24 +12,24 @@ module Nix.Render where
|
|||
import Data.ByteString (ByteString)
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Void
|
||||
import Nix.Expr.Types.Annotated
|
||||
import Text.Megaparsec.Error
|
||||
import Text.Megaparsec.Pos (SourcePos(..))
|
||||
import Text.PrettyPrint.ANSI.Leijen
|
||||
|
||||
class Monad m => MonadFile m where
|
||||
readFile :: FilePath -> m ByteString
|
||||
|
||||
posAndMsg :: SourcePos -> Doc -> ParseError t Void
|
||||
posAndMsg :: SourcePos -> Doc a-> ParseError t Void
|
||||
posAndMsg beg msg =
|
||||
FancyError (beg :| [])
|
||||
(Set.fromList [ErrorFail (show msg) :: ErrorFancy Void])
|
||||
|
||||
renderLocation :: MonadFile m => SrcSpan -> Doc -> m Doc
|
||||
renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)
|
||||
renderLocation (SrcSpan beg@(SourcePos "<string>" _ _) _) msg =
|
||||
return $ text $ init $ parseErrorPretty @Char (posAndMsg beg msg)
|
||||
return $ pretty $ init $ parseErrorPretty @Char (posAndMsg beg msg)
|
||||
|
||||
renderLocation (SrcSpan beg@(SourcePos path _ _) _) msg = do
|
||||
contents <- Nix.Render.readFile path
|
||||
return $ text $ init $ parseErrorPretty' contents (posAndMsg beg msg)
|
||||
return $ pretty $ init $ parseErrorPretty' contents (posAndMsg beg msg)
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ module Nix.Render.Frame where
|
|||
import Control.Monad.Reader
|
||||
import Data.Fix
|
||||
import Data.Typeable
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Nix.Eval
|
||||
import Nix.Exec
|
||||
import Nix.Expr
|
||||
|
|
@ -28,16 +29,15 @@ import Nix.Thunk
|
|||
import Nix.Utils
|
||||
import Nix.Value
|
||||
import Text.Megaparsec.Pos
|
||||
import qualified Text.PrettyPrint.ANSI.Leijen as P
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
import qualified Text.Show.Pretty as PS
|
||||
#endif
|
||||
|
||||
renderFrames :: forall v e m.
|
||||
(MonadReader e m, Has e Options,
|
||||
MonadVar m, MonadFile m, Typeable m, Typeable v)
|
||||
=> Frames -> m Doc
|
||||
renderFrames
|
||||
:: forall v e m ann
|
||||
. ( MonadReader e m, Has e Options
|
||||
, MonadVar m, MonadFile m, Typeable m, Typeable v)
|
||||
=> Frames -> m (Doc ann)
|
||||
renderFrames [] = pure mempty
|
||||
renderFrames (x:xs) = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
|
|
@ -51,13 +51,13 @@ renderFrames (x:xs) = do
|
|||
concat <$> mapM (renderFrame @v) (reverse (x:xs))
|
||||
pure $ case frames of
|
||||
[] -> mempty
|
||||
_ -> foldr1 (P.<$>) frames
|
||||
_ -> vsep frames
|
||||
where
|
||||
go :: NixFrame -> [Doc]
|
||||
go :: NixFrame -> [Doc ann]
|
||||
go f = case framePos @v @m f of
|
||||
Just pos ->
|
||||
[text "While evaluating at "
|
||||
<> text (sourcePosPretty pos)
|
||||
["While evaluating at "
|
||||
<> pretty (sourcePosPretty pos)
|
||||
<> colon]
|
||||
Nothing -> []
|
||||
|
||||
|
|
@ -70,29 +70,29 @@ framePos (NixFrame _ f)
|
|||
_ -> Nothing
|
||||
| otherwise = Nothing
|
||||
|
||||
renderFrame :: forall v e m.
|
||||
renderFrame :: forall v e m ann.
|
||||
(MonadReader e m, Has e Options, MonadVar m,
|
||||
MonadFile m, Typeable m, Typeable v)
|
||||
=> NixFrame -> m [Doc]
|
||||
=> NixFrame -> m [Doc ann]
|
||||
renderFrame (NixFrame level f)
|
||||
| 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 (e :: NormalLoop m) <- fromException f = renderNormalLoop level e
|
||||
| Just (e :: ExecFrame m) <- fromException f = renderExecFrame level e
|
||||
| Just (e :: ErrorCall) <- fromException f = pure [text (show e)]
|
||||
| Just (e :: ErrorCall) <- fromException f = pure [pretty (show e)]
|
||||
| otherwise = error $ "Unrecognized frame: " ++ show f
|
||||
|
||||
wrapExpr :: NExprF r -> NExpr
|
||||
wrapExpr x = Fix (Fix (NSym "<?>") <$ x)
|
||||
|
||||
renderEvalFrame :: (MonadReader e m, Has e Options, MonadFile m)
|
||||
=> NixLevel -> EvalFrame m v -> m [Doc]
|
||||
=> NixLevel -> EvalFrame m v -> m [Doc ann]
|
||||
renderEvalFrame level f = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
case f of
|
||||
EvaluatingExpr scope e@(Fix (Compose (Ann ann _))) -> do
|
||||
let scopeInfo | scopes opts = [string (show scope)]
|
||||
let scopeInfo | scopes opts = [pretty $ show scope]
|
||||
| otherwise = []
|
||||
fmap (\x -> scopeInfo ++ [x]) $ renderLocation ann
|
||||
=<< renderExpr level "While evaluating" "Expression" e
|
||||
|
|
@ -105,59 +105,64 @@ renderEvalFrame level f = do
|
|||
|
||||
Calling name ann ->
|
||||
fmap (:[]) $ renderLocation ann $
|
||||
text "While calling builtins." <> text name
|
||||
"While calling builtins." <> pretty name
|
||||
|
||||
_ -> pure []
|
||||
|
||||
renderExpr :: (MonadReader e m, Has e Options, MonadFile m)
|
||||
=> NixLevel -> String -> String -> NExprLoc -> m Doc
|
||||
=> NixLevel -> String -> String -> NExprLoc -> m (Doc ann)
|
||||
renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
let rendered
|
||||
| verbose opts >= DebugInfo =
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
text (PS.ppShow (stripAnnotation e))
|
||||
pretty (PS.ppShow (stripAnnotation e))
|
||||
#else
|
||||
text (show (stripAnnotation e))
|
||||
pretty (show (stripAnnotation e))
|
||||
#endif
|
||||
| verbose opts >= Chatty =
|
||||
prettyNix (stripAnnotation e)
|
||||
| otherwise =
|
||||
prettyNix (Fix (Fix (NSym "<?>") <$ x))
|
||||
pure $ if verbose opts >= Chatty
|
||||
then text (longLabel ++ ":\n>>>>>>>>")
|
||||
P.<$> indent 2 rendered
|
||||
P.<$> text "<<<<<<<<"
|
||||
else text shortLabel <> text ": " </> rendered
|
||||
then vsep $
|
||||
[ pretty (longLabel ++ ":\n>>>>>>>>")
|
||||
, indent 2 rendered
|
||||
, "<<<<<<<<"
|
||||
]
|
||||
else pretty shortLabel <> fillSep [": ", rendered]
|
||||
|
||||
renderValueFrame :: (MonadReader e m, Has e Options,
|
||||
MonadFile m, MonadVar m)
|
||||
=> NixLevel -> ValueFrame m -> m [Doc]
|
||||
=> NixLevel -> ValueFrame m -> m [Doc ann]
|
||||
renderValueFrame level = fmap (:[]) . \case
|
||||
ForcingThunk -> pure $ text "ForcingThunk"
|
||||
ConcerningValue _v -> pure $ text "ConcerningValue"
|
||||
Comparison _ _ -> pure $ text "Comparing"
|
||||
Addition _ _ -> pure $ text "Adding"
|
||||
Division _ _ -> pure $ text "Dividing"
|
||||
Multiplication _ _ -> pure $ text "Multiplying"
|
||||
ForcingThunk -> pure "ForcingThunk"
|
||||
ConcerningValue _v -> pure "ConcerningValue"
|
||||
Comparison _ _ -> pure "Comparing"
|
||||
Addition _ _ -> pure "Adding"
|
||||
Division _ _ -> pure "Dividing"
|
||||
Multiplication _ _ -> pure "Multiplying"
|
||||
|
||||
Coercion x y ->
|
||||
pure $ text desc <> text (describeValue x)
|
||||
<> text " to " <> text (describeValue y)
|
||||
Coercion x y -> pure $ mconcat
|
||||
[ desc
|
||||
, pretty (describeValue x)
|
||||
, " to "
|
||||
, pretty (describeValue y)
|
||||
]
|
||||
where
|
||||
desc | level <= Error = "Cannot coerce "
|
||||
| otherwise = "While coercing "
|
||||
|
||||
CoercionToJsonNF _v -> pure $ text "CoercionToJsonNF"
|
||||
CoercionFromJson _j -> pure $ text "CoercionFromJson"
|
||||
ExpectationNF _t _v -> pure $ text "ExpectationNF"
|
||||
CoercionToJsonNF _v -> pure "CoercionToJsonNF"
|
||||
CoercionFromJson _j -> pure "CoercionFromJson"
|
||||
ExpectationNF _t _v -> pure "ExpectationNF"
|
||||
Expectation t v -> do
|
||||
v' <- renderValue level "" "" v
|
||||
pure $ text "Saw " <> v'
|
||||
<> text " but expected " <> text (describeValue t)
|
||||
pure $ "Saw " <> v'
|
||||
<> " but expected " <> pretty (describeValue t)
|
||||
|
||||
renderValue :: (MonadReader e m, Has e Options, MonadFile m, MonadVar m)
|
||||
=> NixLevel -> String -> String -> NValue m -> m Doc
|
||||
=> NixLevel -> String -> String -> NValue m -> m (Doc ann)
|
||||
renderValue _level _longLabel _shortLabel v = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
if values opts
|
||||
|
|
@ -165,23 +170,23 @@ renderValue _level _longLabel _shortLabel v = do
|
|||
else prettyNValue v
|
||||
|
||||
renderExecFrame :: (MonadReader e m, Has e Options, MonadVar m, MonadFile m)
|
||||
=> NixLevel -> ExecFrame m -> m [Doc]
|
||||
=> NixLevel -> ExecFrame m -> m [Doc ann]
|
||||
renderExecFrame level = \case
|
||||
Assertion ann v ->
|
||||
fmap (:[]) $ renderLocation ann
|
||||
=<< ((text "Assertion failed:" </>)
|
||||
=<< ((\d -> fillSep ["Assertion failed:", d])
|
||||
<$> renderValue level "" "" v)
|
||||
|
||||
renderThunkLoop :: (MonadReader e m, Has e Options, MonadFile m)
|
||||
=> NixLevel -> ThunkLoop -> m [Doc]
|
||||
=> NixLevel -> ThunkLoop -> m [Doc ann]
|
||||
renderThunkLoop _level = pure . (:[]) . \case
|
||||
ThunkLoop Nothing -> text "<<thunk loop>>"
|
||||
ThunkLoop Nothing -> "<<thunk loop>>"
|
||||
ThunkLoop (Just n) ->
|
||||
text $ "<<loop forcing thunk #" ++ show n ++ ">>"
|
||||
pretty $ "<<loop forcing thunk #" ++ show n ++ ">>"
|
||||
|
||||
renderNormalLoop :: (MonadReader e m, Has e Options, MonadFile m, MonadVar m)
|
||||
=> NixLevel -> NormalLoop m -> m [Doc]
|
||||
=> NixLevel -> NormalLoop m -> m [Doc ann]
|
||||
renderNormalLoop level = fmap (:[]) . \case
|
||||
NormalLoop v -> do
|
||||
v' <- renderValue level "" "" v
|
||||
pure $ text "<<loop during normalization forcing " <> v' <> text ">>"
|
||||
pure $ "<<loop during normalization forcing " <> v' <> ">>"
|
||||
|
|
|
|||
|
|
@ -12,7 +12,9 @@ import Data.Fix
|
|||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Semigroup
|
||||
import Data.String.Interpolate.IsString
|
||||
import Data.Text (Text, unpack, pack)
|
||||
import Data.Text (Text, unpack)
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Text.Prettyprint.Doc.Render.Text
|
||||
import Nix.Atoms
|
||||
import Nix.Expr
|
||||
import Nix.Parser
|
||||
|
|
@ -20,7 +22,6 @@ import Nix.Pretty
|
|||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Test.Tasty.TH
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
|
||||
|
||||
case_constant_int = assertParseText "234" $ mkInt 234
|
||||
|
||||
|
|
@ -394,9 +395,9 @@ assertParseFail str = case parseNixText str of
|
|||
assertParsePrint :: Text -> Text -> Assertion
|
||||
assertParsePrint src expect =
|
||||
let Success expr = parseNixTextLoc src
|
||||
result = displayS
|
||||
. renderPretty 0.4 80
|
||||
result = renderStrict
|
||||
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
|
||||
. prettyNix
|
||||
. stripAnnotation
|
||||
$ expr
|
||||
in assertEqual "" expect (pack (result ""))
|
||||
in assertEqual "" expect result
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ import Data.Char
|
|||
import Data.Fix
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Hedgehog
|
||||
import qualified Hedgehog.Gen as Gen
|
||||
import qualified Hedgehog.Range as Range
|
||||
|
|
@ -27,8 +28,6 @@ import Nix.Pretty
|
|||
import Test.Tasty
|
||||
import Test.Tasty.Hedgehog
|
||||
import Text.Megaparsec (Pos, SourcePos, mkPos)
|
||||
import Text.PrettyPrint.ANSI.Leijen ((</>), text)
|
||||
import qualified Text.PrettyPrint.ANSI.Leijen as P
|
||||
import qualified Text.Show.Pretty as PS
|
||||
|
||||
asciiString :: MonadGen m => m String
|
||||
|
|
@ -188,38 +187,38 @@ normalize = cata $ \case
|
|||
-- | Test that parse . pretty == id up to attribute position information.
|
||||
prop_prettyparse :: Monad m => NExpr -> PropertyT m ()
|
||||
prop_prettyparse p = do
|
||||
let prog = show (pretty p)
|
||||
let prog = show (prettyNix p)
|
||||
case parse (pack prog) of
|
||||
Failure s -> do
|
||||
footnote $ show $
|
||||
text "Parse failed:" </> text (show s)
|
||||
P.<$> P.indent 2 (pretty p)
|
||||
footnote $ show $ vsep
|
||||
[ fillSep ["Parse failed:", pretty (show s)]
|
||||
, indent 2 (prettyNix p)
|
||||
]
|
||||
discard
|
||||
Success v
|
||||
| equivUpToNormalization p v -> success
|
||||
| otherwise -> do
|
||||
let pp = normalise prog
|
||||
pv = normalise (show (pretty v))
|
||||
footnote $ show $
|
||||
text "----------------------------------------"
|
||||
P.<$> text "Expr before:" P.<$> P.indent 2 (text (PS.ppShow p))
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Expr after:" P.<$> P.indent 2 (text (PS.ppShow v))
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Pretty before:" P.<$> P.indent 2 (text prog)
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Pretty after:" P.<$> P.indent 2 (pretty v)
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Normalised before:" P.<$> P.indent 2 (text pp)
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Normalised after:" P.<$> P.indent 2 (text pv)
|
||||
P.<$> text "========================================"
|
||||
P.<$> text "Normalised diff:"
|
||||
P.<$> text (ppDiff (diff pp pv))
|
||||
P.<$> text "========================================"
|
||||
pv = normalise (show (prettyNix v))
|
||||
footnote $ show $ vsep $
|
||||
[ "----------------------------------------"
|
||||
, vsep ["Expr before:", indent 2 (pretty (PS.ppShow p))]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Expr after:", indent 2 (pretty (PS.ppShow v))]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Pretty before:", indent 2 (pretty prog)]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Pretty after:", indent 2 (prettyNix v)]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Normalised before:", indent 2 (pretty pp)]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Normalised after:", indent 2 (pretty pv)]
|
||||
, "========================================"
|
||||
, vsep ["Normalised diff:", pretty (ppDiff (diff pp pv))]
|
||||
, "========================================"
|
||||
]
|
||||
assert (pp == pv)
|
||||
where
|
||||
pretty = prettyNix
|
||||
parse = parseNixText
|
||||
|
||||
normalise = unlines . map (reverse . dropWhile isSpace . reverse) . lines
|
||||
|
|
|
|||
Loading…
Reference in New Issue