{-# LANGUAGE FlexibleInstances, Safe #-}
module Language.Haskell.TH.PprLib (
        
        Doc,            
        PprM,
        
        empty,
        semi, comma, colon, dcolon, space, equals, arrow,
        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
    (Uniq, Name(..), showName', NameFlavour(..), NameIs(..))
import qualified Text.PrettyPrint as HPJ
import Control.Monad (liftM, liftM2, ap)
import Language.Haskell.TH.Lib.Map ( Map )
import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )
import Prelude hiding ((<>))
infixl 6 <>
infixl 6 <+>
infixl 5 $$, $+$
instance Show Doc where
   show :: Doc -> String
show Doc
d = Doc -> String
HPJ.render (Doc -> Doc
to_HPJ_Doc Doc
d)
isEmpty :: Doc    -> PprM Bool;  
empty   :: Doc;                 
semi    :: Doc;                 
comma   :: Doc;                 
colon   :: Doc;                 
dcolon  :: Doc;                 
space   :: Doc;                 
equals  :: Doc;                 
arrow   :: 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, Uniq)
data PprM 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') = case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Name
fm of
                         Just Name
d -> (Name
d, State
s)
                         Maybe Name
Nothing -> let n'' :: 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
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)
instance Functor PprM where
      fmap :: 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
instance Applicative PprM where
      pure :: 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
instance Monad PprM where
    PprM 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
                            in PprM b -> State -> (b, State)
forall a. PprM a -> State -> (a, State)
runPprM (a -> PprM b
k a
x) State
s'
type Doc = PprM HPJ.Doc
isEmpty :: 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
<> :: 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 = do Doc
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 :: Doc -> [Doc] -> [Doc]
punctuate Doc
_ []     = []
punctuate Doc
p (Doc
d:[Doc]
ds) = Doc -> [Doc] -> [Doc]
go Doc
d [Doc]
ds
                   where
                     go :: 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