{-# LANGUAGE OverloadedStrings #-}

-- | ByteString formatting via 'Data.ByteString.Builder.Builder'.
module Data.Fmt.ByteString (
    -- * ByteFmt
    ByteFmt,
    runByteFmt,
    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 Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder, byteString, toLazyByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL

-- | A 'Fmt' specialized to 'Builder'.
type ByteFmt = Fmt Builder

-- | Run a 'ByteFmt' to produce a lazy 'BL.ByteString'.
{-# INLINE runByteFmt #-}
runByteFmt :: ByteFmt BL.ByteString a -> a
runByteFmt :: forall a. ByteFmt ByteString a -> a
runByteFmt (Fmt (Builder -> ByteString) -> a
f) = (Builder -> ByteString) -> a
f Builder -> ByteString
toLazyByteString

-- | Run a 'ByteFmt' and print the result to stdout.
{-# INLINE printf #-}
printf :: ByteFmt (IO ()) a -> a
printf :: forall a. ByteFmt (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
$ ByteString -> IO ()
BL.putStr (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString

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

-- | Convert a Builder to strict ByteString (for splitting operations).
{-# INLINE toStrict #-}
toStrict :: Builder -> ByteString
toStrict :: Builder -> ByteString
toStrict = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString

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

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

-- | Format each value in a foldable and join the results.
{-# INLINEABLE cat1With #-}
cat1With ::
    Foldable f =>
    ([ByteString] -> ByteString) ->
    Fmt1 Builder ByteString a ->
    Fmt1 Builder s (f a)
cat1With :: forall (f :: * -> *) a s.
Foldable f =>
([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
cat1With [ByteString] -> ByteString
join Fmt1 Builder ByteString 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
$ ByteString -> Builder
byteString (ByteString -> Builder) -> (f a -> ByteString) -> f a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
join ([ByteString] -> ByteString)
-> (f a -> [ByteString]) -> f a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt1 Builder ByteString a -> a -> ByteString
forall a. Fmt1 Builder ByteString a -> a -> ByteString
run1 Fmt1 Builder ByteString a
f) ([a] -> [ByteString]) -> (f a -> [a]) -> f a -> [ByteString]
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.
--
-- >>> runByteFmt (hsep (fmt1 byteString)) ["one", "two", "three"]
-- "one two three"
{-# INLINE hsep #-}
hsep :: Foldable f => Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
hsep :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
hsep = ([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
cat1With (ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
" ")

-- | Format each value on its own line.
{-# INLINE vsep #-}
vsep :: Foldable f => Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
vsep :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
vsep = ([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
cat1With [ByteString] -> ByteString
B.unlines

-- | Format each value on its own line, indented by @n@ spaces.
{-# INLINE hang #-}
hang :: Foldable f => Int -> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
hang :: forall (f :: * -> *) a s.
Foldable f =>
Int -> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
hang Int
n Fmt1 Builder ByteString 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 :: ByteString
pad = Int -> Char -> ByteString
B.replicate Int
n Char
' '
        items :: [ByteString]
items = (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> ByteString
pad ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Fmt1 Builder ByteString a -> a -> ByteString
forall a. Fmt1 Builder ByteString a -> a -> ByteString
run1 Fmt1 Builder ByteString 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 ByteString -> Builder
byteString ([ByteString] -> ByteString
B.unlines [ByteString]
items)

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

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

-- | Split the formatted output using a splitting function, then
-- rejoin with a custom combinator.
{-# INLINE splitWith #-}
splitWith ::
    (ByteString -> (ByteString, ByteString)) ->
    (ByteString -> ByteString -> Fmt Builder a2 a1) ->
    Fmt Builder a1 b ->
    Fmt Builder a2 b
splitWith :: forall a2 a1 b.
(ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString -> Fmt Builder a2 a1)
-> Fmt Builder a1 b
-> Fmt Builder a2 b
splitWith ByteString -> (ByteString, ByteString)
brk ByteString -> ByteString -> 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 (ByteString
l, ByteString
r) = ByteString -> (ByteString, ByteString)
brk (Builder -> ByteString
toStrict Builder
b)
     in (ByteString -> ByteString -> Fmt Builder a2 a1)
-> (ByteString, ByteString) -> Fmt Builder a2 a1
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Fmt Builder a2 a1
join (ByteString
l, ByteString
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.
--
-- >>> runByteFmt (replace1 "bar" "FOO" (fmt (byteString "foobarbaz")))
-- "fooFOObaz"
{-# INLINE replace1 #-}
replace1 :: ByteString -> Fmt Builder a a -> Fmt Builder a b -> Fmt Builder a b
replace1 :: forall a b.
ByteString -> Fmt Builder a a -> Fmt Builder a b -> Fmt Builder a b
replace1 ByteString
needle Fmt Builder a a
replacement =
    (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString -> Fmt Builder a a)
-> Fmt Builder a b
-> Fmt Builder a b
forall a2 a1 b.
(ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString -> Fmt Builder a2 a1)
-> Fmt Builder a1 b
-> Fmt Builder a2 b
splitWith (ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
needle) ((ByteString -> ByteString -> Fmt Builder a a)
 -> Fmt Builder a b -> Fmt Builder a b)
-> (ByteString -> ByteString -> Fmt Builder a a)
-> Fmt Builder a b
-> Fmt Builder a b
forall a b. (a -> b) -> a -> b
$ \ByteString
l ByteString
r0 ->
        case ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
needle ByteString
r0 of
            Maybe ByteString
Nothing -> Builder -> Fmt Builder a a
forall m a. m -> Fmt m a a
fmt (ByteString -> Builder
byteString ByteString
l)
            Just ByteString
r -> Builder -> Fmt Builder a a
forall m a. m -> Fmt m a a
fmt (ByteString -> Builder
byteString ByteString
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 (ByteString -> Builder
byteString ByteString
r)

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

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

-- | Format a foldable as a YAML-style list.
--
-- >>> printf (yamlList (fmt1 byteString)) ["one", "two"]
-- - one
-- - two
{-# INLINE yamlList #-}
yamlList :: Foldable f => Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
yamlList :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
yamlList = ([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a)
cat1With (([ByteString] -> ByteString)
 -> Fmt1 Builder ByteString a -> Fmt1 Builder s (f a))
-> ([ByteString] -> ByteString)
-> Fmt1 Builder ByteString a
-> Fmt1 Builder s (f a)
forall a b. (a -> b) -> a -> b
$ \[ByteString]
xs -> [ByteString] -> ByteString
B.unlines ((ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString
"- " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) [ByteString]
xs)

-- | Format key-value pairs as a JSON-style map.
{-# INLINE jsonMap #-}
jsonMap :: (Foldable f) => Fmt1 Builder ByteString k -> Fmt1 Builder ByteString v -> Fmt1 Builder s (f (k, v))
jsonMap :: forall (f :: * -> *) k v s.
Foldable f =>
Fmt1 Builder ByteString k
-> Fmt1 Builder ByteString v -> Fmt1 Builder s (f (k, v))
jsonMap Fmt1 Builder ByteString k
kf Fmt1 Builder ByteString 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 :: [ByteString]
items = ((k, v) -> ByteString) -> [(k, v)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> ByteString
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) -> ByteString
fmtPair (k
k, v
v) = Fmt1 Builder ByteString k -> k -> ByteString
forall a. Fmt1 Builder ByteString a -> a -> ByteString
run1 Fmt1 Builder ByteString k
kf k
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Fmt1 Builder ByteString v -> v -> ByteString
forall a. Fmt1 Builder ByteString a -> a -> ByteString
run1 Fmt1 Builder ByteString v
vf v
v
     in ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString
"{" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
", " [ByteString]
items ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"}"

-- | Format key-value pairs as a YAML-style map.
{-# INLINE yamlMap #-}
yamlMap :: (Foldable f) => Fmt1 Builder ByteString k -> Fmt1 Builder ByteString v -> Fmt1 Builder s (f (k, v))
yamlMap :: forall (f :: * -> *) k v s.
Foldable f =>
Fmt1 Builder ByteString k
-> Fmt1 Builder ByteString v -> Fmt1 Builder s (f (k, v))
yamlMap Fmt1 Builder ByteString k
kf Fmt1 Builder ByteString 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 :: [ByteString]
items = ((k, v) -> ByteString) -> [(k, v)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> ByteString
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) -> ByteString
fmtPair (k
k, v
v) = Fmt1 Builder ByteString k -> k -> ByteString
forall a. Fmt1 Builder ByteString a -> a -> ByteString
run1 Fmt1 Builder ByteString k
kf k
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Fmt1 Builder ByteString v -> v -> ByteString
forall a. Fmt1 Builder ByteString a -> a -> ByteString
run1 Fmt1 Builder ByteString v
vf v
v
     in ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.unlines [ByteString]
items