@@ -16,7 +16,6 @@ import Data.Aeson (eitherDecode)
16
16
import Data.ByteString.Lazy qualified as BS
17
17
import Data.Map (Map )
18
18
import Data.Map qualified as Map
19
- import Data.Text (Text )
20
19
import Data.Text.IO qualified as Text
21
20
import Prettyprinter
22
21
import System.Environment (getArgs )
@@ -48,36 +47,36 @@ main = do
48
47
Right KoreJson {term} -> do
49
48
case runExcept $ internalisePattern DisallowAlias CheckSubsorts Nothing internalDef term of
50
49
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
+ ]
56
57
unless (null unsupported) $ do
57
58
putStrLn $ " ...as well as " <> show (length unsupported) <> " unsupported parts:"
58
59
mapM_ print unsupported
59
60
Left (NoTermFound _) ->
60
61
case runExcept $ internalisePredicates DisallowAlias CheckSubsorts Nothing internalDef [term] of
61
62
Left es -> error (show es)
62
63
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
+ ]
68
70
unless (null ts. unsupported) $ do
69
71
putStrLn $ " ...as well as " <> show (length ts. unsupported) <> " unsupported parts:"
70
72
mapM_ print ts. unsupported
71
73
Left err -> error (show err)
72
74
where
73
- showSubst :: Map Variable Term -> Text
75
+ showSubst :: Map Variable Term -> Doc ann
74
76
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]
80
79
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