Skip to content

Commit bf6ca73

Browse files
MaximilianAlgehedMaximilianAlgehed
committed
use better pretty-printing
1 parent ef33f5b commit bf6ca73

File tree

5 files changed

+27
-17
lines changed

5 files changed

+27
-17
lines changed

‎src/Constrained/AbstractSyntax.hs‎

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -305,10 +305,9 @@ instance Pretty (PredD deps) where
305305
sep
306306
[ "memberPred"
307307
, pretty term
308-
, "(" <> viaShow (length vs) <> " items)"
309-
, brackets (fillSep (punctuate "," (map viaShow (NE.toList vs))))
308+
, prettyShowList (NE.toList vs)
310309
]
311-
ElemPred False term vs -> align $ sep ["notMemberPred", pretty term, fillSep (punctuate "," (map viaShow (NE.toList vs)))]
310+
ElemPred False term vs -> align $ sep ["notMemberPred", pretty term, prettyShowList (NE.toList vs)]
312311
Exists _ (x :-> p) -> align $ sep ["exists" <+> viaShow x <+> "in", pretty p]
313312
Let t (x :-> p) -> align $ sep ["let" <+> viaShow x <+> "=" /> pretty t <+> "in", pretty p]
314313
And ps -> braces $ vsep' $ map pretty ps
@@ -377,15 +376,15 @@ instance (Show a, Typeable a, Show (TypeSpecD deps a)) => Pretty (WithPrec (Spec
377376
ExplainSpec es z -> "ExplainSpec" <+> viaShow es <+> "$" /> pretty z
378377
ErrorSpec es -> "ErrorSpec" /> vsep' (map fromString (NE.toList es))
379378
TrueSpec -> fromString $ "TrueSpec @(" ++ showType @a ++ ")"
380-
MemberSpec xs -> "MemberSpec" <+> viaShow (NE.toList xs)
379+
MemberSpec xs -> "MemberSpec" <+> prettyShowList (NE.toList xs)
381380
SuspendedSpec x p -> parensIf (d > 10) $ "constrained $ \\" <+> viaShow x <+> "->" /> pretty p
382381
-- TODO: require pretty for `TypeSpec` to make this much nicer
383382
TypeSpecD ts cant ->
384383
parensIf (d > 10) $
385384
"TypeSpec"
386385
/> vsep
387386
[ fromString (showsPrec 11 ts "")
388-
, viaShow cant
387+
, prettyShowList cant
389388
]
390389

391390
instance (Show a, Typeable a, Show (TypeSpecD deps a)) => Pretty (SpecificationD deps a) where

‎src/Constrained/Generation.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -856,8 +856,8 @@ stepPlan :: MonadGenError m => SolverPlan -> Env -> SolverPlan -> GenT m (Env, S
856856
stepPlan _ env plan@(SolverPlan []) = pure (env, plan)
857857
stepPlan (SolverPlan origStages) env (SolverPlan (stage@(SolverStage (x :: Var a) ps spec relevant) : pl)) = do
858858
let errorMessage = "Failed to step the plan" />
859-
vsep [ "Relevant parts of original plan:" //> pretty narrowedOrigPlan
860-
, "Relevant parts of the env:" //> pretty narrowedEnv
859+
vsep [ "Relevant parts of the original plan:" //> pretty narrowedOrigPlan
860+
, "Already generated variables:" //> pretty narrowedEnv
861861
, "Current stage:" //> pretty stage
862862
]
863863
-- TODO: tests for this, including tests for transitive behaviour

‎src/Constrained/PrettyUtils.hs‎

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE ImportQualifiedPost #-}
23
{-# LANGUAGE ExistentialQuantification #-}
34
{-# LANGUAGE FlexibleContexts #-}
45
{-# LANGUAGE GADTs #-}
@@ -15,9 +16,11 @@ module Constrained.PrettyUtils (
1516
parensIf,
1617
prettyPrec,
1718

18-
-- * Lists
19+
-- * Lists and sets
1920
ppList,
2021
ppListC,
22+
prettyShowSet,
23+
prettyShowList,
2124

2225
-- * General helpers
2326
prettyType,
@@ -28,6 +31,8 @@ module Constrained.PrettyUtils (
2831
) where
2932

3033
import Constrained.List
34+
import Data.Set (Set)
35+
import Data.Set qualified as Set
3136
import Data.String (fromString)
3237
import Data.Typeable
3338
import Prettyprinter
@@ -58,6 +63,12 @@ ppListC ::
5863
ppListC _ Nil = []
5964
ppListC pp (a :> as) = pp a : ppListC @c pp as
6065

66+
prettyShowSet :: Show a => Set a -> Doc ann
67+
prettyShowSet xs = fillSep $ "{" : punctuate "," (map viaShow (Set.toList xs)) ++ ["}"]
68+
69+
prettyShowList :: Show a => [a] -> Doc ann
70+
prettyShowList xs = fillSep $ "[" : punctuate "," (map viaShow xs) ++ ["]"]
71+
6172
-- | Pretty-print a type
6273
prettyType :: forall t x. Typeable t => Doc x
6374
prettyType = fromString $ show (typeRep (Proxy @t))

‎src/Constrained/Spec/List.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -358,8 +358,8 @@ instance Semantics ListW where
358358
semantics AppendW = (++)
359359

360360
instance Syntax ListW where
361-
prettySymbol AppendW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "append_" <+> viaShow n <+> prettyPrec 10 y
362-
prettySymbol AppendW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "append_" <+> prettyPrec 10 y <+> viaShow n
361+
prettySymbol AppendW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "append_" <+> prettyShowList n <+> prettyPrec 10 y
362+
prettySymbol AppendW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "append_" <+> prettyPrec 10 y <+> prettyShowList n
363363
prettySymbol _ _ _ = Nothing
364364

365365
instance Show (ListW d r) where

‎src/Constrained/Spec/Set.hs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -251,13 +251,13 @@ instance Semantics SetW where
251251
semantics = setSem
252252

253253
instance Syntax SetW where
254-
prettySymbol SubsetW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "subset_" <+> viaShow (Set.toList n) <+> prettyPrec 10 y
255-
prettySymbol SubsetW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "subset_" <+> prettyPrec 10 y <+> viaShow (Set.toList n)
256-
prettySymbol DisjointW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "disjoint_" <+> viaShow (Set.toList n) <+> prettyPrec 10 y
257-
prettySymbol DisjointW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "disjoint_" <+> prettyPrec 10 y <+> viaShow (Set.toList n)
258-
prettySymbol UnionW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "union_" <+> viaShow (Set.toList n) <+> prettyPrec 10 y
259-
prettySymbol UnionW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "union_" <+> prettyPrec 10 y <+> viaShow (Set.toList n)
260-
prettySymbol MemberW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "member_" <+> prettyPrec 10 y <+> viaShow (Set.toList n)
254+
prettySymbol SubsetW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "subset_" <+> prettyShowSet n <+> prettyPrec 10 y
255+
prettySymbol SubsetW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "subset_" <+> prettyPrec 10 y <+> prettyShowSet n
256+
prettySymbol DisjointW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "disjoint_" <+> prettyShowSet n <+> prettyPrec 10 y
257+
prettySymbol DisjointW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "disjoint_" <+> prettyPrec 10 y <+> prettyShowSet n
258+
prettySymbol UnionW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "union_" <+> prettyShowSet n <+> prettyPrec 10 y
259+
prettySymbol UnionW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "union_" <+> prettyPrec 10 y <+> prettyShowSet n
260+
prettySymbol MemberW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "member_" <+> prettyPrec 10 y <+> prettyShowSet n
261261
prettySymbol _ _ _ = Nothing
262262

263263
instance (Ord a, HasSpec a, HasSpec (Set a)) => Semigroup (Term (Set a)) where

0 commit comments

Comments
 (0)