Skip to content

Commit 6bfb6fc

Browse files
committed
use infix, render less text and more doc
1 parent de6ddad commit 6bfb6fc

File tree

1 file changed

+19
-20
lines changed

1 file changed

+19
-20
lines changed

dev-tools/pretty/Pretty.hs

Lines changed: 19 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,6 @@ import Data.Aeson (eitherDecode)
1616
import Data.ByteString.Lazy qualified as BS
1717
import Data.Map (Map)
1818
import Data.Map qualified as Map
19-
import Data.Text (Text)
2019
import Data.Text.IO qualified as Text
2120
import Prettyprinter
2221
import System.Environment (getArgs)
@@ -48,36 +47,36 @@ main = do
4847
Right KoreJson{term} -> do
4948
case runExcept $ internalisePattern DisallowAlias CheckSubsorts Nothing internalDef term of
5049
Right (trm, preds, ceils, subst, unsupported) -> do
51-
mapM_ Text.putStrLn $
52-
["Pretty-printing pattern:", renderText $ pretty' @'[Decoded] trm]
53-
<> renderThings "Bool predicates:" preds
54-
<> renderThings "Ceil predicates:" ceils
55-
<> ["Substitution:", showSubst subst]
50+
Text.putStrLn . renderText . vsep $
51+
[ "Pretty-printing pattern:"
52+
, pretty' @'[Decoded, Infix] trm
53+
, renderThings "Bool predicates:" preds
54+
, renderThings "Ceil predicates:" ceils
55+
, hang 2 $ "Substitution:" <> line <> showSubst subst
56+
]
5657
unless (null unsupported) $ do
5758
putStrLn $ "...as well as " <> show (length unsupported) <> " unsupported parts:"
5859
mapM_ print unsupported
5960
Left (NoTermFound _) ->
6061
case runExcept $ internalisePredicates DisallowAlias CheckSubsorts Nothing internalDef [term] of
6162
Left es -> error (show es)
6263
Right ts -> do
63-
mapM_ Text.putStrLn $
64-
"Pretty-printing predicates:"
65-
: renderThings "Bool predicates:" ts.boolPredicates
66-
<> renderThings "Ceil predicates:" ts.ceilPredicates
67-
<> ["Substitution:", showSubst ts.substitution]
64+
Text.putStrLn . renderText . vsep $
65+
[ "Pretty-printing predicates:"
66+
, renderThings "Bool predicates:" ts.boolPredicates
67+
, renderThings "Ceil predicates:" ts.ceilPredicates
68+
, hang 2 $ "Substitution:" <> line <> showSubst ts.substitution
69+
]
6870
unless (null ts.unsupported) $ do
6971
putStrLn $ "...as well as " <> show (length ts.unsupported) <> " unsupported parts:"
7072
mapM_ print ts.unsupported
7173
Left err -> error (show err)
7274
where
73-
showSubst :: Map Variable Term -> Text
75+
showSubst :: Map Variable Term -> Doc ann
7476
showSubst m =
75-
renderText $
76-
vsep
77-
[ pretty' @'[Decoded] v <+> "->" <+> pretty' @'[Decoded] expr
78-
| (v, expr) <- Map.assocs m
79-
]
77+
vsep
78+
[pretty' @'[Decoded] v <+> "->" <+> pretty' @'[Decoded, Infix] expr | (v, expr) <- Map.assocs m]
8079

81-
renderThings :: Pretty (PrettyWithModifiers '[Decoded] a) => Text -> [a] -> [Text]
82-
renderThings heading [] = [heading <> " -"]
83-
renderThings heading things = heading : map (renderText . pretty' @'[Decoded]) things
80+
renderThings :: Pretty (PrettyWithModifiers '[Decoded, Infix] a) => Doc ann -> [a] -> Doc ann
81+
renderThings heading [] = heading <> " -"
82+
renderThings heading things = hang 2 $ vsep $ heading : map (pretty' @'[Decoded, Infix]) things

0 commit comments

Comments
 (0)