    {-# LANGUAGE MagicHash #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.Utils.Ppr
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  David Terei <code@davidterei.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- John Hughes's and Simon Peyton Jones's Pretty Printer Combinators
    --
    -- Based on /The Design of a Pretty-printing Library/
    -- in Advanced Functional Programming,
    -- Johan Jeuring and Erik Meijer (eds), LNCS 925
    -- <http://www.cse.chalmers.se/~rjmh/Papers/pretty.ps>
    --
    -----------------------------------------------------------------------------

    {-
    Note [Differences between libraries/pretty and compiler/GHC/Utils/Ppr.hs]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For historical reasons, there are two different copies of `Pretty` in the GHC
    source tree:
     * `libraries/pretty` is a submodule containing
       https://github.com/haskell/pretty. This is the `pretty` library as released
       on hackage. It is used by several other libraries in the GHC source tree
       (e.g. template-haskell and Cabal).
     * `compiler/GHC/Utils/Ppr.hs` (this module). It is used by GHC only.

    There is an ongoing effort in https://github.com/haskell/pretty/issues/1 and
    https://gitlab.haskell.org/ghc/ghc/issues/10735 to try to get rid of GHC's copy
    of Pretty.

    Currently, GHC's copy of Pretty resembles pretty-1.1.2.0, with the following
    major differences:
     * GHC's copy uses `Faststring` for performance reasons.
     * GHC's copy has received a backported bugfix for #12227, which was
       released as pretty-1.1.3.4 ("Remove harmful $! forcing in beside",
       https://github.com/haskell/pretty/pull/35).

    Other differences are minor. Both copies define some extra functions and
    instances not defined in the other copy. To see all differences, do this in a
    ghc git tree:

        $ cd libraries/pretty
        $ git checkout v1.1.2.0
        $ cd -
        $ vimdiff compiler/GHC/Utils/Ppr.hs \
                  libraries/pretty/src/Text/PrettyPrint/HughesPJ.hs

    For parity with `pretty-1.1.2.1`, the following two `pretty` commits would
    have to be backported:
      * "Resolve foldr-strictness stack overflow bug"
        (307b8173f41cd776eae8f547267df6d72bff2d68)
      * "Special-case reduce for horiz/vert"
        (c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c)
    This has not been done sofar, because these commits seem to cause more
    allocation in the compiler (see thomie's comments in
    https://github.com/haskell/pretty/pull/9).
    -}

    module GHC.Utils.Ppr (

            -- * The document type
            Doc, TextDetails(..),

            -- * Constructing documents

            -- ** Converting values into documents
            char, text, ftext, ptext, ztext, sizedText, zeroWidthText, emptyText,
            int, integer, float, double, rational, hex,

            -- ** Simple derived documents
            semi, comma, colon, space, equals,
            lparen, rparen, lbrack, rbrack, lbrace, rbrace,

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

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

            -- * Predicates on documents
            isEmpty,
            docHead,

            -- * Rendering documents

            -- ** Rendering with a particular style
            Style(..),
            style,
            renderStyle,
            Mode(..),

            -- ** General rendering
            fullRender, txtPrinter,

            -- ** GHC-specific rendering
            printDoc, printDoc_,
            bufLeftRender, printLeftRender -- performance hack

      ) where

    import GHC.Prelude.Basic hiding (error)
    import Control.Applicative ((<|>))

    import GHC.Utils.BufHandle
    import GHC.Data.FastString
    import GHC.Utils.Panic.Plain
    import System.IO
    import Numeric (showHex)

    --for a RULES
    import GHC.Base ( unpackCString#, unpackNBytes#, Int(..) )
    import GHC.Ptr  ( Ptr(..) )

    -- ---------------------------------------------------------------------------
    -- The Doc calculus

    {-
    Laws for $$
    ~~~~~~~~~~~
    <a1>    (x $$ y) $$ z   = x $$ (y $$ z)
    <a2>    empty $$ x      = x
    <a3>    x $$ empty      = x

            ...ditto $+$...

    Laws for <>
    ~~~~~~~~~~~
    <b1>    (x <> y) <> z   = x <> (y <> z)
    <b2>    empty <> x      = empty
    <b3>    x <> empty      = x

            ...ditto <+>...

    Laws for text
    ~~~~~~~~~~~~~
    <t1>    text s <> text t        = text (s++t)
    <t2>    text "" <> x            = x, if x non-empty

    ** because of law n6, t2 only holds if x doesn't
    ** start with `nest'.

    Laws for nest
    ~~~~~~~~~~~~~
    <n1>    nest 0 x                = x
    <n2>    nest k (nest k' x)      = nest (k+k') x
    <n3>    nest k (x <> y)         = nest k x <> nest k y
    <n4>    nest k (x $$ y)         = nest k x $$ nest k y
    <n5>    nest k empty            = empty
    <n6>    x <> nest k y           = x <> y, if x non-empty

    ** Note the side condition on <n6>!  It is this that
    ** makes it OK for empty to be a left unit for <>.

    Miscellaneous
    ~~~~~~~~~~~~~
    <m1>    (text s <> x) $$ y = text s <> ((text "" <> x) $$
                                             nest (-length s) y)

    <m2>    (x $$ y) <> z = x $$ (y <> z)
            if y non-empty

    Laws for list versions
    ~~~~~~~~~~~~~~~~~~~~~~
    <l1>    sep (ps++[empty]++qs)   = sep (ps ++ qs)
            ...ditto hsep, hcat, vcat, fill...

    <l2>    nest k (sep ps) = sep (map (nest k) ps)
            ...ditto hsep, hcat, vcat, fill...

    Laws for oneLiner
    ~~~~~~~~~~~~~~~~~
    <o1>    oneLiner (nest k p) = nest k (oneLiner p)
    <o2>    oneLiner (x <> y)   = oneLiner x <> oneLiner y

    You might think that the following version of <m1> would
    be neater:

    <3 NO>  (text s <> x) $$ y = text s <> ((empty <> x)) $$
                                             nest (-length s) y)

    But it doesn't work, for if x=empty, we would have

            text s $$ y = text s <> (empty $$ nest (-length s) y)
                        = text s <> nest (-length s) y
    -}

    -- ---------------------------------------------------------------------------
    -- Operator fixity

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

    -- ---------------------------------------------------------------------------
    -- The Doc data type

    -- | The abstract type of documents.
    -- A Doc represents a *set* of layouts. A Doc with
    -- no occurrences of Union or NoDoc represents just one layout.
    data Doc
      = Empty                                            -- empty
      | NilAbove Doc                                     -- text "" $$ x
      | TextBeside !TextDetails {-# UNPACK #-} !Int Doc  -- text s <> x
      | Nest {-# UNPACK #-} !Int Doc                     -- nest k x
      | Union Doc Doc                                    -- ul `union` ur
      | NoDoc                                            -- The empty set of documents
      | Beside Doc Bool Doc                              -- True <=> space between
      | Above Doc Bool Doc                               -- True <=> never overlap

    {-
    Here are the invariants:

    1) The argument of NilAbove is never Empty. Therefore
       a NilAbove occupies at least two lines.

    2) The argument of @TextBeside@ is never @Nest@.

    3) The layouts of the two arguments of @Union@ both flatten to the same
       string.

    4) The arguments of @Union@ are either @TextBeside@, or @NilAbove@.

    5) A @NoDoc@ may only appear on the first line of the left argument of an
       union. Therefore, the right argument of an union can never be equivalent
       to the empty set (@NoDoc@).

    6) An empty document is always represented by @Empty@.  It can't be
       hidden inside a @Nest@, or a @Union@ of two @Empty@s.

    7) The first line of every layout in the left argument of @Union@ is
       longer than the first line of any layout in the right argument.
       (1) ensures that the left argument has a first line.  In view of
       (3), this invariant means that the right argument must have at
       least two lines.

    Notice the difference between
       * NoDoc (no documents)
       * Empty (one empty document; no height and no width)
       * text "" (a document containing the empty string;
                  one line high, but has no width)
    -}

    -- | RDoc is a "reduced GDoc", guaranteed not to have a top-level Above or Beside.
    type RDoc = Doc

    -- | The TextDetails data type
    --
    -- A TextDetails represents a fragment of text that will be
    -- output at some point.
    data TextDetails = Chr  {-# UNPACK #-} !Char -- ^ A single Char fragment
                     | Str  String -- ^ A whole String fragment
                     | PStr FastString                      -- a hashed string
                     | ZStr FastZString                     -- a z-encoded string
                     | LStr {-# UNPACK #-} !PtrString
                       -- a '\0'-terminated array of bytes
                     | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char
                       -- a repeated character (e.g., ' ')

    instance Show Doc where
      showsPrec :: Int -> Doc -> ShowS
    showsPrec Int
    _ Doc
    doc String
    cont = Mode
    -> Int
    -> Float
    -> (TextDetails -> ShowS)
    -> String
    -> Doc
    -> String
    forall a.
    Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
    fullRender (Style -> Mode
    mode Style
    style) (Style -> Int
    lineLength Style
    style)
                                        (Style -> Float
    ribbonsPerLine Style
    style)
                                        TextDetails -> ShowS
    txtPrinter String
    cont Doc
    doc

    -- ---------------------------------------------------------------------------
    -- Values and Predicates on GDocs and TextDetails

    -- | A document of height and width 1, containing a literal character.
    char :: Char -> Doc
    char :: Char -> Doc
    char Char
    c = TextDetails -> Int -> Doc -> Doc
    textBeside_ (Char -> TextDetails
    Chr Char
    c) Int
    1 Doc
    Empty

    -- | A document of height 1 containing a literal string.
    -- 'text' satisfies the following laws:
    --
    -- * @'text' s '<>' 'text' t = 'text' (s'++'t)@
    --
    -- * @'text' \"\" '<>' x = x@, if @x@ non-empty
    --
    -- The side condition on the last law is necessary because @'text' \"\"@
    -- has height 1, while 'empty' has no height.
    text :: String -> Doc
    text :: String -> Doc
    text String
    s = TextDetails -> Int -> Doc -> Doc
    textBeside_ (String -> TextDetails
    Str String
    s) (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s) Doc
    Empty
    {-# NOINLINE [0] text #-}   -- Give the RULE a chance to fire
                                -- It must wait till after phase 1 when
                                -- the unpackCString first is manifested

    -- RULE that turns (text "abc") into (ptext (A# "abc"#)) to avoid the
    -- intermediate packing/unpacking of the string.
    {-# RULES "text/str"
        forall a. text (unpackCString# a)  = ptext (mkPtrString# a)
      #-}
    {-# RULES "text/unpackNBytes#"
        forall p n. text (unpackNBytes# p n) = ptext (PtrString (Ptr p) (I# n))
      #-}

    -- Empty strings are desugared into [] (not "unpackCString#..."), hence they are
    -- not matched by the text/str rule above.
    {-# RULES "text/[]"
        text [] = emptyText
      #-}

    ftext :: FastString -> Doc
    ftext :: FastString -> Doc
    ftext FastString
    s = TextDetails -> Int -> Doc -> Doc
    textBeside_ (FastString -> TextDetails
    PStr FastString
    s) (FastString -> Int
    lengthFS FastString
    s) Doc
    Empty

    ptext :: PtrString -> Doc
    ptext :: PtrString -> Doc
    ptext PtrString
    s = TextDetails -> Int -> Doc -> Doc
    textBeside_ (PtrString -> TextDetails
    LStr PtrString
    s) (PtrString -> Int
    lengthPS PtrString
    s) Doc
    Empty

    ztext :: FastZString -> Doc
    ztext :: FastZString -> Doc
    ztext FastZString
    s = TextDetails -> Int -> Doc -> Doc
    textBeside_ (FastZString -> TextDetails
    ZStr FastZString
    s) (FastZString -> Int
    lengthFZS FastZString
    s) Doc
    Empty

    -- | Some text with any width. (@text s = sizedText (length s) s@)
    sizedText :: Int -> String -> Doc
    sizedText :: Int -> String -> Doc
    sizedText Int
    l String
    s = TextDetails -> Int -> Doc -> Doc
    textBeside_ (String -> TextDetails
    Str String
    s) Int
    l Doc
    Empty

    -- | Some text, but without any width. Use for non-printing text
    -- such as a HTML or Latex tags
    zeroWidthText :: String -> Doc
    zeroWidthText :: String -> Doc
    zeroWidthText = Int -> String -> Doc
    sizedText Int
    0

    -- | Empty text (one line high but no width). (@emptyText = text ""@)
    emptyText :: Doc
    emptyText :: Doc
    emptyText = Int -> String -> Doc
    sizedText Int
    0 []
      -- defined as a CAF. Sharing occurs especially via the text/[] rule above.
      -- Every use of `text ""` in user code should be replaced with this.

    -- | The empty document, with no height and no width.
    -- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere
    -- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.
    empty :: Doc
    empty :: Doc
    empty = Doc
    Empty

    -- | Returns 'True' if the document is empty
    isEmpty :: Doc -> Bool
    isEmpty :: Doc -> Bool
    isEmpty Doc
    Empty = Bool
    True
    isEmpty Doc
    _     = Bool
    False

    -- | Get the first character of a document. We also return a new document,
    -- equivalent to the original one but faster to render. Use it to avoid work
    -- duplication.
    docHead :: Doc -> (Maybe Char, Doc)
    docHead :: Doc -> (Maybe Char, Doc)
    docHead Doc
    d = (Maybe Char
    headChar, Doc
    rdoc)
      where
        rdoc :: Doc
    rdoc = Doc -> Doc
    reduceDoc Doc
    d
        headChar :: Maybe Char
    headChar = Doc -> Maybe Char
    go Doc
    rdoc

        go :: RDoc -> Maybe Char
        go :: Doc -> Maybe Char
    go (Union Doc
    p Doc
    q)  = Doc -> Maybe Char
    go (Doc -> Doc -> Doc
    first Doc
    p Doc
    q)
        go (Nest Int
    _ Doc
    p)   = Doc -> Maybe Char
    go Doc
    p
        go Doc
    Empty        = Maybe Char
    forall a. Maybe a
    Nothing
        go (NilAbove Doc
    _) = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    '\n'
        go (TextBeside TextDetails
    td Int
    _ Doc
    p) = TextDetails -> Maybe Char
    go_td TextDetails
    td Maybe Char -> Maybe Char -> Maybe Char
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Doc -> Maybe Char
    go Doc
    p
        go Doc
    NoDoc       = String -> Maybe Char
    forall a. String -> a
    error String
    "docHead: NoDoc"
        go (Above {})  = String -> Maybe Char
    forall a. String -> a
    error String
    "docHead: Above"
        go (Beside {}) = String -> Maybe Char
    forall a. String -> a
    error String
    "docHead: Beside"

        go_td :: TextDetails -> Maybe Char
        go_td :: TextDetails -> Maybe Char
    go_td (Chr Char
    c)  = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c
        go_td (Str String
    s)  = String -> Maybe Char
    go_str String
    s
        go_td (PStr FastString
    s) = String -> Maybe Char
    go_str (FastString -> String
    unpackFS FastString
    s) -- O(1) because unpackFS is lazy
        go_td (ZStr FastZString
    s) = String -> Maybe Char
    go_str (Int -> FastZString -> String
    zStringTakeN Int
    1 FastZString
    s)
        go_td (LStr PtrString
    s) = String -> Maybe Char
    go_str (Int -> PtrString -> String
    unpackPtrStringTakeN Int
    1 PtrString
    s)
        go_td (RStr Int
    n Char
    c) = if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c else Maybe Char
    forall a. Maybe a
    Nothing

        go_str :: String -> Maybe Char
        go_str :: String -> Maybe Char
    go_str []    = Maybe Char
    forall a. Maybe a
    Nothing
        go_str (Char
    c:String
    _) = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c

    {-
    Q: What is the reason for negative indentation (i.e. argument to indent
       is < 0) ?

    A:
    This indicates an error in the library client's code.
    If we compose a <> b, and the first line of b is more indented than some
    other lines of b, the law <n6> (<> eats nests) may cause the pretty
    printer to produce an invalid layout:

    doc       |0123345
    ------------------
    d1        |a...|
    d2        |...b|
              |c...|

    d1<>d2    |ab..|
             c|....|

    Consider a <> b, let `s' be the length of the last line of `a', `k' the
    indentation of the first line of b, and `k0' the indentation of the
    left-most line b_i of b.

    The produced layout will have negative indentation if `k - k0 > s', as
    the first line of b will be put on the (s+1)th column, effectively
    translating b horizontally by (k-s). Now if the i^th line of b has an
    indentation k0 < (k-s), it is translated out-of-page, causing
    `negative indentation'.
    -}

    semi   :: Doc -- ^ A ';' character
    comma  :: Doc -- ^ A ',' character
    colon  :: Doc -- ^ A ':' character
    space  :: Doc -- ^ A space character
    equals :: Doc -- ^ A '=' character
    lparen :: Doc -- ^ A '(' character
    rparen :: Doc -- ^ A ')' character
    lbrack :: Doc -- ^ A '[' character
    rbrack :: Doc -- ^ A ']' character
    lbrace :: Doc -- ^ A '{' character
    rbrace :: Doc -- ^ A '}' character
    semi :: Doc
    semi   = Char -> Doc
    char Char
    ';'
    comma :: Doc
    comma  = Char -> Doc
    char Char
    ','
    colon :: Doc
    colon  = Char -> Doc
    char Char
    ':'
    space :: Doc
    space  = Char -> Doc
    char Char
    ' '
    equals :: Doc
    equals = Char -> Doc
    char Char
    '='
    lparen :: Doc
    lparen = Char -> Doc
    char Char
    '('
    rparen :: Doc
    rparen = Char -> Doc
    char Char
    ')'
    lbrack :: Doc
    lbrack = Char -> Doc
    char Char
    '['
    rbrack :: Doc
    rbrack = Char -> Doc
    char Char
    ']'
    lbrace :: Doc
    lbrace = Char -> Doc
    char Char
    '{'
    rbrace :: Doc
    rbrace = Char -> Doc
    char Char
    '}'

    spaceText, nlText :: TextDetails
    spaceText :: TextDetails
    spaceText = Char -> TextDetails
    Chr Char
    ' '
    nlText :: TextDetails
    nlText    = Char -> TextDetails
    Chr Char
    '\n'

    int      :: Int      -> Doc -- ^ @int n = text (show n)@
    integer  :: Integer  -> Doc -- ^ @integer n = text (show n)@
    float    :: Float    -> Doc -- ^ @float n = text (show n)@
    double   :: Double   -> Doc -- ^ @double n = text (show n)@
    rational :: Rational -> Doc -- ^ @rational n = text (show n)@
    hex      :: Integer  -> Doc -- ^ See Note [Print Hexadecimal Literals]
    int :: Int -> Doc
    int      Int
    n = String -> Doc
    text (Int -> String
    forall a. Show a => a -> String
    show Int
    n)
    integer :: Integer -> Doc
    integer  Integer
    n = String -> Doc
    text (Integer -> String
    forall a. Show a => a -> String
    show Integer
    n)
    float :: Float -> Doc
    float    Float
    n = String -> Doc
    text (Float -> String
    forall a. Show a => a -> String
    show Float
    n)
    double :: Double -> Doc
    double   Double
    n = String -> Doc
    text (Double -> String
    forall a. Show a => a -> String
    show Double
    n)
    rational :: Rational -> Doc
    rational Rational
    n = String -> Doc
    text (Rational -> String
    forall a. Show a => a -> String
    show Rational
    n)
    hex :: Integer -> Doc
    hex      Integer
    n = String -> Doc
    text (Char
    '0' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    'x' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    padded)
        where
        str :: String
    str = Integer -> ShowS
    forall a. Integral a => a -> ShowS
    showHex Integer
    n String
    ""
        strLen :: Int
    strLen = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str)
        len :: Int
    len = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (Double -> Double -> Double
    forall a. Floating a => a -> a -> a
    logBase Double
    2 (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    strLen :: Double)) :: Int)
        padded :: String
    padded = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    strLen) Char
    '0' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    str

    parens       :: Doc -> Doc -- ^ Wrap document in @(...)@
    brackets     :: Doc -> Doc -- ^ Wrap document in @[...]@
    braces       :: Doc -> Doc -- ^ Wrap document in @{...}@
    quotes       :: Doc -> Doc -- ^ Wrap document in @\`...\'@
    squotes      :: Doc -> Doc -- ^ Wrap document in @\'...\'@
    quote        :: Doc -> Doc
    doubleQuotes :: Doc -> Doc -- ^ Wrap document in @\"...\"@
    quotes :: Doc -> Doc
    quotes Doc
    p       = Char -> Doc
    char Char
    '`' Doc -> Doc -> Doc
    <> Doc
    p Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '\''
    squotes :: Doc -> Doc
    squotes Doc
    p      = Char -> Doc
    char Char
    '\'' Doc -> Doc -> Doc
    <> Doc
    p Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '\''
    quote :: Doc -> Doc
    quote Doc
    p        = Char -> Doc
    char Char
    '\'' Doc -> Doc -> Doc
    <> Doc
    p
    doubleQuotes :: Doc -> Doc
    doubleQuotes Doc
    p = Char -> Doc
    char Char
    '"' Doc -> Doc -> Doc
    <> Doc
    p Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '"'
    parens :: Doc -> Doc
    parens Doc
    p       = Char -> Doc
    char Char
    '(' Doc -> Doc -> Doc
    <> Doc
    p Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ')'
    brackets :: Doc -> Doc
    brackets Doc
    p     = Char -> Doc
    char Char
    '[' Doc -> Doc -> Doc
    <> Doc
    p Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ']'
    braces :: Doc -> Doc
    braces Doc
    p       = Char -> Doc
    char Char
    '{' Doc -> Doc -> Doc
    <> Doc
    p Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '}'

    {-
    Note [Print Hexadecimal Literals]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Relevant discussions:
     * Phabricator: https://phabricator.haskell.org/D4465
     * GHC Trac: https://gitlab.haskell.org/ghc/ghc/issues/14872

    There is a flag `-dhex-word-literals` that causes literals of
    type `Word#` or `Word64#` to be displayed in hexadecimal instead
    of decimal when dumping GHC core. It also affects the presentation
    of these in GHC's error messages. Additionally, the hexadecimal
    encoding of these numbers is zero-padded so that its length is
    a power of two. As an example of what this does,
    consider the following haskell file `Literals.hs`:

        module Literals where

        alpha :: Int
        alpha = 100 + 200

        beta :: Word -> Word
        beta x = x + div maxBound 255 + div 0xFFFFFFFF 255 + 0x0202

    We get the following dumped core when we compile on a 64-bit
    machine with ghc -O2 -fforce-recomp -ddump-simpl -dsuppress-all
    -dhex-word-literals literals.hs:

        ==================== Tidy Core ====================

        ... omitted for brevity ...

        -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
        alpha
        alpha = I# 300#

        -- RHS size: {terms: 12, types: 3, coercions: 0, joins: 0/0}
        beta
        beta
          = \ x_aYE ->
              case x_aYE of { W# x#_a1v0 ->
              W#
                (plusWord#
                   (plusWord# (plusWord# x#_a1v0 0x0101010101010101##) 0x01010101##)
                   0x0202##)
              }

    Notice that the word literals are in hexadecimals and that they have
    been padded with zeroes so that their lengths are 16, 8, and 4, respectively.

    -}

    -- | Apply 'parens' to 'Doc' if boolean is true.
    maybeParens :: Bool -> Doc -> Doc
    maybeParens :: Bool -> Doc -> Doc
    maybeParens Bool
    False = Doc -> Doc
    forall a. a -> a
    id
    maybeParens Bool
    True = Doc -> Doc
    parens

    -- ---------------------------------------------------------------------------
    -- Structural operations on GDocs

    -- | Perform some simplification of a built up @GDoc@.
    reduceDoc :: Doc -> RDoc
    reduceDoc :: Doc -> Doc
    reduceDoc (Beside Doc
    p Bool
    g Doc
    q) = Doc
    p Doc -> Doc -> Doc
    forall a b. a -> b -> b
    `seq` Bool
    g Bool -> Doc -> Doc
    forall a b. a -> b -> b
    `seq` (Doc -> Bool -> Doc -> Doc
    beside Doc
    p Bool
    g (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $! Doc -> Doc
    reduceDoc Doc
    q)
    reduceDoc (Above  Doc
    p Bool
    g Doc
    q) = Doc
    p Doc -> Doc -> Doc
    forall a b. a -> b -> b
    `seq` Bool
    g Bool -> Doc -> Doc
    forall a b. a -> b -> b
    `seq` (Doc -> Bool -> Doc -> Doc
    above  Doc
    p Bool
    g (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $! Doc -> Doc
    reduceDoc Doc
    q)
    reduceDoc Doc
    p              = Doc
    p

    -- | List version of '<>'.
    hcat :: [Doc] -> Doc
    hcat :: [Doc] -> Doc
    hcat = Doc -> Doc
    reduceAB (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Bool -> Doc -> Doc -> Doc
    beside_' Bool
    False) Doc
    empty

    -- | List version of '<+>'.
    hsep :: [Doc] -> Doc
    hsep :: [Doc] -> Doc
    hsep = Doc -> Doc
    reduceAB (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Bool -> Doc -> Doc -> Doc
    beside_' Bool
    True)  Doc
    empty

    -- | List version of '$$'.
    vcat :: [Doc] -> Doc
    vcat :: [Doc] -> Doc
    vcat = Doc -> Doc
    reduceAB (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Bool -> Doc -> Doc -> Doc
    above_' Bool
    False) Doc
    empty

    -- | Nest (or indent) a document by a given number of positions
    -- (which may also be negative).  'nest' satisfies the laws:
    --
    -- * @'nest' 0 x = x@
    --
    -- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@
    --
    -- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@
    --
    -- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@
    --
    -- * @'nest' k 'empty' = 'empty'@
    --
    -- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty
    --
    -- The side condition on the last law is needed because
    -- 'empty' is a left identity for '<>'.
    nest :: Int -> Doc -> Doc
    nest :: Int -> Doc -> Doc
    nest Int
    k Doc
    p = Int -> Doc -> Doc
    mkNest Int
    k (Doc -> Doc
    reduceDoc Doc
    p)

    -- | @hang d1 n d2 = sep [d1, nest n d2]@
    hang :: Doc -> Int -> Doc -> Doc
    hang :: Doc -> Int -> Doc -> Doc
    hang Doc
    d1 Int
    n Doc
    d2 = [Doc] -> Doc
    sep [Doc
    d1, Int -> Doc -> Doc
    nest Int
    n Doc
    d2]

    -- | Apply 'hang' to the arguments if the first 'Doc' is not empty.
    hangNotEmpty :: Doc -> Int -> Doc -> Doc
    hangNotEmpty :: Doc -> Int -> Doc -> Doc
    hangNotEmpty Doc
    d1 Int
    n Doc
    d2 = if Doc -> Bool
    isEmpty Doc
    d1
                           then Doc
    d2
                           else Doc -> Int -> Doc -> Doc
    hang Doc
    d1 Int
    n Doc
    d2

    -- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
    punctuate :: Doc -> [Doc] -> [Doc]
    punctuate :: Doc -> [Doc] -> [Doc]
    punctuate Doc
    _ []     = []
    punctuate Doc
    p (Doc
    x:[Doc]
    xs) = Doc -> [Doc] -> [Doc]
    go Doc
    x [Doc]
    xs
                       where go :: Doc -> [Doc] -> [Doc]
    go Doc
    y []     = [Doc
    y]
                             go Doc
    y (Doc
    z:[Doc]
    zs) = (Doc
    y Doc -> Doc -> Doc
    <> Doc
    p) Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : Doc -> [Doc] -> [Doc]
    go Doc
    z [Doc]
    zs

    -- mkNest checks for Nest's invariant that it doesn't have an Empty inside it
    mkNest :: Int -> Doc -> Doc
    mkNest :: Int -> Doc -> Doc
    mkNest Int
    k Doc
    _ | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False = Doc
    forall a. HasCallStack => a
    undefined
    mkNest Int
    k (Nest Int
    k1 Doc
    p)       = Int -> Doc -> Doc
    mkNest (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    k1) Doc
    p
    mkNest Int
    _ Doc
    NoDoc             = Doc
    NoDoc
    mkNest Int
    _ Doc
    Empty             = Doc
    Empty
    mkNest Int
    0 Doc
    p                 = Doc
    p
    mkNest Int
    k Doc
    p                 = Int -> Doc -> Doc
    nest_ Int
    k Doc
    p

    -- mkUnion checks for an empty document
    mkUnion :: Doc -> Doc -> Doc
    mkUnion :: Doc -> Doc -> Doc
    mkUnion Doc
    Empty Doc
    _ = Doc
    Empty
    mkUnion Doc
    p Doc
    q     = Doc
    p Doc -> Doc -> Doc
    `union_` Doc
    q

    beside_' :: Bool -> Doc -> Doc -> Doc
    beside_' :: Bool -> Doc -> Doc -> Doc
    beside_' Bool
    _ Doc
    p Doc
    Empty = Doc
    p
    beside_' Bool
    g Doc
    p Doc
    q     = Doc -> Bool -> Doc -> Doc
    Beside Doc
    p Bool
    g Doc
    q

    above_' :: Bool -> Doc -> Doc -> Doc
    above_' :: Bool -> Doc -> Doc -> Doc
    above_' Bool
    _ Doc
    p Doc
    Empty = Doc
    p
    above_' Bool
    g Doc
    p Doc
    q     = Doc -> Bool -> Doc -> Doc
    Above Doc
    p Bool
    g Doc
    q

    reduceAB :: Doc -> Doc
    reduceAB :: Doc -> Doc
    reduceAB (Above  Doc
    Empty Bool
    _ Doc
    q) = Doc
    q
    reduceAB (Beside Doc
    Empty Bool
    _ Doc
    q) = Doc
    q
    reduceAB Doc
    doc                = Doc
    doc

    nilAbove_ :: RDoc -> RDoc
    nilAbove_ :: Doc -> Doc
    nilAbove_ = Doc -> Doc
    NilAbove

    -- Arg of a TextBeside is always an RDoc
    textBeside_ :: TextDetails -> Int -> RDoc -> RDoc
    textBeside_ :: TextDetails -> Int -> Doc -> Doc
    textBeside_ = TextDetails -> Int -> Doc -> Doc
    TextBeside

    nest_ :: Int -> RDoc -> RDoc
    nest_ :: Int -> Doc -> Doc
    nest_ = Int -> Doc -> Doc
    Nest

    union_ :: RDoc -> RDoc -> RDoc
    union_ :: Doc -> Doc -> Doc
    union_ = Doc -> Doc -> Doc
    Union

    -- ---------------------------------------------------------------------------
    -- Vertical composition @$$@

    -- | Above, except that if the last line of the first argument stops
    -- at least one position before the first line of the second begins,
    -- these two lines are overlapped.  For example:
    --
    -- >    text "hi" $$ nest 5 (text "there")
    --
    -- lays out as
    --
    -- >    hi   there
    --
    -- rather than
    --
    -- >    hi
    -- >         there
    --
    -- '$$' is associative, with identity 'empty', and also satisfies
    --
    -- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.
    --
    ($$) :: Doc -> Doc -> Doc
    Doc
    p $$ :: Doc -> Doc -> Doc
    $$  Doc
    q = Doc -> Bool -> Doc -> Doc
    above_ Doc
    p Bool
    False Doc
    q

    -- | Above, with no overlapping.
    -- '$+$' is associative, with identity 'empty'.
    ($+$) :: Doc -> Doc -> Doc
    Doc
    p $+$ :: Doc -> Doc -> Doc
    $+$ Doc
    q = Doc -> Bool -> Doc -> Doc
    above_ Doc
    p Bool
    True Doc
    q

    above_ :: Doc -> Bool -> Doc -> Doc
    above_ :: Doc -> Bool -> Doc -> Doc
    above_ Doc
    p Bool
    _ Doc
    Empty = Doc
    p
    above_ Doc
    Empty Bool
    _ Doc
    q = Doc
    q
    above_ Doc
    p Bool
    g Doc
    q     = Doc -> Bool -> Doc -> Doc
    Above Doc
    p Bool
    g Doc
    q

    above :: Doc -> Bool -> RDoc -> RDoc
    above :: Doc -> Bool -> Doc -> Doc
    above (Above Doc
    p Bool
    g1 Doc
    q1)  Bool
    g2 Doc
    q2 = Doc -> Bool -> Doc -> Doc
    above Doc
    p Bool
    g1 (Doc -> Bool -> Doc -> Doc
    above Doc
    q1 Bool
    g2 Doc
    q2)
    above p :: Doc
    p@(Beside{})     Bool
    g  Doc
    q  = Doc -> Bool -> Int -> Doc -> Doc
    aboveNest (Doc -> Doc
    reduceDoc Doc
    p) Bool
    g Int
    0 (Doc -> Doc
    reduceDoc Doc
    q)
    above Doc
    p Bool
    g Doc
    q                  = Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    p             Bool
    g Int
    0 (Doc -> Doc
    reduceDoc Doc
    q)

    -- Specification: aboveNest p g k q = p $g$ (nest k q)
    aboveNest :: RDoc -> Bool -> Int -> RDoc -> RDoc
    aboveNest :: Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    _                   Bool
    _ Int
    k Doc
    _ | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False = Doc
    forall a. HasCallStack => a
    undefined
    aboveNest Doc
    NoDoc               Bool
    _ Int
    _ Doc
    _ = Doc
    NoDoc
    aboveNest (Doc
    p1 `Union` Doc
    p2)     Bool
    g Int
    k Doc
    q = Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    p1 Bool
    g Int
    k Doc
    q Doc -> Doc -> Doc
    `union_`
                                          Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    p2 Bool
    g Int
    k Doc
    q

    aboveNest Doc
    Empty               Bool
    _ Int
    k Doc
    q = Int -> Doc -> Doc
    mkNest Int
    k Doc
    q
    aboveNest (Nest Int
    k1 Doc
    p)         Bool
    g Int
    k Doc
    q = Int -> Doc -> Doc
    nest_ Int
    k1 (Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    p Bool
    g (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    k1) Doc
    q)
                                      -- p can't be Empty, so no need for mkNest

    aboveNest (NilAbove Doc
    p)        Bool
    g Int
    k Doc
    q = Doc -> Doc
    nilAbove_ (Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    p Bool
    g Int
    k Doc
    q)
    aboveNest (TextBeside TextDetails
    s Int
    sl Doc
    p) Bool
    g Int
    k Doc
    q = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    s Int
    sl Doc
    rest
                                        where
                                          !k1 :: Int
    k1  = Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sl
                                          rest :: Doc
    rest = case Doc
    p of
                                                    Doc
    Empty -> Bool -> Int -> Doc -> Doc
    nilAboveNest Bool
    g Int
    k1 Doc
    q
                                                    Doc
    _     -> Doc -> Bool -> Int -> Doc -> Doc
    aboveNest  Doc
    p Bool
    g Int
    k1 Doc
    q
    aboveNest (Above {})          Bool
    _ Int
    _ Doc
    _ = String -> Doc
    forall a. String -> a
    error String
    "aboveNest Above"
    aboveNest (Beside {})         Bool
    _ Int
    _ Doc
    _ = String -> Doc
    forall a. String -> a
    error String
    "aboveNest Beside"

    -- Specification: text s <> nilaboveNest g k q
    --              = text s <> (text "" $g$ nest k q)
    nilAboveNest :: Bool -> Int -> RDoc -> RDoc
    nilAboveNest :: Bool -> Int -> Doc -> Doc
    nilAboveNest Bool
    _ Int
    k Doc
    _           | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False = Doc
    forall a. HasCallStack => a
    undefined
    nilAboveNest Bool
    _ Int
    _ Doc
    Empty       = Doc
    Empty
                                   -- Here's why the "text s <>" is in the spec!
    nilAboveNest Bool
    g Int
    k (Nest Int
    k1 Doc
    q) = Bool -> Int -> Doc -> Doc
    nilAboveNest Bool
    g (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    k1) Doc
    q
    nilAboveNest Bool
    g Int
    k Doc
    q           | Bool -> Bool
    not Bool
    g Bool -> Bool -> Bool
    && Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0      -- No newline if no overlap
                                 = TextDetails -> Int -> Doc -> Doc
    textBeside_ (Int -> Char -> TextDetails
    RStr Int
    k Char
    ' ') Int
    k Doc
    q
                                 | Bool
    otherwise           -- Put them really above
                                 = Doc -> Doc
    nilAbove_ (Int -> Doc -> Doc
    mkNest Int
    k Doc
    q)

    -- ---------------------------------------------------------------------------
    -- Horizontal composition @<>@

    -- We intentionally avoid Data.Monoid.(<>) here due to interactions of
    -- Data.Monoid.(<>) and (<+>).  See
    -- http://www.haskell.org/pipermail/libraries/2011-November/017066.html

    -- | Beside.
    -- '<>' is associative, with identity 'empty'.
    (<>) :: Doc -> Doc -> Doc
    Doc
    p <> :: Doc -> Doc -> Doc
    <>  Doc
    q = Doc -> Bool -> Doc -> Doc
    beside_ Doc
    p Bool
    False Doc
    q

    -- | Beside, separated by space, unless one of the arguments is 'empty'.
    -- '<+>' is associative, with identity 'empty'.
    (<+>) :: Doc -> Doc -> Doc
    Doc
    p <+> :: Doc -> Doc -> Doc
    <+> Doc
    q = Doc -> Bool -> Doc -> Doc
    beside_ Doc
    p Bool
    True  Doc
    q

    beside_ :: Doc -> Bool -> Doc -> Doc
    beside_ :: Doc -> Bool -> Doc -> Doc
    beside_ Doc
    p Bool
    _ Doc
    Empty = Doc
    p
    beside_ Doc
    Empty Bool
    _ Doc
    q = Doc
    q
    beside_ Doc
    p Bool
    g Doc
    q     = Doc -> Bool -> Doc -> Doc
    Beside Doc
    p Bool
    g Doc
    q

    -- Specification: beside g p q = p <g> q
    beside :: Doc -> Bool -> RDoc -> RDoc
    beside :: Doc -> Bool -> Doc -> Doc
    beside Doc
    NoDoc               Bool
    _ Doc
    _   = Doc
    NoDoc
    beside (Doc
    p1 `Union` Doc
    p2)     Bool
    g Doc
    q   = Doc -> Bool -> Doc -> Doc
    beside Doc
    p1 Bool
    g Doc
    q Doc -> Doc -> Doc
    `union_` Doc -> Bool -> Doc -> Doc
    beside Doc
    p2 Bool
    g Doc
    q
    beside Doc
    Empty               Bool
    _ Doc
    q   = Doc
    q
    beside (Nest Int
    k Doc
    p)          Bool
    g Doc
    q   = Int -> Doc -> Doc
    nest_ Int
    k (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $! Doc -> Bool -> Doc -> Doc
    beside Doc
    p Bool
    g Doc
    q
    beside p :: Doc
    p@(Beside Doc
    p1 Bool
    g1 Doc
    q1) Bool
    g2 Doc
    q2
             | Bool
    g1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    g2              = Doc -> Bool -> Doc -> Doc
    beside Doc
    p1 Bool
    g1 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $! Doc -> Bool -> Doc -> Doc
    beside Doc
    q1 Bool
    g2 Doc
    q2
             | Bool
    otherwise             = Doc -> Bool -> Doc -> Doc
    beside (Doc -> Doc
    reduceDoc Doc
    p) Bool
    g2 Doc
    q2
    beside p :: Doc
    p@(Above{})         Bool
    g Doc
    q   = let !d :: Doc
    d = Doc -> Doc
    reduceDoc Doc
    p in Doc -> Bool -> Doc -> Doc
    beside Doc
    d Bool
    g Doc
    q
    beside (NilAbove Doc
    p)        Bool
    g Doc
    q   = Doc -> Doc
    nilAbove_ (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $! Doc -> Bool -> Doc -> Doc
    beside Doc
    p Bool
    g Doc
    q
    beside (TextBeside TextDetails
    s Int
    sl Doc
    p) Bool
    g Doc
    q   = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    s Int
    sl Doc
    rest
                                   where
                                      rest :: Doc
    rest = case Doc
    p of
                                               Doc
    Empty -> Bool -> Doc -> Doc
    nilBeside Bool
    g Doc
    q
                                               Doc
    _     -> Doc -> Bool -> Doc -> Doc
    beside Doc
    p Bool
    g Doc
    q

    -- Specification: text "" <> nilBeside g p
    --              = text "" <g> p
    nilBeside :: Bool -> RDoc -> RDoc
    nilBeside :: Bool -> Doc -> Doc
    nilBeside Bool
    _ Doc
    Empty         = Doc
    Empty -- Hence the text "" in the spec
    nilBeside Bool
    g (Nest Int
    _ Doc
    p)    = Bool -> Doc -> Doc
    nilBeside Bool
    g Doc
    p
    nilBeside Bool
    g Doc
    p | Bool
    g         = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    spaceText Int
    1 Doc
    p
                  | Bool
    otherwise = Doc
    p

    -- ---------------------------------------------------------------------------
    -- Separate, @sep@

    -- Specification: sep ps  = oneLiner (hsep ps)
    --                         `union`
    --                          vcat ps

    -- | Either 'hsep' or 'vcat'.
    sep  :: [Doc] -> Doc
    sep :: [Doc] -> Doc
    sep = Bool -> [Doc] -> Doc
    sepX Bool
    True   -- Separate with spaces

    -- | Either 'hcat' or 'vcat'.
    cat :: [Doc] -> Doc
    cat :: [Doc] -> Doc
    cat = Bool -> [Doc] -> Doc
    sepX Bool
    False  -- Don't

    sepX :: Bool -> [Doc] -> Doc
    sepX :: Bool -> [Doc] -> Doc
    sepX Bool
    _ []     = Doc
    empty
    sepX Bool
    x (Doc
    p:[Doc]
    ps) = Bool -> Doc -> Int -> [Doc] -> Doc
    sep1 Bool
    x (Doc -> Doc
    reduceDoc Doc
    p) Int
    0 [Doc]
    ps

    -- Specification: sep1 g k ys = sep (x : map (nest k) ys)
    --                            = oneLiner (x <g> nest k (hsep ys))
    --                              `union` x $$ nest k (vcat ys)
    sep1 :: Bool -> RDoc -> Int -> [Doc] -> RDoc
    sep1 :: Bool -> Doc -> Int -> [Doc] -> Doc
    sep1 Bool
    _ Doc
    _                   Int
    k [Doc]
    _  | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False = Doc
    forall a. HasCallStack => a
    undefined
    sep1 Bool
    _ Doc
    NoDoc               Int
    _ [Doc]
    _  = Doc
    NoDoc
    sep1 Bool
    g (Doc
    p `Union` Doc
    q)       Int
    k [Doc]
    ys = Bool -> Doc -> Int -> [Doc] -> Doc
    sep1 Bool
    g Doc
    p Int
    k [Doc]
    ys Doc -> Doc -> Doc
    `union_`
                                      Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    q Bool
    False Int
    k (Doc -> Doc
    reduceDoc ([Doc] -> Doc
    vcat [Doc]
    ys))

    sep1 Bool
    g Doc
    Empty               Int
    k [Doc]
    ys = Int -> Doc -> Doc
    mkNest Int
    k (Bool -> [Doc] -> Doc
    sepX Bool
    g [Doc]
    ys)
    sep1 Bool
    g (Nest Int
    n Doc
    p)          Int
    k [Doc]
    ys = Int -> Doc -> Doc
    nest_ Int
    n (Bool -> Doc -> Int -> [Doc] -> Doc
    sep1 Bool
    g Doc
    p (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) [Doc]
    ys)

    sep1 Bool
    _ (NilAbove Doc
    p)        Int
    k [Doc]
    ys = Doc -> Doc
    nilAbove_
                                      (Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    p Bool
    False Int
    k (Doc -> Doc
    reduceDoc ([Doc] -> Doc
    vcat [Doc]
    ys)))
    sep1 Bool
    g (TextBeside TextDetails
    s Int
    sl Doc
    p) Int
    k [Doc]
    ys = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    s Int
    sl (Bool -> Doc -> Int -> [Doc] -> Doc
    sepNB Bool
    g Doc
    p (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sl) [Doc]
    ys)
    sep1 Bool
    _ (Above {})          Int
    _ [Doc]
    _  = String -> Doc
    forall a. String -> a
    error String
    "sep1 Above"
    sep1 Bool
    _ (Beside {})         Int
    _ [Doc]
    _  = String -> Doc
    forall a. String -> a
    error String
    "sep1 Beside"

    -- Specification: sepNB p k ys = sep1 (text "" <> p) k ys
    -- Called when we have already found some text in the first item
    -- We have to eat up nests
    sepNB :: Bool -> Doc -> Int -> [Doc] -> Doc
    sepNB :: Bool -> Doc -> Int -> [Doc] -> Doc
    sepNB Bool
    g (Nest Int
    _ Doc
    p) Int
    k [Doc]
    ys
      = Bool -> Doc -> Int -> [Doc] -> Doc
    sepNB Bool
    g Doc
    p Int
    k [Doc]
    ys -- Never triggered, because of invariant (2)
    sepNB Bool
    g Doc
    Empty Int
    k [Doc]
    ys
      = Doc -> Doc
    oneLiner (Bool -> Doc -> Doc
    nilBeside Bool
    g (Doc -> Doc
    reduceDoc Doc
    rest)) Doc -> Doc -> Doc
    `mkUnion`
        -- XXX: TODO: PRETTY: Used to use True here (but GHC used False...)
        Bool -> Int -> Doc -> Doc
    nilAboveNest Bool
    False Int
    k (Doc -> Doc
    reduceDoc ([Doc] -> Doc
    vcat [Doc]
    ys))
      where
        rest :: Doc
    rest | Bool
    g         = [Doc] -> Doc
    hsep [Doc]
    ys
             | Bool
    otherwise = [Doc] -> Doc
    hcat [Doc]
    ys
    sepNB Bool
    g Doc
    p Int
    k [Doc]
    ys
      = Bool -> Doc -> Int -> [Doc] -> Doc
    sep1 Bool
    g Doc
    p Int
    k [Doc]
    ys

    -- ---------------------------------------------------------------------------
    -- @fill@

    -- | \"Paragraph fill\" version of 'cat'.
    fcat :: [Doc] -> Doc
    fcat :: [Doc] -> Doc
    fcat = Bool -> [Doc] -> Doc
    fill Bool
    False

    -- | \"Paragraph fill\" version of 'sep'.
    fsep :: [Doc] -> Doc
    fsep :: [Doc] -> Doc
    fsep = Bool -> [Doc] -> Doc
    fill Bool
    True

    -- Specification:
    --
    -- fill g docs = fillIndent 0 docs
    --
    -- fillIndent k [] = []
    -- fillIndent k [p] = p
    -- fillIndent k (p1:p2:ps) =
    --    oneLiner p1 <g> fillIndent (k + length p1 + g ? 1 : 0)
    --                               (remove_nests (oneLiner p2) : ps)
    --     `Union`
    --    (p1 $*$ nest (-k) (fillIndent 0 ps))
    --
    -- $*$ is defined for layouts (not Docs) as
    -- layout1 $*$ layout2 | hasMoreThanOneLine layout1 = layout1 $$ layout2
    --                     | otherwise                  = layout1 $+$ layout2

    fill :: Bool -> [Doc] -> RDoc
    fill :: Bool -> [Doc] -> Doc
    fill Bool
    _ []     = Doc
    empty
    fill Bool
    g (Doc
    p:[Doc]
    ps) = Bool -> Doc -> Int -> [Doc] -> Doc
    fill1 Bool
    g (Doc -> Doc
    reduceDoc Doc
    p) Int
    0 [Doc]
    ps

    fill1 :: Bool -> RDoc -> Int -> [Doc] -> Doc
    fill1 :: Bool -> Doc -> Int -> [Doc] -> Doc
    fill1 Bool
    _ Doc
    _                   Int
    k [Doc]
    _  | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False = Doc
    forall a. HasCallStack => a
    undefined
    fill1 Bool
    _ Doc
    NoDoc               Int
    _ [Doc]
    _  = Doc
    NoDoc
    fill1 Bool
    g (Doc
    p `Union` Doc
    q)       Int
    k [Doc]
    ys = Bool -> Doc -> Int -> [Doc] -> Doc
    fill1 Bool
    g Doc
    p Int
    k [Doc]
    ys Doc -> Doc -> Doc
    `union_`
                                       Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    q Bool
    False Int
    k (Bool -> [Doc] -> Doc
    fill Bool
    g [Doc]
    ys)
    fill1 Bool
    g Doc
    Empty               Int
    k [Doc]
    ys = Int -> Doc -> Doc
    mkNest Int
    k (Bool -> [Doc] -> Doc
    fill Bool
    g [Doc]
    ys)
    fill1 Bool
    g (Nest Int
    n Doc
    p)          Int
    k [Doc]
    ys = Int -> Doc -> Doc
    nest_ Int
    n (Bool -> Doc -> Int -> [Doc] -> Doc
    fill1 Bool
    g Doc
    p (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) [Doc]
    ys)
    fill1 Bool
    g (NilAbove Doc
    p)        Int
    k [Doc]
    ys = Doc -> Doc
    nilAbove_ (Doc -> Bool -> Int -> Doc -> Doc
    aboveNest Doc
    p Bool
    False Int
    k (Bool -> [Doc] -> Doc
    fill Bool
    g [Doc]
    ys))
    fill1 Bool
    g (TextBeside TextDetails
    s Int
    sl Doc
    p) Int
    k [Doc]
    ys = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    s Int
    sl (Bool -> Doc -> Int -> [Doc] -> Doc
    fillNB Bool
    g Doc
    p (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sl) [Doc]
    ys)
    fill1 Bool
    _ (Above {})          Int
    _ [Doc]
    _  = String -> Doc
    forall a. String -> a
    error String
    "fill1 Above"
    fill1 Bool
    _ (Beside {})         Int
    _ [Doc]
    _  = String -> Doc
    forall a. String -> a
    error String
    "fill1 Beside"

    fillNB :: Bool -> Doc -> Int -> [Doc] -> Doc
    fillNB :: Bool -> Doc -> Int -> [Doc] -> Doc
    fillNB Bool
    _ Doc
    _           Int
    k [Doc]
    _  | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False = Doc
    forall a. HasCallStack => a
    undefined
    fillNB Bool
    g (Nest Int
    _ Doc
    p)  Int
    k [Doc]
    ys   = Bool -> Doc -> Int -> [Doc] -> Doc
    fillNB Bool
    g Doc
    p Int
    k [Doc]
    ys
                                  -- Never triggered, because of invariant (2)
    fillNB Bool
    _ Doc
    Empty Int
    _ []         = Doc
    Empty
    fillNB Bool
    g Doc
    Empty Int
    k (Doc
    Empty:[Doc]
    ys) = Bool -> Doc -> Int -> [Doc] -> Doc
    fillNB Bool
    g Doc
    Empty Int
    k [Doc]
    ys
    fillNB Bool
    g Doc
    Empty Int
    k (Doc
    y:[Doc]
    ys)     = Bool -> Int -> Doc -> [Doc] -> Doc
    fillNBE Bool
    g Int
    k Doc
    y [Doc]
    ys
    fillNB Bool
    g Doc
    p Int
    k [Doc]
    ys             = Bool -> Doc -> Int -> [Doc] -> Doc
    fill1 Bool
    g Doc
    p Int
    k [Doc]
    ys

    fillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc
    fillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc
    fillNBE Bool
    g Int
    k Doc
    y [Doc]
    ys
      = Bool -> Doc -> Doc
    nilBeside Bool
    g (Bool -> Doc -> Int -> [Doc] -> Doc
    fill1 Bool
    g ((Doc -> Doc
    elideNest (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> Doc
    oneLiner (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> Doc
    reduceDoc) Doc
    y) Int
    k' [Doc]
    ys)
        -- XXX: TODO: PRETTY: Used to use True here (but GHC used False...)
        Doc -> Doc -> Doc
    `mkUnion` Bool -> Int -> Doc -> Doc
    nilAboveNest Bool
    False Int
    k (Bool -> [Doc] -> Doc
    fill Bool
    g (Doc
    yDoc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    :[Doc]
    ys))
      where k' :: Int
    k' = if Bool
    g then Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 else Int
    k

    elideNest :: Doc -> Doc
    elideNest :: Doc -> Doc
    elideNest (Nest Int
    _ Doc
    d) = Doc
    d
    elideNest Doc
    d          = Doc
    d

    -- ---------------------------------------------------------------------------
    -- Selecting the best layout

    best :: Int   -- Line length
         -> Int   -- Ribbon length
         -> RDoc
         -> RDoc  -- No unions in here!
    best :: Int -> Int -> Doc -> Doc
    best Int
    w0 Int
    r = Int -> Doc -> Doc
    get Int
    w0
      where
        get :: Int          -- (Remaining) width of line
            -> Doc -> Doc
        get :: Int -> Doc -> Doc
    get Int
    w Doc
    _ | Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Bool
    False = Doc
    forall a. HasCallStack => a
    undefined
        get Int
    _ Doc
    Empty               = Doc
    Empty
        get Int
    _ Doc
    NoDoc               = Doc
    NoDoc
        get Int
    w (NilAbove Doc
    p)        = Doc -> Doc
    nilAbove_ (Int -> Doc -> Doc
    get Int
    w Doc
    p)
        get Int
    w (TextBeside TextDetails
    s Int
    sl Doc
    p) = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    s Int
    sl (Int -> Int -> Doc -> Doc
    get1 Int
    w Int
    sl Doc
    p)
        get Int
    w (Nest Int
    k Doc
    p)          = Int -> Doc -> Doc
    nest_ Int
    k (Int -> Doc -> Doc
    get (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    k) Doc
    p)
        get Int
    w (Doc
    p `Union` Doc
    q)       = Int -> Int -> Doc -> Doc -> Doc
    nicest Int
    w Int
    r (Int -> Doc -> Doc
    get Int
    w Doc
    p) (Int -> Doc -> Doc
    get Int
    w Doc
    q)
        get Int
    _ (Above {})          = String -> Doc
    forall a. String -> a
    error String
    "best get Above"
        get Int
    _ (Beside {})         = String -> Doc
    forall a. String -> a
    error String
    "best get Beside"

        get1 :: Int         -- (Remaining) width of line
             -> Int         -- Amount of first line already eaten up
             -> Doc         -- This is an argument to TextBeside => eat Nests
             -> Doc         -- No unions in here!

        get1 :: Int -> Int -> Doc -> Doc
    get1 Int
    w Int
    _ Doc
    _ | Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Bool
    False  = Doc
    forall a. HasCallStack => a
    undefined
        get1 Int
    _ Int
    _  Doc
    Empty               = Doc
    Empty
        get1 Int
    _ Int
    _  Doc
    NoDoc               = Doc
    NoDoc
        get1 Int
    w Int
    sl (NilAbove Doc
    p)        = Doc -> Doc
    nilAbove_ (Int -> Doc -> Doc
    get (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sl) Doc
    p)
        get1 Int
    w Int
    sl (TextBeside TextDetails
    t Int
    tl Doc
    p) = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    t Int
    tl (Int -> Int -> Doc -> Doc
    get1 Int
    w (Int
    sl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    tl) Doc
    p)
        get1 Int
    w Int
    sl (Nest Int
    _ Doc
    p)          = Int -> Int -> Doc -> Doc
    get1 Int
    w Int
    sl Doc
    p
        get1 Int
    w Int
    sl (Doc
    p `Union` Doc
    q)       = Int -> Int -> Int -> Doc -> Doc -> Doc
    nicest1 Int
    w Int
    r Int
    sl (Int -> Int -> Doc -> Doc
    get1 Int
    w Int
    sl Doc
    p)
                                                       (Int -> Int -> Doc -> Doc
    get1 Int
    w Int
    sl Doc
    q)
        get1 Int
    _ Int
    _  (Above {})          = String -> Doc
    forall a. String -> a
    error String
    "best get1 Above"
        get1 Int
    _ Int
    _  (Beside {})         = String -> Doc
    forall a. String -> a
    error String
    "best get1 Beside"

    nicest :: Int -> Int -> Doc -> Doc -> Doc
    nicest :: Int -> Int -> Doc -> Doc -> Doc
    nicest !Int
    w !Int
    r = Int -> Int -> Int -> Doc -> Doc -> Doc
    nicest1 Int
    w Int
    r Int
    0

    nicest1 :: Int -> Int -> Int -> Doc -> Doc -> Doc
    nicest1 :: Int -> Int -> Int -> Doc -> Doc -> Doc
    nicest1 !Int
    w !Int
    r !Int
    sl Doc
    p Doc
    q | Int -> Doc -> Bool
    fits ((Int
    w Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `min` Int
    r) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sl) Doc
    p = Doc
    p
                          | Bool
    otherwise                 = Doc
    q

    fits :: Int  -- Space available
         -> Doc
         -> Bool -- True if *first line* of Doc fits in space available
    fits :: Int -> Doc -> Bool
    fits Int
    n Doc
    _ | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0           = Bool
    False
    fits Int
    _ Doc
    NoDoc               = Bool
    False
    fits Int
    _ Doc
    Empty               = Bool
    True
    fits Int
    _ (NilAbove Doc
    _)        = Bool
    True
    fits Int
    n (TextBeside TextDetails
    _ Int
    sl Doc
    p) = Int -> Doc -> Bool
    fits (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sl) Doc
    p
    fits Int
    _ (Above {})          = String -> Bool
    forall a. String -> a
    error String
    "fits Above"
    fits Int
    _ (Beside {})         = String -> Bool
    forall a. String -> a
    error String
    "fits Beside"
    fits Int
    _ (Union {})          = String -> Bool
    forall a. String -> a
    error String
    "fits Union"
    fits Int
    _ (Nest {})           = String -> Bool
    forall a. String -> a
    error String
    "fits Nest"

    -- | @first@ returns its first argument if it is non-empty, otherwise its second.
    first :: Doc -> Doc -> Doc
    first :: Doc -> Doc -> Doc
    first Doc
    p Doc
    q | Doc -> Bool
    nonEmptySet Doc
    p = Doc
    p -- unused, because (get OneLineMode) is unused
              | Bool
    otherwise     = Doc
    q

    nonEmptySet :: Doc -> Bool
    nonEmptySet :: Doc -> Bool
    nonEmptySet Doc
    NoDoc              = Bool
    False
    nonEmptySet (Doc
    _ `Union` Doc
    _)      = Bool
    True
    nonEmptySet Doc
    Empty              = Bool
    True
    nonEmptySet (NilAbove Doc
    _)       = Bool
    True
    nonEmptySet (TextBeside TextDetails
    _ Int
    _ Doc
    p) = Doc -> Bool
    nonEmptySet Doc
    p
    nonEmptySet (Nest Int
    _ Doc
    p)         = Doc -> Bool
    nonEmptySet Doc
    p
    nonEmptySet (Above {})         = String -> Bool
    forall a. String -> a
    error String
    "nonEmptySet Above"
    nonEmptySet (Beside {})        = String -> Bool
    forall a. String -> a
    error String
    "nonEmptySet Beside"

    -- @oneLiner@ returns the one-line members of the given set of @GDoc@s.
    oneLiner :: Doc -> Doc
    oneLiner :: Doc -> Doc
    oneLiner Doc
    NoDoc               = Doc
    NoDoc
    oneLiner Doc
    Empty               = Doc
    Empty
    oneLiner (NilAbove Doc
    _)        = Doc
    NoDoc
    oneLiner (TextBeside TextDetails
    s Int
    sl Doc
    p) = TextDetails -> Int -> Doc -> Doc
    textBeside_ TextDetails
    s Int
    sl (Doc -> Doc
    oneLiner Doc
    p)
    oneLiner (Nest Int
    k Doc
    p)          = Int -> Doc -> Doc
    nest_ Int
    k (Doc -> Doc
    oneLiner Doc
    p)
    oneLiner (Doc
    p `Union` Doc
    _)       = Doc -> Doc
    oneLiner Doc
    p
    oneLiner (Above {})          = String -> Doc
    forall a. String -> a
    error String
    "oneLiner Above"
    oneLiner (Beside {})         = String -> Doc
    forall a. String -> a
    error String
    "oneLiner Beside"

    -- ---------------------------------------------------------------------------
    -- Rendering

    -- | A rendering style.
    data Style
      = Style { Style -> Mode
    mode           :: Mode  -- ^ The rendering mode
              , Style -> Int
    lineLength     :: Int   -- ^ Length of line, in chars
              , Style -> Float
    ribbonsPerLine :: Float -- ^ Ratio of line length to ribbon length
              }

    -- | The default style (@mode=PageMode False, lineLength=100, ribbonsPerLine=1.5@).
    style :: Style
    style :: Style
    style = Style { lineLength :: Int
    lineLength = Int
    100, ribbonsPerLine :: Float
    ribbonsPerLine = Float
    1.5, mode :: Mode
    mode = Bool -> Mode
    PageMode Bool
    False }

    -- | Rendering mode.
    data Mode = PageMode { Mode -> Bool
    asciiSpace :: Bool }    -- ^ Normal
              | ZigZagMode   -- ^ With zig-zag cuts
              | LeftMode     -- ^ No indentation, infinitely long lines
              | OneLineMode  -- ^ All on one line

    -- | Can we output an ascii space character for spaces?
    --   Mostly true, but not for e.g. UTF16
    --   See Note [putSpaces optimizations] for why we bother
    --   to track this.
    hasAsciiSpace :: Mode -> Bool
    hasAsciiSpace :: Mode -> Bool
    hasAsciiSpace Mode
    mode =
      case Mode
    mode of
        PageMode Bool
    asciiSpace -> Bool
    asciiSpace
        Mode
    _ -> Bool
    False

    -- | Render the @Doc@ to a String using the given @Style@.
    renderStyle :: Style -> Doc -> String
    renderStyle :: Style -> Doc -> String
    renderStyle Style
    s = Mode
    -> Int
    -> Float
    -> (TextDetails -> ShowS)
    -> String
    -> Doc
    -> String
    forall a.
    Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
    fullRender (Style -> Mode
    mode Style
    s) (Style -> Int
    lineLength Style
    s) (Style -> Float
    ribbonsPerLine Style
    s)
                    TextDetails -> ShowS
    txtPrinter String
    ""

    -- | Default TextDetails printer
    txtPrinter :: TextDetails -> String -> String
    txtPrinter :: TextDetails -> ShowS
    txtPrinter (Chr Char
    c)    String
    s  = Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s
    txtPrinter (Str String
    s1)   String
    s2 = String
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s2
    txtPrinter (PStr FastString
    s1)  String
    s2 = FastString -> String
    unpackFS FastString
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s2
    txtPrinter (ZStr FastZString
    s1)  String
    s2 = FastZString -> String
    zString FastZString
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s2
    txtPrinter (LStr PtrString
    s1)  String
    s2 = PtrString -> String
    unpackPtrString PtrString
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s2
    txtPrinter (RStr Int
    n Char
    c) String
    s2 = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    c String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s2

    -- | The general rendering interface.
    fullRender :: Mode                     -- ^ Rendering mode
               -> Int                      -- ^ Line length
               -> Float                    -- ^ Ribbons per line
               -> (TextDetails -> a -> a)  -- ^ What to do with text
               -> a                        -- ^ What to do at the end
               -> Doc                      -- ^ The document
               -> a                        -- ^ Result
    fullRender :: forall a.
    Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
    fullRender Mode
    OneLineMode Int
    _ Float
    _ TextDetails -> a -> a
    txt a
    end Doc
    doc
      = TextDetails
    -> (Doc -> Doc -> Doc) -> (TextDetails -> a -> a) -> a -> Doc -> a
    forall a.
    TextDetails
    -> (Doc -> Doc -> Doc) -> (TextDetails -> a -> a) -> a -> Doc -> a
    easyDisplay TextDetails
    spaceText (\Doc
    _ Doc
    y -> Doc
    y) TextDetails -> a -> a
    txt a
    end (Doc -> Doc
    reduceDoc Doc
    doc)
    fullRender Mode
    LeftMode    Int
    _ Float
    _ TextDetails -> a -> a
    txt a
    end Doc
    doc
      = TextDetails
    -> (Doc -> Doc -> Doc) -> (TextDetails -> a -> a) -> a -> Doc -> a
    forall a.
    TextDetails
    -> (Doc -> Doc -> Doc) -> (TextDetails -> a -> a) -> a -> Doc -> a
    easyDisplay TextDetails
    nlText Doc -> Doc -> Doc
    first TextDetails -> a -> a
    txt a
    end (Doc -> Doc
    reduceDoc Doc
    doc)

    fullRender Mode
    m Int
    lineLen Float
    ribbons TextDetails -> a -> a
    txt a
    rest Doc
    doc
      = Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a
    forall a.
    Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a
    display Mode
    m Int
    lineLen Int
    ribbonLen TextDetails -> a -> a
    txt a
    rest Doc
    doc'
      where
        doc' :: Doc
    doc' = Int -> Int -> Doc -> Doc
    best Int
    bestLineLen Int
    ribbonLen (Doc -> Doc
    reduceDoc Doc
    doc)

        bestLineLen, ribbonLen :: Int
        ribbonLen :: Int
    ribbonLen   = Float -> Int
    forall b. Integral b => Float -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Int -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    lineLen Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    / Float
    ribbons)
        bestLineLen :: Int
    bestLineLen = case Mode
    m of
                          Mode
    ZigZagMode -> Int
    forall a. Bounded a => a
    maxBound
                          Mode
    _          -> Int
    lineLen

    easyDisplay :: TextDetails
                 -> (Doc -> Doc -> Doc)
                 -> (TextDetails -> a -> a)
                 -> a
                 -> Doc
                 -> a
    easyDisplay :: forall a.
    TextDetails
    -> (Doc -> Doc -> Doc) -> (TextDetails -> a -> a) -> a -> Doc -> a
    easyDisplay TextDetails
    nlSpaceText Doc -> Doc -> Doc
    choose TextDetails -> a -> a
    txt a
    end
      = Doc -> a
    lay
      where
        lay :: Doc -> a
    lay Doc
    NoDoc              = String -> a
    forall a. String -> a
    error String
    "easyDisplay: NoDoc"
        lay (Union Doc
    p Doc
    q)        = Doc -> a
    lay (Doc -> Doc -> Doc
    choose Doc
    p Doc
    q)
        lay (Nest Int
    _ Doc
    p)         = Doc -> a
    lay Doc
    p
        lay Doc
    Empty              = a
    end
        lay (NilAbove Doc
    p)       = TextDetails
    nlSpaceText TextDetails -> a -> a
    `txt` Doc -> a
    lay Doc
    p
        lay (TextBeside TextDetails
    s Int
    _ Doc
    p) = TextDetails
    s TextDetails -> a -> a
    `txt` Doc -> a
    lay Doc
    p
        lay (Above {})         = String -> a
    forall a. String -> a
    error String
    "easyDisplay Above"
        lay (Beside {})        = String -> a
    forall a. String -> a
    error String
    "easyDisplay Beside"

    display :: Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a
    display :: forall a.
    Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a
    display Mode
    m !Int
    page_width !Int
    ribbon_width TextDetails -> a -> a
    txt a
    end Doc
    doc
      = case Int
    page_width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ribbon_width of { Int
    gap_width ->
        case Int
    gap_width Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    2 of { Int
    shift ->
        let
            lay :: Int -> Doc -> a
    lay Int
    k Doc
    _            | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False = a
    forall a. HasCallStack => a
    undefined
            lay Int
    k (Nest Int
    k1 Doc
    p)  = Int -> Doc -> a
    lay (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    k1) Doc
    p
            lay Int
    _ Doc
    Empty        = a
    end
            lay Int
    k (NilAbove Doc
    p) = TextDetails
    nlText TextDetails -> a -> a
    `txt` Int -> Doc -> a
    lay Int
    k Doc
    p
            lay Int
    k (TextBeside TextDetails
    s Int
    sl Doc
    p)
                = case Mode
    m of
                        Mode
    ZigZagMode |  Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    gap_width
                                   -> TextDetails
    nlText TextDetails -> a -> a
    `txt` (
                                      String -> TextDetails
    Str (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    shift Char
    '/') TextDetails -> a -> a
    `txt` (
                                      TextDetails
    nlText TextDetails -> a -> a
    `txt`
                                      Int -> TextDetails -> Int -> Doc -> a
    lay1 (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    shift) TextDetails
    s Int
    sl Doc
    p ))

                                   |  Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
                                   -> TextDetails
    nlText TextDetails -> a -> a
    `txt` (
                                      String -> TextDetails
    Str (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    shift Char
    '\\') TextDetails -> a -> a
    `txt` (
                                      TextDetails
    nlText TextDetails -> a -> a
    `txt`
                                      Int -> TextDetails -> Int -> Doc -> a
    lay1 (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    shift) TextDetails
    s Int
    sl Doc
    p ))

                        Mode
    _ -> Int -> TextDetails -> Int -> Doc -> a
    lay1 Int
    k TextDetails
    s Int
    sl Doc
    p
            lay Int
    _ (Above {})   = String -> a
    forall a. String -> a
    error String
    "display lay Above"
            lay Int
    _ (Beside {})  = String -> a
    forall a. String -> a
    error String
    "display lay Beside"
            lay Int
    _ Doc
    NoDoc        = String -> a
    forall a. String -> a
    error String
    "display lay NoDoc"
            lay Int
    _ (Union {})   = String -> a
    forall a. String -> a
    error String
    "display lay Union"

            lay1 :: Int -> TextDetails -> Int -> Doc -> a
    lay1 !Int
    k TextDetails
    s !Int
    sl Doc
    p    = let !r :: Int
    r = Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sl
                                 in Int -> a -> a
    indent Int
    k (TextDetails
    s TextDetails -> a -> a
    `txt` Int -> Doc -> a
    lay2 Int
    r Doc
    p)

            lay2 :: Int -> Doc -> a
    lay2 Int
    k Doc
    _ | Int
    k Int -> Bool -> Bool
    forall a b. a -> b -> b
    `seq` Bool
    False   = a
    forall a. HasCallStack => a
    undefined
            lay2 Int
    k (NilAbove Doc
    p)        = TextDetails
    nlText TextDetails -> a -> a
    `txt` Int -> Doc -> a
    lay Int
    k Doc
    p
            lay2 Int
    k (TextBeside TextDetails
    s Int
    sl Doc
    p) = TextDetails
    s TextDetails -> a -> a
    `txt` Int -> Doc -> a
    lay2 (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sl) Doc
    p
            lay2 Int
    k (Nest Int
    _ Doc
    p)          = Int -> Doc -> a
    lay2 Int
    k Doc
    p
            lay2 Int
    _ Doc
    Empty               = a
    end
            lay2 Int
    _ (Above {})          = String -> a
    forall a. String -> a
    error String
    "display lay2 Above"
            lay2 Int
    _ (Beside {})         = String -> a
    forall a. String -> a
    error String
    "display lay2 Beside"
            lay2 Int
    _ Doc
    NoDoc               = String -> a
    forall a. String -> a
    error String
    "display lay2 NoDoc"
            lay2 Int
    _ (Union {})          = String -> a
    forall a. String -> a
    error String
    "display lay2 Union"

            indent :: Int -> a -> a
    indent !Int
    n a
    r                = Int -> Char -> TextDetails
    RStr Int
    n Char
    ' ' TextDetails -> a -> a
    `txt` a
    r
        in
        Int -> Doc -> a
    lay Int
    0 Doc
    doc
        }}

    printDoc :: Mode -> Int -> Handle -> Doc -> IO ()
    -- printDoc adds a newline to the end
    printDoc :: Mode -> Int -> Handle -> Doc -> IO ()
    printDoc Mode
    mode Int
    cols Handle
    hdl Doc
    doc = Mode -> Int -> Handle -> Doc -> IO ()
    printDoc_ Mode
    mode Int
    cols Handle
    hdl (Doc
    doc Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "")

    {- Note [putSpaces optimizations]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When using dump flags a lot of what we are dumping ends up being whitespace.
    This is especially true for Core/Stg dumps. Enough so that it's worth optimizing.

    Especially in the common case of writing to an UTF8 or similarly encoded file
    where space is equal to ascii space we use hPutBuf to write a preallocated
    buffer to the file. This avoids a fair bit of allocation.

    For other cases we fall back to the old and slow path for simplicity.

    -}

    printDoc_ :: Mode -> Int -> Handle -> Doc -> IO ()
    -- printDoc_ does not add a newline at the end, so that
    -- successive calls can output stuff on the same line
    -- Rather like putStr vs putStrLn
    printDoc_ :: Mode -> Int -> Handle -> Doc -> IO ()
    printDoc_ Mode
    LeftMode Int
    _ Handle
    hdl Doc
    doc
      = do { Handle -> Doc -> IO ()
    printLeftRender Handle
    hdl Doc
    doc; Handle -> IO ()
    hFlush Handle
    hdl }
    printDoc_ Mode
    mode Int
    pprCols Handle
    hdl Doc
    doc
      = do { Mode
    -> Int
    -> Float
    -> (TextDetails -> IO () -> IO ())
    -> IO ()
    -> Doc
    -> IO ()
    forall a.
    Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
    fullRender Mode
    mode Int
    pprCols Float
    1.5 TextDetails -> IO () -> IO ()
    put IO ()
    done Doc
    doc ;
             Handle -> IO ()
    hFlush Handle
    hdl }
      where
        put :: TextDetails -> IO () -> IO ()
    put (Chr Char
    c)    IO ()
    next = Handle -> Char -> IO ()
    hPutChar Handle
    hdl Char
    c IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    next
        put (Str String
    s)    IO ()
    next = Handle -> String -> IO ()
    hPutStr  Handle
    hdl String
    s IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    next
        put (PStr FastString
    s)   IO ()
    next = Handle -> String -> IO ()
    hPutStr  Handle
    hdl (FastString -> String
    unpackFS FastString
    s) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    next
                              -- NB. not hPutFS, we want this to go through
                              -- the I/O library's encoding layer. (#3398)
        put (ZStr FastZString
    s)   IO ()
    next = Handle -> FastZString -> IO ()
    hPutFZS  Handle
    hdl FastZString
    s IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    next
        put (LStr PtrString
    s)   IO ()
    next = Handle -> PtrString -> IO ()
    hPutPtrString Handle
    hdl PtrString
    s IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    next
        put (RStr Int
    n Char
    c) IO ()
    next
          | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' '
          = Int -> IO ()
    putSpaces Int
    n IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    next
          | Bool
    otherwise
          = Handle -> String -> IO ()
    hPutStr Handle
    hdl (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    c) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    next
        putSpaces :: Int -> IO ()
    putSpaces Int
    n
          -- If we use ascii spaces we are allowed to use hPutBuf
          -- See Note [putSpaces optimizations]
          | Mode -> Bool
    hasAsciiSpace Mode
    mode
          , Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    100
          = Handle -> Ptr (ZonkAny 0) -> Int -> IO ()
    forall a. Handle -> Ptr a -> Int -> IO ()
    hPutBuf Handle
    hdl (Addr# -> Ptr (ZonkAny 0)
    forall a. Addr# -> Ptr a
    Ptr Addr#
    spaces') Int
    n
          | Mode -> Bool
    hasAsciiSpace Mode
    mode
          , Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    100
          = Handle -> Ptr (ZonkAny 1) -> Int -> IO ()
    forall a. Handle -> Ptr a -> Int -> IO ()
    hPutBuf Handle
    hdl (Addr# -> Ptr (ZonkAny 1)
    forall a. Addr# -> Ptr a
    Ptr Addr#
    spaces') Int
    100 IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> IO ()
    putSpaces (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    100)

          | Bool
    otherwise = Handle -> String -> IO ()
    hPutStr Handle
    hdl (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    ' ')

        done :: IO ()
    done = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- hPutChar hdl '\n'
        -- 100 spaces, so we avoid the allocation of replicate n ' '
        spaces' :: Addr#
    spaces' = Addr#
    "                                                                                                    "#

      -- some versions of hPutBuf will barf if the length is zero
    hPutPtrString :: Handle -> PtrString -> IO ()
    hPutPtrString :: Handle -> PtrString -> IO ()
    hPutPtrString Handle
    _handle (PtrString Ptr Word8
    _ Int
    0) = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    hPutPtrString Handle
    handle  (PtrString Ptr Word8
    a Int
    l) = Handle -> Ptr Word8 -> Int -> IO ()
    forall a. Handle -> Ptr a -> Int -> IO ()
    hPutBuf Handle
    handle Ptr Word8
    a Int
    l

    -- Printing output in LeftMode is performance critical: it's used when
    -- dumping C and assembly output, so we allow ourselves a few dirty
    -- hacks:
    --
    -- (1) we specialise fullRender for LeftMode with IO output.
    --
    -- (2) we add a layer of buffering on top of Handles.  Handles
    --     don't perform well with lots of hPutChars, which is mostly
    --     what we're doing here, because Handles have to be thread-safe
    --     and async exception-safe.  We only have a single thread and don't
    --     care about exceptions, so we add a layer of fast buffering
    --     over the Handle interface.

    printLeftRender :: Handle -> Doc -> IO ()
    printLeftRender :: Handle -> Doc -> IO ()
    printLeftRender Handle
    hdl Doc
    doc = do
      b <- Handle -> IO BufHandle
    newBufHandle Handle
    hdl
      bufLeftRender b doc
      bFlush b

    bufLeftRender :: BufHandle -> Doc -> IO ()
    bufLeftRender :: BufHandle -> Doc -> IO ()
    bufLeftRender BufHandle
    b Doc
    doc = BufHandle -> Doc -> IO ()
    layLeft BufHandle
    b (Doc -> Doc
    reduceDoc Doc
    doc)

    layLeft :: BufHandle -> Doc -> IO ()
    layLeft :: BufHandle -> Doc -> IO ()
    layLeft !BufHandle
    _ Doc
    NoDoc             = String -> IO ()
    forall a. String -> a
    error String
    "layLeft: NoDoc"
    layLeft BufHandle
    b (Union Doc
    p Doc
    q)        = BufHandle -> Doc -> IO ()
    layLeft BufHandle
    b (Doc -> IO ()) -> Doc -> IO ()
    forall a b. (a -> b) -> a -> b
    $! Doc -> Doc -> Doc
    first Doc
    p Doc
    q
    layLeft BufHandle
    b (Nest Int
    _ Doc
    p)         = BufHandle -> Doc -> IO ()
    layLeft BufHandle
    b (Doc -> IO ()) -> Doc -> IO ()
    forall a b. (a -> b) -> a -> b
    $! Doc
    p
    layLeft BufHandle
    b Doc
    Empty              = BufHandle -> Char -> IO ()
    bPutChar BufHandle
    b Char
    '\n'
    layLeft BufHandle
    b (NilAbove Doc
    p)       = BufHandle -> Char -> IO ()
    bPutChar BufHandle
    b Char
    '\n' IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BufHandle -> Doc -> IO ()
    layLeft BufHandle
    b Doc
    p
    layLeft BufHandle
    b (TextBeside TextDetails
    s Int
    _ Doc
    p) = BufHandle -> TextDetails -> IO ()
    put BufHandle
    b TextDetails
    s IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BufHandle -> Doc -> IO ()
    layLeft BufHandle
    b Doc
    p
     where
        put :: BufHandle -> TextDetails -> IO ()
    put !BufHandle
    b (Chr Char
    c)   = BufHandle -> Char -> IO ()
    bPutChar BufHandle
    b Char
    c
        put BufHandle
    b (Str String
    s)    = BufHandle -> String -> IO ()
    bPutStr  BufHandle
    b String
    s
        put BufHandle
    b (PStr FastString
    s)   = BufHandle -> FastString -> IO ()
    bPutFS   BufHandle
    b FastString
    s
        put BufHandle
    b (ZStr FastZString
    s)   = BufHandle -> FastZString -> IO ()
    bPutFZS  BufHandle
    b FastZString
    s
        put BufHandle
    b (LStr PtrString
    s)   = BufHandle -> PtrString -> IO ()
    bPutPtrString BufHandle
    b PtrString
    s
        put BufHandle
    b (RStr Int
    n Char
    c) = BufHandle -> Int -> Char -> IO ()
    bPutReplicate BufHandle
    b Int
    n Char
    c
    layLeft BufHandle
    _ Doc
    _                  = String -> IO ()
    forall a. HasCallStack => String -> a
    panic String
    "layLeft: Unhandled case"

    -- Define error=panic, for easier comparison with libraries/pretty.
    error :: String -> a
    error :: forall a. String -> a
    error = String -> a
    forall a. HasCallStack => String -> a
    panic