    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Data.SCargot.Print
             ( -- * Pretty-Printing
               encodeOne
             , encode
             , encodeOneLazy
             , encodeLazy
               -- * Pretty-Printing Control
             , SExprPrinter
             , Indent(..)
             , setFromCarrier
             , setMaxWidth
             , removeMaxWidth
             , setIndentAmount
             , setIndentStrategy
               -- * Default Printing Strategies
             , basicPrint
             , flatPrint
             , unconstrainedPrint
             ) where

    import qualified Data.Foldable as F
    import           Data.Monoid ((<>))
    import qualified Data.Sequence as Seq
    import           Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import qualified Data.Text.Lazy.Builder as B
    import qualified Data.Traversable as T

    import           Data.SCargot.Repr

    -- | The 'Indent' type is used to determine how to indent subsequent
    --   s-expressions in a list, after printing the head of the list.  This only
    --   applies if the entire list cannot be printed within the allowable
    --   'SExprPrinter.maxWidth'; a sub-maxWidth printing will not add newlines or
    --   indentation.
    data Indent
      = Swing -- ^ A 'Swing' indent will indent subsequent exprs some fixed
              --   amount more than the current line.
              --
              --   > (foo
              --   >   bar
              --   >   baz
              --   >   quux)
              --
              -- Any 'SExprPrinter.indentAmount' applies relative to the entry at the
              -- head of the list; in the above example, the indentAmount is 1.
      | SwingAfter Int -- ^ A 'SwingAfter' @n@ indent will try to print the
                       --   first @n@ expressions after the head on the same
                       --   line as the head, and all after will be swung.
                       --   'SwingAfter' @0@ is equivalent to 'Swing'.
                       --
                       --   > (foo bar
                       --   >   baz
                       --   >   quux)
                       --
                       -- The 'SExprPrinter.indentAmount' is handled in the same way
                       -- as for the 'Swing' setting.
      | Align -- ^ An 'Align' indent will print the first expression after the head
              -- on the same line, and subsequent expressions will be aligned with
              -- that one.  Note that this ignores any 'SExprPrinter.indentAmount'
              -- specified for the printer.
              --
              --   > (foo bar
              --   >      baz
              --   >      quux)
        deriving (Indent -> Indent -> Bool
    (Indent -> Indent -> Bool)
    -> (Indent -> Indent -> Bool) -> Eq Indent
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Indent -> Indent -> Bool
    == :: Indent -> Indent -> Bool
    $c/= :: Indent -> Indent -> Bool
    /= :: Indent -> Indent -> Bool
    Eq, Int -> Indent -> ShowS
    [Indent] -> ShowS
    Indent -> String
    (Int -> Indent -> ShowS)
    -> (Indent -> String) -> ([Indent] -> ShowS) -> Show Indent
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Indent -> ShowS
    showsPrec :: Int -> Indent -> ShowS
    $cshow :: Indent -> String
    show :: Indent -> String
    $cshowList :: [Indent] -> ShowS
    showList :: [Indent] -> ShowS
    Show)

    -- | A 'SExprPrinter' value describes how to print a given value as an
    --   s-expression. The @carrier@ type parameter indicates the value
    --   that will be printed, and the @atom@ parameter indicates the type
    --   that will represent tokens in an s-expression structure.
    data SExprPrinter atom carrier = SExprPrinter
      { forall atom carrier. SExprPrinter atom carrier -> atom -> Text
    atomPrinter  :: atom -> Text
          -- ^ How to serialize a given atom to 'Text'.
      , forall atom carrier.
    SExprPrinter atom carrier -> carrier -> SExpr atom
    fromCarrier  :: carrier -> SExpr atom
          -- ^ How to turn a carrier type back into a 'Sexpr'.
      , forall atom carrier.
    SExprPrinter atom carrier -> SExpr atom -> Indent
    swingIndent  :: SExpr atom -> Indent
          -- ^ How to indent subsequent expressions, as determined by
          --   the head of the list.
      , forall atom carrier. SExprPrinter atom carrier -> Int
    indentAmount :: Int
          -- ^ How much to indent after a swung indentation, relative to the *head*
          -- element.
      , forall atom carrier. SExprPrinter atom carrier -> Maybe Int
    maxWidth     :: Maybe Int
          -- ^ The maximum width (if any) If this is 'None' then the resulting
          --   s-expression might be printed on one line (if
          --   'SExprPrinter.indentPrint' is 'False') and might be pretty-printed in
          --   the most naive way possible (if 'SExprPrinter.indentPrint' is 'True').
      , forall atom carrier. SExprPrinter atom carrier -> Bool
    indentPrint :: Bool
          -- ^ Whether to indent or not.
      }

    -- | A default 'SExprPrinter' struct that will always print a 'SExpr'
    --   as a single line.
    flatPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom)
    flatPrint :: forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
    flatPrint = (\SExprPrinter atom (SExpr atom)
    p -> SExprPrinter atom (SExpr atom)
    p { indentPrint :: Bool
    indentPrint = Bool
    False}) (SExprPrinter atom (SExpr atom) -> SExprPrinter atom (SExpr atom))
    -> ((atom -> Text) -> SExprPrinter atom (SExpr atom))
    -> (atom -> Text)
    -> SExprPrinter atom (SExpr atom)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SExprPrinter atom (SExpr atom) -> SExprPrinter atom (SExpr atom)
    forall atom carrier.
    SExprPrinter atom carrier -> SExprPrinter atom carrier
    removeMaxWidth (SExprPrinter atom (SExpr atom) -> SExprPrinter atom (SExpr atom))
    -> ((atom -> Text) -> SExprPrinter atom (SExpr atom))
    -> (atom -> Text)
    -> SExprPrinter atom (SExpr atom)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (atom -> Text) -> SExprPrinter atom (SExpr atom)
    forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
    basicPrint

    -- | A default 'SExprPrinter' struct that will always swing subsequent
    --   expressions onto later lines if they're too long, indenting them
    --   by two spaces, and uses a soft maximum width of 80 characters
    basicPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom)
    basicPrint :: forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
    basicPrint atom -> Text
    printer = SExprPrinter
      { atomPrinter :: atom -> Text
    atomPrinter  = atom -> Text
    printer
      , fromCarrier :: SExpr atom -> SExpr atom
    fromCarrier  = SExpr atom -> SExpr atom
    forall a. a -> a
    id
      , swingIndent :: SExpr atom -> Indent
    swingIndent  = Indent -> SExpr atom -> Indent
    forall a b. a -> b -> a
    const Indent
    Swing
      , indentAmount :: Int
    indentAmount = Int
    2
      , maxWidth :: Maybe Int
    maxWidth     = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    80
      , indentPrint :: Bool
    indentPrint  = Bool
    True
      }

    -- | A default 'SExprPrinter' struct that will always swing subsequent
    -- expressions onto later lines if they're too long, indenting them by
    -- two spaces, but makes no effort to keep the pretty-printed sources
    -- inside a maximum width. In the case that we want indented printing
    -- but don't care about a "maximum" width, we can print more
    -- efficiently than in other situations.
    unconstrainedPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom)
    unconstrainedPrint :: forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
    unconstrainedPrint = SExprPrinter atom (SExpr atom) -> SExprPrinter atom (SExpr atom)
    forall atom carrier.
    SExprPrinter atom carrier -> SExprPrinter atom carrier
    removeMaxWidth (SExprPrinter atom (SExpr atom) -> SExprPrinter atom (SExpr atom))
    -> ((atom -> Text) -> SExprPrinter atom (SExpr atom))
    -> (atom -> Text)
    -> SExprPrinter atom (SExpr atom)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (atom -> Text) -> SExprPrinter atom (SExpr atom)
    forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
    basicPrint

    data Size = Size
      { Size -> Int
    sizeSum :: !Int
      , Size -> Int
    sizeMax :: !Int
      } deriving (Int -> Size -> ShowS
    [Size] -> ShowS
    Size -> String
    (Int -> Size -> ShowS)
    -> (Size -> String) -> ([Size] -> ShowS) -> Show Size
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Size -> ShowS
    showsPrec :: Int -> Size -> ShowS
    $cshow :: Size -> String
    show :: Size -> String
    $cshowList :: [Size] -> ShowS
    showList :: [Size] -> ShowS
    Show)

    -- | This is an intermediate representation which is like (but not
    -- identical to) a RichSExpr representation. In particular, it has a
    -- special case for empty lists, and it also keeps a single piece of
    -- indent information around for each list
    data Intermediate
      = IAtom Text
      -- ^ An atom, already serialized
      | IList Indent Size Intermediate (Seq.Seq Intermediate) (Maybe Text)
      -- ^ A (possibly-improper) list, with the intended indentation
      -- strategy, the head of the list, the main set of elements, and the
      -- final improper element (if it exists)
      | IEmpty
      -- ^ An empty list
        deriving Int -> Intermediate -> ShowS
    [Intermediate] -> ShowS
    Intermediate -> String
    (Int -> Intermediate -> ShowS)
    -> (Intermediate -> String)
    -> ([Intermediate] -> ShowS)
    -> Show Intermediate
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Intermediate -> ShowS
    showsPrec :: Int -> Intermediate -> ShowS
    $cshow :: Intermediate -> String
    show :: Intermediate -> String
    $cshowList :: [Intermediate] -> ShowS
    showList :: [Intermediate] -> ShowS
    Show

    sizeOf :: Intermediate -> Size
    sizeOf :: Intermediate -> Size
    sizeOf Intermediate
    IEmpty = Int -> Int -> Size
    Size Int
    2 Int
    2
    sizeOf (IAtom Text
    t) = Int -> Int -> Size
    Size Int
    len Int
    len where len :: Int
    len = Text -> Int
    T.length Text
    t
    sizeOf (IList Indent
    _ (Size Int
    n Int
    m) Intermediate
    _ Seq Intermediate
    _ Maybe Text
    _) = Int -> Int -> Size
    Size (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)

    concatSize :: Size -> Size -> Size
    concatSize :: Size -> Size -> Size
    concatSize Size
    l Size
    r = Size
      { sizeSum :: Int
    sizeSum = Size -> Int
    sizeSum Size
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Size -> Int
    sizeSum Size
    r  -- 1 for the ' ' between elements
      , sizeMax :: Int
    sizeMax = Size -> Int
    sizeMax Size
    l Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `max` Size -> Int
    sizeMax Size
    r
      }

    toIntermediate :: SExprPrinter a (SExpr a) -> SExpr a -> Intermediate
    toIntermediate :: forall a. SExprPrinter a (SExpr a) -> SExpr a -> Intermediate
    toIntermediate
      SExprPrinter { atomPrinter :: forall atom carrier. SExprPrinter atom carrier -> atom -> Text
    atomPrinter = a -> Text
    printAtom
                   , swingIndent :: forall atom carrier.
    SExprPrinter atom carrier -> SExpr atom -> Indent
    swingIndent = SExpr a -> Indent
    swing
                   } = SExpr a -> Intermediate
    headOf
      where
        headOf :: SExpr a -> Intermediate
    headOf (SAtom a
    a)    = Text -> Intermediate
    IAtom (a -> Text
    printAtom a
    a)
        headOf SExpr a
    SNil         = Intermediate
    IEmpty
        headOf (SCons SExpr a
    x SExpr a
    xs) =
          Indent
    -> Intermediate
    -> Seq Intermediate
    -> SExpr a
    -> Size
    -> Intermediate
    gather (SExpr a -> Indent
    swing SExpr a
    x) Intermediate
    hd Seq Intermediate
    forall a. Seq a
    Seq.empty SExpr a
    xs (Intermediate -> Size
    sizeOf Intermediate
    hd) where hd :: Intermediate
    hd = SExpr a -> Intermediate
    headOf SExpr a
    x
        gather :: Indent
    -> Intermediate
    -> Seq Intermediate
    -> SExpr a
    -> Size
    -> Intermediate
    gather Indent
    sw Intermediate
    hd Seq Intermediate
    rs SExpr a
    SNil Size
    sz =
          Indent
    -> Size
    -> Intermediate
    -> Seq Intermediate
    -> Maybe Text
    -> Intermediate
    IList Indent
    sw Size
    sz Intermediate
    hd Seq Intermediate
    rs Maybe Text
    forall a. Maybe a
    Nothing
        gather Indent
    sw Intermediate
    hd Seq Intermediate
    rs (SAtom a
    a) Size
    sz =
          Indent
    -> Size
    -> Intermediate
    -> Seq Intermediate
    -> Maybe Text
    -> Intermediate
    IList Indent
    sw (Size
    sz Size -> Size -> Size
    `concatSize` Size
    aSize) Intermediate
    hd Seq Intermediate
    rs (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    aStr)
            where aSize :: Size
    aSize = Int -> Int -> Size
    Size Int
    aLen Int
    aLen
                  aLen :: Int
    aLen = Text -> Int
    T.length Text
    aStr Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 -- 2 for the ". " between the pair
                  aStr :: Text
    aStr = a -> Text
    printAtom a
    a
        gather Indent
    sw Intermediate
    hd Seq Intermediate
    rs (SCons SExpr a
    x SExpr a
    xs) Size
    sz =
          Indent
    -> Intermediate
    -> Seq Intermediate
    -> SExpr a
    -> Size
    -> Intermediate
    gather Indent
    sw Intermediate
    hd (Seq Intermediate
    rs Seq Intermediate -> Intermediate -> Seq Intermediate
    forall a. Seq a -> a -> Seq a
    Seq.|> Intermediate
    x') SExpr a
    xs (Size
    sz Size -> Size -> Size
    `concatSize` Intermediate -> Size
    sizeOf Intermediate
    x')
            where x' :: Intermediate
    x' = SExpr a -> Intermediate
    headOf SExpr a
    x

    unboundIndentPrintSExpr :: SExprPrinter a (SExpr a) -> SExpr a -> TL.Text
    unboundIndentPrintSExpr :: forall a. SExprPrinter a (SExpr a) -> SExpr a -> Text
    unboundIndentPrintSExpr SExprPrinter a (SExpr a)
    spec = Seq Builder -> Text
    finalize (Seq Builder -> Text)
    -> (SExpr a -> Seq Builder) -> SExpr a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Intermediate -> Seq Builder
    go (Intermediate -> Seq Builder)
    -> (SExpr a -> Intermediate) -> SExpr a -> Seq Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SExprPrinter a (SExpr a) -> SExpr a -> Intermediate
    forall a. SExprPrinter a (SExpr a) -> SExpr a -> Intermediate
    toIntermediate SExprPrinter a (SExpr a)
    spec
      where
        finalize :: Seq Builder -> Text
    finalize = Builder -> Text
    B.toLazyText (Builder -> Text)
    -> (Seq Builder -> Builder) -> Seq Builder -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Seq Builder -> Builder
    joinLinesS

        go :: Intermediate -> Seq.Seq B.Builder
        go :: Intermediate -> Seq Builder
    go (IAtom Text
    t) = Builder -> Seq Builder
    forall a. a -> Seq a
    Seq.singleton (Text -> Builder
    B.fromText Text
    t)
        go Intermediate
    IEmpty    = Builder -> Seq Builder
    forall a. a -> Seq a
    Seq.singleton (String -> Builder
    B.fromString String
    "()")
        -- this case should never be called with an empty argument to
        -- @values@, as that should have been translated to @IEmpty@
        -- instead.
        go (IList Indent
    iv Size
    _ Intermediate
    initial Seq Intermediate
    values Maybe Text
    rest)
          -- if we're looking at an s-expression that has no nested
          -- s-expressions, then we might as well consider it flat and let
          -- it take the whole line
          | Just Seq Builder
    strings <- (Intermediate -> Maybe Builder)
    -> Seq Intermediate -> Maybe (Seq Builder)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Seq a -> f (Seq b)
    T.traverse Intermediate -> Maybe Builder
    ppBasic (Intermediate
    initial Intermediate -> Seq Intermediate -> Seq Intermediate
    forall a. a -> Seq a -> Seq a
    Seq.<| Seq Intermediate
    values) =
            Builder -> Seq Builder
    forall a. a -> Seq a
    Seq.singleton (Char -> Builder
    B.singleton Char
    '(' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Seq Builder -> Builder
    buildUnwords Seq Builder
    strings Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Maybe Text -> Builder
    pTail Maybe Text
    rest)

          -- it's not "flat", so we might want to swing after the first thing
          | Indent
    Swing <- Indent
    iv =
              -- if this match fails, then it means we've failed to
              -- convert to an Intermediate correctly!
              let butLast :: Seq Builder
    butLast = Seq Builder -> Seq Builder
    insertParen (Intermediate -> Seq Builder
    go Intermediate
    initial) Seq Builder -> Seq Builder -> Seq Builder
    forall a. Semigroup a => a -> a -> a
    <> (Builder -> Builder) -> Seq Builder -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Builder -> Builder
    doIndent ((Intermediate -> Seq Builder) -> Seq Intermediate -> Seq Builder
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Intermediate -> Seq Builder
    go Seq Intermediate
    values)
              in Maybe Text -> Seq Builder -> Seq Builder
    handleTail Maybe Text
    rest Seq Builder
    butLast

          -- ...or after several things
          | SwingAfter Int
    n <- Indent
    iv =
              let (Seq Intermediate
    hs, Seq Intermediate
    xs) = Int -> Seq Intermediate -> (Seq Intermediate, Seq Intermediate)
    forall a. Int -> Seq a -> (Seq a, Seq a)
    Seq.splitAt Int
    n (Intermediate
    initial Intermediate -> Seq Intermediate -> Seq Intermediate
    forall a. a -> Seq a -> Seq a
    Seq.<| Seq Intermediate
    values)
                  hd :: Builder
    hd = Char -> Builder
    B.singleton Char
    '(' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Seq Builder -> Builder
    buildUnwords ((Intermediate -> Seq Builder) -> Seq Intermediate -> Seq Builder
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Intermediate -> Seq Builder
    go Seq Intermediate
    hs)
                  butLast :: Seq Builder
    butLast = Builder
    hd Builder -> Seq Builder -> Seq Builder
    forall a. a -> Seq a -> Seq a
    Seq.<| (Builder -> Builder) -> Seq Builder -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Builder -> Builder
    doIndent ((Intermediate -> Seq Builder) -> Seq Intermediate -> Seq Builder
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Intermediate -> Seq Builder
    go Seq Intermediate
    xs)
              in Maybe Text -> Seq Builder -> Seq Builder
    handleTail Maybe Text
    rest Seq Builder
    butLast

          -- the 'align' choice is clunkier because we need to know how
          -- deep to indent, so we have to force the first builder to grab its size
          | Bool
    otherwise =
            let -- so we grab that and figure out its length plus two (for
                -- the leading paren and the following space). This uses a
                -- max because it's possible the first thing is itself a
                -- multi-line s-expression (in which case it seems like
                -- using the Align strategy is a terrible idea, but who am
                -- I to quarrel with the wild fruits upon the Tree of
                -- Life?)
                len :: Int64
    len = Int64
    2 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Seq Int64 -> Int64
    forall a. Ord a => Seq a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    F.maximum ((Builder -> Int64) -> Seq Builder -> Seq Int64
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text -> Int64
    TL.length (Text -> Int64) -> (Builder -> Text) -> Builder -> Int64
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Text
    B.toLazyText) (Intermediate -> Seq Builder
    go Intermediate
    initial))
            in case Seq Intermediate -> ViewL Intermediate
    forall a. Seq a -> ViewL a
    Seq.viewl Seq Intermediate
    values of
              -- if there's nothing after the head of the expression, then
              -- we simply close it
              ViewL Intermediate
    Seq.EmptyL -> Seq Builder -> Seq Builder
    insertParen (Seq Builder -> Seq Builder
    insertCloseParen (Intermediate -> Seq Builder
    go Intermediate
    initial))
              -- otherwise, we put the first two things on the same line
              -- with spaces and everything else gets indended the
              -- forementioned length
              Intermediate
    y Seq.:< Seq Intermediate
    ys ->
                let hd :: Builder
    hd = Char -> Builder
    B.singleton Char
    '(' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Seq Builder -> Builder
    buildUnwords ((Intermediate -> Seq Builder) -> Seq Intermediate -> Seq Builder
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Intermediate -> Seq Builder
    go ([Intermediate] -> Seq Intermediate
    forall a. [a] -> Seq a
    Seq.fromList [Intermediate
    initial, Intermediate
    y]))
                    butLast :: Seq Builder
    butLast = Builder
    hd Builder -> Seq Builder -> Seq Builder
    forall a. a -> Seq a -> Seq a
    Seq.<| (Builder -> Builder) -> Seq Builder -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Builder -> Builder
    doIndentOf (Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    len)) ((Intermediate -> Seq Builder) -> Seq Intermediate -> Seq Builder
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Intermediate -> Seq Builder
    go Seq Intermediate
    ys)
                in Maybe Text -> Seq Builder -> Seq Builder
    handleTail Maybe Text
    rest Seq Builder
    butLast

        doIndent :: B.Builder -> B.Builder
        doIndent :: Builder -> Builder
    doIndent = Int -> Builder -> Builder
    doIndentOf (SExprPrinter a (SExpr a) -> Int
    forall atom carrier. SExprPrinter atom carrier -> Int
    indentAmount SExprPrinter a (SExpr a)
    spec Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) -- 1 for '('

        doIndentOf :: Int -> B.Builder -> B.Builder
        doIndentOf :: Int -> Builder -> Builder
    doIndentOf Int
    n Builder
    b = Text -> Builder
    B.fromText (Int -> Text -> Text
    T.replicate Int
    n Text
    " ") Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    b

        insertParen :: Seq.Seq B.Builder -> Seq.Seq B.Builder
        insertParen :: Seq Builder -> Seq Builder
    insertParen Seq Builder
    s = case Seq Builder -> ViewL Builder
    forall a. Seq a -> ViewL a
    Seq.viewl Seq Builder
    s of
          ViewL Builder
    Seq.EmptyL -> Seq Builder
    s
          Builder
    x Seq.:< Seq Builder
    xs -> (Char -> Builder
    B.singleton Char
    '(' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    x) Builder -> Seq Builder -> Seq Builder
    forall a. a -> Seq a -> Seq a
    Seq.<| Seq Builder
    xs

        handleTail :: Maybe Text -> Seq.Seq B.Builder -> Seq.Seq B.Builder
        handleTail :: Maybe Text -> Seq Builder -> Seq Builder
    handleTail Maybe Text
    Nothing = Seq Builder -> Seq Builder
    insertCloseParen
        handleTail (Just Text
    t) =
          let txtInd :: Builder
    txtInd = Text -> Builder
    B.fromText (Text -> Builder) -> Text -> Builder
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.replicate (SExprPrinter a (SExpr a) -> Int
    forall atom carrier. SExprPrinter atom carrier -> Int
    indentAmount SExprPrinter a (SExpr a)
    spec) Text
    " "
              sep :: Builder
    sep = String -> Builder
    B.fromString String
    " . "
          in (Seq Builder -> Builder -> Seq Builder
    forall a. Seq a -> a -> Seq a
    Seq.|> (Builder
    txtInd Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    sep Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    B.fromText Text
    t Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    B.singleton Char
    ')'))

        insertCloseParen :: Seq.Seq B.Builder -> Seq.Seq B.Builder
        insertCloseParen :: Seq Builder -> Seq Builder
    insertCloseParen Seq Builder
    s = case Seq Builder -> ViewR Builder
    forall a. Seq a -> ViewR a
    Seq.viewr Seq Builder
    s of
          ViewR Builder
    Seq.EmptyR -> Builder -> Seq Builder
    forall a. a -> Seq a
    Seq.singleton (Char -> Builder
    B.singleton Char
    ')')
          Seq Builder
    xs Seq.:> Builder
    x -> Seq Builder
    xs Seq Builder -> Builder -> Seq Builder
    forall a. Seq a -> a -> Seq a
    Seq.|> (Builder
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    B.singleton Char
    ')')

        buildUnwords :: Seq Builder -> Builder
    buildUnwords Seq Builder
    sq =
          case Seq Builder -> ViewL Builder
    forall a. Seq a -> ViewL a
    Seq.viewl Seq Builder
    sq of
          ViewL Builder
    Seq.EmptyL -> Builder
    forall a. Monoid a => a
    mempty
          Builder
    t Seq.:< Seq Builder
    ts -> Builder
    t Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> (Builder -> Builder) -> Seq Builder -> Builder
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap (\ Builder
    x -> Char -> Builder
    B.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    x) Seq Builder
    ts

        pTail :: Maybe Text -> Builder
    pTail Maybe Text
    Nothing = Char -> Builder
    B.singleton Char
    ')'
        pTail (Just Text
    t) = String -> Builder
    B.fromString String
    " . " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    B.fromText Text
    t Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    B.singleton Char
    ')'

        ppBasic :: Intermediate -> Maybe Builder
    ppBasic (IAtom Text
    t) = Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just (Text -> Builder
    B.fromText Text
    t)
        ppBasic (Intermediate
    IEmpty) = Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just (String -> Builder
    B.fromString String
    "()")
        ppBasic Intermediate
    _ = Maybe Builder
    forall a. Maybe a
    Nothing

    -- | Modify the carrier type of a 'SExprPrinter' by describing how
    --   to convert the new type back to the previous type. For example,
    --   to pretty-print a well-formed s-expression, we can modify the
    --   'SExprPrinter' value as follows:
    --
    -- >>> let printer = setFromCarrier fromWellFormed (basicPrint id)
    -- >>> encodeOne printer (WFSList [WFSAtom "ele", WFSAtom "phant"])
    -- "(ele phant)"
    setFromCarrier :: (c -> b) -> SExprPrinter a b -> SExprPrinter a c
    setFromCarrier :: forall c b a. (c -> b) -> SExprPrinter a b -> SExprPrinter a c
    setFromCarrier c -> b
    fc SExprPrinter a b
    pr = SExprPrinter a b
    pr { fromCarrier :: c -> SExpr a
    fromCarrier = SExprPrinter a b -> b -> SExpr a
    forall atom carrier.
    SExprPrinter atom carrier -> carrier -> SExpr atom
    fromCarrier SExprPrinter a b
    pr (b -> SExpr a) -> (c -> b) -> c -> SExpr a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . c -> b
    fc }

    -- | Dictate a maximum width for pretty-printed s-expressions.
    --
    -- >>> let printer = setMaxWidth 8 (basicPrint id)
    -- >>> encodeOne printer (L [A "one", A "two", A "three"])
    -- "(one \n  two\n  three)"
    setMaxWidth :: Int -> SExprPrinter atom carrier -> SExprPrinter atom carrier
    setMaxWidth :: forall atom carrier.
    Int -> SExprPrinter atom carrier -> SExprPrinter atom carrier
    setMaxWidth Int
    n SExprPrinter atom carrier
    pr = SExprPrinter atom carrier
    pr { maxWidth :: Maybe Int
    maxWidth = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n }

    -- | Allow the serialized s-expression to be arbitrarily wide. This
    --   makes all pretty-printing happen on a single line.
    --
    -- >>> let printer = removeMaxWidth (basicPrint id)
    -- >>> encodeOne printer (L [A "one", A "two", A "three"])
    -- "(one two three)"
    removeMaxWidth :: SExprPrinter atom carrier -> SExprPrinter atom carrier
    removeMaxWidth :: forall atom carrier.
    SExprPrinter atom carrier -> SExprPrinter atom carrier
    removeMaxWidth SExprPrinter atom carrier
    pr = SExprPrinter atom carrier
    pr { maxWidth :: Maybe Int
    maxWidth = Maybe Int
    forall a. Maybe a
    Nothing }

    -- | Set the number of spaces that a subsequent line will be indented
    --   after a swing indentation.
    --
    -- >>> let printer = setMaxWidth 12 (basicPrint id)
    -- >>> encodeOne printer (L [A "elephant", A "pachyderm"])
    -- "(elephant \n  pachyderm)"
    -- >>> encodeOne (setIndentAmount 4) (L [A "elephant", A "pachyderm"])
    -- "(elephant \n    pachyderm)"
    setIndentAmount :: Int -> SExprPrinter atom carrier -> SExprPrinter atom carrier
    setIndentAmount :: forall atom carrier.
    Int -> SExprPrinter atom carrier -> SExprPrinter atom carrier
    setIndentAmount Int
    n SExprPrinter atom carrier
    pr = SExprPrinter atom carrier
    pr { indentAmount :: Int
    indentAmount = Int
    n }

    -- | Dictate how to indent subsequent lines based on the leading
    --   subexpression in an s-expression. For details on how this works,
    --   consult the documentation of the 'Indent' type.
    --
    -- >>> let indent (A "def") = SwingAfter 1; indent _ = Swing
    -- >>> let printer = setIndentStrategy indent (setMaxWidth 8 (basicPrint id))
    -- >>> encodeOne printer (L [ A "def", L [ A "func", A "arg" ], A "body" ])
    -- "(def (func arg)\n  body)"
    -- >>> encodeOne printer (L [ A "elephant", A "among", A "pachyderms" ])
    -- "(elephant \n  among\n  pachyderms)"
    setIndentStrategy :: (SExpr atom -> Indent) -> SExprPrinter atom carrier -> SExprPrinter atom carrier
    setIndentStrategy :: forall atom carrier.
    (SExpr atom -> Indent)
    -> SExprPrinter atom carrier -> SExprPrinter atom carrier
    setIndentStrategy SExpr atom -> Indent
    st SExprPrinter atom carrier
    pr = SExprPrinter atom carrier
    pr { swingIndent :: SExpr atom -> Indent
    swingIndent = SExpr atom -> Indent
    st }

    spaceDot :: B.Builder
    spaceDot :: Builder
    spaceDot = Char -> Builder
    B.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    B.singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    B.singleton Char
    ' '

    -- Indents a line by n spaces
    indent :: Int -> B.Builder -> B.Builder
    indent :: Int -> Builder -> Builder
    indent Int
    n Builder
    ts =
      [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [ Char -> Builder
    B.singleton Char
    ' ' | Int
    _ <- [Int
    1..Int
    n]] Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    ts

    -- Sort of like 'unlines' but without the trailing newline
    joinLinesS :: Seq.Seq B.Builder -> B.Builder
    joinLinesS :: Seq Builder -> Builder
    joinLinesS Seq Builder
    s = case Seq Builder -> ViewL Builder
    forall a. Seq a -> ViewL a
    Seq.viewl Seq Builder
    s of
      ViewL Builder
    Seq.EmptyL -> Builder
    ""
      Builder
    t Seq.:< Seq Builder
    ts
        | Seq Builder -> Bool
    forall a. Seq a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    F.null Seq Builder
    ts -> Builder
    t
        | Bool
    otherwise -> Builder
    t Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    B.fromString String
    "\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Seq Builder -> Builder
    joinLinesS Seq Builder
    ts

    -- Sort of like 'unlines' but without the trailing newline
    unwordsS :: Seq.Seq B.Builder -> B.Builder
    unwordsS :: Seq Builder -> Builder
    unwordsS Seq Builder
    s = case Seq Builder -> ViewL Builder
    forall a. Seq a -> ViewL a
    Seq.viewl Seq Builder
    s of
      ViewL Builder
    Seq.EmptyL -> Builder
    ""
      Builder
    t Seq.:< Seq Builder
    ts
        | Seq Builder -> Bool
    forall a. Seq a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    F.null Seq Builder
    ts -> Builder
    t
        | Bool
    otherwise -> Builder
    t Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    " " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Seq Builder -> Builder
    unwordsS Seq Builder
    ts

    -- Indents every line n spaces, and adds a newline to the beginning
    -- used in swung indents
    indentAllS :: Int -> Seq.Seq B.Builder -> B.Builder
    indentAllS :: Int -> Seq Builder -> Builder
    indentAllS Int
    n Seq Builder
    s = if Seq Builder -> Bool
    forall a. Seq a -> Bool
    Seq.null Seq Builder
    s
                     then Builder
    ""
                     else (Builder
    "\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>) (Builder -> Builder) -> Builder -> Builder
    forall a b. (a -> b) -> a -> b
    $ Seq Builder -> Builder
    joinLinesS (Seq Builder -> Builder) -> Seq Builder -> Builder
    forall a b. (a -> b) -> a -> b
    $ (Builder -> Builder) -> Seq Builder -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Builder -> Builder
    indent Int
    n) Seq Builder
    s

    -- Indents every line but the first by some amount
    -- used in aligned indents
    indentSubsequentS :: Int -> Seq.Seq B.Builder -> B.Builder
    indentSubsequentS :: Int -> Seq Builder -> Builder
    indentSubsequentS Int
    n Seq Builder
    s = case Seq Builder -> ViewL Builder
    forall a. Seq a -> ViewL a
    Seq.viewl Seq Builder
    s of
      ViewL Builder
    Seq.EmptyL -> Builder
    ""
      Builder
    t Seq.:< Seq Builder
    ts
        | Seq Builder -> Bool
    forall a. Seq a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    F.null Seq Builder
    ts -> Builder
    t
        | Bool
    otherwise -> Seq Builder -> Builder
    joinLinesS (Builder
    t Builder -> Seq Builder -> Seq Builder
    forall a. a -> Seq a -> Seq a
    Seq.<| (Builder -> Builder) -> Seq Builder -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Builder -> Builder
    indent Int
    n) Seq Builder
    ts)

    -- oh god this code is so disgusting
    -- i'm sorry to everyone i let down by writing this
    -- i swear i'll do better in the future i promise i have to
    -- for my sake and for everyone's

    -- | Pretty-print a 'SExpr' according to the options in a
    --   'LayoutOptions' value.
    prettyPrintSExpr :: SExprPrinter a (SExpr a) -> SExpr a -> TL.Text
    prettyPrintSExpr :: forall a. SExprPrinter a (SExpr a) -> SExpr a -> Text
    prettyPrintSExpr pr :: SExprPrinter a (SExpr a)
    pr@SExprPrinter { Bool
    Int
    Maybe Int
    a -> Text
    SExpr a -> SExpr a
    SExpr a -> Indent
    atomPrinter :: forall atom carrier. SExprPrinter atom carrier -> atom -> Text
    fromCarrier :: forall atom carrier.
    SExprPrinter atom carrier -> carrier -> SExpr atom
    swingIndent :: forall atom carrier.
    SExprPrinter atom carrier -> SExpr atom -> Indent
    indentAmount :: forall atom carrier. SExprPrinter atom carrier -> Int
    maxWidth :: forall atom carrier. SExprPrinter atom carrier -> Maybe Int
    indentPrint :: forall atom carrier. SExprPrinter atom carrier -> Bool
    atomPrinter :: a -> Text
    fromCarrier :: SExpr a -> SExpr a
    swingIndent :: SExpr a -> Indent
    indentAmount :: Int
    maxWidth :: Maybe Int
    indentPrint :: Bool
    .. } SExpr a
    expr = case Maybe Int
    maxWidth of
      Maybe Int
    Nothing
        | Bool
    indentPrint -> SExprPrinter a (SExpr a) -> SExpr a -> Text
    forall a. SExprPrinter a (SExpr a) -> SExpr a -> Text
    unboundIndentPrintSExpr SExprPrinter a (SExpr a)
    pr (SExpr a -> SExpr a
    fromCarrier SExpr a
    expr)
        | Bool
    otherwise   -> SExpr Text -> Text
    flatPrintSExpr ((a -> Text) -> SExpr a -> SExpr Text
    forall a b. (a -> b) -> SExpr a -> SExpr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Text
    atomPrinter (SExpr a -> SExpr a
    fromCarrier SExpr a
    expr))
      Just Int
    w  -> Int -> SExprPrinter a (SExpr a) -> SExpr a -> Text
    forall a. Int -> SExprPrinter a (SExpr a) -> SExpr a -> Text
    indentPrintSExpr' Int
    w SExprPrinter a (SExpr a)
    pr SExpr a
    expr

    indentPrintSExpr' :: Int -> SExprPrinter a (SExpr a) -> SExpr a -> TL.Text
    indentPrintSExpr' :: forall a. Int -> SExprPrinter a (SExpr a) -> SExpr a -> Text
    indentPrintSExpr' Int
    maxAmt pr :: SExprPrinter a (SExpr a)
    pr@SExprPrinter { Bool
    Int
    Maybe Int
    a -> Text
    SExpr a -> SExpr a
    SExpr a -> Indent
    atomPrinter :: forall atom carrier. SExprPrinter atom carrier -> atom -> Text
    fromCarrier :: forall atom carrier.
    SExprPrinter atom carrier -> carrier -> SExpr atom
    swingIndent :: forall atom carrier.
    SExprPrinter atom carrier -> SExpr atom -> Indent
    indentAmount :: forall atom carrier. SExprPrinter atom carrier -> Int
    maxWidth :: forall atom carrier. SExprPrinter atom carrier -> Maybe Int
    indentPrint :: forall atom carrier. SExprPrinter atom carrier -> Bool
    atomPrinter :: a -> Text
    fromCarrier :: SExpr a -> SExpr a
    swingIndent :: SExpr a -> Indent
    indentAmount :: Int
    maxWidth :: Maybe Int
    indentPrint :: Bool
    .. } = Builder -> Text
    B.toLazyText (Builder -> Text) -> (SExpr a -> Builder) -> SExpr a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Intermediate -> Builder
    pp Int
    0 (Intermediate -> Builder)
    -> (SExpr a -> Intermediate) -> SExpr a -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SExprPrinter a (SExpr a) -> SExpr a -> Intermediate
    forall a. SExprPrinter a (SExpr a) -> SExpr a -> Intermediate
    toIntermediate SExprPrinter a (SExpr a)
    pr
      where
        pp :: Int -> Intermediate -> Builder
    pp Int
    _   Intermediate
    IEmpty       = String -> Builder
    B.fromString String
    "()"
        pp Int
    _   (IAtom Text
    t)    = Text -> Builder
    B.fromText Text
    t
        pp Int
    ind (IList Indent
    i Size
    sz Intermediate
    h Seq Intermediate
    values Maybe Text
    end) =
          -- we always are going to have a head, a (possibly empty) body,
          -- and a (possibly empty) tail in our list formats
          Char -> Builder
    B.singleton Char
    '(' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    hd Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    body Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    tl Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    B.singleton Char
    ')'
          where
            -- the tail is either nothing, or the final dotted pair
            tl :: Builder
    tl = case Maybe Text
    end of
                   Maybe Text
    Nothing -> Builder
    forall a. Monoid a => a
    mempty
                   Just Text
    x  -> String -> Builder
    B.fromString String
    " . " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    B.fromText Text
    x
            -- the head is the pretty-printed head, with an ambient
            -- indentation of +1 to account for the left paren
            hd :: Builder
    hd = Int -> Intermediate -> Builder
    pp (Int
    indInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Intermediate
    h
            indented :: Builder
    indented =
              case Indent
    i of
                SwingAfter Int
    n ->
                  let (Seq Intermediate
    l, Seq Intermediate
    ls) = Int -> Seq Intermediate -> (Seq Intermediate, Seq Intermediate)
    forall a. Int -> Seq a -> (Seq a, Seq a)
    Seq.splitAt Int
    n Seq Intermediate
    values
                      t :: Builder
    t  = Seq Builder -> Builder
    unwordsS ((Intermediate -> Builder) -> Seq Intermediate -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Intermediate -> Builder
    pp (Int
    indInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)) Seq Intermediate
    l) -- 1 for (, 1 for ' '
                      nextInd :: Int
    nextInd = Int
    ind Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    indentAmount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 -- 1 for (
                      ts :: Builder
    ts = Int -> Seq Builder -> Builder
    indentAllS Int
    nextInd ((Intermediate -> Builder) -> Seq Intermediate -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Intermediate -> Builder
    pp Int
    nextInd) Seq Intermediate
    ls)
                  in Char -> Builder
    B.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    t Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    ts
                Indent
    Swing ->
                  let nextInd :: Int
    nextInd = Int
    ind Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    indentAmount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 -- 1 for (
                  in Int -> Seq Builder -> Builder
    indentAllS Int
    nextInd ((Intermediate -> Builder) -> Seq Intermediate -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Intermediate -> Builder
    pp Int
    nextInd) Seq Intermediate
    values)
                Indent
    Align ->
                  let headWidth :: Int
    headWidth = Size -> Int
    sizeSum (Intermediate -> Size
    sizeOf Intermediate
    h)
                      nextInd :: Int
    nextInd = Int
    ind Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    headWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 -- 1 for (, 1 for ' ' below
                  in Char -> Builder
    B.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                     Int -> Seq Builder -> Builder
    indentSubsequentS Int
    nextInd ((Intermediate -> Builder) -> Seq Intermediate -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Intermediate -> Builder
    pp Int
    nextInd) Seq Intermediate
    values)
            body :: Builder
    body
              -- if there's nothing here, then we don't have anything to
              -- indent
              | Seq Intermediate -> Int
    forall a. Seq a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Seq Intermediate
    values Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Builder
    forall a. Monoid a => a
    mempty
              -- if we can't fit the whole next s-expression on the same
              -- line, then we use the indented form
              | Size -> Int
    sizeSum Size
    sz Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ind Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxAmt = Builder
    indented
              | Bool
    otherwise =
                -- otherwise we print the whole thing on one line!
                Char -> Builder
    B.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Seq Builder -> Builder
    unwordsS ((Intermediate -> Builder) -> Seq Intermediate -> Seq Builder
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Intermediate -> Builder
    pp (Int
    ind Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) Seq Intermediate
    values)

    -- if we don't indent anything, then we can ignore a bunch of the
    -- details above
    flatPrintSExpr :: SExpr Text -> TL.Text
    flatPrintSExpr :: SExpr Text -> Text
    flatPrintSExpr = Builder -> Text
    B.toLazyText (Builder -> Text) -> (SExpr Text -> Builder) -> SExpr Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SExpr Text -> Builder
    pHead
      where
        pHead :: SExpr Text -> Builder
    pHead (SCons SExpr Text
    x SExpr Text
    xs) =
          Char -> Builder
    B.singleton Char
    '(' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> SExpr Text -> Builder
    pHead SExpr Text
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> SExpr Text -> Builder
    pTail SExpr Text
    xs
        pHead (SAtom Text
    t)    =
          Text -> Builder
    B.fromText Text
    t
        pHead SExpr Text
    SNil         =
          Char -> Builder
    B.singleton Char
    '(' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    B.singleton Char
    ')'

        pTail :: SExpr Text -> Builder
    pTail (SCons SExpr Text
    x SExpr Text
    xs) =
          Char -> Builder
    B.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> SExpr Text -> Builder
    pHead SExpr Text
    x Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> SExpr Text -> Builder
    pTail SExpr Text
    xs
        pTail (SAtom Text
    t) =
          Builder
    spaceDot Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
          Text -> Builder
    B.fromText Text
    t Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
          Char -> Builder
    B.singleton Char
    ')'
        pTail SExpr Text
    SNil =
          Char -> Builder
    B.singleton Char
    ')'

    -- | Turn a single s-expression into a string according to a given
    --   'SExprPrinter'.
    encodeOne :: SExprPrinter atom carrier -> carrier -> Text
    encodeOne :: forall atom carrier. SExprPrinter atom carrier -> carrier -> Text
    encodeOne s :: SExprPrinter atom carrier
    s@(SExprPrinter { Bool
    Int
    Maybe Int
    atom -> Text
    carrier -> SExpr atom
    SExpr atom -> Indent
    atomPrinter :: forall atom carrier. SExprPrinter atom carrier -> atom -> Text
    fromCarrier :: forall atom carrier.
    SExprPrinter atom carrier -> carrier -> SExpr atom
    swingIndent :: forall atom carrier.
    SExprPrinter atom carrier -> SExpr atom -> Indent
    indentAmount :: forall atom carrier. SExprPrinter atom carrier -> Int
    maxWidth :: forall atom carrier. SExprPrinter atom carrier -> Maybe Int
    indentPrint :: forall atom carrier. SExprPrinter atom carrier -> Bool
    atomPrinter :: atom -> Text
    fromCarrier :: carrier -> SExpr atom
    swingIndent :: SExpr atom -> Indent
    indentAmount :: Int
    maxWidth :: Maybe Int
    indentPrint :: Bool
    .. }) =
      Text -> Text
    TL.toStrict (Text -> Text) -> (carrier -> Text) -> carrier -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SExprPrinter atom (SExpr atom) -> SExpr atom -> Text
    forall a. SExprPrinter a (SExpr a) -> SExpr a -> Text
    prettyPrintSExpr (SExprPrinter atom carrier
    s { fromCarrier :: SExpr atom -> SExpr atom
    fromCarrier = SExpr atom -> SExpr atom
    forall a. a -> a
    id }) (SExpr atom -> Text) -> (carrier -> SExpr atom) -> carrier -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . carrier -> SExpr atom
    fromCarrier

    -- | Turn a list of s-expressions into a single string according to
    --   a given 'SExprPrinter'.
    encode :: SExprPrinter atom carrier -> [carrier] -> Text
    encode :: forall atom carrier. SExprPrinter atom carrier -> [carrier] -> Text
    encode SExprPrinter atom carrier
    spec =
      Text -> [Text] -> Text
    T.intercalate Text
    "\n\n" ([Text] -> Text) -> ([carrier] -> [Text]) -> [carrier] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (carrier -> Text) -> [carrier] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (SExprPrinter atom carrier -> carrier -> Text
    forall atom carrier. SExprPrinter atom carrier -> carrier -> Text
    encodeOne SExprPrinter atom carrier
    spec)

    -- | Turn a single s-expression into a lazy 'Text' according to a given
    --   'SExprPrinter'.
    encodeOneLazy :: SExprPrinter atom carrier -> carrier -> TL.Text
    encodeOneLazy :: forall atom carrier. SExprPrinter atom carrier -> carrier -> Text
    encodeOneLazy s :: SExprPrinter atom carrier
    s@(SExprPrinter { Bool
    Int
    Maybe Int
    atom -> Text
    carrier -> SExpr atom
    SExpr atom -> Indent
    atomPrinter :: forall atom carrier. SExprPrinter atom carrier -> atom -> Text
    fromCarrier :: forall atom carrier.
    SExprPrinter atom carrier -> carrier -> SExpr atom
    swingIndent :: forall atom carrier.
    SExprPrinter atom carrier -> SExpr atom -> Indent
    indentAmount :: forall atom carrier. SExprPrinter atom carrier -> Int
    maxWidth :: forall atom carrier. SExprPrinter atom carrier -> Maybe Int
    indentPrint :: forall atom carrier. SExprPrinter atom carrier -> Bool
    atomPrinter :: atom -> Text
    fromCarrier :: carrier -> SExpr atom
    swingIndent :: SExpr atom -> Indent
    indentAmount :: Int
    maxWidth :: Maybe Int
    indentPrint :: Bool
    .. }) =
      SExprPrinter atom (SExpr atom) -> SExpr atom -> Text
    forall a. SExprPrinter a (SExpr a) -> SExpr a -> Text
    prettyPrintSExpr (SExprPrinter atom carrier
    s { fromCarrier :: SExpr atom -> SExpr atom
    fromCarrier = SExpr atom -> SExpr atom
    forall a. a -> a
    id }) (SExpr atom -> Text) -> (carrier -> SExpr atom) -> carrier -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . carrier -> SExpr atom
    fromCarrier

    -- | Turn a list of s-expressions into a lazy 'Text' according to
    --   a given 'SExprPrinter'.
    encodeLazy :: SExprPrinter atom carrier -> [carrier] -> TL.Text
    encodeLazy :: forall atom carrier. SExprPrinter atom carrier -> [carrier] -> Text
    encodeLazy SExprPrinter atom carrier
    spec = Text -> [Text] -> Text
    TL.intercalate Text
    "\n\n" ([Text] -> Text) -> ([carrier] -> [Text]) -> [carrier] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (carrier -> Text) -> [carrier] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (SExprPrinter atom carrier -> carrier -> Text
    forall atom carrier. SExprPrinter atom carrier -> carrier -> Text
    encodeOneLazy SExprPrinter atom carrier
    spec)