{-# LANGUAGE FlexibleInstances, Safe #-}-- | 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 (Uniq ,Name (..),showName' ,NameFlavour (..),NameIs (..))importqualifiedText.PrettyPrint asHPJimportControl.Monad (liftM ,liftM2 ,ap )importLanguage.Haskell.TH.Lib.Map (Map )importqualifiedLanguage.Haskell.TH.Lib.Map asMap(lookup ,insert ,empty )importPrelude hiding((<>) )infixl6<> infixl6<+> infixl5$$ ,$+$ -- ----------------------------------------------------------------------------- The interface-- The primitive Doc valuesinstanceShow Doc whereshow :: Doc -> String
show 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 ,Uniq )dataPprM a =PprM {forall a. 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' NameIs
ni n :: Name
n @(Name OccName
o (NameU Uniq
_))=(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 @(Map Name Name
fm ,Uniq
i )->let(Name
n' ,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 ofJust Name
d ->(Name
d ,State
s )Maybe Name
Nothing ->letn'' :: Name
n'' =OccName -> NameFlavour -> Name
Name OccName
o (Uniq -> NameFlavour
NameU Uniq
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 ,Uniq
i Uniq -> Uniq -> Uniq
forall a. Num a => a -> a -> a
+ Uniq
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' NameIs
ni 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.Doc to_HPJ_Doc :: Doc -> Doc
to_HPJ_Doc 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 ,Uniq
0)instanceFunctor PprM wherefmap :: forall a b. (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
liftM instanceApplicative PprM wherepure :: forall a. a -> PprM a
pure 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
$ \State
s ->(a
x ,State
s )<*> :: forall a b. 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
ap instanceMonad PprM wherePprM a
m >>= :: forall a b. PprM a -> (a -> PprM b) -> PprM b
>>= 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
$ \State
s ->let(a
x ,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
liftM Doc -> Bool
HPJ.isEmpty empty :: Doc
empty =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.empty semi :: Doc
semi =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.semi comma :: Doc
comma =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.comma colon :: Doc
colon =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.colon dcolon :: Doc
dcolon =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
HPJ.text String
"::"space :: Doc
space =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.space equals :: Doc
equals =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.equals arrow :: Doc
arrow =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
HPJ.text String
"->"lparen :: Doc
lparen =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.lparen rparen :: Doc
rparen =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.rparen lbrack :: Doc
lbrack =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.lbrack rbrack :: Doc
rbrack =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.rbrack lbrace :: Doc
lbrace =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.lbrace rbrace :: Doc
rbrace =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
HPJ.rbrace text :: String -> Doc
text =Doc -> Doc
forall a. a -> PprM a
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.text ptext :: String -> Doc
ptext =Doc -> Doc
forall a. a -> PprM a
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.ptext char :: Char -> Doc
char =Doc -> Doc
forall a. a -> PprM a
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.char int :: Int -> Doc
int =Doc -> Doc
forall a. a -> PprM a
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.int integer :: Uniq -> Doc
integer =Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Doc) -> (Uniq -> Doc) -> Uniq -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniq -> Doc
HPJ.integer float :: Float -> Doc
float =Doc -> Doc
forall a. a -> PprM a
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.float double :: Double -> Doc
double =Doc -> Doc
forall a. a -> PprM a
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.double rational :: Rational -> Doc
rational =Doc -> Doc
forall a. a -> PprM a
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.rational parens :: Doc -> Doc
parens =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Doc -> Doc
HPJ.parens brackets :: Doc -> Doc
brackets =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Doc -> Doc
HPJ.brackets braces :: Doc -> Doc
braces =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Doc -> Doc
HPJ.braces quotes :: Doc -> Doc
quotes =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Doc -> Doc
HPJ.quotes doubleQuotes :: Doc -> Doc
doubleQuotes =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Doc -> 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
liftM2 Doc -> 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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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
liftM2 Doc -> 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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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
liftM2 Doc -> 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
liftM2 Doc -> 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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence cat :: [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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence sep :: [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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence fcat :: [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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence fsep :: [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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence nest :: Int -> Doc -> Doc
nest Int
n =(Doc -> Doc) -> Doc -> Doc
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Doc -> Doc
HPJ.nest Int
n )hang :: Doc -> Int -> Doc -> Doc
hang Doc
d1 Int
n Doc
d2 =doDoc
d1' <-Doc
d1 Doc
d2' <-Doc
d2 Doc -> Doc
forall a. a -> PprM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Int -> Doc -> Doc
HPJ.hang Doc
d1' Int
n Doc
d2' )-- punctuate uses the same definition as Text.PrettyPrintpunctuate :: Doc -> [Doc] -> [Doc]
punctuate Doc
_[]=[]punctuate Doc
p (Doc
d : [Doc]
ds )=Doc -> [Doc] -> [Doc]
go Doc
d [Doc]
ds wherego :: Doc -> [Doc] -> [Doc]
go Doc
d' []=[Doc
d' ]go Doc
d' (Doc
e : [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