{-# LANGUAGE DerivingVia #-}

-- | String formatting via 'ShowS'-backed 'Builder'.
--
-- @
-- import Data.Fmt
-- import Data.Fmt.String
--
-- runStringFmt $ "hello" % " " % "world"
-- -- "hello world"
-- @
module Data.Fmt.String (
    -- * Builder
    Builder (..),

    -- * StringFmt
    StringFmt,
    runStringFmt,
    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.List (intercalate, isPrefixOf)
import Data.Fmt.Type (Fmt (..), Fmt1, fmt, fmt1, (%))
import Data.Monoid (Endo (..))
import Data.String (IsString (..))

-- | A 'ShowS'-backed string builder with O(1) concatenation.
newtype Builder = Builder {Builder -> ShowS
unBuilder :: ShowS}
    deriving (NonEmpty Builder -> Builder
Builder -> Builder -> Builder
(Builder -> Builder -> Builder)
-> (NonEmpty Builder -> Builder)
-> (forall b. Integral b => b -> Builder -> Builder)
-> Semigroup Builder
forall b. Integral b => b -> Builder -> Builder
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Builder -> Builder -> Builder
<> :: Builder -> Builder -> Builder
$csconcat :: NonEmpty Builder -> Builder
sconcat :: NonEmpty Builder -> Builder
$cstimes :: forall b. Integral b => b -> Builder -> Builder
stimes :: forall b. Integral b => b -> Builder -> Builder
Semigroup, Semigroup Builder
Builder
Semigroup Builder =>
Builder
-> (Builder -> Builder -> Builder)
-> ([Builder] -> Builder)
-> Monoid Builder
[Builder] -> Builder
Builder -> Builder -> Builder
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Builder
mempty :: Builder
$cmappend :: Builder -> Builder -> Builder
mappend :: Builder -> Builder -> Builder
$cmconcat :: [Builder] -> Builder
mconcat :: [Builder] -> Builder
Monoid) via (Endo String)

instance IsString Builder where
    fromString :: String -> Builder
fromString String
s = ShowS -> Builder
Builder (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Show Builder where
    show :: Builder -> String
show (Builder ShowS
f) = ShowS
f String
""

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

-- | Run a 'StringFmt' to produce a 'String'.
{-# INLINE runStringFmt #-}
runStringFmt :: StringFmt String a -> a
runStringFmt :: forall a. StringFmt String a -> a
runStringFmt (Fmt (Builder -> String) -> a
f) = (Builder -> String) -> a
f (\(Builder ShowS
s) -> ShowS
s String
"")

-- | Run a 'StringFmt' and print the result to stdout.
{-# INLINE printf #-}
printf :: StringFmt (IO ()) a -> a
printf :: forall a. StringFmt (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
$ \(Builder ShowS
s) -> String -> IO ()
putStr (ShowS
s String
"")

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

-- | Run a Fmt1 to String.
{-# INLINE run1 #-}
run1 :: Fmt1 Builder String a -> a -> String
run1 :: forall a. Fmt1 Builder String a -> a -> String
run1 (Fmt (Builder -> String) -> a -> String
f) = (Builder -> String) -> a -> String
f (\(Builder ShowS
s) -> ShowS
s String
"")

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

-- | Format each value in a foldable and join the results.
{-# INLINEABLE cat1With #-}
cat1With ::
    Foldable f =>
    ([String] -> String) ->
    Fmt1 Builder String a ->
    Fmt1 Builder s (f a)
cat1With :: forall (f :: * -> *) a s.
Foldable f =>
([String] -> String)
-> Fmt1 Builder String a -> Fmt1 Builder s (f a)
cat1With [String] -> String
join Fmt1 Builder String 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
$ ShowS -> Builder
Builder (ShowS -> Builder) -> (f a -> ShowS) -> f a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> (f a -> String) -> f a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
join ([String] -> String) -> (f a -> [String]) -> f a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Fmt1 Builder String a -> a -> String
forall a. Fmt1 Builder String a -> a -> String
run1 Fmt1 Builder String a
f) ([a] -> [String]) -> (f a -> [a]) -> f a -> [String]
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 String a -> Fmt1 Builder s (f a)
hsep :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 Builder String a -> Fmt1 Builder s (f a)
hsep = ([String] -> String)
-> Fmt1 Builder String a -> Fmt1 Builder s (f a)
forall (f :: * -> *) a s.
Foldable f =>
([String] -> String)
-> Fmt1 Builder String a -> Fmt1 Builder s (f a)
cat1With (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" ")

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

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

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

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

-- | Split the formatted output using a splitting function, then
-- rejoin with a custom combinator.
{-# INLINE splitWith #-}
splitWith ::
    (String -> (String, String)) ->
    (String -> String -> Fmt Builder a2 a1) ->
    Fmt Builder a1 b ->
    Fmt Builder a2 b
splitWith :: forall a2 a1 b.
(String -> (String, String))
-> (String -> String -> Fmt Builder a2 a1)
-> Fmt Builder a1 b
-> Fmt Builder a2 b
splitWith String -> (String, String)
brk String -> String -> 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 s :: String
s = Builder -> String
forall a. Show a => a -> String
show Builder
b
        (String
l, String
r) = String -> (String, String)
brk String
s
     in (String -> String -> Fmt Builder a2 a1)
-> (String, String) -> Fmt Builder a2 a1
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Fmt Builder a2 a1
join (String
l, String
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 :: String -> Fmt Builder a a -> Fmt Builder a b -> Fmt Builder a b
replace1 :: forall a b.
String -> Fmt Builder a a -> Fmt Builder a b -> Fmt Builder a b
replace1 String
needle Fmt Builder a a
replacement =
    (String -> (String, String))
-> (String -> String -> Fmt Builder a a)
-> Fmt Builder a b
-> Fmt Builder a b
forall a2 a1 b.
(String -> (String, String))
-> (String -> String -> Fmt Builder a2 a1)
-> Fmt Builder a1 b
-> Fmt Builder a2 b
splitWith (String -> String -> (String, String)
breakOn String
needle) ((String -> String -> Fmt Builder a a)
 -> Fmt Builder a b -> Fmt Builder a b)
-> (String -> String -> Fmt Builder a a)
-> Fmt Builder a b
-> Fmt Builder a b
forall a b. (a -> b) -> a -> b
$ \String
l String
r0 ->
        case String -> String -> Maybe String
forall {a}. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix' String
needle String
r0 of
            Maybe String
Nothing -> Builder -> Fmt Builder a a
forall m a. m -> Fmt m a a
fmt (String -> Builder
forall a. IsString a => String -> a
fromString String
l)
            Just String
r -> Builder -> Fmt Builder a a
forall m a. m -> Fmt m a a
fmt (String -> Builder
forall a. IsString a => String -> a
fromString String
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 (String -> Builder
forall a. IsString a => String -> a
fromString String
r)
  where
    breakOn :: String -> String -> (String, String)
breakOn String
pat String
s = String -> String -> (String, String)
go String
"" String
s
      where
        go :: String -> String -> (String, String)
go String
acc [] = (ShowS
forall a. [a] -> [a]
reverse String
acc, [])
        go String
acc rest :: String
rest@(Char
c : String
cs)
            | String
pat String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
rest = (ShowS
forall a. [a] -> [a]
reverse String
acc, String
rest)
            | Bool
otherwise = String -> String -> (String, String)
go (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) String
cs

    stripPrefix' :: [a] -> [a] -> Maybe [a]
stripPrefix' [] [a]
ys = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ys
    stripPrefix' [a]
_ [] = Maybe [a]
forall a. Maybe a
Nothing
    stripPrefix' (a
x : [a]
xs) (a
y : [a]
ys)
        | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a] -> Maybe [a]
stripPrefix' [a]
xs [a]
ys
        | Bool
otherwise = Maybe [a]
forall a. Maybe a
Nothing

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

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

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

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

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