    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE FlexibleInstances #-}

    -- | Internal format starters.

    module Formatting.Internal
      ( Format(..)
      , (%)
      , (%+)
      , (%.)
      , (<%+>)
      , now
      , bind
      , mapf
      , later
      , format
      , sformat
      , bprint
      , bformat
      , fprint
      , fprintLn
      , hprint
      , hprintLn
      , formatToString
      ) where

    import           Control.Category (Category(..))
    import           Control.Monad.IO.Class (MonadIO (..))
    import           Data.Monoid
    import           Data.String
    import qualified Data.Text as S (Text)
    import           Data.Text.Lazy (Text)
    import qualified Data.Text.Lazy as T
    import qualified Data.Text.Lazy as TL
    import           Data.Text.Lazy.Builder (Builder)
    import qualified Data.Text.Lazy.Builder as T
    import qualified Data.Text.Lazy.Builder as TLB
    import qualified Data.Text.Lazy.IO as T
    import           Prelude hiding ((.),id)
    import           System.IO

    -- $setup
    -- >>> import Formatting.Formatters

    -- | A formatter. When you construct formatters the first type
    -- parameter, @r@, will remain polymorphic.  The second type
    -- parameter, @a@, will change to reflect the types of the data that
    -- will be formatted.  For example, in
    --
    -- @
    -- myFormat :: Format r (Text -> Int -> r)
    -- myFormat = \"Person's name is \" % text % \", age is \" % hex
    -- @
    --
    -- the first type parameter remains polymorphic, and the second type
    -- parameter is @Text -> Int -> r@, which indicates that it formats a
    -- 'Text' and an 'Int'.
    --
    -- When you run the 'Format', for example with 'format', you provide
    -- the arguments and they will be formatted into a string.
    --
    -- @
    -- \> format (\"Person's name is \" % text % \", age is \" % hex) \"Dave\" 54
    -- \"Person's name is Dave, age is 36\"
    -- @
    newtype Format r a =
      Format {forall r a. Format r a -> (Builder -> r) -> a
    runFormat :: (Builder -> r) -> a}

    -- | This can be used almost like contramap, e.g:
    --
    -- @
    -- formatter :: Format r (b -> r)
    -- formatter = _
    --
    -- adapter :: a -> b
    -- adapter = _
    --
    -- adapted :: Format r (a -> r)
    -- adapted = fmap (. adapter) formatter
    -- @
    instance Functor (Format r) where
      fmap :: forall a b. (a -> b) -> Format r a -> Format r b
    fmap a -> b
    f (Format (Builder -> r) -> a
    k) = ((Builder -> r) -> b) -> Format r b
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format (a -> b
    f (a -> b) -> ((Builder -> r) -> a) -> (Builder -> r) -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Builder -> r) -> a
    k)

    instance Semigroup (Format r (a -> r)) where
      Format r (a -> r)
    m <> :: Format r (a -> r) -> Format r (a -> r) -> Format r (a -> r)
    <> Format r (a -> r)
    n =
        ((Builder -> r) -> a -> r) -> Format r (a -> r)
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format (\Builder -> r
    k a
    a ->
                  Format r (a -> r) -> (Builder -> r) -> a -> r
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format r (a -> r)
    m (\Builder
    b1 -> Format r (a -> r) -> (Builder -> r) -> a -> r
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format r (a -> r)
    n (\Builder
    b2 -> Builder -> r
    k (Builder
    b1 Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    b2)) a
    a) a
    a)

    -- | Like @(<>)@ except put a space between the two formatters. For example:
    -- @format (year <%+> month <%+> dayOfMonth) now@ will yield @"2022 06 06"@
    (<%+>) :: Format r (a -> r) -> Format r (a -> r) -> Format r (a -> r)
    Format r (a -> r)
    m <%+> :: forall r a.
    Format r (a -> r) -> Format r (a -> r) -> Format r (a -> r)
    <%+> Format r (a -> r)
    n =
      ((Builder -> r) -> a -> r) -> Format r (a -> r)
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format (\Builder -> r
    k a
    a ->
                Format r (a -> r) -> (Builder -> r) -> a -> r
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format r (a -> r)
    m (\Builder
    b1 -> Format r (a -> r) -> (Builder -> r) -> a -> r
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format r (a -> r)
    n (\Builder
    b2 -> Builder -> r
    k (Builder
    b1 Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    TLB.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    b2)) a
    a) a
    a)

    -- | Useful instance for applying two formatters to the same input
    -- argument. For example: @format (year <> "/" % month) now@ will
    -- yield @"2015/01"@.
    instance Monoid (Format r (a -> r)) where
      mempty :: Format r (a -> r)
    mempty = ((Builder -> r) -> a -> r) -> Format r (a -> r)
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format (\Builder -> r
    k a
    _ -> Builder -> r
    k Builder
    forall a. Monoid a => a
    mempty)

    -- | Useful instance for writing format string. With this you can
    -- write @\"Foo\"@ instead of @now "Foo!"@.
    instance (a ~ r) => IsString (Format r a) where
      fromString :: String -> Format r a
    fromString = Builder -> Format r r
    forall r. Builder -> Format r r
    now (Builder -> Format r r)
    -> (String -> Builder) -> String -> Format r r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . String -> Builder
    forall a. IsString a => String -> a
    fromString

    -- | The same as (%). At present using 'Category' has an import
    -- overhead, but one day it might be imported as standard.
    instance Category Format where
      id :: forall a. Format a a
    id = Builder -> Format a a
    forall r. Builder -> Format r r
    now Builder
    forall a. Monoid a => a
    mempty
      Format b c
    f . :: forall b c a. Format b c -> Format a b -> Format a c
    . Format a b
    g =
        Format b c
    f Format b c -> (Builder -> Format a b) -> Format a c
    forall r a r'.
    Format r a -> (Builder -> Format r' r) -> Format r' a
    `bind`
        \Builder
    a ->
          Format a b
    g Format a b -> (Builder -> Format a a) -> Format a b
    forall r a r'.
    Format r a -> (Builder -> Format r' r) -> Format r' a
    `bind`
          \Builder
    b -> Builder -> Format a a
    forall r. Builder -> Format r r
    now (Builder
    a Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    b)

    -- | Concatenate two formatters.
    --
    -- @formatter1 % formatter2@ is a formatter that accepts arguments for
    -- @formatter1@ and @formatter2@ and concatenates their results.  For example
    --
    -- @
    -- format1 :: Format r (Text -> r)
    -- format1 = \"Person's name is \" % text
    -- @
    --
    -- @
    -- format2 :: Format r r
    -- format2 = \", \"
    -- @
    --
    -- @
    -- format3 :: Format r (Int -> r)
    -- format3 = \"age is \" % hex
    -- @
    --
    -- @
    -- myFormat :: Format r (Text -> Int -> r)
    -- myFormat = format1 % format2 % format3
    -- @
    --
    -- Notice how the argument types of @format1@ and @format3@ are
    -- gathered into the type of @myFormat@.
    --
    -- (This is actually the composition operator for 'Format's
    -- 'Category' instance, but that is (at present) inconvenient to use
    -- with regular "Prelude". So this function is provided as a
    -- convenience.)
    (%) :: Format r a -> Format r' r -> Format r' a
    % :: forall b c a. Format b c -> Format a b -> Format a c
    (%) = Format r a -> Format r' r -> Format r' a
    forall b c a. Format b c -> Format a b -> Format a c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    (.)
    infixr 9 %

    -- | Concatenate two formatters with a space in between.
    --
    -- >>> :set -XOverloadedStrings
    -- >>> format (int %+ "+" %+ int %+ "=" %+ int) 2 3 5
    -- "2 + 3 = 5"
    --
    (%+) :: Format r a -> Format r' r -> Format r' a
    Format r a
    f %+ :: forall b c a. Format b c -> Format a b -> Format a c
    %+ Format r' r
    g =
        Format r a
    f Format r a -> (Builder -> Format r' r) -> Format r' a
    forall r a r'.
    Format r a -> (Builder -> Format r' r) -> Format r' a
    `bind`
        \Builder
    a ->
          Format r' r
    g Format r' r -> (Builder -> Format r' r') -> Format r' r
    forall r a r'.
    Format r a -> (Builder -> Format r' r) -> Format r' a
    `bind`
          \Builder
    b -> Builder -> Format r' r'
    forall r. Builder -> Format r r
    now (Builder
    a Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    TLB.singleton Char
    ' ' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    b)
    infixr 9 %+

    -- | Function compose two formatters. Will feed the result of one
    -- formatter into another.
    (%.) :: Format r (Builder -> r') -> Format r' a -> Format r a
    %. :: forall r r' a.
    Format r (Builder -> r') -> Format r' a -> Format r a
    (%.) (Format (Builder -> r) -> Builder -> r'
    a) (Format (Builder -> r') -> a
    b) = ((Builder -> r) -> a) -> Format r a
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format ((Builder -> r') -> a
    b ((Builder -> r') -> a)
    -> ((Builder -> r) -> Builder -> r') -> (Builder -> r) -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Builder -> r) -> Builder -> r'
    a)
    infixr 8 %.

    -- | Don't format any data, just output a constant 'Builder'.
    now :: Builder -> Format r r
    now :: forall r. Builder -> Format r r
    now Builder
    a = ((Builder -> r) -> r) -> Format r r
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format ((Builder -> r) -> Builder -> r
    forall a b. (a -> b) -> a -> b
    $ Builder
    a)

    -- | Monadic indexed bind for holey monoids.
    bind :: Format r a -> (Builder -> Format r' r) -> Format r' a
    Format r a
    m bind :: forall r a r'.
    Format r a -> (Builder -> Format r' r) -> Format r' a
    `bind` Builder -> Format r' r
    f = ((Builder -> r') -> a) -> Format r' a
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format (((Builder -> r') -> a) -> Format r' a)
    -> ((Builder -> r') -> a) -> Format r' a
    forall a b. (a -> b) -> a -> b
    $ \Builder -> r'
    k -> Format r a -> (Builder -> r) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format r a
    m (\Builder
    a -> Format r' r -> (Builder -> r') -> r
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat (Builder -> Format r' r
    f Builder
    a) Builder -> r'
    k)

    -- | Functorial map over a formatter's input. Example: @format (mapf (drop 1) string) \"hello\"@
    mapf :: (a -> b) -> Format r (b -> t) -> Format r (a -> t)
    mapf :: forall a b r t. (a -> b) -> Format r (b -> t) -> Format r (a -> t)
    mapf a -> b
    f Format r (b -> t)
    m = ((Builder -> r) -> a -> t) -> Format r (a -> t)
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format (\Builder -> r
    k -> Format r (b -> t) -> (Builder -> r) -> b -> t
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format r (b -> t)
    m Builder -> r
    k (b -> t) -> (a -> b) -> a -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . a -> b
    f)

    -- | Format a value of type @a@ using a function of type @a ->
    -- 'Builder'@. For example, @later (f :: Int -> Builder)@ produces
    -- @Format r (Int -> r)@.
    later :: (a -> Builder) -> Format r (a -> r)
    later :: forall a r. (a -> Builder) -> Format r (a -> r)
    later a -> Builder
    f = ((Builder -> r) -> a -> r) -> Format r (a -> r)
    forall r a. ((Builder -> r) -> a) -> Format r a
    Format ((Builder -> r) -> (a -> Builder) -> a -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . a -> Builder
    f)

    -- | Run the formatter and return a lazy 'Text' value.
    format :: Format Text a -> a
    format :: forall a. Format Text a -> a
    format Format Text a
    m = Format Text a -> (Builder -> Text) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format Text a
    m Builder -> Text
    T.toLazyText

    -- | Run the formatter and return a strict 'S.Text' value.
    sformat :: Format S.Text a -> a
    sformat :: forall a. Format Text a -> a
    sformat Format Text a
    m = Format Text a -> (Builder -> Text) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format Text a
    m (Text -> Text
    T.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Builder -> Text
    T.toLazyText)

    -- | Run the formatter and return a 'Builder' value.
    bprint :: Format Builder a -> a
    bprint :: forall a. Format Builder a -> a
    bprint Format Builder a
    m = Format Builder a -> (Builder -> Builder) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format Builder a
    m Builder -> Builder
    forall a. a -> a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id

    -- | Run the formatter and return a 'Builder' value.
    --
    -- This is a newer synonym for 'bprint', following the naming convention set by 'format' and 'sformat'.
    bformat :: Format Builder a -> a
    bformat :: forall a. Format Builder a -> a
    bformat Format Builder a
    m = Format Builder a -> (Builder -> Builder) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format Builder a
    m Builder -> Builder
    forall a. a -> a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id

    -- | Run the formatter and print out the text to stdout.
    fprint :: MonadIO m => Format (m ()) a -> a
    fprint :: forall (m :: * -> *) a. MonadIO m => Format (m ()) a -> a
    fprint Format (m ()) a
    m = Format (m ()) a -> (Builder -> m ()) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format (m ()) a
    m (IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (Builder -> IO ()) -> Builder -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Text -> IO ()
    T.putStr (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Builder -> Text
    T.toLazyText)

    -- | Run the formatter and print out the text to stdout, followed by a newline.
    fprintLn :: MonadIO m => Format (m ()) a -> a
    fprintLn :: forall (m :: * -> *) a. MonadIO m => Format (m ()) a -> a
    fprintLn Format (m ()) a
    m = Format (m ()) a -> (Builder -> m ()) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format (m ()) a
    m (IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (Builder -> IO ()) -> Builder -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Text -> IO ()
    T.putStrLn (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Builder -> Text
    T.toLazyText)

    -- | Run the formatter and put the output onto the given 'Handle'.
    hprint :: MonadIO m => Handle -> Format (m ()) a -> a
    hprint :: forall (m :: * -> *) a. MonadIO m => Handle -> Format (m ()) a -> a
    hprint Handle
    h Format (m ()) a
    m = Format (m ()) a -> (Builder -> m ()) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format (m ()) a
    m (IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (Builder -> IO ()) -> Builder -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Handle -> Text -> IO ()
    T.hPutStr Handle
    h (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Builder -> Text
    T.toLazyText)

    -- | Run the formatter and put the output and a newline onto the given 'Handle'.
    hprintLn :: MonadIO m => Handle -> Format (m ()) a -> a
    hprintLn :: forall (m :: * -> *) a. MonadIO m => Handle -> Format (m ()) a -> a
    hprintLn Handle
    h Format (m ()) a
    m = Format (m ()) a -> (Builder -> m ()) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format (m ()) a
    m (IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (Builder -> IO ()) -> Builder -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Handle -> Text -> IO ()
    T.hPutStrLn Handle
    h (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Builder -> Text
    T.toLazyText)

    -- | Run the formatter and return a list of characters.
    formatToString :: Format String a -> a
    formatToString :: forall a. Format String a -> a
    formatToString Format String a
    m = Format String a -> (Builder -> String) -> a
    forall r a. Format r a -> (Builder -> r) -> a
    runFormat Format String a
    m (Text -> String
    TL.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Builder -> Text
    TLB.toLazyText)