diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/BooleanFormula.hs | 2 | ||||
| -rw-r--r-- | compiler/utils/Outputable.hs | 13 | ||||
| -rw-r--r-- | compiler/utils/Pretty.hs | 8 |
3 files changed, 18 insertions, 5 deletions
diff --git a/compiler/utils/BooleanFormula.hs b/compiler/utils/BooleanFormula.hs index 41ac13963e..382431e549 100644 --- a/compiler/utils/BooleanFormula.hs +++ b/compiler/utils/BooleanFormula.hs @@ -193,7 +193,7 @@ pprBooleanFormula :: (Rational -> a -> SDoc) -> Rational -> BooleanFormula a -> pprBooleanFormula pprVar = pprBooleanFormula' pprVar pprAnd pprOr where pprAnd p = cparen (p > 3) . fsep . punctuate comma - pprOr p = cparen (p > 2) . fsep . intersperse (text "|") + pprOr p = cparen (p > 2) . fsep . intersperse vbar -- Pretty print human in readable format, "either `a' or `b' or (`c', `d' and `e')"? pprBooleanFormulaNice :: Outputable a => BooleanFormula a -> SDoc diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 83febd5d04..fbd6760923 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -25,7 +25,7 @@ module Outputable ( int, intWithCommas, integer, float, double, rational, parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets, paBrackets, - semi, comma, colon, dcolon, space, equals, dot, + semi, comma, colon, dcolon, space, equals, dot, vbar, arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt, lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore, blankLine, forAllLit, @@ -33,7 +33,7 @@ module Outputable ( ($$), ($+$), vcat, sep, cat, fsep, fcat, - hang, punctuate, ppWhen, ppUnless, + hang, hangNotEmpty, punctuate, ppWhen, ppUnless, speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes, coloured, PprColour, colType, colCoerc, colDataCon, @@ -521,7 +521,7 @@ quotes d = ('\'' : _, _) -> pp_d _other -> Pretty.quotes pp_d -semi, comma, colon, equals, space, dcolon, underscore, dot :: SDoc +semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc @@ -541,6 +541,7 @@ equals = docToSDoc $ Pretty.equals space = docToSDoc $ Pretty.space underscore = char '_' dot = char '.' +vbar = char '|' lparen = docToSDoc $ Pretty.lparen rparen = docToSDoc $ Pretty.rparen lbrack = docToSDoc $ Pretty.lbrack @@ -606,6 +607,12 @@ hang :: SDoc -- ^ The header -> SDoc hang d1 n d2 = SDoc $ \sty -> Pretty.hang (runSDoc d1 sty) n (runSDoc d2 sty) +-- | This behaves like 'hang', but does not indent the second document +-- when the header is empty. +hangNotEmpty :: SDoc -> Int -> SDoc -> SDoc +hangNotEmpty d1 n d2 = + SDoc $ \sty -> Pretty.hangNotEmpty (runSDoc d1 sty) n (runSDoc d2 sty) + punctuate :: SDoc -- ^ The punctuation -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements -> [SDoc] -- ^ Punctuated list diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 4aae2c8c53..74d69f23d0 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -180,7 +180,7 @@ module Pretty ( sep, cat, fsep, fcat, nest, - hang, punctuate, + hang, hangNotEmpty, punctuate, -- * Predicates on documents isEmpty, @@ -563,6 +563,12 @@ nest k p = mkNest k (reduceDoc p) hang :: Doc -> Int -> Doc -> Doc hang d1 n d2 = sep [d1, nest n d2] +-- | Apply 'hang' to the arguments if the first 'Doc' is not empty. +hangNotEmpty :: Doc -> Int -> Doc -> Doc +hangNotEmpty d1 n d2 = if isEmpty d1 + then d2 + else hang d1 n d2 + -- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@ punctuate :: Doc -> [Doc] -> [Doc] punctuate _ [] = [] |