    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}

    {-|
    Module      : Text.Pretty.Simple.Internal.OutputPrinter
    Copyright   : (c) Dennis Gosnell, 2016
    License     : BSD-style (see LICENSE file)
    Maintainer  : cdep.illabout@gmail.com
    Stability   : experimental
    Portability : POSIX

    -}
    module Text.Pretty.Simple.Internal.OutputPrinter
      where

    #if __GLASGOW_HASKELL__ < 710
    -- We don't need this import for GHC 7.10 as it exports all required functions
    -- from Prelude
    import Control.Applicative
    #endif

    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Control.Monad.Reader (MonadReader(ask, reader), runReader)
    import Data.Char (isPrint, isSpace, ord)
    import Numeric (showHex)
    import Data.Foldable (fold)
    import Data.Text.Lazy (Text)
    import Data.Text.Lazy.Builder (Builder, fromString, toLazyText)
    import Data.Typeable (Typeable)
    import Data.List (dropWhileEnd, intercalate)
    import Data.Maybe (fromMaybe)
    import Text.Read (readMaybe)
    import GHC.Generics (Generic)
    import System.IO (Handle, hIsTerminalDevice)

    import Text.Pretty.Simple.Internal.Color
           (ColorOptions(..), colorReset, defaultColorOptionsDarkBg,
            defaultColorOptionsLightBg)
    import Text.Pretty.Simple.Internal.Output
           (NestLevel(..), Output(..), OutputType(..))

    -- | Determines whether pretty-simple should check if the output 'Handle' is a
    -- TTY device.  Normally, users only want to print in color if the output
    -- 'Handle' is a TTY device.
    data CheckColorTty
      = CheckColorTty
      -- ^ Check if the output 'Handle' is a TTY device.  If the output 'Handle' is
      -- a TTY device, determine whether to print in color based on
      -- 'outputOptionsColorOptions'. If not, then set 'outputOptionsColorOptions'
      -- to 'Nothing' so the output does not get colorized.
      | NoCheckColorTty
      -- ^ Don't check if the output 'Handle' is a TTY device.  Determine whether to
      -- colorize the output based solely on the value of
      -- 'outputOptionsColorOptions'.
      deriving (CheckColorTty -> CheckColorTty -> Bool
    (CheckColorTty -> CheckColorTty -> Bool)
    -> (CheckColorTty -> CheckColorTty -> Bool) -> Eq CheckColorTty
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: CheckColorTty -> CheckColorTty -> Bool
    $c/= :: CheckColorTty -> CheckColorTty -> Bool
    == :: CheckColorTty -> CheckColorTty -> Bool
    $c== :: CheckColorTty -> CheckColorTty -> Bool
    Eq, (forall x. CheckColorTty -> Rep CheckColorTty x)
    -> (forall x. Rep CheckColorTty x -> CheckColorTty)
    -> Generic CheckColorTty
    forall x. Rep CheckColorTty x -> CheckColorTty
    forall x. CheckColorTty -> Rep CheckColorTty x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep CheckColorTty x -> CheckColorTty
    $cfrom :: forall x. CheckColorTty -> Rep CheckColorTty x
    Generic, Int -> CheckColorTty -> ShowS
    [CheckColorTty] -> ShowS
    CheckColorTty -> String
    (Int -> CheckColorTty -> ShowS)
    -> (CheckColorTty -> String)
    -> ([CheckColorTty] -> ShowS)
    -> Show CheckColorTty
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [CheckColorTty] -> ShowS
    $cshowList :: [CheckColorTty] -> ShowS
    show :: CheckColorTty -> String
    $cshow :: CheckColorTty -> String
    showsPrec :: Int -> CheckColorTty -> ShowS
    $cshowsPrec :: Int -> CheckColorTty -> ShowS
    Show, Typeable)

    -- | Data-type wrapping up all the options available when rendering the list
    -- of 'Output's.
    data OutputOptions = OutputOptions
      { OutputOptions -> Int
    outputOptionsIndentAmount :: Int
      -- ^ Number of spaces to use when indenting.  It should probably be either 2
      -- or 4.
      , OutputOptions -> Maybe ColorOptions
    outputOptionsColorOptions :: Maybe ColorOptions
      -- ^ If this is 'Nothing', then don't colorize the output.  If this is
      -- @'Just' colorOptions@, then use @colorOptions@ to colorize the output.
      --
      , OutputOptions -> Bool
    outputOptionsEscapeNonPrintable :: Bool
      -- ^ Whether to replace non-printable characters with hexadecimal escape
      -- sequences.
      } deriving (OutputOptions -> OutputOptions -> Bool
    (OutputOptions -> OutputOptions -> Bool)
    -> (OutputOptions -> OutputOptions -> Bool) -> Eq OutputOptions
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: OutputOptions -> OutputOptions -> Bool
    $c/= :: OutputOptions -> OutputOptions -> Bool
    == :: OutputOptions -> OutputOptions -> Bool
    $c== :: OutputOptions -> OutputOptions -> Bool
    Eq, (forall x. OutputOptions -> Rep OutputOptions x)
    -> (forall x. Rep OutputOptions x -> OutputOptions)
    -> Generic OutputOptions
    forall x. Rep OutputOptions x -> OutputOptions
    forall x. OutputOptions -> Rep OutputOptions x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep OutputOptions x -> OutputOptions
    $cfrom :: forall x. OutputOptions -> Rep OutputOptions x
    Generic, Int -> OutputOptions -> ShowS
    [OutputOptions] -> ShowS
    OutputOptions -> String
    (Int -> OutputOptions -> ShowS)
    -> (OutputOptions -> String)
    -> ([OutputOptions] -> ShowS)
    -> Show OutputOptions
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [OutputOptions] -> ShowS
    $cshowList :: [OutputOptions] -> ShowS
    show :: OutputOptions -> String
    $cshow :: OutputOptions -> String
    showsPrec :: Int -> OutputOptions -> ShowS
    $cshowsPrec :: Int -> OutputOptions -> ShowS
    Show, Typeable)

    -- | Default values for 'OutputOptions' when printing to a console with a dark
    -- background.  'outputOptionsIndentAmount' is 4, and
    -- 'outputOptionsColorOptions' is 'defaultColorOptionsDarkBg'.
    defaultOutputOptionsDarkBg :: OutputOptions
    defaultOutputOptionsDarkBg :: OutputOptions
    defaultOutputOptionsDarkBg =
      OutputOptions :: Int -> Maybe ColorOptions -> Bool -> OutputOptions
    OutputOptions
      { outputOptionsIndentAmount :: Int
    outputOptionsIndentAmount = 4
      , outputOptionsColorOptions :: Maybe ColorOptions
    outputOptionsColorOptions = ColorOptions -> Maybe ColorOptions
    forall a. a -> Maybe a
    Just ColorOptions
    defaultColorOptionsDarkBg
      , outputOptionsEscapeNonPrintable :: Bool
    outputOptionsEscapeNonPrintable = Bool
    True
      }

    -- | Default values for 'OutputOptions' when printing to a console with a light
    -- background.  'outputOptionsIndentAmount' is 4, and
    -- 'outputOptionsColorOptions' is 'defaultColorOptionsLightBg'.
    defaultOutputOptionsLightBg :: OutputOptions
    defaultOutputOptionsLightBg :: OutputOptions
    defaultOutputOptionsLightBg =
      OutputOptions :: Int -> Maybe ColorOptions -> Bool -> OutputOptions
    OutputOptions
      { outputOptionsIndentAmount :: Int
    outputOptionsIndentAmount = 4
      , outputOptionsColorOptions :: Maybe ColorOptions
    outputOptionsColorOptions = ColorOptions -> Maybe ColorOptions
    forall a. a -> Maybe a
    Just ColorOptions
    defaultColorOptionsLightBg
      , outputOptionsEscapeNonPrintable :: Bool
    outputOptionsEscapeNonPrintable = Bool
    True
      }

    -- | Default values for 'OutputOptions' when printing using using ANSI escape
    -- sequences for color.  'outputOptionsIndentAmount' is 4, and
    -- 'outputOptionsColorOptions' is 'Nothing'.
    defaultOutputOptionsNoColor :: OutputOptions
    defaultOutputOptionsNoColor :: OutputOptions
    defaultOutputOptionsNoColor =
      OutputOptions :: Int -> Maybe ColorOptions -> Bool -> OutputOptions
    OutputOptions
      { outputOptionsIndentAmount :: Int
    outputOptionsIndentAmount = 4
      , outputOptionsColorOptions :: Maybe ColorOptions
    outputOptionsColorOptions = Maybe ColorOptions
    forall a. Maybe a
    Nothing
      , outputOptionsEscapeNonPrintable :: Bool
    outputOptionsEscapeNonPrintable = Bool
    True
      }

    -- | Given 'OutputOptions', disable colorful output if the given handle
    -- is not connected to a TTY.
    hCheckTTY :: MonadIO m => Handle -> OutputOptions -> m OutputOptions
    hCheckTTY :: Handle -> OutputOptions -> m OutputOptions
    hCheckTTY h :: Handle
    h options :: OutputOptions
    options = IO OutputOptions -> m OutputOptions
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO OutputOptions -> m OutputOptions)
    -> IO OutputOptions -> m OutputOptions
    forall a b. (a -> b) -> a -> b
    $ Bool -> OutputOptions
    conv (Bool -> OutputOptions) -> IO Bool -> IO OutputOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Bool
    tty
      where
        conv :: Bool -> OutputOptions
        conv :: Bool -> OutputOptions
    conv True = OutputOptions
    options
        conv False = OutputOptions
    options { outputOptionsColorOptions :: Maybe ColorOptions
    outputOptionsColorOptions = Maybe ColorOptions
    forall a. Maybe a
    Nothing }

        tty :: IO Bool
        tty :: IO Bool
    tty = Handle -> IO Bool
    hIsTerminalDevice Handle
    h

    -- | Given 'OutputOptions' and a list of 'Output', turn the 'Output' into a
    -- lazy 'Text'.
    render :: OutputOptions -> [Output] -> Text
    render :: OutputOptions -> [Output] -> Text
    render options :: OutputOptions
    options = Builder -> Text
    toLazyText (Builder -> Text) -> ([Output] -> Builder) -> [Output] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Output -> Builder -> Builder) -> Builder -> [Output] -> Builder
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Output -> Builder -> Builder
    foldFunc "" ([Output] -> Builder)
    -> ([Output] -> [Output]) -> [Output] -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Output] -> [Output]
    modificationsOutputList
      where
        foldFunc :: Output -> Builder -> Builder
        foldFunc :: Output -> Builder -> Builder
    foldFunc output :: Output
    output accum :: Builder
    accum = Reader OutputOptions Builder -> OutputOptions -> Builder
    forall r a. Reader r a -> r -> a
    runReader (Output -> Reader OutputOptions Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    Output -> m Builder
    renderOutput Output
    output) OutputOptions
    options Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    accum

    -- | Render a single 'Output' as a 'Builder', using the options specified in
    -- the 'OutputOptions'.
    renderOutput :: MonadReader OutputOptions m => Output -> m Builder
    renderOutput :: Output -> m Builder
    renderOutput (Output nest :: NestLevel
    nest OutputCloseBrace) = NestLevel -> Builder -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> Builder -> m Builder
    renderRainbowParenFor NestLevel
    nest "}"
    renderOutput (Output nest :: NestLevel
    nest OutputCloseBracket) = NestLevel -> Builder -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> Builder -> m Builder
    renderRainbowParenFor NestLevel
    nest "]"
    renderOutput (Output nest :: NestLevel
    nest OutputCloseParen) = NestLevel -> Builder -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> Builder -> m Builder
    renderRainbowParenFor NestLevel
    nest ")"
    renderOutput (Output nest :: NestLevel
    nest OutputComma) = NestLevel -> Builder -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> Builder -> m Builder
    renderRainbowParenFor NestLevel
    nest ","
    renderOutput (Output _ OutputIndent) = do
        Int
    indentSpaces <- (OutputOptions -> Int) -> m Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Int
    outputOptionsIndentAmount
        Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Builder -> m Builder)
    -> ([Builder] -> Builder) -> [Builder] -> m Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> m Builder) -> [Builder] -> m Builder
    forall a b. (a -> b) -> a -> b
    $ Int -> Builder -> [Builder]
    forall a. Int -> a -> [a]
    replicate Int
    indentSpaces " "
    renderOutput (Output _ OutputNewLine) = Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "\n"
    renderOutput (Output nest :: NestLevel
    nest OutputOpenBrace) = NestLevel -> Builder -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> Builder -> m Builder
    renderRainbowParenFor NestLevel
    nest "{"
    renderOutput (Output nest :: NestLevel
    nest OutputOpenBracket) = NestLevel -> Builder -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> Builder -> m Builder
    renderRainbowParenFor NestLevel
    nest "["
    renderOutput (Output nest :: NestLevel
    nest OutputOpenParen) = NestLevel -> Builder -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> Builder -> m Builder
    renderRainbowParenFor NestLevel
    nest "("
    renderOutput (Output _ (OutputOther string :: String
    string)) = do
      Int
    indentSpaces <- (OutputOptions -> Int) -> m Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Int
    outputOptionsIndentAmount
      let spaces :: String
    spaces = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    indentSpaces Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2) ' '
      -- TODO: This probably shouldn't be a string to begin with.
      Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Builder -> m Builder) -> Builder -> m Builder
    forall a b. (a -> b) -> a -> b
    $ String -> Builder
    fromString (String -> Builder) -> String -> Builder
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    indentSubsequentLinesWith String
    spaces String
    string
    renderOutput (Output _ (OutputNumberLit number :: String
    number)) = do
      [m Builder] -> m Builder
    forall (f :: * -> *) a (t :: * -> *).
    (Monad f, Monoid a, Traversable t) =>
    t (f a) -> f a
    sequenceFold
        [ m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorNum
        , Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Builder
    fromString String
    number)
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset
        ]
    renderOutput (Output _ (OutputStringLit string :: String
    string)) = do
      OutputOptions
    options <- m OutputOptions
    forall r (m :: * -> *). MonadReader r m => m r
    ask

      [m Builder] -> m Builder
    forall (f :: * -> *) a (t :: * -> *).
    (Monad f, Monoid a, Traversable t) =>
    t (f a) -> f a
    sequenceFold
        [ m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorQuote
        , Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "\""
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorString
        -- TODO: This probably shouldn't be a string to begin with.
        , Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Builder
    fromString (OutputOptions -> ShowS
    process OutputOptions
    options String
    string))
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorQuote
        , Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "\""
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset
        ]
      where
        process :: OutputOptions -> String -> String
        process :: OutputOptions -> ShowS
    process opts :: OutputOptions
    opts =
          if OutputOptions -> Bool
    outputOptionsEscapeNonPrintable OutputOptions
    opts
            then String -> ShowS
    indentSubsequentLinesWith String
    spaces ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    escapeNonPrintable ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    readStr
            else String -> ShowS
    indentSubsequentLinesWith String
    spaces ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    readStr
          where
            spaces :: String
            spaces :: String
    spaces = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    indentSpaces Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2) ' '

            indentSpaces :: Int
            indentSpaces :: Int
    indentSpaces =  OutputOptions -> Int
    outputOptionsIndentAmount OutputOptions
    opts

            readStr :: String -> String
            readStr :: ShowS
    readStr s :: String
    s = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    s (Maybe String -> String) -> (String -> Maybe String) -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe String
    forall a. Read a => String -> Maybe a
    readMaybe ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ '"'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "\""
    renderOutput (Output _ (OutputCharLit string :: String
    string)) = do
      [m Builder] -> m Builder
    forall (f :: * -> *) a (t :: * -> *).
    (Monad f, Monoid a, Traversable t) =>
    t (f a) -> f a
    sequenceFold
        [ m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorQuote
        , Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "'"
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorString
        , Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Builder
    fromString String
    string)
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorQuote
        , Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "'"
        , m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset
        ]

    -- | Replace non-printable characters with hex escape sequences.
    --
    -- >>> escapeNonPrintable "\x1\x2"
    -- "\\x1\\x2"
    --
    -- Newlines will not be escaped.
    --
    -- >>> escapeNonPrintable "hello\nworld"
    -- "hello\nworld"
    --
    -- Printable characters will not be escaped.
    --
    -- >>> escapeNonPrintable "h\101llo"
    -- "hello"
    escapeNonPrintable :: String -> String
    escapeNonPrintable :: ShowS
    escapeNonPrintable input :: String
    input = (Char -> ShowS) -> String -> ShowS
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Char -> ShowS
    escape "" String
    input

    -- Replace an unprintable character except a newline
    -- with a hex escape sequence.
    escape :: Char -> ShowS
    escape :: Char -> ShowS
    escape c :: Char
    c
      | Char -> Bool
    isPrint Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\n' = (Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :)
      | Bool
    otherwise = ('\\'Char -> ShowS
    forall a. a -> [a] -> [a]
    :) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ('x'Char -> ShowS
    forall a. a -> [a] -> [a]
    :) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. (Integral a, Show a) => a -> ShowS
    showHex (Char -> Int
    ord Char
    c)

    -- |
    -- >>> indentSubsequentLinesWith "  " "aaa"
    -- "aaa"
    --
    -- >>> indentSubsequentLinesWith "  " "aaa\nbbb\nccc"
    -- "aaa\n  bbb\n  ccc"
    --
    -- >>> indentSubsequentLinesWith "  " ""
    -- ""
    indentSubsequentLinesWith :: String -> String -> String
    indentSubsequentLinesWith :: String -> ShowS
    indentSubsequentLinesWith indent :: String
    indent input :: String
    input =
      String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "\n" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ ([String]
    start [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    indent String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    end
      where (start :: [String]
    start, end :: [String]
    end) = Int -> [String] -> ([String], [String])
    forall a. Int -> [a] -> ([a], [a])
    splitAt 1 ([String] -> ([String], [String]))
    -> [String] -> ([String], [String])
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    input

    -- | Produce a 'Builder' corresponding to the ANSI escape sequence for the
    -- color for the @\"@, based on whether or not 'outputOptionsColorOptions' is
    -- 'Just' or 'Nothing', and the value of 'colorQuote'.
    useColorQuote :: forall m. MonadReader OutputOptions m => m Builder
    useColorQuote :: m Builder
    useColorQuote = Builder
    -> (ColorOptions -> Builder) -> Maybe ColorOptions -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ColorOptions -> Builder
    colorQuote (Maybe ColorOptions -> Builder)
    -> m (Maybe ColorOptions) -> m Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (OutputOptions -> Maybe ColorOptions) -> m (Maybe ColorOptions)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Maybe ColorOptions
    outputOptionsColorOptions

    -- | Produce a 'Builder' corresponding to the ANSI escape sequence for the
    -- color for the characters of a string, based on whether or not
    -- 'outputOptionsColorOptions' is 'Just' or 'Nothing', and the value of
    -- 'colorString'.
    useColorString :: forall m. MonadReader OutputOptions m => m Builder
    useColorString :: m Builder
    useColorString = Builder
    -> (ColorOptions -> Builder) -> Maybe ColorOptions -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ColorOptions -> Builder
    colorString (Maybe ColorOptions -> Builder)
    -> m (Maybe ColorOptions) -> m Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (OutputOptions -> Maybe ColorOptions) -> m (Maybe ColorOptions)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Maybe ColorOptions
    outputOptionsColorOptions

    useColorError :: forall m. MonadReader OutputOptions m => m Builder
    useColorError :: m Builder
    useColorError = Builder
    -> (ColorOptions -> Builder) -> Maybe ColorOptions -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ColorOptions -> Builder
    colorError (Maybe ColorOptions -> Builder)
    -> m (Maybe ColorOptions) -> m Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (OutputOptions -> Maybe ColorOptions) -> m (Maybe ColorOptions)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Maybe ColorOptions
    outputOptionsColorOptions

    useColorNum :: forall m. MonadReader OutputOptions m => m Builder
    useColorNum :: m Builder
    useColorNum = Builder
    -> (ColorOptions -> Builder) -> Maybe ColorOptions -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ColorOptions -> Builder
    colorNum (Maybe ColorOptions -> Builder)
    -> m (Maybe ColorOptions) -> m Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (OutputOptions -> Maybe ColorOptions) -> m (Maybe ColorOptions)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Maybe ColorOptions
    outputOptionsColorOptions

    -- | Produce a 'Builder' corresponding to the ANSI escape sequence for
    -- resetting the console color back to the default. Produces an empty 'Builder'
    -- if 'outputOptionsColorOptions' is 'Nothing'.
    useColorReset :: forall m. MonadReader OutputOptions m => m Builder
    useColorReset :: m Builder
    useColorReset = Builder
    -> (ColorOptions -> Builder) -> Maybe ColorOptions -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" (Builder -> ColorOptions -> Builder
    forall a b. a -> b -> a
    const Builder
    colorReset) (Maybe ColorOptions -> Builder)
    -> m (Maybe ColorOptions) -> m Builder
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (OutputOptions -> Maybe ColorOptions) -> m (Maybe ColorOptions)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Maybe ColorOptions
    outputOptionsColorOptions

    -- | Produce a 'Builder' representing the ANSI escape sequence for the color of
    -- the rainbow parenthesis, given an input 'NestLevel' and 'Builder' to use as
    -- the input character.
    --
    -- If 'outputOptionsColorOptions' is 'Nothing', then just return the input
    -- character.  If it is 'Just', then return the input character colorized.
    renderRainbowParenFor
      :: MonadReader OutputOptions m
      => NestLevel -> Builder -> m Builder
    renderRainbowParenFor :: NestLevel -> Builder -> m Builder
    renderRainbowParenFor nest :: NestLevel
    nest string :: Builder
    string =
      [m Builder] -> m Builder
    forall (f :: * -> *) a (t :: * -> *).
    (Monad f, Monoid a, Traversable t) =>
    t (f a) -> f a
    sequenceFold [NestLevel -> m Builder
    forall (m :: * -> *).
    MonadReader OutputOptions m =>
    NestLevel -> m Builder
    useColorRainbowParens NestLevel
    nest, Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Builder
    string, m Builder
    forall (m :: * -> *). MonadReader OutputOptions m => m Builder
    useColorReset]

    useColorRainbowParens
      :: forall m.
         MonadReader OutputOptions m
      => NestLevel -> m Builder
    useColorRainbowParens :: NestLevel -> m Builder
    useColorRainbowParens nest :: NestLevel
    nest = do
      Maybe ColorOptions
    maybeOutputColor <- (OutputOptions -> Maybe ColorOptions) -> m (Maybe ColorOptions)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    reader OutputOptions -> Maybe ColorOptions
    outputOptionsColorOptions
      Builder -> m Builder
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Builder -> m Builder) -> Builder -> m Builder
    forall a b. (a -> b) -> a -> b
    $
        case Maybe ColorOptions
    maybeOutputColor of
          Just ColorOptions {[Builder]
    colorRainbowParens :: ColorOptions -> [Builder]
    colorRainbowParens :: [Builder]
    colorRainbowParens} -> do
            let choicesLen :: Int
    choicesLen = [Builder] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Builder]
    colorRainbowParens
            if Int
    choicesLen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0
              then ""
              else [Builder]
    colorRainbowParens [Builder] -> Int -> Builder
    forall a. [a] -> Int -> a
    !! (NestLevel -> Int
    unNestLevel NestLevel
    nest Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    choicesLen)
          Nothing -> ""

    -- | This is simply @'fmap' 'fold' '.' 'sequence'@.
    sequenceFold :: (Monad f, Monoid a, Traversable t) => t (f a) -> f a
    sequenceFold :: t (f a) -> f a
    sequenceFold = (t a -> a) -> f (t a) -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap t a -> a
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold (f (t a) -> f a) -> (t (f a) -> f (t a)) -> t (f a) -> f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . t (f a) -> f (t a)
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence

    -- | A function that performs optimizations and modifications to a list of
    -- input 'Output's.
    --
    -- An sample of an optimization is 'removeStartingNewLine' which just removes a
    -- newline if it is the first item in an 'Output' list.
    modificationsOutputList :: [Output] -> [Output]
    modificationsOutputList :: [Output] -> [Output]
    modificationsOutputList =
      [Output] -> [Output]
    removeTrailingSpacesInOtherBeforeNewLine ([Output] -> [Output])
    -> ([Output] -> [Output]) -> [Output] -> [Output]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Output] -> [Output]
    shrinkWhitespaceInOthers ([Output] -> [Output])
    -> ([Output] -> [Output]) -> [Output] -> [Output]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Output] -> [Output]
    compressOthers ([Output] -> [Output])
    -> ([Output] -> [Output]) -> [Output] -> [Output]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Output] -> [Output]
    removeStartingNewLine

    -- | Remove a 'OutputNewLine' if it is the first item in the 'Output' list.
    --
    -- >>> removeStartingNewLine [Output 3 OutputNewLine, Output 3 OutputComma]
    -- [Output {outputNestLevel = NestLevel {unNestLevel = 3}, outputOutputType = OutputComma}]
    removeStartingNewLine :: [Output] -> [Output]
    removeStartingNewLine :: [Output] -> [Output]
    removeStartingNewLine ((Output _ OutputNewLine) : t :: [Output]
    t) = [Output]
    t
    removeStartingNewLine outputs :: [Output]
    outputs = [Output]
    outputs

    -- | Remove trailing spaces from the end of a 'OutputOther' token if it is
    -- followed by a 'OutputNewLine', or if it is the final 'Output' in the list.
    -- This function assumes that there is a single 'OutputOther' before any
    -- 'OutputNewLine' (and before the end of the list), so it must be run after
    -- running 'compressOthers'.
    --
    -- >>> removeTrailingSpacesInOtherBeforeNewLine [Output 2 (OutputOther "foo  "), Output 4 OutputNewLine]
    -- [Output {outputNestLevel = NestLevel {unNestLevel = 2}, outputOutputType = OutputOther "foo"},Output {outputNestLevel = NestLevel {unNestLevel = 4}, outputOutputType = OutputNewLine}]
    removeTrailingSpacesInOtherBeforeNewLine :: [Output] -> [Output]
    removeTrailingSpacesInOtherBeforeNewLine :: [Output] -> [Output]
    removeTrailingSpacesInOtherBeforeNewLine [] = []
    removeTrailingSpacesInOtherBeforeNewLine (Output nest :: NestLevel
    nest (OutputOther string :: String
    string):[]) =
      (NestLevel -> OutputType -> Output
    Output NestLevel
    nest (String -> OutputType
    OutputOther (String -> OutputType) -> String -> OutputType
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEnd Char -> Bool
    isSpace String
    string))Output -> [Output] -> [Output]
    forall a. a -> [a] -> [a]
    :[]
    removeTrailingSpacesInOtherBeforeNewLine (Output nest :: NestLevel
    nest (OutputOther string :: String
    string):nl :: Output
    nl@(Output _ OutputNewLine):t :: [Output]
    t) =
      (NestLevel -> OutputType -> Output
    Output NestLevel
    nest (String -> OutputType
    OutputOther (String -> OutputType) -> String -> OutputType
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEnd Char -> Bool
    isSpace String
    string))Output -> [Output] -> [Output]
    forall a. a -> [a] -> [a]
    :Output
    nlOutput -> [Output] -> [Output]
    forall a. a -> [a] -> [a]
    :[Output] -> [Output]
    removeTrailingSpacesInOtherBeforeNewLine [Output]
    t
    removeTrailingSpacesInOtherBeforeNewLine (h :: Output
    h:t :: [Output]
    t) = Output
    h Output -> [Output] -> [Output]
    forall a. a -> [a] -> [a]
    : [Output] -> [Output]
    removeTrailingSpacesInOtherBeforeNewLine [Output]
    t

    -- | If there are two subsequent 'OutputOther' tokens, combine them into just
    -- one 'OutputOther'.
    --
    -- >>> compressOthers [Output 0 (OutputOther "foo"), Output 0 (OutputOther "bar")]
    -- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther "foobar"}]
    compressOthers :: [Output] -> [Output]
    compressOthers :: [Output] -> [Output]
    compressOthers [] = []
    compressOthers (Output _ (OutputOther string1 :: String
    string1):(Output nest :: NestLevel
    nest (OutputOther string2 :: String
    string2)):t :: [Output]
    t) =
      [Output] -> [Output]
    compressOthers ((NestLevel -> OutputType -> Output
    Output NestLevel
    nest (String -> OutputType
    OutputOther (String
    string1 String -> ShowS
    forall a. Monoid a => a -> a -> a
    `mappend` String
    string2))) Output -> [Output] -> [Output]
    forall a. a -> [a] -> [a]
    : [Output]
    t)
    compressOthers (h :: Output
    h:t :: [Output]
    t) = Output
    h Output -> [Output] -> [Output]
    forall a. a -> [a] -> [a]
    : [Output] -> [Output]
    compressOthers [Output]
    t

    -- | In each 'OutputOther' token, compress multiple whitespaces to just one
    -- whitespace.
    --
    -- >>> shrinkWhitespaceInOthers [Output 0 (OutputOther "  hello  ")]
    -- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " hello "}]
    shrinkWhitespaceInOthers :: [Output] -> [Output]
    shrinkWhitespaceInOthers :: [Output] -> [Output]
    shrinkWhitespaceInOthers = (Output -> Output) -> [Output] -> [Output]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Output -> Output
    shrinkWhitespaceInOther

    shrinkWhitespaceInOther :: Output -> Output
    shrinkWhitespaceInOther :: Output -> Output
    shrinkWhitespaceInOther (Output nest :: NestLevel
    nest (OutputOther string :: String
    string)) =
      NestLevel -> OutputType -> Output
    Output NestLevel
    nest (OutputType -> Output)
    -> (String -> OutputType) -> String -> Output
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> OutputType
    OutputOther (String -> Output) -> String -> Output
    forall a b. (a -> b) -> a -> b
    $ ShowS
    shrinkWhitespace String
    string
    shrinkWhitespaceInOther other :: Output
    other = Output
    other

    shrinkWhitespace :: String -> String
    shrinkWhitespace :: ShowS
    shrinkWhitespace (' ':' ':t :: String
    t) = ShowS
    shrinkWhitespace (' 'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    t)
    shrinkWhitespace (h :: Char
    h:t :: String
    t) = Char
    h Char -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    shrinkWhitespace String
    t
    shrinkWhitespace "" = ""