{-# 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 :: Int -> Builder -> Builder
indentF Int
n Builder
a = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText Builder
a) of
    [] -> Text -> Builder
fromLazyText (Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
    [Text]
xs -> Text -> Builder
fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
TL.unlines ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
xs)
  where
    spaces :: Text
spaces = Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Char -> Text
TL.singleton Char
' ')

{- | 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' :: Int -> Text -> Builder -> Builder
indentF' Int
n Text
pref Builder
a = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText Builder
a) of
  []     -> Text -> Builder
fromText Text
pref Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
  (Text
x:[Text]
xs) -> Text -> Builder
fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
TL.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text
TL.fromStrict Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
xs
  where
    spaces :: Text
spaces = Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Char -> Text
TL.singleton Char
' ')

{- | Attach a name to anything:

>>> fmt $ nameF "clients" $ blockListF ["Alice", "Bob", "Zalgo"]
clients:
  - Alice
  - Bob
  - Zalgo
-}
nameF :: Builder -> Builder -> Builder
nameF :: Builder -> Builder -> Builder
nameF Builder
k Builder
v = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText Builder
v) of
    []  -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":\n"
    [Text
l] -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
    [Text]
ls  -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
           [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | Text
s <- [Text]
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 :: f a -> Builder
unwordsF = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> (f a -> [Builder]) -> f a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
" " ([Builder] -> [Builder]) -> (f a -> [Builder]) -> f a -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall p. Buildable p => p -> Builder
build ([a] -> [Builder]) -> (f a -> [a]) -> f a -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
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 :: f a -> Builder
unlinesF = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> (f a -> [Builder]) -> f a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder
nl (Builder -> Builder) -> (a -> Builder) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
build) ([a] -> [Builder]) -> (f a -> [a]) -> f a -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  where
    nl :: Builder -> Builder
nl Builder
x | Text
"\n" Text -> Text -> Bool
`TL.isSuffixOf` Builder -> Text
toLazyText Builder
x = Builder
x
         | Bool
otherwise = Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\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 :: f a -> Builder
listF = (a -> Builder) -> f a -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
listF' a -> Builder
forall p. Buildable p => p -> Builder
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' :: (a -> Builder) -> f a -> Builder
listF' a -> Builder
fbuild f a
xs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
  Builder
"[" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:
  Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
