module Language.Haskell.TH.PprLib (
Doc,
PprM,
empty,
semi, comma, colon, space, equals,
lparen, rparen, lbrack, rbrack, lbrace, rbrace,
text, char, ptext,
int, integer, float, double, rational,
parens, brackets, braces, quotes, doubleQuotes,
(<>), (<+>), hcat, hsep,
($$), ($+$), vcat,
sep, cat,
fsep, fcat,
nest,
hang, punctuate,
isEmpty,
to_HPJ_Doc, pprName, pprName'
) where
import Language.Haskell.TH.Syntax
(Name(..), showName', NameFlavour(..), NameIs(..))
import qualified Text.PrettyPrint.HughesPJ as HPJ
import Control.Monad (liftM, liftM2)
import Data.Map ( Map )
import qualified Data.Map as Map ( lookup, insert, empty )
import GHC.Base (Int(..))
infixl 6 <>
infixl 6 <+>
infixl 5 $$, $+$
instance Show Doc where
show d = HPJ.render (to_HPJ_Doc d)
isEmpty :: Doc -> PprM Bool;
empty :: Doc;
semi :: Doc;
comma :: Doc;
colon :: Doc;
space :: Doc;
equals :: Doc;
lparen :: Doc;
rparen :: Doc;
lbrack :: Doc;
rbrack :: Doc;
lbrace :: Doc;
rbrace :: Doc;
text :: String -> Doc
ptext :: String -> Doc
char :: Char -> Doc
int :: Int -> Doc
integer :: Integer -> Doc
float :: Float -> Doc
double :: Double -> Doc
rational :: Rational -> Doc
parens :: Doc -> Doc;
brackets :: Doc -> Doc;
braces :: Doc -> Doc;
quotes :: Doc -> Doc;
doubleQuotes :: Doc -> Doc;
(<>) :: Doc -> Doc -> Doc;
hcat :: [Doc] -> Doc;
(<+>) :: Doc -> Doc -> Doc;
hsep :: [Doc] -> Doc;
($$) :: Doc -> Doc -> Doc;
($+$) :: Doc -> Doc -> Doc;
vcat :: [Doc] -> Doc;
cat :: [Doc] -> Doc;
sep :: [Doc] -> Doc;
fcat :: [Doc] -> Doc;
fsep :: [Doc] -> Doc;
nest :: Int -> Doc -> Doc;
hang :: Doc -> Int -> Doc -> Doc;
punctuate :: Doc -> [Doc] -> [Doc];
type State = (Map Name Name, Int)
data PprM a = PprM { runPprM :: State -> (a, State) }
pprName :: Name -> Doc
pprName = pprName' Alone
pprName' :: NameIs -> Name -> Doc
pprName' ni n@(Name o (NameU _))
= PprM $ \s@(fm, i@(I# i'))
-> let (n', s') = case Map.lookup n fm of
Just d -> (d, s)
Nothing -> let n'' = Name o (NameU i')
in (n'', (Map.insert n n'' fm, i + 1))
in (HPJ.text $ showName' ni n', s')
pprName' ni n = text $ showName' ni n
to_HPJ_Doc :: Doc -> HPJ.Doc
to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)
instance Monad PprM where
return x = PprM $ \s -> (x, s)
m >>= k = PprM $ \s -> let (x, s') = runPprM m s
in runPprM (k x) s'
type Doc = PprM HPJ.Doc
isEmpty = liftM HPJ.isEmpty
empty = return HPJ.empty
semi = return HPJ.semi
comma = return HPJ.comma
colon = return HPJ.colon
space = return HPJ.space
equals = return HPJ.equals
lparen = return HPJ.lparen
rparen = return HPJ.rparen
lbrack = return HPJ.lbrack
rbrack = return HPJ.rbrack
lbrace = return HPJ.lbrace
rbrace = return HPJ.rbrace
text = return . HPJ.text
ptext = return . HPJ.ptext
char = return . HPJ.char
int = return . HPJ.int
integer = return . HPJ.integer
float = return . HPJ.float
double = return . HPJ.double
rational = return . HPJ.rational
parens = liftM HPJ.parens
brackets = liftM HPJ.brackets
braces = liftM HPJ.braces
quotes = liftM HPJ.quotes
doubleQuotes = liftM HPJ.doubleQuotes
(<>) = liftM2 (HPJ.<>)
hcat = liftM HPJ.hcat . sequence
(<+>) = liftM2 (HPJ.<+>)
hsep = liftM HPJ.hsep . sequence
($$) = liftM2 (HPJ.$$)
($+$) = liftM2 (HPJ.$+$)
vcat = liftM HPJ.vcat . sequence
cat = liftM HPJ.cat . sequence
sep = liftM HPJ.sep . sequence
fcat = liftM HPJ.fcat . sequence
fsep = liftM HPJ.fsep . sequence
nest n = liftM (HPJ.nest n)
hang d1 n d2 = do d1' <- d1
d2' <- d2
return (HPJ.hang d1' n d2')
punctuate _ [] = []
punctuate p (d:ds) = go d ds
where
go d' [] = [d']
go d' (e:es) = (d' <> p) : go e es