{-# LANGUAGE FlexibleInstances #-}-- | Monadic front-end to Text.PrettyPrintmoduleLanguage.Haskell.TH.PprLib(-- * The document typeDoc ,-- Abstract, instance of ShowPprM ,-- * Primitive Documentsempty ,semi ,comma ,colon ,dcolon ,space ,equals ,arrow ,lparen ,rparen ,lbrack ,rbrack ,lbrace ,rbrace ,-- * Converting values into documentstext ,char ,ptext ,int ,integer ,float ,double ,rational ,-- * Wrapping documents in delimitersparens ,brackets ,braces ,quotes ,doubleQuotes ,-- * Combining documents(<>) ,(<+>) ,hcat ,hsep ,($$) ,($+$) ,vcat ,sep ,cat ,fsep ,fcat ,nest ,hang ,punctuate ,-- * Predicates on documentsisEmpty ,to_HPJ_Doc ,pprName ,pprName' )whereimportLanguage.Haskell.TH.Syntax (Name (..),showName' ,NameFlavour (..),NameIs (..))importqualifiedText.PrettyPrintasHPJimportControl.Monad(liftM,liftM2,ap)importLanguage.Haskell.TH.Lib.Map (Map )importqualifiedLanguage.Haskell.TH.Lib.Map asMap(lookup ,insert ,empty )importPreludehiding((<>))infixl6<> infixl6<+> infixl5$$ ,$+$ -- ----------------------------------------------------------------------------- The interface-- The primitive Doc valuesinstanceShowDoc whereshow :: Doc -> String
showd :: Doc
d =Doc -> String
HPJ.render(Doc -> Doc
to_HPJ_Doc Doc
d )isEmpty ::Doc ->PprM Bool;-- ^ Returns 'True' if the document is emptyempty ::Doc ;-- ^ An empty documentsemi ::Doc ;-- ^ A ';' charactercomma ::Doc ;-- ^ A ',' charactercolon ::Doc ;-- ^ A ':' characterdcolon ::Doc ;-- ^ A "::" stringspace ::Doc ;-- ^ A space characterequals ::Doc ;-- ^ A '=' characterarrow ::Doc ;-- ^ A "->" stringlparen ::Doc ;-- ^ A '(' characterrparen ::Doc ;-- ^ A ')' characterlbrack ::Doc ;-- ^ A '[' characterrbrack ::Doc ;-- ^ A ']' characterlbrace ::Doc ;-- ^ A '{' characterrbrace ::Doc ;-- ^ A '}' charactertext ::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 ;-- ^ Wrap document in @(...)@brackets ::Doc ->Doc ;-- ^ Wrap document in @[...]@braces ::Doc ->Doc ;-- ^ Wrap document in @{...}@quotes ::Doc ->Doc ;-- ^ Wrap document in @\'...\'@doubleQuotes ::Doc ->Doc ;-- ^ Wrap document in @\"...\"@-- Combining @Doc@ values(<>) ::Doc ->Doc ->Doc ;-- ^Besidehcat ::[Doc ]->Doc ;-- ^List version of '<>'(<+>) ::Doc ->Doc ->Doc ;-- ^Beside, separated by spacehsep ::[Doc ]->Doc ;-- ^List version of '<+>'($$) ::Doc ->Doc ->Doc ;-- ^Above; if there is no-- overlap it \"dovetails\" the two($+$) ::Doc ->Doc ->Doc ;-- ^Above, without dovetailing.vcat ::[Doc ]->Doc ;-- ^List version of '$$'cat ::[Doc ]->Doc ;-- ^ Either hcat or vcatsep ::[Doc ]->Doc ;-- ^ Either hsep or vcatfcat ::[Doc ]->Doc ;-- ^ \"Paragraph fill\" version of catfsep ::[Doc ]->Doc ;-- ^ \"Paragraph fill\" version of sepnest ::Int->Doc ->Doc ;-- ^ Nested-- GHC-specific ones.hang ::Doc ->Int->Doc ->Doc ;-- ^ @hang d1 n d2 = sep [d1, nest n d2]@punctuate ::Doc ->[Doc ]->[Doc ]-- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@-- ----------------------------------------------------------------------------- The "implementation"typeState =(Map Name Name ,Int)dataPprM a =PprM {PprM a -> State -> (a, State)
runPprM ::State ->(a ,State )}pprName ::Name ->Doc pprName :: Name -> Doc
pprName =NameIs -> Name -> Doc
pprName' NameIs
Alone pprName' ::NameIs ->Name ->Doc pprName' :: NameIs -> Name -> Doc
pprName' ni :: NameIs
ni n :: Name
n @(Name o :: OccName
o (NameU _))=(State -> (Doc, State)) -> Doc
forall a. (State -> (a, State)) -> PprM a
PprM ((State -> (Doc, State)) -> Doc) -> (State -> (Doc, State)) -> Doc
forall a b. (a -> b) -> a -> b
$\s :: State
s @(fm :: Map Name Name
fm ,i :: Int
i )->let(n' :: Name
n' ,s' :: State
s' )=caseName -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Name
fm ofJustd :: Name
d ->(Name
d ,State
s )Nothing->letn'' :: Name
n'' =OccName -> NameFlavour -> Name
Name OccName
o (Int -> NameFlavour
NameU Int
i )in(Name
n'' ,(Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n Name
n'' Map Name Name
fm ,Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+1))in(String -> Doc
HPJ.text(String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$NameIs -> Name -> String
showName' NameIs
ni Name
n' ,State
s' )pprName' ni :: NameIs
ni n :: Name
n =String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$NameIs -> Name -> String
showName' NameIs
ni Name
n {-
instance Show Name where
 show (Name occ (NameU u)) = occString occ ++ "_" ++ show (I# u)
 show (Name occ NameS) = occString occ
 show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ
data Name = Name OccName NameFlavour
data NameFlavour
 | NameU Int# -- A unique local name
-}to_HPJ_Doc ::Doc ->HPJ.Docto_HPJ_Doc :: Doc -> Doc
to_HPJ_Doc d :: Doc
d =(Doc, State) -> Doc
forall a b. (a, b) -> a
fst((Doc, State) -> Doc) -> (Doc, State) -> Doc
forall a b. (a -> b) -> a -> b
$Doc -> State -> (Doc, State)
forall a. PprM a -> State -> (a, State)
runPprM Doc
d (Map Name Name
forall k a. Map k a
Map.empty ,0)instanceFunctorPprM wherefmap :: (a -> b) -> PprM a -> PprM b
fmap=(a -> b) -> PprM a -> PprM b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMinstanceApplicativePprM wherepure :: a -> PprM a
purex :: a
x =(State -> (a, State)) -> PprM a
forall a. (State -> (a, State)) -> PprM a
PprM ((State -> (a, State)) -> PprM a)
-> (State -> (a, State)) -> PprM a
forall a b. (a -> b) -> a -> b
$\s :: State
s ->(a
x ,State
s )<*> :: PprM (a -> b) -> PprM a -> PprM b
(<*>)=PprM (a -> b) -> PprM a -> PprM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
apinstanceMonadPprM wherem :: PprM a
m >>= :: PprM a -> (a -> PprM b) -> PprM b
>>=k :: a -> PprM b
k =(State -> (b, State)) -> PprM b
forall a. (State -> (a, State)) -> PprM a
PprM ((State -> (b, State)) -> PprM b)
-> (State -> (b, State)) -> PprM b
forall a b. (a -> b) -> a -> b
$\s :: State
s ->let(x :: a
x ,s' :: State
s' )=PprM a -> State -> (a, State)
forall a. PprM a -> State -> (a, State)
runPprM PprM a
m State
s inPprM b -> State -> (b, State)
forall a. PprM a -> State -> (a, State)
runPprM (a -> PprM b
k a
x )State
s' typeDoc =PprM HPJ.Doc-- The primitive Doc valuesisEmpty :: Doc -> PprM Bool
isEmpty =(Doc -> Bool) -> Doc -> PprM Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMDoc -> Bool
HPJ.isEmptyempty :: Doc
empty =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.emptysemi :: Doc
semi =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.semicomma :: Doc
comma =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.commacolon :: Doc
colon =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.colondcolon :: Doc
dcolon =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$String -> Doc
HPJ.text"::"space :: Doc
space =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.spaceequals :: Doc
equals =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.equalsarrow :: Doc
arrow =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$String -> Doc
HPJ.text"->"lparen :: Doc
lparen =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.lparenrparen :: Doc
rparen =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.rparenlbrack :: Doc
lbrack =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.lbrackrbrack :: Doc
rbrack =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.rbracklbrace :: Doc
lbrace =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.lbracerbrace :: Doc
rbrace =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
returnDoc
HPJ.rbracetext :: String -> Doc
text =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Doc
HPJ.textptext :: String -> Doc
ptext =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Doc
HPJ.ptextchar :: Char -> Doc
char =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (Char -> Doc) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Doc
HPJ.charint :: Int -> Doc
int =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Doc
HPJ.intinteger :: Integer -> Doc
integer =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (Integer -> Doc) -> Integer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Integer -> Doc
HPJ.integerfloat :: Float -> Doc
float =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (Float -> Doc) -> Float -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Float -> Doc
HPJ.floatdouble :: Double -> Doc
double =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (Double -> Doc) -> Double -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Double -> Doc
HPJ.doublerational :: Rational -> Doc
rational =Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Doc) -> (Rational -> Doc) -> Rational -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rational -> Doc
HPJ.rationalparens :: Doc -> Doc
parens =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMDoc -> Doc
HPJ.parensbrackets :: Doc -> Doc
brackets =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMDoc -> Doc
HPJ.bracketsbraces :: Doc -> Doc
braces =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMDoc -> Doc
HPJ.bracesquotes :: Doc -> Doc
quotes =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMDoc -> Doc
HPJ.quotesdoubleQuotes :: Doc -> Doc
doubleQuotes =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMDoc -> Doc
HPJ.doubleQuotes-- Combining @Doc@ values<> :: Doc -> Doc -> Doc
(<>) =(Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2Doc -> Doc -> Doc
(HPJ.<>)hcat :: [Doc] -> Doc
hcat =([Doc] -> Doc) -> PprM [Doc] -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM[Doc] -> Doc
HPJ.hcat(PprM [Doc] -> Doc) -> ([Doc] -> PprM [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> PprM [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence<+> :: Doc -> Doc -> Doc
(<+>) =(Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2Doc -> Doc -> Doc
(HPJ.<+>)hsep :: [Doc] -> Doc
hsep =([Doc] -> Doc) -> PprM [Doc] -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM[Doc] -> Doc
HPJ.hsep(PprM [Doc] -> Doc) -> ([Doc] -> PprM [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> PprM [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence$$ :: Doc -> Doc -> Doc
($$) =(Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2Doc -> Doc -> Doc
(HPJ.$$)$+$ :: Doc -> Doc -> Doc
($+$) =(Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2Doc -> Doc -> Doc
(HPJ.$+$)vcat :: [Doc] -> Doc
vcat =([Doc] -> Doc) -> PprM [Doc] -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM[Doc] -> Doc
HPJ.vcat(PprM [Doc] -> Doc) -> ([Doc] -> PprM [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> PprM [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequencecat :: [Doc] -> Doc
cat =([Doc] -> Doc) -> PprM [Doc] -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM[Doc] -> Doc
HPJ.cat(PprM [Doc] -> Doc) -> ([Doc] -> PprM [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> PprM [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequencesep :: [Doc] -> Doc
sep =([Doc] -> Doc) -> PprM [Doc] -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM[Doc] -> Doc
HPJ.sep(PprM [Doc] -> Doc) -> ([Doc] -> PprM [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> PprM [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequencefcat :: [Doc] -> Doc
fcat =([Doc] -> Doc) -> PprM [Doc] -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM[Doc] -> Doc
HPJ.fcat(PprM [Doc] -> Doc) -> ([Doc] -> PprM [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> PprM [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequencefsep :: [Doc] -> Doc
fsep =([Doc] -> Doc) -> PprM [Doc] -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM[Doc] -> Doc
HPJ.fsep(PprM [Doc] -> Doc) -> ([Doc] -> PprM [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Doc] -> PprM [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequencenest :: Int -> Doc -> Doc
nest n :: Int
n =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM(Int -> Doc -> Doc
HPJ.nestInt
n )hang :: Doc -> Int -> Doc -> Doc
hang d1 :: Doc
d1 n :: Int
n d2 :: Doc
d2 =doDoc
d1' <-Doc
d1 Doc
d2' <-Doc
d2 Doc -> Doc
forall (m :: * -> *) a. Monad m => a -> m a
return(Doc -> Int -> Doc -> Doc
HPJ.hangDoc
d1' Int
n Doc
d2' )-- punctuate uses the same definition as Text.PrettyPrintpunctuate :: Doc -> [Doc] -> [Doc]
punctuate _[]=[]punctuate p :: Doc
p (d :: Doc
d :ds :: [Doc]
ds )=Doc -> [Doc] -> [Doc]
go Doc
d [Doc]
ds wherego :: Doc -> [Doc] -> [Doc]
go d' :: Doc
d' []=[Doc
d' ]go d' :: Doc
d' (e :: Doc
e :es :: [Doc]
es )=(Doc
d' Doc -> Doc -> Doc
<> Doc
p )Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:Doc -> [Doc] -> [Doc]
go Doc
e [Doc]
es