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