@@ -0,0 +1,259 @@
1+||| Common combinators.
2+module Text.PrettyPrint.WL.Combinators
4+import Text.PrettyPrint.WL.Core
5+import Text.PrettyPrint.WL.Characters
10+-- --------------------------------------------------- [ Alignment Combinators ]
12+||| The document `(align x)` renders document `x` with the nesting
13+||| level set to the current column. It is used for example to
16+align d = column (\k => nesting (\i => nest (k - i) d))
18+||| The hang combinator implements hanging indentation. The document
19+||| `(hang i x)` renders document `x` with a nesting level set to the
20+||| current column plus `i`.
21+hang : Int -> Doc -> Doc
22+hang i d = align (nest i d)
24+||| The document `(indent i x)` indents document `x` with `i` spaces.
25+indent : Int -> Doc -> Doc
26+indent i d = hang i (text (spaces i) <+> d)
28+-- -------------------------------------------------- [ High-Level Combinators ]
30+||| The document `softLine` behaves like `space` if the resulting
31+||| output fits the page, otherwise it behaves like `line`.
35+||| The document `softbreak` behaves like `empty` if the resulting
36+||| output fits the page, otherwise it behaves like 'line'.
38+softBreak = group breakLine
40+infixr 5 |/|, |//|, |$|, |$$|
44+concatDoc : Doc -> Doc -> Doc -> Doc
45+concatDoc sep x y = x `beside` (sep `beside` y)
47+||| The document `(x |+| y)` concatenates document `x` and document
48+||| `y`. It is an associative operation having 'empty' as a left and
50+(|+|) : Doc -> Doc -> Doc
53+||| The document `(x |++| y)` concatenates document `x` and `y` with a
54+||| `space` in between.
55+(|++|) : Doc -> Doc -> Doc
56+(|++|) = concatDoc space
58+||| The document `(x |/| y)` concatenates document `x` and `y` with a
59+||| 'softline' in between. This effectively puts `x` and `y` either
60+||| next to each other (with a `space` in between) or underneath each
62+(|/|) : Doc -> Doc -> Doc
63+(|/|) = concatDoc softLine
65+||| The document `(x |//| y)` concatenates document `x` and `y` with
66+||| a 'softbreak' in between. This effectively puts `x` and `y` either
67+||| right next to each other or underneath each other.
68+(|//|) : Doc -> Doc -> Doc
69+(|//|) = concatDoc softBreak
71+||| The document `(x |$| y)` concatenates document `x` and `y` with a
72+||| `line` in between.
73+(|$|) : Doc -> Doc -> Doc
74+(|$|) = concatDoc line
76+||| The document `(x |$$| y)` concatenates document `x` and `y` with
77+||| a `linebreak` in between.
78+(|$$|) : Doc -> Doc -> Doc
79+(|$$|) = concatDoc breakLine
81+||| The document `(vsep xs)` concatenates all documents `xs`
82+||| vertically with `(|$|)`. If a 'group' undoes the line breaks
83+||| inserted by `vsep`, all documents are separated with a space.
84+vsep : List Doc -> Doc
87+||| The document `(sep xs)` concatenates all documents `xs` either
88+||| horizontally with `(|++|)`, if it fits the page, or vertically with
94+||| The document `(fillSep xs)` concatenates documents `xs`
95+||| horizontally with `(|++|)` as long as its fits the page, than
96+||| inserts a `line` and continues doing that for all documents in
98+fillSep : List Doc -> Doc
101+||| The document `(hsep xs)` concatenates all documents `xs`
102+||| horizontally with `(|++|)`.
103+hsep : List Doc -> Doc
106+||| The document `(hcat xs)` concatenates all documents `xs`
107+||| horizontally with `(|+|)`.
108+hcat : List Doc -> Doc
111+||| The document `(vcat xs)` concatenates all documents `xs`
112+||| vertically with `(|$$|)`. If a `group` undoes the line breaks
113+||| inserted by `vcat`, all documents are directly concatenated.
114+vcat : List Doc -> Doc
117+||| The document `(cat xs)` concatenates all documents `xs` either
118+||| horizontally with `(|+|)`, if it fits the page, or vertically with
120+cat : List Doc -> Doc
123+||| The document `(fillCat xs)` concatenates documents `xs`
124+||| horizontally with `(|+|)` as long as its fits the page, than inserts
125+||| a `linebreak` and continues doing that for all documents in `xs`.
126+fillCat : List Doc -> Doc
127+fillCat = fold (|//|)
129+||| The document `(enclose l r x)` encloses document `x` between
130+||| documents `l` and `r` using `(|+|)`.
131+enclose : Doc -> Doc -> Doc -> Doc
132+enclose l r x = concatDoc x l r
135+squotes = enclose squote squote
138+dquotes = enclose dquote dquote
141+braces = enclose lbrace rbrace
144+parens = enclose lparen rparen
147+angles = enclose langle rangle
149+brackets : Doc -> Doc
150+brackets = enclose lbracket rbracket
152+-- ----------------------------------------------------- [ Lists, Sets, Tuples ]
154+||| The document `(encloseSep l r sep xs)` concatenates the documents
155+||| `xs` separated by `sep` and encloses the resulting document by `l`
156+||| and `r`. The documents are rendered horizontally if that fits the
157+||| page. Otherwise they are aligned vertically. All separators are put
158+||| in front of the elements.
159+encloseSep : (l : Doc)
164+encloseSep l r s [] = l <+> r
165+encloseSep l r s [x] = l <+> x <+> r
166+encloseSep l r s xs = align (cat (zipWith (<+>) (l :: replicate (length xs) s) xs) <+> r)
168+||| The document `(list xs)` comma separates the documents `xs` and
169+||| encloses them in square brackets. The documents are rendered
170+||| horizontally if that fits the page. Otherwise they are aligned
171+||| vertically. All comma separators are put in front of the
173+list : List Doc -> Doc
174+list = encloseSep lbracket rbracket comma
176+||| The document `(tupled xs)` comma separates the documents `xs`
177+||| and encloses them in parenthesis. The documents are rendered
178+||| horizontally if that fits the page. Otherwise they are aligned
179+||| vertically. All comma separators are put in front of the
181+tupled : List Doc -> Doc
182+tupled = encloseSep lparen rparen comma
184+||| The document `(set xs)` separates the documents `xs` with
185+||| commas and encloses them in braces. The documents are
186+||| rendered horizontally if that fits the page. Otherwise they are
187+||| aligned vertically. All comma's are put in front of the
189+set : List Doc -> Doc
190+set = encloseSep lbrace rbrace comma
192+||| The document `(semiBraces xs)` separates the documents `xs` with
193+||| semi-colon and encloses them in braces. The documents are
194+||| rendered horizontally if that fits the page. Otherwise they are
195+||| aligned vertically. All semi-colons's are put in front of the
197+semiBrace : List Doc -> Doc
198+semiBrace = encloseSep lbrace rbrace semi
200+||| `(punctuate p xs)` concatenates all documents in `xs` with
201+||| document `p` except for the last document.
202+punctuate : Doc -> List Doc -> List Doc
204+punctuate p [x] = [x]
205+punctuate p (x :: xs) = (x <+> p) :: punctuate p xs
207+-- ------------------------------------------------------------------- [ Fills ]
209+width : Doc -> (Int -> Doc) -> Doc
210+width doc f = column (\k => doc <+> column (\k' => f (k' - k)))
212+||| The document `(fillBreak i x)` first renders document `x`. It
213+||| than appends `space`s until the width is equal to `i`. If the
214+||| width of `x` is already larger than `i`, the nesting level is
215+||| increased by `i` and a `line` is appended.
216+fillBreak : (i : Int) -> (x : Doc) -> Doc
218+ width x (\w => if (w > f)
219+ then nest f breakLine
220+ else text (spaces (f - w)))
222+||| The document `(fill i x)` renders document `x`. It than appends
223+||| `space`s until the width is equal to `i`. If the width of `x` is
224+||| already larger, nothing is appended. This combinator is quite
225+||| useful in practice to output a list of bindings.
226+fill : (i : Int) -> (x : Doc) -> Doc
228+ width d (\w => if (w >= f)
230+ else text (spaces (f - w)))
232+-- -------------------------------------------------------------- [ Primatives ]
234+||| The document `(literal s)` concatenates all characters in `s`
235+||| using `line` for newline characters and `char` for all other
236+||| characters. It is used instead of 'text' whenever the text contains
237+||| newline characters.
238+literal : (str : String) -> Doc
239+literal str = mkLiteral (unpack str)
241+ mkLiteral : List Char -> Doc
242+ mkLiteral Nil = empty
243+ mkLiteral ('\n':: ss) = line <+> mkLiteral ss
244+ mkLiteral (c :: ss) = char c <+> mkLiteral ss
247+bool b = text (show b)
250+nat n = text (show n)
253+int i = text (show i)
255+integer : Integer -> Doc
256+integer i = text (show i)
258+double : Double -> Doc
259+double d = text (show d)