    {-# LANGUAGE FlexibleInstances, Safe #-}

    -- | Monadic front-end to Text.PrettyPrint

    module GHC.Boot.TH.PprLib (

            -- * The document type
            Doc,            -- Abstract, instance of Show
            PprM,

            -- * Primitive Documents
            empty,
            semi, comma, colon, dcolon, space, equals, arrow,
            lparen, rparen, lbrack, rbrack, lbrace, rbrace,

            -- * Converting values into documents
            text, char, ptext,
            int, integer, float, double, rational,

            -- * Wrapping documents in delimiters
            parens, brackets, braces, quotes, doubleQuotes,

            -- * Combining documents
            (<>), (<+>), hcat, hsep,
            ($$), ($+$), vcat,
            sep, cat,
            fsep, fcat,
            nest,
            hang, punctuate,

            -- * Predicates on documents
            isEmpty,

        to_HPJ_Doc, pprName, pprName'
      ) where

    import GHC.Boot.TH.Syntax
        (Uniq, Name(..), showName', NameFlavour(..), NameIs(..))
    import qualified Text.PrettyPrint as HPJ
    import Control.Monad (liftM, liftM2, ap)
    import GHC.Boot.TH.Lib.Map ( Map )
    import qualified GHC.Boot.TH.Lib.Map as Map ( lookup, insert, empty )
    import Prelude hiding ((<>))

    infixl 6 <>
    infixl 6 <+>
    infixl 5 $$, $+$

    -- ---------------------------------------------------------------------------
    -- The interface

    -- The primitive Doc values

    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;  -- ^ Returns 'True' if the document is empty

    empty   :: Doc;                 -- ^ An empty document
    semi    :: Doc;                 -- ^ A ';' character
    comma   :: Doc;                 -- ^ A ',' character
    colon   :: Doc;                 -- ^ A ':' character
    dcolon  :: Doc;                 -- ^ A "::" string
    space   :: Doc;                 -- ^ A space character
    equals  :: Doc;                 -- ^ A '=' character
    arrow   :: Doc;                 -- ^ A "->" string
    lparen  :: Doc;                 -- ^ A '(' character
    rparen  :: Doc;                 -- ^ A ')' character
    lbrack  :: Doc;                 -- ^ A '[' character
    rbrack  :: Doc;                 -- ^ A ']' character
    lbrace  :: Doc;                 -- ^ A '{' character
    rbrace  :: Doc;                 -- ^ A '}' character

    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;     -- ^ 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;     -- ^Beside
    hcat   :: [Doc] -> Doc;          -- ^List version of '<>'
    (<+>)  :: Doc -> Doc -> Doc;     -- ^Beside, separated by space
    hsep   :: [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 vcat
    sep    :: [Doc] -> Doc;          -- ^ Either hsep or vcat
    fcat   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of cat
    fsep   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of sep

    nest   :: 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"

    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

    {-
    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)

    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

    -- The primitive Doc values

    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

    -- 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 = do d1' <- Doc
    d1
                      d2' <- d2
                      return (HPJ.hang d1' n d2')

    -- punctuate uses the same definition as Text.PrettyPrint
    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