content: {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  
  module Fmt.Internal.Formatters where
  
  
  -- Generic useful things
  import Data.List (intersperse)
  import Lens.Micro
  #if __GLASGOW_HASKELL__ < 804
  import Data.Monoid ((<>))
  #endif
  -- Text
  import qualified Data.Text as T
  import qualified Data.Text.Lazy as TL
  import Data.Text (Text)
  -- 'Buildable' and text-format stuff
  import Formatting.Buildable
  import qualified Formatting.Internal.Raw as F
  -- Text 'Builder'
  import Data.Text.Lazy.Builder hiding (fromString)
  -- 'Foldable' and 'IsList' for list/map formatters
  import Data.Foldable (toList)
  import GHC.Exts (IsList, Item)
  import qualified GHC.Exts as IsList (toList)
  
  import Fmt.Internal.Core
  
  
  ----------------------------------------------------------------------------
  -- Doctest setup
  ----------------------------------------------------------------------------
  
  -- $setup
  -- >>> import Fmt
  
  ----------------------------------------------------------------------------
  -- Text formatters
  ----------------------------------------------------------------------------
  
  {- |
  Indent a block of text.
  
  >>> fmt $ "This is a list:\n" <> indentF 4 (blockListF [1,2,3])
  This is a list:
      - 1
      - 2
      - 3
  
  The output will always end with a newline, even when the input doesn't.
  -}
  indentF :: Int -> Builder -> Builder
  indentF n a = case TL.lines (toLazyText a) of
      [] -> fromLazyText (spaces <> "\n")
      xs -> fromLazyText $ TL.unlines (map (spaces <>) xs)
    where
      spaces = TL.replicate (fromIntegral n) (TL.singleton ' ')
  
  {- | Add a prefix to the first line, and indent all lines but the first one.
  
  The output will always end with a newline, even when the input doesn't.
  -}
  indentF' :: Int -> T.Text -> Builder -> Builder
  indentF' n pref a = case TL.lines (toLazyText a) of
    []     -> fromText pref <> "\n"
    (x:xs) -> fromLazyText $
              TL.unlines $ (TL.fromStrict pref <> x) : map (spaces <>) xs
    where
      spaces = TL.replicate (fromIntegral n) (TL.singleton ' ')
  
  {- | Attach a name to anything:
  
  >>> fmt $ nameF "clients" $ blockListF ["Alice", "Bob", "Zalgo"]
  clients:
    - Alice
    - Bob
    - Zalgo
  -}
  nameF :: Builder -> Builder -> Builder
  nameF k v = case TL.lines (toLazyText v) of
      []  -> k <> ":\n"
      [l] -> k <> ": " <> fromLazyText l <> "\n"
      ls  -> k <> ":\n" <>
             mconcat ["  " <> fromLazyText s <> "\n" | s <- ls]
  
  {- | Put spaces between elements.
  
  >>> fmt $ unwordsF ["hello", "world"]
  hello world
  
  Of course, it works on anything 'Buildable':
  
  >>> fmt $ unwordsF [1, 2]
  1 2
  -}
  unwordsF :: (Foldable f, Buildable a) => f a -> Builder
  unwordsF = mconcat . intersperse " " . map build . toList
  
  {-# SPECIALIZE unwordsF :: Buildable a => [a] -> Builder #-}
  
  {- | Arrange elements on separate lines.
  
  >>> fmt $ unlinesF ["hello", "world"]
  hello
  world
  -}
  unlinesF :: (Foldable f, Buildable a) => f a -> Builder
  unlinesF = mconcat . map (nl . build) . toList
    where
      nl x | "\n" `TL.isSuffixOf` toLazyText x = x
           | otherwise = x <> "\n"
  
  {-# SPECIALIZE unlinesF :: Buildable a => [a] -> Builder #-}
  
  ----------------------------------------------------------------------------
  -- List formatters
  ----------------------------------------------------------------------------
  
  {- | A simple comma-separated list formatter.
  
  >>> listF ["hello", "world"]
  "[hello, world]"
  
  For multiline output, use 'jsonListF'.
  -}
  listF :: (Foldable f, Buildable a) => f a -> Builder
  listF = listF' build
  {-# INLINE listF #-}
  
  {- | A version of 'listF' that lets you supply your own building function for
  list elements.
  
  For instance, to format a list of numbers as hex:
  
  >>> listF' hexF [1234, 5678]
  "[4d2, 162e]"
  -}
  listF' :: (Foldable f) => (a -> Builder) -> f a -> Builder
  listF' fbuild xs = mconcat $
    "[" :
    intersperse ", " (map fbuild (toList xs)) ++
    ["]"]
  
  {-# SPECIALIZE listF' :: (a -> Builder) -> [a] -> Builder #-}
  
  {- Note [Builder appending]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  The documentation for 'Builder' says that it's preferrable to associate
  'Builder' appends to the right (i.e. @a <> (b <> c)@). The maximum possible
  association-to-the-right is achieved when we avoid appending builders until
  the last second (i.e. in the latter scenario):
  
      -- (a1 <> x) <> (a2 <> x) <> ...
      mconcat [a <> x | a <- as]
  
      -- a1 <> x <> a2 <> x <> ...
      mconcat $ concat [[a, x] | a <- as]
  
  However, benchmarks have shown that the former way is actually faster.
  -}
  
  {- | A multiline formatter for lists.
  
  >>> fmt $ blockListF [1,2,3]
  - 1
  - 2
  - 3
  
  Multi-line elements are indented correctly:
  
  >>> fmt $ blockListF ["hello\nworld", "foo\nbar\nquix"]
  - hello
    world
  - foo
    bar
    quix
  
  -}
  blockListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder
  blockListF = blockListF' "-" build
  {-# INLINE blockListF #-}
  
  {- | A version of 'blockListF' that lets you supply your own building function
  for list elements (instead of 'build') and choose the bullet character
  (instead of @"-"@).
  -}
  blockListF'
    :: forall f a. Foldable f
    => Text                       -- ^ Bullet
    -> (a -> Builder)             -- ^ Builder for elements
    -> f a                        -- ^ Structure with elements
    -> Builder
  blockListF' bullet fbuild xs = if null items then "[]\n" else mconcat items
    where
      items = map buildItem (toList xs)
      spaces = mconcat $ replicate (T.length bullet + 1) (singleton ' ')
      buildItem x = case TL.lines (toLazyText (fbuild x)) of
        []     -> bullet |+ "\n"
        (l:ls) -> bullet |+ " " +| l |+ "\n" <>
                  mconcat [spaces <> fromLazyText s <> "\n" | s <- ls]
  
  {-# SPECIALIZE blockListF' :: Text -> (a -> Builder) -> [a] -> Builder #-}
  
  {- | A JSON-style formatter for lists.
  
  >>> fmt $ jsonListF [1,2,3]
  [
    1
  , 2
  , 3
  ]
  
  Like 'blockListF', it handles multiline elements well:
  
  >>> fmt $ jsonListF ["hello\nworld", "foo\nbar\nquix"]
  [
    hello
    world
  , foo
    bar
    quix
  ]
  -}
  jsonListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder
  jsonListF = jsonListF' build
  {-# INLINE jsonListF #-}
  
  {- | A version of 'jsonListF' that lets you supply your own building function
  for list elements.
  -}
  jsonListF' :: forall f a. (Foldable f) => (a -> Builder) -> f a -> Builder
  jsonListF' fbuild xs
    | null items = "[]\n"
    | otherwise  = "[\n" <> mconcat items <> "]\n"
    where
      items = zipWith buildItem (True : repeat False) (toList xs)
      -- Item builder
      buildItem :: Bool -> a -> Builder
      buildItem isFirst x =
        case map fromLazyText (TL.lines (toLazyText (fbuild x))) of
          [] | isFirst   -> "\n"
             | otherwise -> ",\n"
          ls ->
              mconcat . map (<> "\n") $
                ls & _head %~ (if isFirst then ("  " <>) else (", " <>))
                   & _tail.each %~ ("  " <>)
  
  {-# SPECIALIZE jsonListF' :: (a -> Builder) -> [a] -> Builder #-}
  
  ----------------------------------------------------------------------------
  -- Map formatters
  ----------------------------------------------------------------------------
  
  {- | A simple JSON-like map formatter; works for Map, HashMap, etc, as well as
  ordinary lists of pairs.
  
  >>> mapF [("a", 1), ("b", 4)]
  "{a: 1, b: 4}"
  
  For multiline output, use 'jsonMapF'.
  -}
  mapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
  mapF = mapF' build build
  {-# INLINE mapF #-}
  
  {- | A version of 'mapF' that lets you supply your own building function for
  keys and values.
  -}
  mapF'
    :: (IsList t, Item t ~ (k, v))
    => (k -> Builder) -> (v -> Builder) -> t -> Builder
  mapF' fbuild_k fbuild_v xs =
    "{" <> mconcat (intersperse ", " (map buildPair (IsList.toList xs))) <> "}"
    where
      buildPair (k, v) = fbuild_k k <> ": " <> fbuild_v v
  
  {- | A YAML-like map formatter:
  
  >>> fmt $ blockMapF [("Odds", blockListF [1,3]), ("Evens", blockListF [2,4])]
  Odds:
    - 1
    - 3
  Evens:
    - 2
    - 4
  -}
  blockMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
  blockMapF = blockMapF' build build
  {-# INLINE blockMapF #-}
  
  {- | A version of 'blockMapF' that lets you supply your own building function
  for keys and values.
  -}
  blockMapF'
    :: (IsList t, Item t ~ (k, v))
    => (k -> Builder) -> (v -> Builder) -> t -> Builder
  blockMapF' fbuild_k fbuild_v xs
    | null items = "{}\n"
    | otherwise  = mconcat items
    where
      items = map (\(k, v) -> nameF (fbuild_k k) (fbuild_v v)) (IsList.toList xs)
  
  {- | A JSON-like map formatter (unlike 'mapF', always multiline):
  
  >>> fmt $ jsonMapF [("Odds", jsonListF [1,3]), ("Evens", jsonListF [2,4])]
  {
    Odds:
      [
        1
      , 3
      ]
  , Evens:
      [
        2
      , 4
      ]
  }
  -}
  jsonMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
  jsonMapF = jsonMapF' build build
  {-# INLINE jsonMapF #-}
  
  {- | A version of 'jsonMapF' that lets you supply your own building function
  for keys and values.
  -}
  jsonMapF'
    :: forall t k v.
       (IsList t, Item t ~ (k, v))
    => (k -> Builder) -> (v -> Builder) -> t -> Builder
  jsonMapF' fbuild_k fbuild_v xs
    | null items = "{}\n"
    | otherwise  = "{\n" <> mconcat items <> "}\n"
    where
      items = zipWith buildItem (True : repeat False) (IsList.toList xs)
      -- Item builder
      buildItem :: Bool -> (k, v) -> Builder
      buildItem isFirst (k, v) = do
        let kb = (if isFirst then "  " else ", ") <> fbuild_k k
        case map fromLazyText (TL.lines (toLazyText (fbuild_v v))) of
          []  -> kb <> ":\n"
          [l] -> kb <> ": " <> l <> "\n"
          ls  -> kb <> ":\n" <>
                 mconcat ["    " <> s <> "\n" | s <- ls]
  
  ----------------------------------------------------------------------------
  -- ADT formatters
  ----------------------------------------------------------------------------
  
  {- | Like 'build' for 'Maybe', but displays 'Nothing' as @\<Nothing\>@ instead
  of an empty string.
  
  'build':
  
  >>> build (Nothing :: Maybe Int)
  ""
  >>> build (Just 1 :: Maybe Int)
  "1"
  
  'maybeF':
  
  >>> maybeF (Nothing :: Maybe Int)
  "<Nothing>"
  >>> maybeF (Just 1 :: Maybe Int)
  "1"
  -}
  maybeF :: Buildable a => Maybe a -> Builder
  maybeF = maybe "<Nothing>" build
  
  {- |
  Format an 'Either':
  
  >>> eitherF (Right 1 :: Either Bool Int)
  "<Right: 1>"
  -}
  eitherF :: (Buildable a, Buildable b) => Either a b -> Builder
  eitherF = either (\x -> "<Left: " <> build x <> ">")
                   (\x -> "<Right: " <> build x <> ">")
  
  ----------------------------------------------------------------------------
  -- Other formatters
  ----------------------------------------------------------------------------
  
  {- |
  Take the first N characters:
  
  >>> prefixF 3 "hello"
  "hel"
  -}
  prefixF :: Buildable a => Int -> a -> Builder
  prefixF size =
    fromLazyText . TL.take (fromIntegral size) . toLazyText . build
  
  {- |
  Take the last N characters:
  
  >>> suffixF 3 "hello"
  "llo"
  -}
  suffixF :: Buildable a => Int -> a -> Builder
  suffixF size =
    fromLazyText .
    (\t -> TL.drop (TL.length t - fromIntegral size) t) .
    toLazyText . build
  
  {- |
  @padLeftF n c@ pads the string with character @c@ from the left side until it
  becomes @n@ characters wide (and does nothing if the string is already that
  long, or longer):
  
  >>> padLeftF 5 '0' 12
  "00012"
  >>> padLeftF 5 '0' 123456
  "123456"
  -}
  padLeftF :: Buildable a => Int -> Char -> a -> Builder
  padLeftF = F.left
  
  {- |
  @padRightF n c@ pads the string with character @c@ from the right side until
  it becomes @n@ characters wide (and does nothing if the string is already
  that long, or longer):
  
  >>> padRightF 5 ' ' "foo"
  "foo  "
  >>> padRightF 5 ' ' "foobar"
  "foobar"
  -}
  padRightF :: Buildable a => Int -> Char -> a -> Builder
  padRightF = F.right
  
  {- |
  @padBothF n c@ pads the string with character @c@ from both sides until
  it becomes @n@ characters wide (and does nothing if the string is already
  that long, or longer):
  
  >>> padBothF 5 '=' "foo"
  "=foo="
  >>> padBothF 5 '=' "foobar"
  "foobar"
  
  When padding can't be distributed equally, the left side is preferred:
  
  >>> padBothF 8 '=' "foo"
  "===foo=="
  -}
  padBothF :: Buildable a => Int -> Char -> a -> Builder
  padBothF i c =
    fromLazyText . TL.center (fromIntegral i) c . toLazyText . build
  
  ----------------------------------------------------------------------------
  -- Conditional formatters
  ----------------------------------------------------------------------------
  
  {- | Display something only if the condition is 'True' (empty string
  otherwise).
  
  Note that it can only take a 'Builder' (because otherwise it would be
  unusable with ('+|')-formatted strings which can resolve to any
  'FromBuilder'). You can use 'build' to convert any value to a 'Builder'.
  -}
  whenF :: Bool -> Builder -> Builder
  whenF True  x = x
  whenF False _ = mempty
  {-# INLINE whenF #-}
  
  {- | Display something only if the condition is 'False' (empty string
  otherwise).
  -}
  unlessF :: Bool -> Builder -> Builder
  unlessF False x = x
  unlessF True  _ = mempty
  {-# INLINE unlessF #-}
  