    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.Haskell.Pretty
    -- Copyright   :  (c) The GHC Team, Noel Winstanley 1997-2000
    -- License     :  BSD-3-Clause
    --
    -- Maintainer  :  Andreas Abel
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- Pretty printer for Haskell.
    --
    -----------------------------------------------------------------------------

    module Language.Haskell.Pretty
      ( -- * Pretty printing
        Pretty,
        prettyPrintStyleMode,
        prettyPrintWithMode,
        prettyPrint,

        -- * Pretty-printing styles (from "Text.PrettyPrint.HughesPJ")
        P.Style(..),
        P.style,
        P.Mode(..),

        -- * Haskell formatting modes
        PPHsMode(..),
        Indent,
        PPLayout(..),
        defaultMode
      ) where

    import           Language.Haskell.Syntax

    import           Control.Applicative as App (Applicative (..))
    import           Control.Monad           (ap)

    import qualified Text.PrettyPrint        as P

    infixl 5 $$$

    -----------------------------------------------------------------------------

    -- | Varieties of layout we can use.
    data PPLayout = PPOffsideRule   -- ^ Classical layout.
                  | PPSemiColon     -- ^ Classical layout made explicit.
                  | PPInLine        -- ^ Inline decls, with newlines between them.
                  | PPNoLayout      -- ^ Everything on a single line.
                  deriving PPLayout -> PPLayout -> Bool
    (PPLayout -> PPLayout -> Bool)
    -> (PPLayout -> PPLayout -> Bool) -> Eq PPLayout
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PPLayout -> PPLayout -> Bool
    == :: PPLayout -> PPLayout -> Bool
    $c/= :: PPLayout -> PPLayout -> Bool
    /= :: PPLayout -> PPLayout -> Bool
    Eq

    type Indent = Int

    -- | Pretty-printing parameters.
    --
    -- /Note:/ the 'onsideIndent' must be positive and less than all other indents.
    data PPHsMode = PPHsMode {
                                    -- | Indentation of a class or instance.
                    PPHsMode -> Int
    classIndent  :: Indent,
                                    -- | Indentation of a @do@-expression.
                    PPHsMode -> Int
    doIndent     :: Indent,
                                    -- | Indentation of the body of a
                                    -- @case@ expression.
                    PPHsMode -> Int
    caseIndent   :: Indent,
                                    -- | Indentation of the declarations in a
                                    -- @let@ expression.
                    PPHsMode -> Int
    letIndent    :: Indent,
                                    -- | Indentation of the declarations in a
                                    -- @where@ clause.
                    PPHsMode -> Int
    whereIndent  :: Indent,
                                    -- | Indentation added for continuation
                                    -- lines that would otherwise be offside.
                    PPHsMode -> Int
    onsideIndent :: Indent,
                                    -- | Blank lines between statements?
                    PPHsMode -> Bool
    spacing      :: Bool,
                                    -- | Pretty-printing style to use.
                    PPHsMode -> PPLayout
    layout       :: PPLayout,
                                    -- | Add GHC-style @LINE@ pragmas to output?
                    PPHsMode -> Bool
    linePragmas  :: Bool,
                                    -- | (not implemented yet)
                    PPHsMode -> Bool
    comments     :: Bool
                    }

    -- | The default mode: pretty-print using the offside rule and sensible
    -- defaults.
    defaultMode :: PPHsMode
    defaultMode :: PPHsMode
    defaultMode = PPHsMode{
                          classIndent :: Int
    classIndent = Int
    8,
                          doIndent :: Int
    doIndent = Int
    3,
                          caseIndent :: Int
    caseIndent = Int
    4,
                          letIndent :: Int
    letIndent = Int
    4,
                          whereIndent :: Int
    whereIndent = Int
    6,
                          onsideIndent :: Int
    onsideIndent = Int
    2,
                          spacing :: Bool
    spacing = Bool
    True,
                          layout :: PPLayout
    layout = PPLayout
    PPOffsideRule,
                          linePragmas :: Bool
    linePragmas = Bool
    False,
                          comments :: Bool
    comments = Bool
    True
                          }

    -- | Pretty printing monad
    newtype DocM s a = DocM (s -> a)

    instance Functor (DocM s) where
             fmap :: forall a b. (a -> b) -> DocM s a -> DocM s b
    fmap a -> b
    f DocM s a
    xs = do x <- DocM s a
    xs; return (f x)

    -- | @since 1.0.2.0
    instance App.Applicative (DocM s) where
            pure :: forall a. a -> DocM s a
    pure = a -> DocM s a
    forall a s. a -> DocM s a
    retDocM
            <*> :: forall a b. DocM s (a -> b) -> DocM s a -> DocM s b
    (<*>) = DocM s (a -> b) -> DocM s a -> DocM s b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap
            *> :: forall a b. DocM s a -> DocM s b -> DocM s b
    (*>) = DocM s a -> DocM s b -> DocM s b
    forall s a b. DocM s a -> DocM s b -> DocM s b
    then_DocM

    instance Monad (DocM s) where
            >>= :: forall a b. DocM s a -> (a -> DocM s b) -> DocM s b
    (>>=) = DocM s a -> (a -> DocM s b) -> DocM s b
    forall s a b. DocM s a -> (a -> DocM s b) -> DocM s b
    thenDocM
            >> :: forall a b. DocM s a -> DocM s b -> DocM s b
    (>>) = DocM s a -> DocM s b -> DocM s b
    forall a b. DocM s a -> DocM s b -> DocM s b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    (*>)
            return :: forall a. a -> DocM s a
    return = a -> DocM s a
    forall a. a -> DocM s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    {-# INLINE thenDocM #-}
    {-# INLINE then_DocM #-}
    {-# INLINE retDocM #-}
    {-# INLINE unDocM #-}
    {-# INLINE getPPEnv #-}

    thenDocM :: DocM s a -> (a -> DocM s b) -> DocM s b
    thenDocM :: forall s a b. DocM s a -> (a -> DocM s b) -> DocM s b
    thenDocM DocM s a
    m a -> DocM s b
    k = (s -> b) -> DocM s b
    forall s a. (s -> a) -> DocM s a
    DocM ((s -> b) -> DocM s b) -> (s -> b) -> DocM s b
    forall a b. (a -> b) -> a -> b
    $ (\s
    s -> case DocM s a -> s -> a
    forall s a. DocM s a -> s -> a
    unDocM DocM s a
    m (s -> a) -> s -> a
    forall a b. (a -> b) -> a -> b
    $ s
    s of a
    a -> DocM s b -> s -> b
    forall s a. DocM s a -> s -> a
    unDocM (a -> DocM s b
    k a
    a) (s -> b) -> s -> b
    forall a b. (a -> b) -> a -> b
    $ s
    s)

    then_DocM :: DocM s a -> DocM s b -> DocM s b
    then_DocM :: forall s a b. DocM s a -> DocM s b -> DocM s b
    then_DocM DocM s a
    m DocM s b
    k = (s -> b) -> DocM s b
    forall s a. (s -> a) -> DocM s a
    DocM ((s -> b) -> DocM s b) -> (s -> b) -> DocM s b
    forall a b. (a -> b) -> a -> b
    $ (\s
    s -> case DocM s a -> s -> a
    forall s a. DocM s a -> s -> a
    unDocM DocM s a
    m (s -> a) -> s -> a
    forall a b. (a -> b) -> a -> b
    $ s
    s of a
    _ -> DocM s b -> s -> b
    forall s a. DocM s a -> s -> a
    unDocM DocM s b
    k (s -> b) -> s -> b
    forall a b. (a -> b) -> a -> b
    $ s
    s)

    retDocM :: a -> DocM s a
    retDocM :: forall a s. a -> DocM s a
    retDocM a
    a = (s -> a) -> DocM s a
    forall s a. (s -> a) -> DocM s a
    DocM (\s
    _s -> a
    a)

    unDocM :: DocM s a -> (s -> a)
    unDocM :: forall s a. DocM s a -> s -> a
    unDocM (DocM s -> a
    f) = s -> a
    f

    -- all this extra stuff, just for this one function.
    getPPEnv :: DocM s s
    getPPEnv :: forall s. DocM s s
    getPPEnv = (s -> s) -> DocM s s
    forall s a. (s -> a) -> DocM s a
    DocM s -> s
    forall a. a -> a
    id

    -- So that pp code still looks the same
    -- this means we lose some generality though

    -- | The document type produced by these pretty printers uses a 'PPHsMode'
    -- environment.
    type Doc = DocM PPHsMode P.Doc

    -- | Things that can be pretty-printed, including all the syntactic objects
    -- in "Language.Haskell.Syntax".
    class Pretty a where
            -- | Pretty-print something in isolation.
            pretty :: a -> Doc
            -- | Pretty-print something in a precedence context.
            prettyPrec :: Int -> a -> Doc
            pretty = Int -> a -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    0
            prettyPrec Int
    _ = a -> Doc
    forall a. Pretty a => a -> Doc
    pretty

    -- The pretty printing combinators

    empty :: Doc
    empty :: Doc
    empty = Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc
    P.empty

    nest :: Int -> Doc -> Doc
    nest :: Int -> Doc -> Doc
    nest Int
    i Doc
    m = Doc
    m Doc -> (Doc -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Doc -> Doc
    P.nest Int
    i

    -- Literals

    text :: String -> Doc
    text :: String -> Doc
    text = Doc -> Doc
    forall a. a -> DocM PPHsMode 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
    P.text
    -- ptext = return . P.text

    char :: Char -> Doc
    char :: Char -> Doc
    char = Doc -> Doc
    forall a. a -> DocM PPHsMode 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
    P.char

    int :: Int -> Doc
    int :: Int -> Doc
    int = Doc -> Doc
    forall a. a -> DocM PPHsMode 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
    P.int

    integer :: Integer -> Doc
    integer :: Integer -> Doc
    integer = Doc -> Doc
    forall a. a -> DocM PPHsMode a
    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
    P.integer

    float :: Float -> Doc
    float :: Float -> Doc
    float = Doc -> Doc
    forall a. a -> DocM PPHsMode 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
    P.float

    double :: Double -> Doc
    double :: Double -> Doc
    double = Doc -> Doc
    forall a. a -> DocM PPHsMode 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
    P.double

    -- rational :: Rational -> Doc
    -- rational = return . P.rational

    -- Simple Combining Forms

    parens, brackets, braces :: Doc -> Doc
    parens :: Doc -> Doc
    parens Doc
    d = Doc
    d Doc -> (Doc -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> Doc
    P.parens
    brackets :: Doc -> Doc
    brackets Doc
    d = Doc
    d Doc -> (Doc -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> Doc
    P.brackets
    braces :: Doc -> Doc
    braces Doc
    d = Doc
    d Doc -> (Doc -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> Doc
    P.braces
    -- quotes d = d >>= return . P.quotes
    -- doubleQuotes d = d >>= return . P.doubleQuotes

    parensIf :: Bool -> Doc -> Doc
    parensIf :: Bool -> Doc -> Doc
    parensIf Bool
    True  = Doc -> Doc
    parens
    parensIf Bool
    False = Doc -> Doc
    forall a. a -> a
    id

    -- Constants

    semi,comma,space,equals :: Doc
    semi :: Doc
    semi = Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc
    P.semi
    comma :: Doc
    comma = Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc
    P.comma
    -- colon = return P.colon
    space :: Doc
    space = Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc
    P.space
    equals :: Doc
    equals = Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc
    P.equals

    -- lparen,rparen,lbrack,rbrack,lbrace,rbrace :: Doc
    -- lparen = return  P.lparen
    -- rparen = return  P.rparen
    -- lbrack = return  P.lbrack
    -- rbrack = return  P.rbrack
    -- lbrace = return  P.lbrace
    -- rbrace = return  P.rbrace

    -- Combinators

    (<<>>),(<+>),($$) :: Doc -> Doc -> Doc
    Doc
    aM <<>> :: Doc -> Doc -> Doc
    <<>> Doc
    bM = do{a<-Doc
    aM;b<-bM;return (a P.<> b)}
    Doc
    aM <+> :: Doc -> Doc -> Doc
    <+> Doc
    bM = do{a<-Doc
    aM;b<-bM;return (a P.<+> b)}
    Doc
    aM $$ :: Doc -> Doc -> Doc
    $$ Doc
    bM = do{a<-Doc
    aM;b<-bM;return (a P.$$ b)}
    -- aM $+$ bM = do{a<-aM;b<-bM;return (a P.$+$ b)}

    hcat,hsep,vcat,fsep :: [Doc] -> Doc
    hcat :: [Doc] -> Doc
    hcat [Doc]
    dl = [Doc] -> DocM PPHsMode [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]
    dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    P.hcat
    hsep :: [Doc] -> Doc
    hsep [Doc]
    dl = [Doc] -> DocM PPHsMode [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]
    dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    P.hsep
    vcat :: [Doc] -> Doc
    vcat [Doc]
    dl = [Doc] -> DocM PPHsMode [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]
    dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    P.vcat
    -- sep dl = sequence dl >>= return . P.sep
    -- cat dl = sequence dl >>= return . P.cat
    fsep :: [Doc] -> Doc
    fsep [Doc]
    dl = [Doc] -> DocM PPHsMode [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]
    dl DocM PPHsMode [Doc] -> ([Doc] -> Doc) -> Doc
    forall a b.
    DocM PPHsMode a -> (a -> DocM PPHsMode b) -> DocM PPHsMode b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Doc -> Doc
    forall a. a -> DocM PPHsMode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    P.fsep
    -- fcat dl = sequence dl >>= return . P.fcat

    -- Some More

    -- hang :: Doc -> Int -> Doc -> Doc
    -- hang dM i rM = do{d<-dM;r<-rM;return $ P.hang d i r}

    -- Yuk, had to cut-n-paste this one from Pretty.hs
    punctuate :: Doc -> [Doc] -> [Doc]
    punctuate :: Doc -> [Doc] -> [Doc]
    punctuate Doc
    _ []     = []
    punctuate Doc
    p (Doc
    d1:[Doc]
    ds) = Doc -> [Doc] -> [Doc]
    go Doc
    d1 [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

    -- | render the document with a given style and mode.
    renderStyleMode :: P.Style -> PPHsMode -> Doc -> String
    renderStyleMode :: Style -> PPHsMode -> Doc -> String
    renderStyleMode Style
    ppStyle PPHsMode
    ppMode Doc
    d = Style -> Doc -> String
    P.renderStyle Style
    ppStyle (Doc -> String) -> (PPHsMode -> Doc) -> PPHsMode -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> PPHsMode -> Doc
    forall s a. DocM s a -> s -> a
    unDocM Doc
    d (PPHsMode -> String) -> PPHsMode -> String
    forall a b. (a -> b) -> a -> b
    $ PPHsMode
    ppMode

    -- --- | render the document with a given mode.
    -- renderWithMode :: PPHsMode -> Doc -> String
    -- renderWithMode = renderStyleMode P.style

    -- -- | render the document with 'defaultMode'.
    -- render :: Doc -> String
    -- render = renderWithMode defaultMode

    -- | pretty-print with a given style and mode.
    prettyPrintStyleMode :: Pretty a => P.Style -> PPHsMode -> a -> String
    prettyPrintStyleMode :: forall a. Pretty a => Style -> PPHsMode -> a -> String
    prettyPrintStyleMode Style
    ppStyle PPHsMode
    ppMode = Style -> PPHsMode -> Doc -> String
    renderStyleMode Style
    ppStyle PPHsMode
    ppMode (Doc -> String) -> (a -> Doc) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Doc
    forall a. Pretty a => a -> Doc
    pretty

    -- | pretty-print with the default style and a given mode.
    prettyPrintWithMode :: Pretty a => PPHsMode -> a -> String
    prettyPrintWithMode :: forall a. Pretty a => PPHsMode -> a -> String
    prettyPrintWithMode = Style -> PPHsMode -> a -> String
    forall a. Pretty a => Style -> PPHsMode -> a -> String
    prettyPrintStyleMode Style
    P.style

    -- | pretty-print with the default style and 'defaultMode'.
    prettyPrint :: Pretty a => a -> String
    prettyPrint :: forall a. Pretty a => a -> String
    prettyPrint = PPHsMode -> a -> String
    forall a. Pretty a => PPHsMode -> a -> String
    prettyPrintWithMode PPHsMode
    defaultMode

    -- fullRenderWithMode :: PPHsMode -> P.Mode -> Int -> Float ->
    --                       (P.TextDetails -> a -> a) -> a -> Doc -> a
    -- fullRenderWithMode ppMode m i f fn e mD =
    --                    P.fullRender m i f fn e $ (unDocM mD) ppMode
    --
    --
    -- fullRender :: P.Mode -> Int -> Float -> (P.TextDetails -> a -> a)
    --               -> a -> Doc -> a
    -- fullRender = fullRenderWithMode defaultMode

    -------------------------  Pretty-Print a Module --------------------
    instance Pretty HsModule where
            pretty :: HsModule -> Doc
    pretty (HsModule SrcLoc
    pos Module
    m Maybe [HsExportSpec]
    mbExports [HsImportDecl]
    imp [HsDecl]
    decls) =
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    Doc -> [Doc] -> Doc
    topLevel (Module -> Maybe [HsExportSpec] -> Doc
    ppHsModuleHeader Module
    m Maybe [HsExportSpec]
    mbExports)
                             ((HsImportDecl -> Doc) -> [HsImportDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsImportDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsImportDecl]
    imp [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsDecl -> Doc) -> [HsDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsDecl]
    decls)

    --------------------------  Module Header ------------------------------
    ppHsModuleHeader :: Module -> Maybe [HsExportSpec] ->  Doc
    ppHsModuleHeader :: Module -> Maybe [HsExportSpec] -> Doc
    ppHsModuleHeader Module
    m Maybe [HsExportSpec]
    mbExportList = [Doc] -> Doc
    mySep [
            String -> Doc
    text String
    "module",
            Module -> Doc
    forall a. Pretty a => a -> Doc
    pretty Module
    m,
            ([HsExportSpec] -> Doc) -> Maybe [HsExportSpec] -> Doc
    forall a. (a -> Doc) -> Maybe a -> Doc
    maybePP ([Doc] -> Doc
    parenList ([Doc] -> Doc)
    -> ([HsExportSpec] -> [Doc]) -> [HsExportSpec] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsExportSpec -> Doc) -> [HsExportSpec] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsExportSpec -> Doc
    forall a. Pretty a => a -> Doc
    pretty) Maybe [HsExportSpec]
    mbExportList,
            String -> Doc
    text String
    "where"]

    instance Pretty Module where
            pretty :: Module -> Doc
    pretty (Module String
    modName) = String -> Doc
    text String
    modName

    instance Pretty HsExportSpec where
            pretty :: HsExportSpec -> Doc
    pretty (HsEVar HsQName
    name)                = HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name
            pretty (HsEAbs HsQName
    name)                = HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name
            pretty (HsEThingAll HsQName
    name)           = HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name Doc -> Doc -> Doc
    <<>> String -> Doc
    text String
    "(..)"
            pretty (HsEThingWith HsQName
    name [HsCName]
    nameList) =
                    HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name Doc -> Doc -> Doc
    <<>> ([Doc] -> Doc
    parenList ([Doc] -> Doc) -> ([HsCName] -> [Doc]) -> [HsCName] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsCName -> Doc) -> [HsCName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsCName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsCName] -> Doc) -> [HsCName] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsCName]
    nameList)
            pretty (HsEModuleContents Module
    m)       = String -> Doc
    text String
    "module" Doc -> Doc -> Doc
    <+> Module -> Doc
    forall a. Pretty a => a -> Doc
    pretty Module
    m

    instance Pretty HsImportDecl where
            pretty :: HsImportDecl -> Doc
    pretty (HsImportDecl SrcLoc
    pos Module
    m Bool
    qual Maybe Module
    mbName Maybe (Bool, [HsImportSpec])
    mbSpecs) =
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep [String -> Doc
    text String
    "import",
                           if Bool
    qual then String -> Doc
    text String
    "qualified" else Doc
    empty,
                           Module -> Doc
    forall a. Pretty a => a -> Doc
    pretty Module
    m,
                           (Module -> Doc) -> Maybe Module -> Doc
    forall a. (a -> Doc) -> Maybe a -> Doc
    maybePP (\Module
    m' -> String -> Doc
    text String
    "as" Doc -> Doc -> Doc
    <+> Module -> Doc
    forall a. Pretty a => a -> Doc
    pretty Module
    m') Maybe Module
    mbName,
                           ((Bool, [HsImportSpec]) -> Doc)
    -> Maybe (Bool, [HsImportSpec]) -> Doc
    forall a. (a -> Doc) -> Maybe a -> Doc
    maybePP (Bool, [HsImportSpec]) -> Doc
    forall {a}. Pretty a => (Bool, [a]) -> Doc
    exports Maybe (Bool, [HsImportSpec])
    mbSpecs]
                where
                    exports :: (Bool, [a]) -> Doc
    exports (Bool
    b,[a]
    specList) =
                            if Bool
    b then String -> Doc
    text String
    "hiding" Doc -> Doc -> Doc
    <+> Doc
    specs else Doc
    specs
                        where specs :: Doc
    specs = [Doc] -> Doc
    parenList ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Doc) -> [a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([a] -> Doc) -> [a] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [a]
    specList

    instance Pretty HsImportSpec where
            pretty :: HsImportSpec -> Doc
    pretty (HsIVar HsName
    name)                = HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name
            pretty (HsIAbs HsName
    name)                = HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name
            pretty (HsIThingAll HsName
    name)           = HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name Doc -> Doc -> Doc
    <<>> String -> Doc
    text String
    "(..)"
            pretty (HsIThingWith HsName
    name [HsCName]
    nameList) =
                    HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name Doc -> Doc -> Doc
    <<>> ([Doc] -> Doc
    parenList ([Doc] -> Doc) -> ([HsCName] -> [Doc]) -> [HsCName] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsCName -> Doc) -> [HsCName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsCName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsCName] -> Doc) -> [HsCName] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsCName]
    nameList)

    -------------------------  Declarations ------------------------------
    instance Pretty HsDecl where
            pretty :: HsDecl -> Doc
    pretty (HsTypeDecl SrcLoc
    loc HsName
    name [HsName]
    nameList HsType
    htype) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    loc (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ( [String -> Doc
    text String
    "type", HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name]
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsName -> Doc) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsName]
    nameList
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [Doc
    equals, HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsType
    htype])

            pretty (HsDataDecl SrcLoc
    loc HsContext
    context HsName
    name [HsName]
    nameList [HsConDecl]
    constrList [HsQName]
    derives) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    loc (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ( [String -> Doc
    text String
    "data", HsContext -> Doc
    ppHsContext HsContext
    context, HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name]
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsName -> Doc) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsName]
    nameList)
                            Doc -> Doc -> Doc
    <+> ([Doc] -> Doc
    myVcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Doc -> Doc -> Doc
    (<+>) (Doc
    equals Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : Doc -> [Doc]
    forall a. a -> [a]
    repeat (Char -> Doc
    char Char
    '|'))
                                                       ((HsConDecl -> Doc) -> [HsConDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsConDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsConDecl]
    constrList))
                            Doc -> Doc -> Doc
    $$$ [HsQName] -> Doc
    ppHsDeriving [HsQName]
    derives)

            pretty (HsNewTypeDecl SrcLoc
    pos HsContext
    context HsName
    name [HsName]
    nameList HsConDecl
    constr [HsQName]
    derives) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ( [String -> Doc
    text String
    "newtype", HsContext -> Doc
    ppHsContext HsContext
    context, HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name]
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsName -> Doc) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsName]
    nameList)
                            Doc -> Doc -> Doc
    <+> Doc
    equals Doc -> Doc -> Doc
    <+> (HsConDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsConDecl
    constr Doc -> Doc -> Doc
    $$$ [HsQName] -> Doc
    ppHsDeriving [HsQName]
    derives)

            --m{spacing=False}
            -- special case for empty class declaration
            pretty (HsClassDecl SrcLoc
    pos HsContext
    context HsName
    name [HsName]
    nameList []) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ( [String -> Doc
    text String
    "class", HsContext -> Doc
    ppHsContext HsContext
    context, HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name]
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsName -> Doc) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsName]
    nameList)
            pretty (HsClassDecl SrcLoc
    pos HsContext
    context HsName
    name [HsName]
    nameList [HsDecl]
    declList) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ( [String -> Doc
    text String
    "class", HsContext -> Doc
    ppHsContext HsContext
    context, HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name]
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsName -> Doc) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsName]
    nameList [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> Doc
    text String
    "where"])
                    Doc -> Doc -> Doc
    $$$ (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    classIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsDecl]
    declList)

            -- m{spacing=False}
            -- special case for empty instance declaration
            pretty (HsInstDecl SrcLoc
    pos HsContext
    context HsQName
    name [HsType]
    args []) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ( [String -> Doc
    text String
    "instance", HsContext -> Doc
    ppHsContext HsContext
    context, HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name]
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsType -> Doc) -> [HsType] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsType -> Doc
    ppHsAType [HsType]
    args)
            pretty (HsInstDecl SrcLoc
    pos HsContext
    context HsQName
    name [HsType]
    args [HsDecl]
    declList) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ( [String -> Doc
    text String
    "instance", HsContext -> Doc
    ppHsContext HsContext
    context, HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name]
                            [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (HsType -> Doc) -> [HsType] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsType -> Doc
    ppHsAType [HsType]
    args [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> Doc
    text String
    "where"])
                    Doc -> Doc -> Doc
    $$$ (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    classIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsDecl]
    declList)

            pretty (HsDefaultDecl SrcLoc
    pos [HsType]
    htypes) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    String -> Doc
    text String
    "default" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    parenList ((HsType -> Doc) -> [HsType] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsType]
    htypes)

            pretty (HsTypeSig SrcLoc
    pos [HsName]
    nameList HsQualType
    qualType) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ((Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> ([HsName] -> [Doc]) -> [HsName] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsName -> Doc) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsName] -> [Doc]) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ [HsName]
    nameList)
                          [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> Doc
    text String
    "::", HsQualType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQualType
    qualType])

            pretty (HsForeignImport SrcLoc
    pos String
    conv HsSafety
    safety String
    entity HsName
    name HsType
    ty) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [String -> Doc
    text String
    "foreign", String -> Doc
    text String
    "import", String -> Doc
    text String
    conv, HsSafety -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsSafety
    safety] [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++
                            (if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    entity then [] else [String -> Doc
    text (String -> String
    forall a. Show a => a -> String
    show String
    entity)]) [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++
                            [HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name, String -> Doc
    text String
    "::", HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsType
    ty]

            pretty (HsForeignExport SrcLoc
    pos String
    conv String
    entity HsName
    name HsType
    ty) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [String -> Doc
    text String
    "foreign", String -> Doc
    text String
    "export", String -> Doc
    text String
    conv] [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++
                            (if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    entity then [] else [String -> Doc
    text (String -> String
    forall a. Show a => a -> String
    show String
    entity)]) [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++
                            [HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name, String -> Doc
    text String
    "::", HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsType
    ty]

            pretty (HsFunBind [HsMatch]
    matches) =
                    [Doc] -> Doc
    ppBindings ((HsMatch -> Doc) -> [HsMatch] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsMatch -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsMatch]
    matches)

            pretty (HsPatBind SrcLoc
    pos HsPat
    pat HsRhs
    rhs [HsDecl]
    whereDecls) =
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    myFsep [HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    pat, HsRhs -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsRhs
    rhs] Doc -> Doc -> Doc
    $$$ [HsDecl] -> Doc
    ppWhere [HsDecl]
    whereDecls

            pretty (HsInfixDecl SrcLoc
    pos HsAssoc
    assoc Int
    prec [HsOp]
    opList) =
                    Doc -> Doc
    blankline (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    mySep ([HsAssoc -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsAssoc
    assoc, Int -> Doc
    int Int
    prec]
                           [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> ([HsOp] -> [Doc]) -> [HsOp] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsOp -> Doc) -> [HsOp] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsOp -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsOp] -> [Doc]) -> [HsOp] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ [HsOp]
    opList))

    instance Pretty HsAssoc where
            pretty :: HsAssoc -> Doc
    pretty HsAssoc
    HsAssocNone  = String -> Doc
    text String
    "infix"
            pretty HsAssoc
    HsAssocLeft  = String -> Doc
    text String
    "infixl"
            pretty HsAssoc
    HsAssocRight = String -> Doc
    text String
    "infixr"

    instance Pretty HsSafety where
            pretty :: HsSafety -> Doc
    pretty HsSafety
    HsSafe   = String -> Doc
    text String
    "safe"
            pretty HsSafety
    HsUnsafe = String -> Doc
    text String
    "unsafe"

    instance Pretty HsMatch where
            pretty :: HsMatch -> Doc
    pretty (HsMatch SrcLoc
    pos HsName
    f [HsPat]
    ps HsRhs
    rhs [HsDecl]
    whereDecls) =
                    SrcLoc -> Doc -> Doc
    markLine SrcLoc
    pos (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    myFsep ([Doc]
    lhs [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [HsRhs -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsRhs
    rhs])
                    Doc -> Doc -> Doc
    $$$ [HsDecl] -> Doc
    ppWhere [HsDecl]
    whereDecls
                where
                    lhs :: [Doc]
    lhs = case [HsPat]
    ps of
                            HsPat
    l:HsPat
    r:[HsPat]
    ps' | HsName -> Bool
    isSymbolName HsName
    f ->
                                    let hd :: [Doc]
    hd = [HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    l, HsName -> Doc
    ppHsName HsName
    f, HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    r] in
                                    if [HsPat] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HsPat]
    ps' then [Doc]
    hd
                                    else Doc -> Doc
    parens ([Doc] -> Doc
    myFsep [Doc]
    hd) Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (HsPat -> Doc) -> [HsPat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> HsPat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    2) [HsPat]
    ps'
                            [HsPat]
    _ -> HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    f Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (HsPat -> Doc) -> [HsPat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> HsPat -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    2) [HsPat]
    ps

    ppWhere :: [HsDecl] -> Doc
    ppWhere :: [HsDecl] -> Doc
    ppWhere [] = Doc
    empty
    ppWhere [HsDecl]
    l  = Int -> Doc -> Doc
    nest Int
    2 (String -> Doc
    text String
    "where" Doc -> Doc -> Doc
    $$$ (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    whereIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsDecl]
    l))

    ------------------------- Data & Newtype Bodies -------------------------
    instance Pretty HsConDecl where
            pretty :: HsConDecl -> Doc
    pretty (HsRecDecl SrcLoc
    _pos HsName
    name [([HsName], HsBangType)]
    fieldList) =
                    HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name Doc -> Doc -> Doc
    <<>> ([Doc] -> Doc
    braceList ([Doc] -> Doc)
    -> ([([HsName], HsBangType)] -> [Doc])
    -> [([HsName], HsBangType)]
    -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([HsName], HsBangType) -> Doc)
    -> [([HsName], HsBangType)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ([HsName], HsBangType) -> Doc
    ppField ([([HsName], HsBangType)] -> Doc)
    -> [([HsName], HsBangType)] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [([HsName], HsBangType)]
    fieldList)

            pretty (HsConDecl SrcLoc
    _pos name :: HsName
    name@(HsSymbol String
    _) [HsBangType
    l, HsBangType
    r]) =
                    [Doc] -> Doc
    myFsep [Int -> HsBangType -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    prec_btype HsBangType
    l, HsName -> Doc
    ppHsName HsName
    name,
                            Int -> HsBangType -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    prec_btype HsBangType
    r]
            pretty (HsConDecl SrcLoc
    _pos HsName
    name [HsBangType]
    typeList) =
                    [Doc] -> Doc
    mySep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ HsName -> Doc
    ppHsName HsName
    name Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (HsBangType -> Doc) -> [HsBangType] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> HsBangType -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    prec_atype) [HsBangType]
    typeList

    ppField :: ([HsName],HsBangType) -> Doc
    ppField :: ([HsName], HsBangType) -> Doc
    ppField ([HsName]
    names, HsBangType
    ty) =
            [Doc] -> Doc
    myFsepSimple ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> ([HsName] -> [Doc]) -> [HsName] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsName -> Doc) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsName] -> [Doc]) -> [HsName] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ [HsName]
    names) [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++
                           [String -> Doc
    text String
    "::", HsBangType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsBangType
    ty]

    instance Pretty HsBangType where
            prettyPrec :: Int -> HsBangType -> Doc
    prettyPrec Int
    _ (HsBangedTy HsType
    ty)   = Char -> Doc
    char Char
    '!' Doc -> Doc -> Doc
    <<>> HsType -> Doc
    ppHsAType HsType
    ty
            prettyPrec Int
    p (HsUnBangedTy HsType
    ty) = Int -> HsType -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    p HsType
    ty

    ppHsDeriving :: [HsQName] -> Doc
    ppHsDeriving :: [HsQName] -> Doc
    ppHsDeriving []  = Doc
    empty
    ppHsDeriving [HsQName
    d] = String -> Doc
    text String
    "deriving" Doc -> Doc -> Doc
    <+> HsQName -> Doc
    ppHsQName HsQName
    d
    ppHsDeriving [HsQName]
    ds  = String -> Doc
    text String
    "deriving" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    parenList ((HsQName -> Doc) -> [HsQName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsQName -> Doc
    ppHsQName [HsQName]
    ds)

    ------------------------- Types -------------------------
    instance Pretty HsQualType where
            pretty :: HsQualType -> Doc
    pretty (HsQualType HsContext
    context HsType
    htype) =
                    [Doc] -> Doc
    myFsep [HsContext -> Doc
    ppHsContext HsContext
    context, HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsType
    htype]

    ppHsBType :: HsType -> Doc
    ppHsBType :: HsType -> Doc
    ppHsBType = Int -> HsType -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    prec_btype

    ppHsAType :: HsType -> Doc
    ppHsAType :: HsType -> Doc
    ppHsAType = Int -> HsType -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyPrec Int
    prec_atype

    -- precedences for types
    prec_btype, prec_atype :: Int
    prec_btype :: Int
    prec_btype = Int
    1  -- left argument of ->,
                    -- or either argument of an infix data constructor
    prec_atype :: Int
    prec_atype = Int
    2  -- argument of type or data constructor, or of a class

    instance Pretty HsType where
            prettyPrec :: Int -> HsType -> Doc
    prettyPrec Int
    p (HsTyFun HsType
    a HsType
    b) = Bool -> Doc -> Doc
    parensIf (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    myFsep [HsType -> Doc
    ppHsBType HsType
    a, String -> Doc
    text String
    "->", HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsType
    b]
            prettyPrec Int
    _ (HsTyTuple [HsType]
    l) = [Doc] -> Doc
    parenList ([Doc] -> Doc) -> ([HsType] -> [Doc]) -> [HsType] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsType -> Doc) -> [HsType] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsType] -> Doc) -> [HsType] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsType]
    l
            prettyPrec Int
    p (HsTyApp HsType
    a HsType
    b)
                    | HsType
    a HsType -> HsType -> Bool
    forall a. Eq a => a -> a -> Bool
    == HsType
    list_tycon = Doc -> Doc
    brackets (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsType
    b         -- special case
                    | Bool
    otherwise = Bool -> Doc -> Doc
    parensIf (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    prec_btype) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                            [Doc] -> Doc
    myFsep [HsType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsType
    a, HsType -> Doc
    ppHsAType HsType
    b]
            prettyPrec Int
    _ (HsTyVar HsName
    name) = HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name
            prettyPrec Int
    _ (HsTyCon HsQName
    name) = HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name

    ------------------------- Expressions -------------------------
    instance Pretty HsRhs where
            pretty :: HsRhs -> Doc
    pretty (HsUnGuardedRhs HsExp
    e)        = Doc
    equals Doc -> Doc -> Doc
    <+> HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e
            pretty (HsGuardedRhss [HsGuardedRhs]
    guardList) = [Doc] -> Doc
    myVcat ([Doc] -> Doc)
    -> ([HsGuardedRhs] -> [Doc]) -> [HsGuardedRhs] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsGuardedRhs -> Doc) -> [HsGuardedRhs] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsGuardedRhs -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsGuardedRhs] -> Doc) -> [HsGuardedRhs] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsGuardedRhs]
    guardList

    instance Pretty HsGuardedRhs where
            pretty :: HsGuardedRhs -> Doc
    pretty (HsGuardedRhs SrcLoc
    _pos HsExp
    guard HsExp
    body) =
                    [Doc] -> Doc
    myFsep [Char -> Doc
    char Char
    '|', HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    guard, Doc
    equals, HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    body]

    instance Pretty HsLiteral where
            pretty :: HsLiteral -> Doc
    pretty (HsInt Integer
    i)        = Integer -> Doc
    integer Integer
    i
            pretty (HsChar Char
    c)       = String -> Doc
    text (Char -> String
    forall a. Show a => a -> String
    show Char
    c)
            pretty (HsString String
    s)     = String -> Doc
    text (String -> String
    forall a. Show a => a -> String
    show String
    s)
            pretty (HsFrac Rational
    r)       = Double -> Doc
    double (Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r)
            -- GHC unboxed literals:
            pretty (HsCharPrim Char
    c)   = String -> Doc
    text (Char -> String
    forall a. Show a => a -> String
    show Char
    c)           Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '#'
            pretty (HsStringPrim String
    s) = String -> Doc
    text (String -> String
    forall a. Show a => a -> String
    show String
    s)           Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '#'
            pretty (HsIntPrim Integer
    i)    = Integer -> Doc
    integer Integer
    i               Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '#'
            pretty (HsFloatPrim Rational
    r)  = Float -> Doc
    float  (Rational -> Float
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r) Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '#'
            pretty (HsDoublePrim Rational
    r) = Double -> Doc
    double (Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r) Doc -> Doc -> Doc
    <<>> String -> Doc
    text String
    "##"

    instance Pretty HsExp where
            pretty :: HsExp -> Doc
    pretty (HsLit HsLiteral
    l) = HsLiteral -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsLiteral
    l
            -- lambda stuff
            pretty (HsInfixApp HsExp
    a HsQOp
    op HsExp
    b) = [Doc] -> Doc
    myFsep [HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    a, HsQOp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQOp
    op, HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    b]
            pretty (HsNegApp HsExp
    e) = [Doc] -> Doc
    myFsep [Char -> Doc
    char Char
    '-', HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e]
            pretty (HsApp HsExp
    a HsExp
    b) = [Doc] -> Doc
    myFsep [HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    a, HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    b]
            pretty (HsLambda SrcLoc
    _loc [HsPat]
    expList HsExp
    body) = [Doc] -> Doc
    myFsep ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    Char -> Doc
    char Char
    '\\' Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (HsPat -> Doc) -> [HsPat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsPat]
    expList [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> Doc
    text String
    "->", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    body]
            -- keywords
            pretty (HsLet [HsDecl]
    expList HsExp
    letBody) =
                    [Doc] -> Doc
    myFsep [String -> Doc
    text String
    "let" Doc -> Doc -> Doc
    <+> (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    letIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsDecl]
    expList),
                            String -> Doc
    text String
    "in", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    letBody]
            pretty (HsIf HsExp
    cond HsExp
    thenexp HsExp
    elsexp) =
                    [Doc] -> Doc
    myFsep [String -> Doc
    text String
    "if", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    cond,
                            String -> Doc
    text String
    "then", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    thenexp,
                            String -> Doc
    text String
    "else", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    elsexp]
            pretty (HsCase HsExp
    cond [HsAlt]
    altList) =
                    [Doc] -> Doc
    myFsep [String -> Doc
    text String
    "case", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    cond, String -> Doc
    text String
    "of"]
                    Doc -> Doc -> Doc
    $$$ (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    caseIndent ((HsAlt -> Doc) -> [HsAlt] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsAlt -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsAlt]
    altList)
            pretty (HsDo [HsStmt]
    stmtList) =
                    String -> Doc
    text String
    "do" Doc -> Doc -> Doc
    $$$ (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    doIndent ((HsStmt -> Doc) -> [HsStmt] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsStmt -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsStmt]
    stmtList)
            -- Constructors & Vars
            pretty (HsVar HsQName
    name) = HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name
            pretty (HsCon HsQName
    name) = HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name
            pretty (HsTuple [HsExp]
    expList) = [Doc] -> Doc
    parenList ([Doc] -> Doc) -> ([HsExp] -> [Doc]) -> [HsExp] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsExp -> Doc) -> [HsExp] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsExp] -> Doc) -> [HsExp] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsExp]
    expList
            -- weird stuff
            pretty (HsParen HsExp
    e) = Doc -> Doc
    parens (Doc -> Doc) -> (HsExp -> Doc) -> HsExp -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty (HsExp -> Doc) -> HsExp -> Doc
    forall a b. (a -> b) -> a -> b
    $ HsExp
    e
            pretty (HsLeftSection HsExp
    e HsQOp
    op) = Doc -> Doc
    parens (HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e Doc -> Doc -> Doc
    <+> HsQOp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQOp
    op)
            pretty (HsRightSection HsQOp
    op HsExp
    e) = Doc -> Doc
    parens (HsQOp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQOp
    op Doc -> Doc -> Doc
    <+> HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e)
            pretty (HsRecConstr HsQName
    c [HsFieldUpdate]
    fieldList) =
                    HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    c Doc -> Doc -> Doc
    <<>> ([Doc] -> Doc
    braceList ([Doc] -> Doc)
    -> ([HsFieldUpdate] -> [Doc]) -> [HsFieldUpdate] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsFieldUpdate -> Doc) -> [HsFieldUpdate] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsFieldUpdate -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsFieldUpdate] -> Doc) -> [HsFieldUpdate] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsFieldUpdate]
    fieldList)
            pretty (HsRecUpdate HsExp
    e [HsFieldUpdate]
    fieldList) =
                    HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e Doc -> Doc -> Doc
    <<>> ([Doc] -> Doc
    braceList ([Doc] -> Doc)
    -> ([HsFieldUpdate] -> [Doc]) -> [HsFieldUpdate] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsFieldUpdate -> Doc) -> [HsFieldUpdate] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsFieldUpdate -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsFieldUpdate] -> Doc) -> [HsFieldUpdate] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsFieldUpdate]
    fieldList)
            -- patterns
            -- special case that would otherwise be buggy
            pretty (HsAsPat HsName
    name (HsIrrPat HsExp
    e)) =
                    [Doc] -> Doc
    myFsep [HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '@', Char -> Doc
    char Char
    '~' Doc -> Doc -> Doc
    <<>> HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e]
            pretty (HsAsPat HsName
    name HsExp
    e) = [Doc] -> Doc
    hcat [HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name, Char -> Doc
    char Char
    '@', HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e]
            pretty HsExp
    HsWildCard = Char -> Doc
    char Char
    '_'
            pretty (HsIrrPat HsExp
    e) = Char -> Doc
    char Char
    '~' Doc -> Doc -> Doc
    <<>> HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e
            -- Lists
            pretty (HsList [HsExp]
    list) =
                    [Doc] -> Doc
    bracketList ([Doc] -> Doc) -> ([HsExp] -> [Doc]) -> [HsExp] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> ([HsExp] -> [Doc]) -> [HsExp] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsExp -> Doc) -> [HsExp] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsExp] -> Doc) -> [HsExp] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsExp]
    list
            pretty (HsEnumFrom HsExp
    e) =
                    [Doc] -> Doc
    bracketList [HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e, String -> Doc
    text String
    ".."]
            pretty (HsEnumFromTo HsExp
    from HsExp
    to) =
                    [Doc] -> Doc
    bracketList [HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    from, String -> Doc
    text String
    "..", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    to]
            pretty (HsEnumFromThen HsExp
    from HsExp
    thenE) =
                    [Doc] -> Doc
    bracketList [HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    from Doc -> Doc -> Doc
    <<>> Doc
    comma, HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    thenE, String -> Doc
    text String
    ".."]
            pretty (HsEnumFromThenTo HsExp
    from HsExp
    thenE HsExp
    to) =
                    [Doc] -> Doc
    bracketList [HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    from Doc -> Doc -> Doc
    <<>> Doc
    comma, HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    thenE,
                                 String -> Doc
    text String
    "..", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    to]
            pretty (HsListComp HsExp
    e [HsStmt]
    stmtList) =
                    [Doc] -> Doc
    bracketList ([HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e, Char -> Doc
    char Char
    '|']
                                 [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ (Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> ([HsStmt] -> [Doc]) -> [HsStmt] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsStmt -> Doc) -> [HsStmt] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsStmt -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsStmt] -> [Doc]) -> [HsStmt] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ [HsStmt]
    stmtList))
            pretty (HsExpTypeSig SrcLoc
    _pos HsExp
    e HsQualType
    ty) =
                    [Doc] -> Doc
    myFsep [HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e, String -> Doc
    text String
    "::", HsQualType -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQualType
    ty]

    ------------------------- Patterns -----------------------------

    instance Pretty HsPat where
            prettyPrec :: Int -> HsPat -> Doc
    prettyPrec Int
    _ (HsPVar HsName
    name) = HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name
            prettyPrec Int
    _ (HsPLit HsLiteral
    lit) = HsLiteral -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsLiteral
    lit
            prettyPrec Int
    _ (HsPNeg HsPat
    p) = [Doc] -> Doc
    myFsep [Char -> Doc
    char Char
    '-', HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    p]
            prettyPrec Int
    p (HsPInfixApp HsPat
    a HsQName
    op HsPat
    b) = Bool -> Doc -> Doc
    parensIf (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    myFsep [HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    a, HsQOp -> Doc
    forall a. Pretty a => a -> Doc
    pretty (HsQName -> HsQOp
    HsQConOp HsQName
    op), HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    b]
            prettyPrec Int
    p (HsPApp HsQName
    n [HsPat]
    ps) = Bool -> Doc -> Doc
    parensIf (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1) (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                    [Doc] -> Doc
    myFsep (HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    n Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (HsPat -> Doc) -> [HsPat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsPat]
    ps)
            prettyPrec Int
    _ (HsPTuple [HsPat]
    ps) = [Doc] -> Doc
    parenList ([Doc] -> Doc) -> ([HsPat] -> [Doc]) -> [HsPat] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsPat -> Doc) -> [HsPat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsPat] -> Doc) -> [HsPat] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsPat]
    ps
            prettyPrec Int
    _ (HsPList [HsPat]
    ps) =
                    [Doc] -> Doc
    bracketList ([Doc] -> Doc) -> ([HsPat] -> [Doc]) -> [HsPat] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma ([Doc] -> [Doc]) -> ([HsPat] -> [Doc]) -> [HsPat] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsPat -> Doc) -> [HsPat] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsPat] -> Doc) -> [HsPat] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsPat]
    ps
            prettyPrec Int
    _ (HsPParen HsPat
    p) = Doc -> Doc
    parens (Doc -> Doc) -> (HsPat -> Doc) -> HsPat -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty (HsPat -> Doc) -> HsPat -> Doc
    forall a b. (a -> b) -> a -> b
    $ HsPat
    p
            prettyPrec Int
    _ (HsPRec HsQName
    c [HsPatField]
    fields) =
                    HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    c Doc -> Doc -> Doc
    <<>> ([Doc] -> Doc
    braceList ([Doc] -> Doc) -> ([HsPatField] -> [Doc]) -> [HsPatField] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsPatField -> Doc) -> [HsPatField] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsPatField -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsPatField] -> Doc) -> [HsPatField] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsPatField]
    fields)
            -- special case that would otherwise be buggy
            prettyPrec Int
    _ (HsPAsPat HsName
    name (HsPIrrPat HsPat
    pat)) =
                    [Doc] -> Doc
    myFsep [HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '@', Char -> Doc
    char Char
    '~' Doc -> Doc -> Doc
    <<>> HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    pat]
            prettyPrec Int
    _ (HsPAsPat HsName
    name HsPat
    pat) =
                    [Doc] -> Doc
    hcat [HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    name, Char -> Doc
    char Char
    '@', HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    pat]
            prettyPrec Int
    _ HsPat
    HsPWildCard = Char -> Doc
    char Char
    '_'
            prettyPrec Int
    _ (HsPIrrPat HsPat
    pat) = Char -> Doc
    char Char
    '~' Doc -> Doc -> Doc
    <<>> HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    pat

    instance Pretty HsPatField where
            pretty :: HsPatField -> Doc
    pretty (HsPFieldPat HsQName
    name HsPat
    pat) =
                    [Doc] -> Doc
    myFsep [HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name, Doc
    equals, HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    pat]

    ------------------------- Case bodies  -------------------------
    instance Pretty HsAlt where
            pretty :: HsAlt -> Doc
    pretty (HsAlt SrcLoc
    _pos HsPat
    e HsGuardedAlts
    gAlts [HsDecl]
    decls) =
                    [Doc] -> Doc
    myFsep [HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    e, HsGuardedAlts -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsGuardedAlts
    gAlts] Doc -> Doc -> Doc
    $$$ [HsDecl] -> Doc
    ppWhere [HsDecl]
    decls

    instance Pretty HsGuardedAlts where
            pretty :: HsGuardedAlts -> Doc
    pretty (HsUnGuardedAlt HsExp
    e)      = String -> Doc
    text String
    "->" Doc -> Doc -> Doc
    <+> HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e
            pretty (HsGuardedAlts [HsGuardedAlt]
    altList) = [Doc] -> Doc
    myVcat ([Doc] -> Doc)
    -> ([HsGuardedAlt] -> [Doc]) -> [HsGuardedAlt] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsGuardedAlt -> Doc) -> [HsGuardedAlt] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsGuardedAlt -> Doc
    forall a. Pretty a => a -> Doc
    pretty ([HsGuardedAlt] -> Doc) -> [HsGuardedAlt] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [HsGuardedAlt]
    altList

    instance Pretty HsGuardedAlt where
            pretty :: HsGuardedAlt -> Doc
    pretty (HsGuardedAlt SrcLoc
    _pos HsExp
    e HsExp
    body) =
                    [Doc] -> Doc
    myFsep [Char -> Doc
    char Char
    '|', HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e, String -> Doc
    text String
    "->", HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    body]

    ------------------------- Statements in monads & list comprehensions -----
    instance Pretty HsStmt where
            pretty :: HsStmt -> Doc
    pretty (HsGenerator SrcLoc
    _loc HsPat
    e HsExp
    from) =
                    HsPat -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsPat
    e Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "<-" Doc -> Doc -> Doc
    <+> HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    from
            pretty (HsQualifier HsExp
    e) = HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e
            pretty (HsLetStmt [HsDecl]
    declList) =
                    String -> Doc
    text String
    "let" Doc -> Doc -> Doc
    $$$ (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    letIndent ((HsDecl -> Doc) -> [HsDecl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsDecl -> Doc
    forall a. Pretty a => a -> Doc
    pretty [HsDecl]
    declList)

    ------------------------- Record updates
    instance Pretty HsFieldUpdate where
            pretty :: HsFieldUpdate -> Doc
    pretty (HsFieldUpdate HsQName
    name HsExp
    e) =
                    [Doc] -> Doc
    myFsep [HsQName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsQName
    name, Doc
    equals, HsExp -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsExp
    e]

    ------------------------- Names -------------------------
    instance Pretty HsQOp where
            pretty :: HsQOp -> Doc
    pretty (HsQVarOp HsQName
    n) = HsQName -> Doc
    ppHsQNameInfix HsQName
    n
            pretty (HsQConOp HsQName
    n) = HsQName -> Doc
    ppHsQNameInfix HsQName
    n

    ppHsQNameInfix :: HsQName -> Doc
    ppHsQNameInfix :: HsQName -> Doc
    ppHsQNameInfix HsQName
    name
            | HsName -> Bool
    isSymbolName (HsQName -> HsName
    getName HsQName
    name) = HsQName -> Doc
    ppHsQName HsQName
    name
            | Bool
    otherwise = Char -> Doc
    char Char
    '`' Doc -> Doc -> Doc
    <<>> HsQName -> Doc
    ppHsQName HsQName
    name Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '`'

    instance Pretty HsQName where
            pretty :: HsQName -> Doc
    pretty HsQName
    name = Bool -> Doc -> Doc
    parensIf (HsName -> Bool
    isSymbolName (HsQName -> HsName
    getName HsQName
    name)) (HsQName -> Doc
    ppHsQName HsQName
    name)

    ppHsQName :: HsQName -> Doc
    ppHsQName :: HsQName -> Doc
    ppHsQName (UnQual HsName
    name) = HsName -> Doc
    ppHsName HsName
    name
    ppHsQName (Qual Module
    m HsName
    name) = Module -> Doc
    forall a. Pretty a => a -> Doc
    pretty Module
    m Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '.' Doc -> Doc -> Doc
    <<>> HsName -> Doc
    ppHsName HsName
    name
    ppHsQName (Special HsSpecialCon
    sym) = String -> Doc
    text (HsSpecialCon -> String
    specialName HsSpecialCon
    sym)

    instance Pretty HsOp where
            pretty :: HsOp -> Doc
    pretty (HsVarOp HsName
    n) = HsName -> Doc
    ppHsNameInfix HsName
    n
            pretty (HsConOp HsName
    n) = HsName -> Doc
    ppHsNameInfix HsName
    n

    ppHsNameInfix :: HsName -> Doc
    ppHsNameInfix :: HsName -> Doc
    ppHsNameInfix HsName
    name
            | HsName -> Bool
    isSymbolName HsName
    name = HsName -> Doc
    ppHsName HsName
    name
            | Bool
    otherwise = Char -> Doc
    char Char
    '`' Doc -> Doc -> Doc
    <<>> HsName -> Doc
    ppHsName HsName
    name Doc -> Doc -> Doc
    <<>> Char -> Doc
    char Char
    '`'

    instance Pretty HsName where
            pretty :: HsName -> Doc
    pretty HsName
    name = Bool -> Doc -> Doc
    parensIf (HsName -> Bool
    isSymbolName HsName
    name) (HsName -> Doc
    ppHsName HsName
    name)

    ppHsName :: HsName -> Doc
    ppHsName :: HsName -> Doc
    ppHsName (HsIdent String
    s)  = String -> Doc
    text String
    s
    ppHsName (HsSymbol String
    s) = String -> Doc
    text String
    s

    instance Pretty HsCName where
            pretty :: HsCName -> Doc
    pretty (HsVarName HsName
    n) = HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    n
            pretty (HsConName HsName
    n) = HsName -> Doc
    forall a. Pretty a => a -> Doc
    pretty HsName
    n

    isSymbolName :: HsName -> Bool
    isSymbolName :: HsName -> Bool
    isSymbolName (HsSymbol String
    _) = Bool
    True
    isSymbolName HsName
    _            = Bool
    False

    getName :: HsQName -> HsName
    getName :: HsQName -> HsName
    getName (UnQual HsName
    s)         = HsName
    s
    getName (Qual Module
    _ HsName
    s)         = HsName
    s
    getName (Special HsSpecialCon
    HsCons)   = String -> HsName
    HsSymbol String
    ":"
    getName (Special HsSpecialCon
    HsFunCon) = String -> HsName
    HsSymbol String
    "->"
    getName (Special HsSpecialCon
    s)        = String -> HsName
    HsIdent (HsSpecialCon -> String
    specialName HsSpecialCon
    s)

    specialName :: HsSpecialCon -> String
    specialName :: HsSpecialCon -> String
    specialName HsSpecialCon
    HsUnitCon      = String
    "()"
    specialName HsSpecialCon
    HsListCon      = String
    "[]"
    specialName HsSpecialCon
    HsFunCon       = String
    "->"
    specialName (HsTupleCon Int
    n) = String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Char
    ',' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
    specialName HsSpecialCon
    HsCons         = String
    ":"

    ppHsContext :: HsContext -> Doc
    ppHsContext :: HsContext -> Doc
    ppHsContext []      = Doc
    empty
    ppHsContext HsContext
    context = [Doc] -> Doc
    mySep [[Doc] -> Doc
    parenList ((HsAsst -> Doc) -> HsContext -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsAsst -> Doc
    ppHsAsst HsContext
    context), String -> Doc
    text String
    "=>"]

    -- hacked for multi-parameter type classes

    ppHsAsst :: HsAsst -> Doc
    ppHsAsst :: HsAsst -> Doc
    ppHsAsst (HsQName
    a,[HsType]
    ts) = [Doc] -> Doc
    myFsep (HsQName -> Doc
    ppHsQName HsQName
    a Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (HsType -> Doc) -> [HsType] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map HsType -> Doc
    ppHsAType [HsType]
    ts)

    ------------------------- pp utils -------------------------
    maybePP :: (a -> Doc) -> Maybe a -> Doc
    maybePP :: forall a. (a -> Doc) -> Maybe a -> Doc
    maybePP a -> Doc
    _ Maybe a
    Nothing   = Doc
    empty
    maybePP a -> Doc
    pp (Just a
    a) = a -> Doc
    pp a
    a

    parenList :: [Doc] -> Doc
    parenList :: [Doc] -> Doc
    parenList = Doc -> Doc
    parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma

    braceList :: [Doc] -> Doc
    braceList :: [Doc] -> Doc
    braceList = Doc -> Doc
    braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    myFsepSimple ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    comma

    bracketList :: [Doc] -> Doc
    bracketList :: [Doc] -> Doc
    bracketList = Doc -> Doc
    brackets (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    myFsepSimple

    -- Wrap in braces and semicolons, with an extra space at the start in
    -- case the first doc begins with "-", which would be scanned as {-
    flatBlock :: [Doc] -> Doc
    flatBlock :: [Doc] -> Doc
    flatBlock = Doc -> Doc
    braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Doc
    space Doc -> Doc -> Doc
    <<>>) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    semi

    -- Same, but put each thing on a separate line
    prettyBlock :: [Doc] -> Doc
    prettyBlock :: [Doc] -> Doc
    prettyBlock = Doc -> Doc
    braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Doc
    space Doc -> Doc -> Doc
    <<>>) (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    semi

    -- Monadic PP Combinators -- these examine the env

    blankline :: Doc -> Doc
    blankline :: Doc -> Doc
    blankline Doc
    dl = do{e<-DocM PPHsMode PPHsMode
    forall s. DocM s s
    getPPEnv;if spacing e && layout e /= PPNoLayout
                                  then space $$ dl else dl}
    topLevel :: Doc -> [Doc] -> Doc
    topLevel :: Doc -> [Doc] -> Doc
    topLevel Doc
    header [Doc]
    dl = do
             e <- (PPHsMode -> PPLayout)
    -> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
    forall a b. (a -> b) -> DocM PPHsMode a -> DocM PPHsMode b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PPHsMode -> PPLayout
    layout DocM PPHsMode PPHsMode
    forall s. DocM s s
    getPPEnv
             case e of
                 PPLayout
    PPOffsideRule -> Doc
    header Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat [Doc]
    dl
                 PPLayout
    PPSemiColon   -> Doc
    header Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    prettyBlock [Doc]
    dl
                 PPLayout
    PPInLine      -> Doc
    header Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    prettyBlock [Doc]
    dl
                 PPLayout
    PPNoLayout    -> Doc
    header Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    flatBlock [Doc]
    dl

    ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody :: (PPHsMode -> Int) -> [Doc] -> Doc
    ppBody PPHsMode -> Int
    f [Doc]
    dl = do
            e <- (PPHsMode -> PPLayout)
    -> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
    forall a b. (a -> b) -> DocM PPHsMode a -> DocM PPHsMode b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PPHsMode -> PPLayout
    layout DocM PPHsMode PPHsMode
    forall s. DocM s s
    getPPEnv
            i <- fmap f getPPEnv
            case e of
                PPLayout
    PPOffsideRule -> Int -> Doc -> Doc
    nest Int
    i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc]
    dl
                PPLayout
    PPSemiColon   -> Int -> Doc -> Doc
    nest Int
    i (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc] -> Doc
    prettyBlock ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc]
    dl
                PPLayout
    _             -> [Doc] -> Doc
    flatBlock [Doc]
    dl

    ppBindings :: [Doc] -> Doc
    ppBindings :: [Doc] -> Doc
    ppBindings [Doc]
    dl = do
            e <- (PPHsMode -> PPLayout)
    -> DocM PPHsMode PPHsMode -> DocM PPHsMode PPLayout
    forall a b. (a -> b) -> DocM PPHsMode a -> DocM PPHsMode b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PPHsMode -> PPLayout
    layout DocM PPHsMode PPHsMode
    forall s. DocM s s
    getPPEnv
            case e of
                PPLayout
    PPOffsideRule -> [Doc] -> Doc
    vcat [Doc]
    dl
                PPLayout
    PPSemiColon   -> [Doc] -> Doc
    vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    semi ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc]
    dl
                PPLayout
    _             -> [Doc] -> Doc
    hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    punctuate Doc
    semi ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc]
    dl

    ($$$) :: Doc -> Doc -> Doc
    Doc
    a $$$ :: Doc -> Doc -> Doc
    $$$ Doc
    b = (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
    layoutChoice (Doc
    a Doc -> Doc -> Doc
    $$) (Doc
    a Doc -> Doc -> Doc
    <+>) Doc
    b

    mySep :: [Doc] -> Doc
    mySep :: [Doc] -> Doc
    mySep = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
    layoutChoice [Doc] -> Doc
    mySep' [Doc] -> Doc
    hsep
            where
            -- ensure paragraph fills with indentation.
            mySep' :: [Doc] -> Doc
    mySep' [Doc
    x]    = Doc
    x
            mySep' (Doc
    x:[Doc]
    xs) = Doc
    x Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    fsep [Doc]
    xs
            mySep' []     = String -> Doc
    forall a. HasCallStack => String -> a
    error String
    "Internal error: mySep"

    myVcat :: [Doc] -> Doc
    myVcat :: [Doc] -> Doc
    myVcat = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
    layoutChoice [Doc] -> Doc
    vcat [Doc] -> Doc
    hsep

    myFsepSimple :: [Doc] -> Doc
    myFsepSimple :: [Doc] -> Doc
    myFsepSimple = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
    layoutChoice [Doc] -> Doc
    fsep [Doc] -> Doc
    hsep

    -- same, except that continuation lines are indented,
    -- which is necessary to avoid triggering the offside rule.
    myFsep :: [Doc] -> Doc
    myFsep :: [Doc] -> Doc
    myFsep = ([Doc] -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
    layoutChoice [Doc] -> Doc
    fsep' [Doc] -> Doc
    hsep
            where   fsep' :: [Doc] -> Doc
    fsep' [] = Doc
    empty
                    fsep' (Doc
    d:[Doc]
    ds) = do
                            e <- DocM PPHsMode PPHsMode
    forall s. DocM s s
    getPPEnv
                            let n = PPHsMode -> Int
    onsideIndent PPHsMode
    e
                            nest n (fsep (nest (-n) d:ds))

    layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc
    layoutChoice :: forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
    layoutChoice a -> Doc
    a a -> Doc
    b a
    dl = do e <- DocM PPHsMode PPHsMode
    forall s. DocM s s
    getPPEnv
                             if layout e == PPOffsideRule ||
                                layout e == PPSemiColon
                              then a dl else b dl

    -- Prefix something with a LINE pragma, if requested.
    -- GHC's LINE pragma actually sets the current line number to n-1, so
    -- that the following line is line n.  But if there's no newline before
    -- the line we're talking about, we need to compensate by adding 1.

    markLine :: SrcLoc -> Doc -> Doc
    markLine :: SrcLoc -> Doc -> Doc
    markLine SrcLoc
    loc Doc
    doc = do
            e <- DocM PPHsMode PPHsMode
    forall s. DocM s s
    getPPEnv
            let y = SrcLoc -> Int
    srcLine SrcLoc
    loc
            let line a
    l =
                  String -> Doc
    text (String
    "{-# LINE " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SrcLoc -> String
    srcFilename SrcLoc
    loc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\" #-}")
            if linePragmas e then layoutChoice (line y $$) (line (y+1) <+>) doc
                  else doc