Format most comments for haddock.
[ghc.git] / libraries / template-haskell / Language / Haskell / TH / PprLib.hs
1
2 -- | Monadic front-end to Text.PrettyPrint.HughesPJ
3
4 module Language.Haskell.TH.PprLib (
5
6 -- * The document type
7 Doc, -- Abstract, instance of Show
8 PprM,
9
10 -- * Primitive Documents
11 empty,
12 semi, comma, colon, space, equals,
13 lparen, rparen, lbrack, rbrack, lbrace, rbrace,
14
15 -- * Converting values into documents
16 text, char, ptext,
17 int, integer, float, double, rational,
18
19 -- * Wrapping documents in delimiters
20 parens, brackets, braces, quotes, doubleQuotes,
21
22 -- * Combining documents
23 (<>), (<+>), hcat, hsep,
24 ($$), ($+$), vcat,
25 sep, cat,
26 fsep, fcat,
27 nest,
28 hang, punctuate,
29
30 -- * Predicates on documents
31 isEmpty,
32
33 to_HPJ_Doc, pprName, pprName'
34 ) where
35
36
37 import Language.Haskell.TH.Syntax
38 (Name(..), showName', NameFlavour(..), NameIs(..))
39 import qualified Text.PrettyPrint.HughesPJ as HPJ
40 import Control.Monad (liftM, liftM2)
41 import Data.Map ( Map )
42 import qualified Data.Map as Map ( lookup, insert, empty )
43 import GHC.Base (Int(..))
44
45 infixl 6 <>
46 infixl 6 <+>
47 infixl 5 $$, $+$
48
49 -- ---------------------------------------------------------------------------
50 -- The interface
51
52 -- The primitive Doc values
53
54 instance Show Doc where
55 show d = HPJ.render (to_HPJ_Doc d)
56
57 isEmpty :: Doc -> PprM Bool; -- ^ Returns 'True' if the document is empty
58
59 empty :: Doc; -- ^ An empty document
60 semi :: Doc; -- ^ A ';' character
61 comma :: Doc; -- ^ A ',' character
62 colon :: Doc; -- ^ A ':' character
63 space :: Doc; -- ^ A space character
64 equals :: Doc; -- ^ A '=' character
65 lparen :: Doc; -- ^ A '(' character
66 rparen :: Doc; -- ^ A ')' character
67 lbrack :: Doc; -- ^ A '[' character
68 rbrack :: Doc; -- ^ A ']' character
69 lbrace :: Doc; -- ^ A '{' character
70 rbrace :: Doc; -- ^ A '}' character
71
72 text :: String -> Doc
73 ptext :: String -> Doc
74 char :: Char -> Doc
75 int :: Int -> Doc
76 integer :: Integer -> Doc
77 float :: Float -> Doc
78 double :: Double -> Doc
79 rational :: Rational -> Doc
80
81
82 parens :: Doc -> Doc; -- ^ Wrap document in @(...)@
83 brackets :: Doc -> Doc; -- ^ Wrap document in @[...]@
84 braces :: Doc -> Doc; -- ^ Wrap document in @{...}@
85 quotes :: Doc -> Doc; -- ^ Wrap document in @\'...\'@
86 doubleQuotes :: Doc -> Doc; -- ^ Wrap document in @\"...\"@
87
88 -- Combining @Doc@ values
89
90 (<>) :: Doc -> Doc -> Doc; -- ^Beside
91 hcat :: [Doc] -> Doc; -- ^List version of '<>'
92 (<+>) :: Doc -> Doc -> Doc; -- ^Beside, separated by space
93 hsep :: [Doc] -> Doc; -- ^List version of '<+>'
94
95 ($$) :: Doc -> Doc -> Doc; -- ^Above; if there is no
96 -- overlap it \"dovetails\" the two
97 ($+$) :: Doc -> Doc -> Doc; -- ^Above, without dovetailing.
98 vcat :: [Doc] -> Doc; -- ^List version of '$$'
99
100 cat :: [Doc] -> Doc; -- ^ Either hcat or vcat
101 sep :: [Doc] -> Doc; -- ^ Either hsep or vcat
102 fcat :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of cat
103 fsep :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of sep
104
105 nest :: Int -> Doc -> Doc; -- ^ Nested
106
107
108 -- GHC-specific ones.
109
110 hang :: Doc -> Int -> Doc -> Doc; -- ^ @hang d1 n d2 = sep [d1, nest n d2]@
111 punctuate :: Doc -> [Doc] -> [Doc]; -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
112
113
114 -- ---------------------------------------------------------------------------
115 -- The "implementation"
116
117 type State = (Map Name Name, Int)
118 data PprM a = PprM { runPprM :: State -> (a, State) }
119
120 pprName :: Name -> Doc
121 pprName = pprName' Alone
122
123 pprName' :: NameIs -> Name -> Doc
124 pprName' ni n@(Name o (NameU _))
125 = PprM $ \s@(fm, i@(I# i'))
126 -> let (n', s') = case Map.lookup n fm of
127 Just d -> (d, s)
128 Nothing -> let n'' = Name o (NameU i')
129 in (n'', (Map.insert n n'' fm, i + 1))
130 in (HPJ.text $ showName' ni n', s')
131 pprName' ni n = text $ showName' ni n
132
133 {-
134 instance Show Name where
135 show (Name occ (NameU u)) = occString occ ++ "_" ++ show (I# u)
136 show (Name occ NameS) = occString occ
137 show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ
138
139 data Name = Name OccName NameFlavour
140
141 data NameFlavour
142 | NameU Int# -- A unique local name
143 -}
144
145 to_HPJ_Doc :: Doc -> HPJ.Doc
146 to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)
147
148 instance Monad PprM where
149 return x = PprM $ \s -> (x, s)
150 m >>= k = PprM $ \s -> let (x, s') = runPprM m s
151 in runPprM (k x) s'
152
153 type Doc = PprM HPJ.Doc
154
155 -- The primitive Doc values
156
157 isEmpty = liftM HPJ.isEmpty
158
159 empty = return HPJ.empty
160 semi = return HPJ.semi
161 comma = return HPJ.comma
162 colon = return HPJ.colon
163 space = return HPJ.space
164 equals = return HPJ.equals
165 lparen = return HPJ.lparen
166 rparen = return HPJ.rparen
167 lbrack = return HPJ.lbrack
168 rbrack = return HPJ.rbrack
169 lbrace = return HPJ.lbrace
170 rbrace = return HPJ.rbrace
171
172 text = return . HPJ.text
173 ptext = return . HPJ.ptext
174 char = return . HPJ.char
175 int = return . HPJ.int
176 integer = return . HPJ.integer
177 float = return . HPJ.float
178 double = return . HPJ.double
179 rational = return . HPJ.rational
180
181
182 parens = liftM HPJ.parens
183 brackets = liftM HPJ.brackets
184 braces = liftM HPJ.braces
185 quotes = liftM HPJ.quotes
186 doubleQuotes = liftM HPJ.doubleQuotes
187
188 -- Combining @Doc@ values
189
190 (<>) = liftM2 (HPJ.<>)
191 hcat = liftM HPJ.hcat . sequence
192 (<+>) = liftM2 (HPJ.<+>)
193 hsep = liftM HPJ.hsep . sequence
194
195 ($$) = liftM2 (HPJ.$$)
196 ($+$) = liftM2 (HPJ.$+$)
197 vcat = liftM HPJ.vcat . sequence
198
199 cat = liftM HPJ.cat . sequence
200 sep = liftM HPJ.sep . sequence
201 fcat = liftM HPJ.fcat . sequence
202 fsep = liftM HPJ.fsep . sequence
203
204 nest n = liftM (HPJ.nest n)
205
206 hang d1 n d2 = do d1' <- d1
207 d2' <- d2
208 return (HPJ.hang d1' n d2')
209
210 -- punctuate uses the same definition as Text.PrettyPrint.HughesPJ
211 punctuate _ [] = []
212 punctuate p (d:ds) = go d ds
213 where
214 go d' [] = [d']
215 go d' (e:es) = (d' <> p) : go e es
216