", " ((a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
fbuild (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs)) [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++
  [Builder
"]"]

{-# 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 :: f a -> Builder
blockListF = Text -> (a -> Builder) -> f a -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"-" a -> Builder
forall p. Buildable p => p -> Builder
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' :: Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
bullet a -> Builder
fbuild f a
xs = if [Builder] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items then Builder
"[]\n" else [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
items
  where
    items :: [Builder]
items = (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
buildItem (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs)
    spaces :: Builder
spaces = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate (Text -> Int
T.length Text
bullet Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Builder
singleton Char
' ')
    buildItem :: a -> Builder
buildItem a
x = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText (a -> Builder
fbuild a
x)) of
      []     -> Text
bullet Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
      (Text
l:[Text]
ls) -> Text
bullet Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
l Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
spaces Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | Text
s <- [Text]
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 :: f a -> Builder
jsonListF = (a -> Builder) -> f a -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
jsonListF' a -> Builder
forall p. Buildable p => p -> Builder
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' :: (a -> Builder) -> f a -> Builder
jsonListF' a -> Builder
fbuild f a
xs
  | [Builder] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items = Builder
"[]\n"
  | Bool
otherwise  = Builder
"[\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
items Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]\n"
  where
    items :: [Builder]
items = (Bool -> a -> Builder) -> [Bool] -> [a] -> [Builder]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> a -> Builder
buildItem (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs)
    -- Item builder
    buildItem :: Bool -> a -> Builder
    buildItem :: Bool -> a -> Builder
buildItem Bool
isFirst a
x =
      case (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromLazyText (Text -> [Text]
TL.lines (Builder -> Text
toLazyText (a -> Builder
fbuild a
x))) of
        [] | Bool
isFirst   -> Builder
"\n"
           | Bool
otherwise -> Builder
",\n"
        [Builder]
ls ->
            [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
              [Builder]
ls [Builder] -> ([Builder] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& (Builder -> Identity Builder) -> [Builder] -> Identity [Builder]
forall s a. Cons s s a a => Traversal' s a
_head ((Builder -> Identity Builder) -> [Builder] -> Identity [Builder])
-> (Builder -> Builder) -> [Builder] -> [Builder]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (if Bool
isFirst then (Builder
"  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) else (Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>))
                 [Builder] -> ([Builder] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& ([Builder] -> Identity [Builder])
-> [Builder] -> Identity [Builder]
forall s a. Cons s s a a => Traversal' s s
_tail(([Builder] -> Identity [Builder])
 -> [Builder] -> Identity [Builder])
-> ((Builder -> Identity Builder)
    -> [Builder] -> Identity [Builder])
-> (Builder -> Identity Builder)
-> [Builder]
-> Identity [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Builder -> Identity Builder) -> [Builder] -> Identity [Builder]
forall s t a b. Each s t a b => Traversal s t a b
each ((Builder -> Identity Builder) -> [Builder] -> Identity [Builder])
-> (Builder -> Builder) -> [Builder] -> [Builder]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Builder
"  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>)

{-# 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 :: t -> Builder
mapF = (k -> Builder) -> (v -> Builder) -> t -> Builder
forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
mapF' k -> Builder
forall p. Buildable p => p -> Builder
build v -> Builder
forall p. Buildable p => p -> Builder
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' :: (k -> Builder) -> (v -> Builder) -> t -> Builder
mapF' k -> Builder
fbuild_k v -> Builder
fbuild_v t
xs =
  Builder
"{" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
", " (((k, v) -> Builder) -> [(k, v)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> Builder
buildPair (t -> [Item t]
forall l. IsList l => l -> [Item l]
IsList.toList t
xs))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
  where
    buildPair :: (k, v) -> Builder
buildPair (k
k, v
v) = k -> Builder
fbuild_k k
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> v -> Builder
fbuild_v 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 :: t -> Builder
blockMapF = (k -> Builder) -> (v -> Builder) -> t -> Builder
forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
blockMapF' k -> Builder
forall p. Buildable p => p -> Builder
build v -> Builder
forall p. Buildable p => p -> Builder
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' :: (k -> Builder) -> (v -> Builder) -> t -> Builder
blockMapF' k -> Builder
fbuild_k v -> Builder
fbuild_v t
xs
  | [Builder] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items = Builder
"{}\n"
  | Bool
otherwise  = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
items
  where
    items :: [Builder]
items = ((k, v) -> Builder) -> [(k, v)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, v
v) -> Builder -> Builder -> Builder
nameF (k -> Builder
fbuild_k k
k) (v -> Builder
fbuild_v v
v)) (t -> [Item t]
forall l. IsList l => l -> [Item l]
IsList.toList t
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 :: t -> Builder
jsonMapF = (k -> Builder) -> (v -> Builder) -> t -> Builder
forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
jsonMapF' k -> Builder
forall p. Buildable p => p -> Builder
build v -> Builder
forall p. Buildable p => p -> Builder
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' :: (k -> Builder) -> (v -> Builder) -> t -> Builder
jsonMapF' k -> Builder
fbuild_k v -> Builder
fbuild_v t
xs
  | [Builder] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items = Builder
"{}\n"
  | Bool
otherwise  = Builder
"{\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
items Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"
  where
    items :: [Builder]
items = (Bool -> (k, v) -> Builder) -> [Bool] -> [(k, v)] -> [Builder]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> (k, v) -> Builder
buildItem (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) (t -> [Item t]
forall l. IsList l => l -> [Item l]
IsList.toList t
xs)
    -- Item builder
    buildItem :: Bool -> (k, v) -> Builder
    buildItem :: Bool -> (k, v) -> Builder
buildItem Bool
isFirst (k
k, v
v) = do
      let kb :: Builder
kb = (if Bool
isFirst then Builder
"  " else Builder
", ") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> k -> Builder
fbuild_k k
k
      case (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromLazyText (Text -> [Text]
TL.lines (Builder -> Text
toLazyText (v -> Builder
fbuild_v v
v))) of
        []  -> Builder
kb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":\n"
        [Builder
l] -> Builder
kb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
        [Builder]
ls  -> Builder
kb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
               [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"    " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | Builder
s <- [Builder]
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 a -> Builder
maybeF = Builder -> (a -> Builder) -> Maybe a -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"<Nothing>" a -> Builder
forall p. Buildable p => p -> Builder
build

{- |
Format an 'Either':

>>> eitherF (Right 1 :: Either Bool Int)
"<Right: 1>"
-}
eitherF :: (Buildable a, Buildable b) => Either a b -> Builder
eitherF :: Either a b -> Builder
eitherF = (a -> Builder) -> (b -> Builder) -> Either a b -> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
x -> Builder
"<Left: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">")
                 (\b
x -> Builder
"<Right: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> b -> Builder
forall p. Buildable p => p -> Builder
build b
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">")

----------------------------------------------------------------------------
-- Other formatters
----------------------------------------------------------------------------

{- |
Take the first N characters:

>>> prefixF 3 "hello"
"hel"
-}
prefixF :: Buildable a => Int -> a -> Builder
prefixF :: Int -> a -> Builder
prefixF Int
size =
  Text -> Builder
fromLazyText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Text -> Text
TL.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
build

{- |
Take the last N characters:

>>> suffixF 3 "hello"
"llo"
-}
suffixF :: Buildable a => Int -> a -> Builder
suffixF :: Int -> a -> Builder
suffixF Int
size =
  Text -> Builder
fromLazyText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (\Text
t -> Int64 -> Text -> Text
TL.drop (Text -> Int64
TL.length Text
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) Text
t) (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
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 :: Int -> Char -> a -> Builder
padLeftF = Int -> Char -> a -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
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 :: Int -> Char -> a -> Builder
padRightF = Int -> Char -> a -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
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 :: Int -> Char -> a -> Builder
padBothF Int
i Char
c =
  Text -> Builder
fromLazyText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Char -> Text -> Text
TL.center (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Char
c (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
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 :: Bool -> Builder -> Builder
whenF Bool
True  Builder
x = Builder
x
whenF Bool
False Builder
_ = Builder
forall a. Monoid a => a
mempty
{-# INLINE whenF #-}

{- | Display something only if the condition is 'False' (empty string
otherwise).
-}
unlessF :: Bool -> Builder -> Builder
unlessF :: Bool -> Builder -> Builder
unlessF Bool
False Builder
x = Builder
x
unlessF Bool
True  Builder
_ = Builder
forall a. Monoid a => a
mempty
{-# INLINE unlessF #-}