{-# LANGUAGE OverloadedStrings #-}

-- | Text formatting via 'Data.Text.Lazy.Builder'.
module Data.Fmt.Text (
    -- * TextFmt
    TextFmt,
    runTextFmt,
    printf,

    -- * Combinators
    cat1With,
    hsep,
    vsep,
    hang,
    list1,

    -- * Splitting
    replace1,
    splitWith,

    -- * Running Fmt1
    run1,

    -- * Structured output
    jsonList,
    yamlList,
    jsonMap,
    yamlMap,
) where

import Data.Foldable (toList)
import Data.Fmt.Type (Fmt (..), Fmt1, fmt, fmt1, (%))

import qualified Data.Text.IO as TIO
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

-- | A 'Fmt' specialized to 'Data.Text.Lazy.Builder.Builder'.
type TextFmt = Fmt Builder

-- | Run a 'TextFmt' to produce lazy 'TL.Text'.
{-# INLINE runTextFmt #-}
runTextFmt :: TextFmt TL.Text a -> a
runTextFmt :: forall a. TextFmt Text a -> a
runTextFmt (Fmt (Builder -> Text) -> a
f) = (Builder -> Text) -> a
f Builder -> Text
toLazyText

-- | Run a 'TextFmt' and print the result to stdout.
{-# INLINE printf #-}
printf :: TextFmt (IO ()) a -> a
printf :: forall a. TextFmt (IO ()) a -> a
printf (Fmt (Builder -> IO ()) -> a
f) = (Builder -> IO ()) -> a
f ((Builder -> IO ()) -> a) -> (Builder -> IO ()) -> a
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
TIO.putStr (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText

---------------------------------------------------------------------
-- Internal
---------------------------------------------------------------------

{-# INLINE toStrict #-}
toStrict :: Builder -> Text
toStrict :: Builder -> Text
toStrict = Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText

-- | Run a Fmt1 to strict Text.
{-# INLINE run1 #-}
run1 :: Fmt1 Builder Text a -> a -> Text
run1 :: forall a. Fmt1 Builder Text a -> a -> Text
run1 (Fmt (Builder -> Text) -> a -> Text
f) = (Builder -> Text) -> a -> Text
f (Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText)

---------------------------------------------------------------------
-- Combinators
---------------------------------------------------------------------

-- | Format each value in a foldable and join the results.
{-# INLINEABLE cat1With #-}
cat1With ::
    Foldable f =>
    ([Text] -> Text) ->
    Fmt1 Builder Text a ->
    Fmt1 Builder s (f a)
cat1With :: forall (f :: * -> *) a s.
Foldable f =>
([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
cat1With [Text] -> Text
join Fmt1 Builder Text a
f = (f a -> Builder) -> Fmt1 Builder s (f a)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((f a -> Builder) -> Fmt1 Builder s (f a))
-> (f a -> Builder) -> Fmt1 Builder s (f a)
forall a b. (a -> b) -> a -> b
$ Text -> Builder
fromText (Text -> Builder) -> (f a -> Text) -> f a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
join ([Text] -> Text) -> (f a -> [Text]) -> f a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt1 Builder Text a -> a -> Text
forall a. Fmt1 Builder Text a -> a -> Text
run1 Fmt1 Builder Text a
f) ([a] -> [Text]) -> (f a -> [a]) -> f a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Format each value with spaces in between.
{-# INLINE hsep #-}
hsep :: Foldable f => Fmt1 Builder Text a -> Fmt1 Builder s (f a)
hsep :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder Text a -> Fmt1 Builder s (f a)
hsep = ([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
cat1With (Text -> [Text] -> Text
T.intercalate Text
" ")

-- | Format each value on its own line.
{-# INLINE vsep #-}
vsep :: Foldable f => Fmt1 Builder Text a -> Fmt1 Builder s (f a)
vsep :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder Text a -> Fmt1 Builder s (f a)
vsep = ([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
cat1With (Text -> [Text] -> Text
T.intercalate Text
"\n")

-- | Format each value on its own line, indented by @n@ spaces.
{-# INLINE hang #-}
hang :: Foldable f => Int -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
hang :: forall (f :: * -> *) a s.
Foldable f =>
Int -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
hang Int
n Fmt1 Builder Text a
f = (f a -> Builder) -> Fmt1 Builder s (f a)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((f a -> Builder) -> Fmt1 Builder s (f a))
-> (f a -> Builder) -> Fmt1 Builder s (f a)
forall a b. (a -> b) -> a -> b
$ \f a
xs ->
    let pad :: Text
pad = Int -> Text -> Text
T.replicate Int
n Text
" "
        items :: [Text]
items = (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> Text
pad Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Fmt1 Builder Text a -> a -> Text
forall a. Fmt1 Builder Text a -> a -> Text
run1 Fmt1 Builder Text a
f a
x) (f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs)
     in Text -> Builder
fromText ([Text] -> Text
T.unlines [Text]
items)

-- | Format in square brackets with comma separation.
{-# INLINE list1 #-}
list1 :: Foldable f => Fmt1 Builder Text a -> Fmt1 Builder s (f a)
list1 :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder Text a -> Fmt1 Builder s (f a)
list1 = ([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
cat1With (\[Text]
xs -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")

---------------------------------------------------------------------
-- Splitting
---------------------------------------------------------------------

-- | Split the formatted output using a splitting function, then
-- rejoin with a custom combinator.
{-# INLINE splitWith #-}
splitWith ::
    (Text -> (Text, Text)) ->
    (Text -> Text -> Fmt Builder a2 a1) ->
    Fmt Builder a1 b ->
    Fmt Builder a2 b
splitWith :: forall a2 a1 b.
(Text -> (Text, Text))
-> (Text -> Text -> Fmt Builder a2 a1)
-> Fmt Builder a1 b
-> Fmt Builder a2 b
splitWith Text -> (Text, Text)
brk Text -> Text -> Fmt Builder a2 a1
join Fmt Builder a1 b
f = Fmt Builder a1 b
f Fmt Builder a1 b
-> (Builder -> Fmt Builder a2 a1) -> Fmt Builder a2 b
forall {t} {a} {b} {m} {a}.
Fmt t a b -> (t -> Fmt m a a) -> Fmt m a b
`bind_` \Builder
b ->
    let (Text
l, Text
r) = Text -> (Text, Text)
brk (Builder -> Text
toStrict Builder
b)
     in (Text -> Text -> Fmt Builder a2 a1)
-> (Text, Text) -> Fmt Builder a2 a1
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Fmt Builder a2 a1
join (Text
l, Text
r)
  where
    bind_ :: Fmt t a b -> (t -> Fmt m a a) -> Fmt m a b
bind_ Fmt t a b
m t -> Fmt m a a
g = ((m -> a) -> b) -> Fmt m a b
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt (((m -> a) -> b) -> Fmt m a b) -> ((m -> a) -> b) -> Fmt m a b
forall a b. (a -> b) -> a -> b
$ \m -> a
k -> Fmt t a b -> (t -> a) -> b
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt Fmt t a b
m (\t
a -> Fmt m a a -> (m -> a) -> a
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt (t -> Fmt m a a
g t
a) m -> a
k)

-- | Replace the first occurrence of a search term.
{-# INLINE replace1 #-}
replace1 :: Text -> Fmt Builder a a -> Fmt Builder a b -> Fmt Builder a b
replace1 :: forall a b.
Text -> Fmt Builder a a -> Fmt Builder a b -> Fmt Builder a b
replace1 Text
needle Fmt Builder a a
replacement =
    (Text -> (Text, Text))
-> (Text -> Text -> Fmt Builder a a)
-> Fmt Builder a b
-> Fmt Builder a b
forall a2 a1 b.
(Text -> (Text, Text))
-> (Text -> Text -> Fmt Builder a2 a1)
-> Fmt Builder a1 b
-> Fmt Builder a2 b
splitWith (HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
needle) ((Text -> Text -> Fmt Builder a a)
 -> Fmt Builder a b -> Fmt Builder a b)
-> (Text -> Text -> Fmt Builder a a)
-> Fmt Builder a b
-> Fmt Builder a b
forall a b. (a -> b) -> a -> b
$ \Text
l Text
r0 ->
        case Text -> Text -> Maybe Text
T.stripPrefix Text
needle Text
r0 of
            Maybe Text
Nothing -> Builder -> Fmt Builder a a
forall m a. m -> Fmt m a a
fmt (Text -> Builder
fromText Text
l)
            Just Text
r -> Builder -> Fmt Builder a a
forall m a. m -> Fmt m a a
fmt (Text -> Builder
fromText Text
l) Fmt Builder a a -> Fmt Builder a a -> Fmt Builder a a
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
% Fmt Builder a a
replacement Fmt Builder a a -> Fmt Builder a a -> Fmt Builder a a
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
% Builder -> Fmt Builder a a
forall m a. m -> Fmt m a a
fmt (Text -> Builder
fromText Text
r)

---------------------------------------------------------------------
-- Structured output
---------------------------------------------------------------------

-- | Format a foldable as a JSON-style list.
{-# INLINE jsonList #-}
jsonList :: Foldable f => Fmt1 Builder Text a -> Fmt1 Builder s (f a)
jsonList :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder Text a -> Fmt1 Builder s (f a)
jsonList = ([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
cat1With (([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a))
-> ([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
forall a b. (a -> b) -> a -> b
$ \[Text]
xs -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Format a foldable as a YAML-style list.
{-# INLINE yamlList #-}
yamlList :: Foldable f => Fmt1 Builder Text a -> Fmt1 Builder s (f a)
yamlList :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder Text a -> Fmt1 Builder s (f a)
yamlList = ([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
cat1With (([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a))
-> ([Text] -> Text) -> Fmt1 Builder Text a -> Fmt1 Builder s (f a)
forall a b. (a -> b) -> a -> b
$ \[Text]
xs -> [Text] -> Text
T.unlines ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
xs)

-- | Format key-value pairs as a JSON-style map.
{-# INLINE jsonMap #-}
jsonMap :: (Foldable f) => Fmt1 Builder Text k -> Fmt1 Builder Text v -> Fmt1 Builder s (f (k, v))
jsonMap :: forall (f :: * -> *) k v s.
Foldable f =>
Fmt1 Builder Text k
-> Fmt1 Builder Text v -> Fmt1 Builder s (f (k, v))
jsonMap Fmt1 Builder Text k
kf Fmt1 Builder Text v
vf = (f (k, v) -> Builder) -> Fmt1 Builder s (f (k, v))
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((f (k, v) -> Builder) -> Fmt1 Builder s (f (k, v)))
-> (f (k, v) -> Builder) -> Fmt1 Builder s (f (k, v))
forall a b. (a -> b) -> a -> b
$ \f (k, v)
kvs ->
    let items :: [Text]
items = ((k, v) -> Text) -> [(k, v)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> Text
fmtPair (f (k, v) -> [(k, v)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (k, v)
kvs)
        fmtPair :: (k, v) -> Text
fmtPair (k
k, v
v) = Fmt1 Builder Text k -> k -> Text
forall a. Fmt1 Builder Text a -> a -> Text
run1 Fmt1 Builder Text k
kf k
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Fmt1 Builder Text v -> v -> Text
forall a. Fmt1 Builder Text a -> a -> Text
run1 Fmt1 Builder Text v
vf v
v
     in Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
items Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

-- | Format key-value pairs as a YAML-style map.
{-# INLINE yamlMap #-}
yamlMap :: (Foldable f) => Fmt1 Builder Text k -> Fmt1 Builder Text v -> Fmt1 Builder s (f (k, v))
yamlMap :: forall (f :: * -> *) k v s.
Foldable f =>
Fmt1 Builder Text k
-> Fmt1 Builder Text v -> Fmt1 Builder s (f (k, v))
yamlMap Fmt1 Builder Text k
kf Fmt1 Builder Text v
vf = (f (k, v) -> Builder) -> Fmt1 Builder s (f (k, v))
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((f (k, v) -> Builder) -> Fmt1 Builder s (f (k, v)))
-> (f (k, v) -> Builder) -> Fmt1 Builder s (f (k, v))
forall a b. (a -> b) -> a -> b
$ \f (k, v)
kvs ->
    let items :: [Text]
items = ((k, v) -> Text) -> [(k, v)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> Text
fmtPair (f (k, v) -> [(k, v)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (k, v)
kvs)
        fmtPair :: (k, v) -> Text
fmtPair (k
k, v
v) = Fmt1 Builder Text k -> k -> Text
forall a. Fmt1 Builder Text a -> a -> Text
run1 Fmt1 Builder Text k
kf k
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Fmt1 Builder Text v -> v -> Text
forall a. Fmt1 Builder Text a -> a -> Text
run1 Fmt1 Builder Text v
vf v
v
     in Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
items