{-# 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 d =HPJ.render(to_HPJ_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 {runPprM ::State ->(a ,State )}pprName::Name ->Doc pprName =pprName' Alone pprName'::NameIs ->Name ->Doc pprName' ni n @(Name o (NameU _))=PprM $\s @(fm ,i )->let(n' ,s' )=caseMap.lookup n fm ofJustd ->(d ,s )Nothing->letn'' =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 {-
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 d =fst$runPprMd (Map.empty ,0)instanceFunctorPprM wherefmap =liftMinstanceApplicativePprM wherepure x =PprM $\s ->(x ,s )(<*> )=apinstanceMonadPprM wherem >>= k =PprM $\s ->let(x ,s' )=runPprMm s inrunPprM(k x )s' typeDoc =PprM HPJ.Doc-- The primitive Doc valuesisEmpty =liftMHPJ.isEmptyempty =returnHPJ.emptysemi =returnHPJ.semicomma =returnHPJ.commacolon =returnHPJ.colondcolon =return$HPJ.text"::"space =returnHPJ.spaceequals =returnHPJ.equalsarrow =return$HPJ.text"->"lparen =returnHPJ.lparenrparen =returnHPJ.rparenlbrack =returnHPJ.lbrackrbrack =returnHPJ.rbracklbrace =returnHPJ.lbracerbrace =returnHPJ.rbracetext =return.HPJ.textptext =return.HPJ.ptextchar =return.HPJ.charint =return.HPJ.intinteger =return.HPJ.integerfloat =return.HPJ.floatdouble =return.HPJ.doublerational =return.HPJ.rationalparens =liftMHPJ.parensbrackets =liftMHPJ.bracketsbraces =liftMHPJ.bracesquotes =liftMHPJ.quotesdoubleQuotes =liftMHPJ.doubleQuotes-- Combining @Doc@ values(<> )=liftM2(HPJ.<>)hcat =liftMHPJ.hcat.sequence(<+> )=liftM2(HPJ.<+>)hsep =liftMHPJ.hsep.sequence($$ )=liftM2(HPJ.$$)($+$ )=liftM2(HPJ.$+$)vcat =liftMHPJ.vcat.sequencecat =liftMHPJ.cat.sequencesep =liftMHPJ.sep.sequencefcat =liftMHPJ.fcat.sequencefsep =liftMHPJ.fsep.sequencenest n =liftM(HPJ.nestn )hang d1 n d2 =dod1' <-d1 d2' <-d2 return(HPJ.hangd1' n d2' )-- punctuate uses the same definition as Text.PrettyPrintpunctuate _[]=[]punctuatep (d :ds )=go d ds wherego d' []=[d' ]god' (e :es )=(d' <> p ):go e es