content: {-# 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 {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 f (Format k) = Format (f . k)
  
  instance Semigroup (Format r (a -> r)) where
    m <> n =
      Format (\k a ->
                runFormat m (\b1 -> runFormat n (\b2 -> k (b1 <> b2)) 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)
  m <%+> n =
    Format (\k a ->
              runFormat m (\b1 -> runFormat n (\b2 -> k (b1 <> TLB.singleton ' ' <> b2)) 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 (\k _ -> k 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 = now . 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 = now mempty
    f . g =
      f `bind`
      \a ->
        g `bind`
        \b -> now (a `mappend` 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
  (%) = (.)
  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
  f %+ g =
      f `bind`
      \a ->
        g `bind`
        \b -> now (a `mappend` TLB.singleton ' ' `mappend` 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
  (%.) (Format a) (Format b) = Format (b . a)
  infixr 8 %.
  
  -- | Don't format any data, just output a constant 'Builder'.
  now :: Builder -> Format r r
  now a = Format ($ a)
  
  -- | Monadic indexed bind for holey monoids.
  bind :: Format r a -> (Builder -> Format r' r) -> Format r' a
  m `bind` f = Format $ \k -> runFormat m (\a -> runFormat (f a) 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 f m = Format (\k -> runFormat m k . 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 f = Format (. f)
  
  -- | Run the formatter and return a lazy 'Text' value.
  format :: Format Text a -> a
  format m = runFormat m T.toLazyText
  
  -- | Run the formatter and return a strict 'S.Text' value.
  sformat :: Format S.Text a -> a
  sformat m = runFormat m (T.toStrict . T.toLazyText)
  
  -- | Run the formatter and return a 'Builder' value.
  bprint :: Format Builder a -> a
  bprint m = runFormat m 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 m = runFormat m id
  
  -- | Run the formatter and print out the text to stdout.
  fprint :: MonadIO m => Format (m ()) a -> a
  fprint m = runFormat m (liftIO . T.putStr . T.toLazyText)
  
  -- | Run the formatter and print out the text to stdout, followed by a newline.
  fprintLn :: MonadIO m => Format (m ()) a -> a
  fprintLn m = runFormat m (liftIO . T.putStrLn . T.toLazyText)
  
  -- | Run the formatter and put the output onto the given 'Handle'.
  hprint :: MonadIO m => Handle -> Format (m ()) a -> a
  hprint h m = runFormat m (liftIO . T.hPutStr h . 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 h m = runFormat m (liftIO . T.hPutStrLn h . T.toLazyText)
  
  -- | Run the formatter and return a list of characters.
  formatToString :: Format String a -> a
  formatToString m = runFormat m (TL.unpack . TLB.toLazyText)
  