{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Fmt (
    Term,

    -- * Type
    LogFmt,
    Fmt (..),
    spr,
    printf,
    runFmt,
    runLogFmt,
    
    -- * Fmt
    fmt,
    logFmt,
    (%),
    apply,
    bind,
    cat,
    refmt,
    replace1,
    splitWith,

    -- * Fmt1
    Fmt1,
    Fmt2,
    fmt1,
    fmt2,
    fmt1_,
    fmt2_,
    (.%),
    cat1,
    cat1With,
    split1With,

    -- * Html
    Html,
    toHtml,
    comment,
    Attr (..),
    Element (..),
    (!?),

    -- * Formatting
    hsep,
    vsep,
    hang,
    indent,
    prefix,
    suffix,
    enclose,
    tuple,
    quotes,
    quotes',
    parens,
    braces,
    brackets,
    backticks,

    -- * Collections
    left1,
    right1,
    either1,
    maybe1,
    list1,
    jsonList,
    yamlList,
    jsonMap,
    yamlMap,

    -- * Re-exports
    LogStr,
    fromLogStr,
    ToLogStr (..),
    IsString (..),
) where

import Control.Applicative (Const (..), getConst)
import Control.Arrow
import Control.Category (Category (), (<<<), (>>>))
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.Foldable (toList)
import Data.Profunctor
import Data.String
import GHC.Exts (IsList, Item)
import System.Log.FastLogger (LogStr, ToLogStr (..), fromLogStr)
import qualified Control.Category as C
import qualified Data.ByteString.Builder as BL
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified GHC.Exts as IsList (toList)
import qualified Numeric as N

{- $setup
 >>> import Data.Printf
 >>> :load Data.Fmt
-}

type Term = IO ()

type LogFmt = Fmt LogStr

{- | A formatter, implemented as an indexed continuation

 When you construct formatters the first type
 parameter, @r@, will remain polymorphic.  The second type
 parameter, @a@, will change to reflect the types of the data that
 will be formatted.  For example, in

 @
 person :: Fmt2 ByteString Int
 person = \"Person's name is \" % t % \", age is \" % d
 @

 the first type parameter remains polymorphic, and the second type
 parameter is @ByteString -> Int -> r@, which indicates that it formats a
 'ByteString' and an 'Int'.

 When you run the formatter, for example with 'format', you provide
 the arguments and they will be formatted into a string.

 >>> format ("This person's name is " % s % ", their age is " % d) "Anne" 22
 "This person's name is Anne, their age is 22"
-}
newtype Fmt m a b = Fmt {forall m a b. Fmt m a b -> (m -> a) -> b
unFmt :: (m -> a) -> b}

deriving via (Costar ((->) m) a) instance Functor (Fmt m a)
deriving via (Costar ((->) m) a) instance Applicative (Fmt m a)
deriving via (Costar ((->) m) a) instance Monad (Fmt m a)
deriving via (Costar ((->) m)) instance Profunctor (Fmt m)
deriving via (Costar ((->) m)) instance Closed (Fmt m)
deriving via (Costar ((->) m)) instance Costrong (Fmt m)
deriving via (Costar ((->) m)) instance Cochoice (Fmt m)

instance (IsString s, Show a) => Show (Fmt LogStr s a) where
    show :: Fmt LogStr s a -> String
show = a -> String
forall a. Show a => a -> String
show (a -> String) -> (Fmt LogStr s a -> a) -> Fmt LogStr s a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt LogStr s a -> a
forall s a. IsString s => Fmt LogStr s a -> a
runLogFmt

instance (IsString m, a ~ b) => IsString (Fmt m a b) where
    fromString :: String -> Fmt m a b
fromString = m -> Fmt m a a
m -> Fmt m a b
forall m a. m -> Fmt m a a
fmt (m -> Fmt m a b) -> (String -> m) -> String -> Fmt m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m
forall a. IsString a => String -> a
fromString

instance Semigroup m => Semigroup (Fmt1 m s a) where
    <> :: Fmt1 m s a -> Fmt1 m s a -> Fmt1 m s a
(<>) = Fmt1 m s a -> Fmt1 m s a -> Fmt1 m s a
forall m s a. Semigroup m => Fmt1 m s a -> Fmt1 m s a -> Fmt1 m s a
(.%)

instance Monoid m => Monoid (Fmt1 m s a) where
    mempty :: Fmt1 m s a
mempty = ((m -> s) -> a -> s) -> Fmt1 m s a
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt (\m -> s
k a
_ -> m -> s
k m
forall a. Monoid a => a
mempty)

instance Monoid m => Category (Fmt m) where
    id :: forall a. Fmt m a a
id = m -> Fmt m a a
forall m a. m -> Fmt m a a
fmt m
forall a. Monoid a => a
mempty
    . :: forall b c a. Fmt m b c -> Fmt m a b -> Fmt m a c
(.) = Fmt m b c -> Fmt m a b -> Fmt m a c
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
(%)

instance Monoid m => Arrow (Fmt m) where
    arr :: forall b c. (b -> c) -> Fmt m b c
arr b -> c
f = ((m -> b) -> c) -> Fmt m b c
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt (((m -> b) -> c) -> Fmt m b c) -> ((m -> b) -> c) -> Fmt m b c
forall a b. (a -> b) -> a -> b
$ \m -> b
k -> b -> c
f (m -> b
k m
forall a. Monoid a => a
mempty)
    Fmt m b c
x *** :: forall b c b' c'. Fmt m b c -> Fmt m b' c' -> Fmt m (b, b') (c, c')
*** Fmt m b' c'
y = ((b, b') -> b)
-> (c -> c' -> (c, c'))
-> Fmt m b c
-> Fmt m (b, b') (c' -> (c, c'))
forall a b c d. (a -> b) -> (c -> d) -> Fmt m b c -> Fmt m a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (b, b') -> b
forall a b. (a, b) -> a
fst (,) Fmt m b c
x Fmt m (b, b') (c' -> (c, c'))
-> Fmt m (b, b') c' -> Fmt m (b, b') (c, c')
forall a b.
Fmt m (b, b') (a -> b) -> Fmt m (b, b') a -> Fmt m (b, b') b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((b, b') -> b') -> Fmt m b' c' -> Fmt m (b, b') c'
forall a b c. (a -> b) -> Fmt m b c -> Fmt m a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (b, b') -> b'
forall a b. (a, b) -> b
snd Fmt m b' c'
y

instance Monoid m => Strong (Fmt m) where
    first' :: forall a b c. Fmt m a b -> Fmt m (a, c) (b, c)
first' Fmt m a b
x = Fmt m a b
x Fmt m a b -> Fmt m c c -> Fmt m (a, c) (b, c)
forall b c b' c'. Fmt m b c -> Fmt m b' c' -> Fmt m (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Fmt m c c
forall a. Fmt m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id
    second' :: forall a b c. Fmt m a b -> Fmt m (c, a) (c, b)
second' Fmt m a b
x = Fmt m c c
forall a. Fmt m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id Fmt m c c -> Fmt m a b -> Fmt m (c, a) (c, b)
forall b c b' c'. Fmt m b c -> Fmt m b' c' -> Fmt m (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Fmt m a b
x

{- | Run a monadic formatting expression.

   Like the method of 'Text.Printf.PrintfType', 'spr' executes the formatting
   commands contained in the expression and returns the result as a monadic
   variable.

   For example, note that the 'Data.Fmt.Html.li' tag repeats, while the
   'Data.Fmt.Html.ul' tag does not: 

   >>> :{
    let contact = p "You can reach me at" % ul . spr . li $ do
          c1 <- a ! href @String "https://example.com" $ "Website"
          c2 <- a ! href @String "mailto:cmk@example.com" $ "Email"
          pure $ c1 <> c2
    in runLogStr contact
   :}
   "<p>You can reach me at</p><ul><li><a href=\"https://foo.com\">Web</a></li><li><a href=\"mailto:cmk@foo.com\">Email</a></li></ul>"
-}
spr :: IsString s => Fmt LogStr s m -> Fmt m a a
spr :: forall s m a. IsString s => Fmt LogStr s m -> Fmt m a a
spr = m -> Fmt m a a
forall m a. m -> Fmt m a a
fmt (m -> Fmt m a a)
-> (Fmt LogStr s m -> m) -> Fmt LogStr s m -> Fmt m a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt LogStr s m -> m
forall s a. IsString s => Fmt LogStr s a -> a
runLogFmt

-- | Run a formatter and print out the text to stdout.
{-# INLINE printf #-}
printf :: Fmt LogStr Term a -> a
printf :: forall a. Fmt LogStr Term a -> a
printf = (Fmt LogStr Term a -> (LogStr -> Term) -> a)
-> (LogStr -> Term) -> Fmt LogStr Term a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fmt LogStr Term a -> (LogStr -> Term) -> a
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt (ByteString -> Term
B.putStrLn (ByteString -> Term) -> (LogStr -> ByteString) -> LogStr -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> ByteString
fromLogStr)

-- | Run a 'Fmt'.
{-# INLINE runFmt #-}
runFmt :: Fmt m m a -> a
runFmt :: forall m a. Fmt m m a -> a
runFmt = (Fmt m m a -> (m -> m) -> a) -> (m -> m) -> Fmt m m a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fmt m m a -> (m -> m) -> a
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt m -> m
forall a. a -> a
id

-- | Run a 'LogFmt'.
{-# INLINE runLogFmt #-}
runLogFmt :: IsString s => Fmt LogStr s a -> a
runLogFmt :: forall s a. IsString s => Fmt LogStr s a -> a
runLogFmt = (Fmt LogStr s a -> (LogStr -> s) -> a)
-> (LogStr -> s) -> Fmt LogStr s a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fmt LogStr s a -> (LogStr -> s) -> a
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt (String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (LogStr -> String) -> LogStr -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> String)
-> (LogStr -> ByteString) -> LogStr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> ByteString
fromLogStr)
{-# SPECIALIZE runLogFmt :: Fmt LogStr BL.ByteString a -> a #-}
{-# SPECIALIZE runLogFmt :: Fmt LogStr ByteString a -> a #-}
{-# SPECIALIZE runLogFmt :: Fmt LogStr String a -> a #-}
{-# SPECIALIZE runLogFmt :: Fmt LogStr LogStr a -> a #-}
{-# SPECIALIZE runLogFmt :: Fmt LogStr Builder a -> a #-}

-- | Format a constant value of type @m@.
{-# INLINE fmt #-}
fmt :: m -> Fmt m a a
fmt :: forall m a. m -> Fmt m a a
fmt m
m = ((m -> a) -> a) -> Fmt m a a
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt ((m -> a) -> m -> a
forall a b. (a -> b) -> a -> b
$ m
m)

-- | Format a constant value of type @m@.
{-# INLINE logFmt #-}
logFmt :: ToLogStr m => m -> Fmt LogStr a a
logFmt :: forall m a. ToLogStr m => m -> Fmt LogStr a a
logFmt = LogStr -> Fmt LogStr a a
forall m a. m -> Fmt m a a
fmt (LogStr -> Fmt LogStr a a) -> (m -> LogStr) -> m -> Fmt LogStr a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr

-- | Concatenate two formatters.
infixr 0 %

{-# INLINE (%) #-}
(%) :: Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
Fmt m b c
f % :: forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
% Fmt m a b
g =
    Fmt m b c
f
        Fmt m b c -> (m -> Fmt m a b) -> Fmt m a c
forall m a1 b a2. Fmt m a1 b -> (m -> Fmt m a2 a1) -> Fmt m a2 b
`bind` \m
a ->
            Fmt m a b
g
                Fmt m a b -> (m -> Fmt m a a) -> Fmt m a b
forall m a1 b a2. Fmt m a1 b -> (m -> Fmt m a2 a1) -> Fmt m a2 b
`bind` \m
b -> m -> Fmt m a a
forall m a. m -> Fmt m a a
fmt (m
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
b)

-- | Apply a 'Fmt1' to a 'Fmt'.
{-# INLINE apply #-}
apply :: Fmt1 m s m -> Fmt m s a -> Fmt m s a
apply :: forall m s a. Fmt1 m s m -> Fmt m s a -> Fmt m s a
apply (Fmt (m -> s) -> m -> s
f) (Fmt (m -> s) -> a
a) = ((m -> s) -> a) -> Fmt m s a
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt ((m -> s) -> a
a ((m -> s) -> a) -> ((m -> s) -> m -> s) -> (m -> s) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m -> s) -> m -> s
f)

-- | Indexed bind.
{-# INLINE bind #-}
bind :: Fmt m a1 b -> (m -> Fmt m a2 a1) -> Fmt m a2 b
bind :: forall m a1 b a2. Fmt m a1 b -> (m -> Fmt m a2 a1) -> Fmt m a2 b
bind Fmt m a1 b
m m -> Fmt m a2 a1
f = ((m -> a2) -> b) -> Fmt m a2 b
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt (((m -> a2) -> b) -> Fmt m a2 b) -> ((m -> a2) -> b) -> Fmt m a2 b
forall a b. (a -> b) -> a -> b
$ \m -> a2
k -> Fmt m a1 b -> (m -> a1) -> b
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt Fmt m a1 b
m (\m
a -> Fmt m a2 a1 -> (m -> a2) -> a1
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt (m -> Fmt m a2 a1
f m
a) m -> a2
k)

-- | Concatenate a collection of formatters.
{-# INLINE cat #-}
cat :: (Monoid m, Foldable f) => f (Fmt m a a) -> Fmt m a a
cat :: forall m (f :: * -> *) a.
(Monoid m, Foldable f) =>
f (Fmt m a a) -> Fmt m a a
cat = (Fmt m a a -> Fmt m a a -> Fmt m a a)
-> Fmt m a a -> f (Fmt m a a) -> Fmt m a a
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Fmt m a a -> Fmt m a a -> Fmt m a a
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
(%) Fmt m a a
forall a. Fmt m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id

-- | Map over the the formatting @Monoid@.
{-# INLINE refmt #-}
refmt :: (m1 -> m2) -> Fmt m1 a b -> Fmt m2 a b
refmt :: forall m1 m2 a b. (m1 -> m2) -> Fmt m1 a b -> Fmt m2 a b
refmt m1 -> m2
m12 (Fmt (m1 -> a) -> b
f) = ((m2 -> a) -> b) -> Fmt m2 a b
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt (((m2 -> a) -> b) -> Fmt m2 a b) -> ((m2 -> a) -> b) -> Fmt m2 a b
forall a b. (a -> b) -> a -> b
$ \m2 -> a
a -> (m1 -> a) -> b
f (m2 -> a
a (m2 -> a) -> (m1 -> m2) -> m1 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m1 -> m2
m12)

{- | Replace one occurance of a search term.

 > replace1 "bar" "foo" "foobarbaz"
 "foofoobaz"
-}
{-# INLINE replace1 #-}
replace1 :: ByteString -> Fmt LogStr a a -> Fmt LogStr a b -> Fmt LogStr a b
replace1 :: forall a b.
ByteString -> Fmt LogStr a a -> Fmt LogStr a b -> Fmt LogStr a b
replace1 ByteString
x Fmt LogStr a a
y =
    (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString -> Fmt LogStr a a)
-> Fmt LogStr a b
-> Fmt LogStr a b
forall a2 a1 b.
(ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString -> Fmt LogStr a2 a1)
-> Fmt LogStr a1 b
-> Fmt LogStr a2 b
splitWith (ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
x) ((ByteString -> ByteString -> Fmt LogStr a a)
 -> Fmt LogStr a b -> Fmt LogStr a b)
-> (ByteString -> ByteString -> Fmt LogStr a a)
-> Fmt LogStr a b
-> Fmt LogStr a b
forall a b. (a -> b) -> a -> b
$ \ByteString
l ByteString
r0 ->
        case ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
x ByteString
r0 of
            Maybe ByteString
Nothing -> ByteString -> Fmt LogStr a a
forall m a. ToLogStr m => m -> Fmt LogStr a a
logFmt ByteString
l
            Just ByteString
r -> [Fmt LogStr a a] -> Fmt LogStr a a
forall m (f :: * -> *) a.
(Monoid m, Foldable f) =>
f (Fmt m a a) -> Fmt m a a
cat [ByteString -> Fmt LogStr a a
forall m a. ToLogStr m => m -> Fmt LogStr a a
logFmt ByteString
l, Fmt LogStr a a
y, ByteString -> Fmt LogStr a a
forall m a. ToLogStr m => m -> Fmt LogStr a a
logFmt ByteString
r]

{-# INLINE splitWith #-}
splitWith ::
    (ByteString -> (ByteString, ByteString)) -> -- Splitter
    (ByteString -> ByteString -> Fmt LogStr a2 a1) -> -- Joiner
    Fmt LogStr a1 b ->
    Fmt LogStr a2 b
splitWith :: forall a2 a1 b.
(ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString -> Fmt LogStr a2 a1)
-> Fmt LogStr a1 b
-> Fmt LogStr a2 b
splitWith ByteString -> (ByteString, ByteString)
break ByteString -> ByteString -> Fmt LogStr a2 a1
join = (Fmt LogStr a1 b
 -> (LogStr -> Fmt LogStr a2 a1) -> Fmt LogStr a2 b)
-> (LogStr -> Fmt LogStr a2 a1)
-> Fmt LogStr a1 b
-> Fmt LogStr a2 b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fmt LogStr a1 b -> (LogStr -> Fmt LogStr a2 a1) -> Fmt LogStr a2 b
forall m a1 b a2. Fmt m a1 b -> (m -> Fmt m a2 a1) -> Fmt m a2 b
bind ((LogStr -> Fmt LogStr a2 a1)
 -> Fmt LogStr a1 b -> Fmt LogStr a2 b)
-> (LogStr -> Fmt LogStr a2 a1)
-> Fmt LogStr a1 b
-> Fmt LogStr a2 b
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString -> Fmt LogStr a2 a1)
-> (ByteString, ByteString) -> Fmt LogStr a2 a1
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Fmt LogStr a2 a1
join ((ByteString, ByteString) -> Fmt LogStr a2 a1)
-> (LogStr -> (ByteString, ByteString))
-> LogStr
-> Fmt LogStr a2 a1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
break (ByteString -> (ByteString, ByteString))
-> (LogStr -> ByteString) -> LogStr -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> ByteString
fromLogStr

-- Fmt1

-------------------------

{- | A unary higher-order formatter.

 @ 'Fmt1' m s a ~ (m -> s) -> a -> s @
-}
type Fmt1 m s a = Fmt m s (a -> s)

{- | A binary higher-order formatter.

 @ 'Fmt2' m s a b ~ (m -> s) -> a -> b -> s @
-}
type Fmt2 m s a b = Fmt m s (a -> b -> s)

{- | A ternary higher-order formatter.

 @ 'Fmt3' m s a b c ~ (m -> s) -> a -> b -> c -> s @
-}
type Fmt3 m s a b c = Fmt m s (a -> b -> c -> s)

{- | Format a value of type @a@ using a function of type @a -> m@.

 @ 'runFmt' . 'fmt1' :: (a -> m) -> a -> m @
-}
{-# INLINE fmt1 #-}
fmt1 :: (a -> m) -> Fmt1 m s a
fmt1 :: forall a m s. (a -> m) -> Fmt1 m s a
fmt1 a -> m
f = ((m -> s) -> a -> s) -> Fmt m s (a -> s)
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt (((m -> s) -> a -> s) -> Fmt m s (a -> s))
-> ((m -> s) -> a -> s) -> Fmt m s (a -> s)
forall a b. (a -> b) -> a -> b
$ \m -> s
k -> m -> s
k (m -> s) -> (a -> m) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f

{-# INLINE fmt2 #-}
fmt2 :: (a -> b -> m) -> Fmt2 m s a b
fmt2 :: forall a b m s. (a -> b -> m) -> Fmt2 m s a b
fmt2 a -> b -> m
f = ((m -> s) -> a -> b -> s) -> Fmt m s (a -> b -> s)
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt (((m -> s) -> a -> b -> s) -> Fmt m s (a -> b -> s))
-> ((m -> s) -> a -> b -> s) -> Fmt m s (a -> b -> s)
forall a b. (a -> b) -> a -> b
$ \m -> s
k -> (m -> s) -> (b -> m) -> b -> s
forall a b. (a -> b) -> (b -> a) -> b -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m -> s
k ((b -> m) -> b -> s) -> (a -> b -> m) -> a -> b -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> m
f

{-# INLINE fmt1_ #-}
fmt1_ :: Fmt m a a -> Fmt1 m a b
fmt1_ :: forall m a b. Fmt m a a -> Fmt1 m a b
fmt1_ = (a -> b -> a) -> Fmt m (b -> a) (b -> a) -> Fmt m a (b -> a)
forall a b c. (a -> b) -> Fmt m b c -> Fmt m a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b -> a
forall a b. a -> b -> a
const (Fmt m (b -> a) (b -> a) -> Fmt m a (b -> a))
-> (Fmt m a a -> Fmt m (b -> a) (b -> a))
-> Fmt m a a
-> Fmt m a (b -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt m a a -> Fmt m (b -> a) (b -> a)
forall a b x. Fmt m a b -> Fmt m (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed

{-# INLINE fmt2_ #-}
fmt2_ :: Fmt m a a -> Fmt2 m a b c
fmt2_ :: forall m a b c. Fmt m a a -> Fmt2 m a b c
fmt2_ = (a -> b -> c -> a)
-> Fmt m (b -> c -> a) (b -> c -> a) -> Fmt m a (b -> c -> a)
forall a b c. (a -> b) -> Fmt m b c -> Fmt m a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((c -> a) -> b -> c -> a
forall a b. a -> b -> a
const ((c -> a) -> b -> c -> a) -> (a -> c -> a) -> a -> b -> c -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c -> a
forall a b. a -> b -> a
const) (Fmt m (b -> c -> a) (b -> c -> a) -> Fmt m a (b -> c -> a))
-> (Fmt m a a -> Fmt m (b -> c -> a) (b -> c -> a))
-> Fmt m a a
-> Fmt m a (b -> c -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fmt m (c -> a) (c -> a) -> Fmt m (b -> c -> a) (b -> c -> a)
forall a b x. Fmt m a b -> Fmt m (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed (Fmt m (c -> a) (c -> a) -> Fmt m (b -> c -> a) (b -> c -> a))
-> (Fmt m a a -> Fmt m (c -> a) (c -> a))
-> Fmt m a a
-> Fmt m (b -> c -> a) (b -> c -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt m a a -> Fmt m (c -> a) (c -> a)
forall a b x. Fmt m a b -> Fmt m (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed)

-- | Concatenate two formatters, applying both to the same input.
infixr 6 .%

{-# INLINE (.%) #-}
(.%) :: Semigroup m => Fmt1 m s a -> Fmt1 m s a -> Fmt1 m s a
Fmt1 m s a
f .% :: forall m s a. Semigroup m => Fmt1 m s a -> Fmt1 m s a -> Fmt1 m s a
.% Fmt1 m s a
g =
    ((m -> s) -> a -> s) -> Fmt1 m s a
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt
        ( \m -> s
k a
a ->
            Fmt1 m s a -> (m -> s) -> a -> s
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt Fmt1 m s a
f (\m
b1 -> Fmt1 m s a -> (m -> s) -> a -> s
forall m a b. Fmt m a b -> (m -> a) -> b
unFmt Fmt1 m s a
g (\m
b2 -> m -> s
k (m
b1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
b2)) a
a) a
a
        )

{- | Format each value in a list and concatenate them all:

 >>> runFmt (cat1 (s % " ")) ["one", "two", "three"]
 "one two three "
-}
{-# INLINE cat1 #-}
cat1 :: (Monoid m, Foldable f) => Fmt1 m m a -> Fmt1 m s (f a)
cat1 :: forall m (f :: * -> *) a s.
(Monoid m, Foldable f) =>
Fmt1 m m a -> Fmt1 m s (f a)
cat1 Fmt1 m m a
f = (f a -> m) -> Fmt1 m s (f a)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((f a -> m) -> Fmt1 m s (f a)) -> (f a -> m) -> Fmt1 m s (f a)
forall a b. (a -> b) -> a -> b
$ (a -> m) -> f a -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Fmt1 m m a -> a -> m
forall m a. Fmt m m a -> a
runFmt Fmt1 m m a
f)

{- | Use the given text-joining function to join together the individually rendered items of a list.

 >>> runLogFmt (cat1With (mconcat . reverse) d) [123, 456, 789]
 "789456123"

 @
 'cat1With' 'L.unlines' :: 'Foldable' f => 'Fmt1' 'LogStr' 'String' a -> 'Fmt1' 'LogStr' s (f a)
 'cat1With' 'T.unlines' :: 'Foldable' f => 'Fmt1' 'LogStr' 'T.Text' a -> 'Fmt1' 'LogStr' s (f a)
 'cat1With' 'B.unlines' :: 'Foldable' f => 'Fmt1' 'LogStr' 'B.ByteString' a -> 'Fmt1' 'LogStr' s (f a)
 'cat1With' '$' 'L.intercalate' " " :: 'Foldable' f => 'Fmt1' 'LogStr' 'String' a -> 'Fmt1' 'LogStr' s (f a)
 'cat1With' '$' 'T.intercalate' " " :: 'Foldable' f => 'Fmt1' 'LogStr' 'T.Text' a -> 'Fmt1' 'LogStr' s (f a)
 'cat1With' '$' 'B.intercalate' " " :: 'Foldable' f => 'Fmt1' 'LogStr' 'B.ByteString' a -> 'Fmt1' 'LogStr' s (f a)
 @
-}
{-# INLINEABLE cat1With #-}
cat1With ::
    (Foldable f, ToLogStr str, IsString str) =>
    ([str] -> str) ->
    Fmt1 LogStr str a ->
    Fmt1 LogStr s (f a)
cat1With :: forall (f :: * -> *) str a s.
(Foldable f, ToLogStr str, IsString str) =>
([str] -> str) -> Fmt1 LogStr str a -> Fmt1 LogStr s (f a)
cat1With [str] -> str
join Fmt1 LogStr str a
f = (f a -> LogStr) -> Fmt1 LogStr s (f a)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((f a -> LogStr) -> Fmt1 LogStr s (f a))
-> (f a -> LogStr) -> Fmt1 LogStr s (f a)
forall a b. (a -> b) -> a -> b
$ str -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (str -> LogStr) -> (f a -> str) -> f a -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [str] -> str
join ([str] -> str) -> (f a -> [str]) -> f a -> str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> str) -> [a] -> [str]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Fmt1 LogStr str a -> a -> str
forall s a. IsString s => Fmt LogStr s a -> a
runLogFmt Fmt1 LogStr str a
f) ([a] -> [str]) -> (f a -> [a]) -> f a -> [str]
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
{-# SPECIALIZE cat1With :: Foldable f => ([LogStr] -> LogStr) -> Fmt1 LogStr LogStr a -> Fmt1 LogStr s (f a) #-}
{-# SPECIALIZE cat1With :: Foldable f => ([Builder] -> Builder) -> Fmt1 LogStr Builder a -> Fmt1 LogStr s (f a) #-}
{-# SPECIALIZE cat1With :: Foldable f => ([ByteString] -> ByteString) -> Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a) #-}
{-# SPECIALIZE cat1With :: Foldable f => ([BL.ByteString] -> BL.ByteString) -> Fmt1 LogStr BL.ByteString a -> Fmt1 LogStr s (f a) #-}

{- | Turn a text-splitting function into a formatting combinator.

 @
  'split1With' 'hsep' :: ('Traversable' f, 'ToLogStr' msg) => ('ByteString' -> f msg) -> 'Fmt' 'LogStr' s a -> 'Fmt' 'LogStr' s a
  'split1With' 'vsep' :: ('Traversable' f, 'ToLogStr' msg) => ('ByteString' -> f msg) -> 'Fmt' 'LogStr' s a -> 'Fmt' 'LogStr' s a
  'split1With' 'list1' :: ('Traversable' f, 'ToLogStr' msg) => ('ByteString' -> f msg) -> 'Fmt' 'LogStr' s a -> 'Fmt' 'LogStr' s a
 @
 >>> commas = reverse . fmap BL.reverse . BL.chunksOf 3 . BL.reverse
 >>> dollars = prefix "$" . split1With commas (intercalate ",") . reversed
 >>> runLogFmt (dollars d) 1234567890
 "$1,234,567,890"
 >>> printf (split1With (BL.splitOn ",") vsep t) "one,two,three"
 one
 two
 three
 >>> printf (split1With (BL.splitOn ",") (indentEach 4) t) "one,two,three"
     one
     two
     three
-}
{-# INLINEABLE split1With #-}
split1With ::
    (Traversable f, ToLogStr str) =>
    (Fmt1 m s_ m -> Fmt1 m m (f LogStr)) ->
    (ByteString -> f str) ->
    Fmt LogStr s a ->
    Fmt m s a
split1With :: forall (f :: * -> *) str m s_ s a.
(Traversable f, ToLogStr str) =>
(Fmt1 m s_ m -> Fmt1 m m (f LogStr))
-> (ByteString -> f str) -> Fmt LogStr s a -> Fmt m s a
split1With Fmt1 m s_ m -> Fmt1 m m (f LogStr)
lf ByteString -> f str
split (Fmt (LogStr -> s) -> a
g) = ((m -> s) -> a) -> Fmt m s a
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt ((LogStr -> s) -> a
g ((LogStr -> s) -> a) -> ((m -> s) -> LogStr -> s) -> (m -> s) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((m -> s) -> (LogStr -> m) -> LogStr -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt1 m m (f LogStr) -> f LogStr -> m
forall m a. Fmt m m a -> a
runFmt (Fmt1 m s_ m -> Fmt1 m m (f LogStr)
lf (Fmt1 m s_ m -> Fmt1 m m (f LogStr))
-> Fmt1 m s_ m -> Fmt1 m m (f LogStr)
forall a b. (a -> b) -> a -> b
$ (m -> m) -> Fmt1 m s_ m
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 m -> m
forall a. a -> a
id) (f LogStr -> m) -> (LogStr -> f LogStr) -> LogStr -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (str -> LogStr) -> f str -> f LogStr
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap str -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (f str -> f LogStr) -> (LogStr -> f str) -> LogStr -> f LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> f str
split (ByteString -> f str) -> (LogStr -> ByteString) -> LogStr -> f str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> ByteString
fromLogStr))

-- Html

-------------------------

{- | Format HTML

  For example:

  @
  contact :: 'Html' 'LogStr'
  contact = 'Data.Fmt.Html.p' "You can reach me at" '%' 'Data.Fmt.Html.ul' . 'spr' . 'Data.Fmt.Html.li' $ do
        c1 <- 'Data.Fmt.Html.a' '!' 'href' @String "https://example.com" $ "Website"
        c2 <- 'Data.Fmt.Html.a' '!' 'href' @String "mailto:cmk@example.com" $ "Email"
        'pure' $ c1 '<>' c2
  @
  
  generates the following output:

  > "<p>You can reach me at</p><ul><li><a href=\"https://foo.com\">Web</a></li><li><a href=\"mailto:cmk@foo.com\">Email</a></li></ul>"
-}
type Html a = Fmt LogStr a a

toHtml :: ToLogStr s => s -> Html a
toHtml :: forall m a. ToLogStr m => m -> Fmt LogStr a a
toHtml = s -> Fmt LogStr a a
forall m a. ToLogStr m => m -> Fmt LogStr a a
logFmt

comment :: ToLogStr s => s -> Html a
comment :: forall m a. ToLogStr m => m -> Fmt LogStr a a
comment = Fmt LogStr a a
-> Fmt LogStr a a -> Fmt LogStr a a -> Fmt LogStr a a
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt LogStr a a
"<!-- " Fmt LogStr a a
" -->" (Fmt LogStr a a -> Fmt LogStr a a)
-> (s -> Fmt LogStr a a) -> s -> Fmt LogStr a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Fmt LogStr a a
forall m a. ToLogStr m => m -> Fmt LogStr a a
toHtml

-- | Type for an attribute.
newtype Attr = Attr (forall a. Html a -> Html a)

instance Semigroup Attr where
    Attr forall a. Html a -> Html a
f <> :: Attr -> Attr -> Attr
<> Attr forall a. Html a -> Html a
g = (forall a. Html a -> Html a) -> Attr
Attr (Html a -> Html a
forall a. Html a -> Html a
g (Html a -> Html a) -> (Html a -> Html a) -> Html a -> Html a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html a -> Html a
forall a. Html a -> Html a
f)

instance Monoid Attr where
    mempty :: Attr
mempty = (forall a. Html a -> Html a) -> Attr
Attr Html a -> Html a
forall a. a -> a
forall a. Html a -> Html a
id

{- | Apply an attribute to an HTML tag.

 The interface is similar to < https://hackage.haskell.org/package/blaze-builder >.

 You should not define your own instances of this class.
-}
class Element html where
    {- | Apply an attribute to an element.

         >>> printf $ img ! src "foo.png"
         <img src="foo.png" />

         This can be used on nested elements as well:

         >>> printf $ p ! style "float: right" $ "Hello!"
         <p style="float: right">Hello!</p>
    -}
    (!) :: html -> Attr -> html

instance Element (Html a) where
    Html a
h ! :: Html a -> Attr -> Html a
! (Attr forall a. Html a -> Html a
f) = Html a -> Html a
forall a. Html a -> Html a
f Html a
h
    {-# INLINE (!) #-}

instance Element (Html a -> Html b) where
    Html a -> Html b
h ! :: (Html a -> Html b) -> Attr -> Html a -> Html b
! Attr
f = (Html b -> Attr -> Html b
forall html. Element html => html -> Attr -> html
! Attr
f) (Html b -> Html b) -> (Html a -> Html b) -> Html a -> Html b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html a -> Html b
h
    {-# INLINE (!) #-}

{- | Shorthand for setting an attribute depending on a conditional.

 Example:

 > p !? (isBig, A.class "big") $ "Hello"

 Gives the same result as:

 > (if isBig then p ! A.class "big" else p) "Hello"
-}
(!?) :: Element html => html -> (Bool, Attr) -> html
!? :: forall html. Element html => html -> (Bool, Attr) -> html
(!?) html
h (Bool
c, Attr
a) = if Bool
c then html
h html -> Attr -> html
forall html. Element html => html -> Attr -> html
! Attr
a else html
h

-- Formatting

-------------------------

{- | Format each value in a list with spaces in between:

 >>> runLogFmt (hsep d) [1, 2, 3]
 "1 2 3"
-}
hsep :: Foldable f => Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
hsep :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
hsep = ([ByteString] -> ByteString)
-> Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
forall (f :: * -> *) str a s.
(Foldable f, ToLogStr str, IsString str) =>
([str] -> str) -> Fmt1 LogStr str a -> Fmt1 LogStr s (f a)
cat1With (([ByteString] -> ByteString)
 -> Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a))
-> ([ByteString] -> ByteString)
-> Fmt1 LogStr ByteString a
-> Fmt1 LogStr s (f a)
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
" "
{-# INLINE hsep #-}

{- | Format each value in a list, placing each on its own line:

 >>> printf (vsep c) ['a'..'c']
 a
 b
 c
-}
vsep :: Foldable f => Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
vsep :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
vsep = ([ByteString] -> ByteString)
-> Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
forall (f :: * -> *) str a s.
(Foldable f, ToLogStr str, IsString str) =>
([str] -> str) -> Fmt1 LogStr str a -> Fmt1 LogStr s (f a)
cat1With [ByteString] -> ByteString
B.unlines
{-# INLINE vsep #-}

{- | Format a list of items, placing one per line, indent by the given number of spaces.

 @ 'indentEach' n = 'Test.Contra.Type.Format.vsep' . 'indent' n @

 >>> printf (split1With BL.lines (indentList 2) t) "one\ntwo\nthree"
   one
   two
   three
 >>> printf ("The lucky numbers are:\n" % indentList 2 d) [7, 13, 1, 42]
 The lucky numbers are:
   7
   13
   1
   42
-}
hang :: Foldable f => Int -> Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
hang :: forall (f :: * -> *) a s.
Foldable f =>
Int -> Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
hang Int
n = Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
forall (f :: * -> *) a s.
Foldable f =>
Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
vsep (Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a))
-> (Fmt1 LogStr ByteString a -> Fmt1 LogStr ByteString a)
-> Fmt1 LogStr ByteString a
-> Fmt1 LogStr s (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Fmt1 LogStr ByteString a -> Fmt1 LogStr ByteString a
forall m a b.
(IsString m, Semigroup m) =>
Int -> Fmt m a b -> Fmt m a b
indent Int
n
{-# INLINE hang #-}

{- | Insert the given number of spaces at the start of the rendered text:

 >>> runFmt (indent 4 d) 7
 "    7"

 Note that this only indents the first line of a multi-line string.
 To indent all lines see 'reindent'.
-}
indent :: (IsString m, Semigroup m) => Int -> Fmt m a b -> Fmt m a b
indent :: forall m a b.
(IsString m, Semigroup m) =>
Int -> Fmt m a b -> Fmt m a b
indent Int
n = m -> Fmt m a b -> Fmt m a b
forall m a b. Semigroup m => m -> Fmt m a b -> Fmt m a b
prefix (m -> Fmt m a b -> Fmt m a b) -> m -> Fmt m a b -> Fmt m a b
forall a b. (a -> b) -> a -> b
$ String -> m
forall a. IsString a => String -> a
fromString (String -> m) -> String -> m
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '
{-# INLINEABLE indent #-}

{- | Add the given prefix to the formatted item:

 >>> runLogFmt ("The answer is: " % prefix "wait for it... " d) 42
 "The answer is: wait for it... 42"

 >>> printf (vsep (indent 4 (prefix "- " d))) [1, 2, 3]
     - 1
     - 2
     - 3
-}
prefix :: Semigroup m => m -> Fmt m a b -> Fmt m a b
prefix :: forall m a b. Semigroup m => m -> Fmt m a b -> Fmt m a b
prefix m
s Fmt m a b
f = m -> Fmt m b b
forall m a. m -> Fmt m a a
fmt m
s Fmt m b b -> Fmt m a b -> Fmt m a b
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
% Fmt m a b
f
{-# INLINE prefix #-}

-- | Add the given suffix to the formatted item.
suffix :: Semigroup m => m -> Fmt m a b -> Fmt m a b
suffix :: forall m a b. Semigroup m => m -> Fmt m a b -> Fmt m a b
suffix m
s Fmt m a b
f = Fmt m a b
f Fmt m a b -> Fmt m a a -> Fmt m a b
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
% m -> Fmt m a a
forall m a. m -> Fmt m a a
fmt m
s
{-# INLINE suffix #-}

{- | Enclose the output string with the given strings:

 >>> runFmt (parens $ enclose v s ", ") 1 "two"
 "(1, two)"
 >>> runFmt (enclose (fmt "<!--") (fmt "-->") s) "an html comment"
 "<!--an html comment-->"
-}
enclose :: Semigroup m => Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose :: forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b2 c
pre Fmt m a b1
suf Fmt m b1 b2
f = Fmt m b2 c
pre Fmt m b2 c -> Fmt m a b2 -> Fmt m a c
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
% Fmt m b1 b2
f Fmt m b1 b2 -> Fmt m a b1 -> Fmt m a b2
forall m b c a. Semigroup m => Fmt m b c -> Fmt m a b -> Fmt m a c
% Fmt m a b1
suf
{-# INLINE enclose #-}

-- @ 'tuple' 'd' 'd' :: 'LogFmt2' a 'Int' @
--
-- >>> runFmt (tuple d t) 1 "two"
-- "(1, two)"
tuple :: (Semigroup m, IsString m) => Fmt m b c -> Fmt m a b -> Fmt m a c
tuple :: forall m b c a.
(Semigroup m, IsString m) =>
Fmt m b c -> Fmt m a b -> Fmt m a c
tuple Fmt m b c
f1 Fmt m a b
f2 = Fmt m a c -> Fmt m a c
forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
parens (Fmt m a c -> Fmt m a c) -> Fmt m a c -> Fmt m a c
forall a b. (a -> b) -> a -> b
$ Fmt m b c -> Fmt m a b -> Fmt m b b -> Fmt m a c
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b c
f1 Fmt m a b
f2 Fmt m b b
", "

{- | Add double quotes around the formatted item:

 Use this to escape a string:

 >>> runFmt ("He said it was based on " % quotes t' % ".") "science"
 He said it was based on "science".
-}
quotes :: (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
quotes :: forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
quotes = Fmt m b b -> Fmt m a a -> Fmt m a b -> Fmt m a b
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b b
"\"" Fmt m a a
"\""
{-# INLINE quotes #-}

{- | Add single quotes around the formatted item:

 >>> let obj = Just Nothing in format ("The object is: " % quotes' shown % ".") obj
 "The object is: 'Just Nothing'."
-}
quotes' :: (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
quotes' :: forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
quotes' = Fmt m b b -> Fmt m a a -> Fmt m a b -> Fmt m a b
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b b
"'" Fmt m a a
"'"
{-# INLINE quotes' #-}

{- | Add parentheses around the formatted item:

 >>> runFmt ("We found " % parens d % " discrepancies.") 17
 "We found (17) discrepancies."

 >>> printf (get 5 (list1 (parens d))) [1..]
 [(1), (2), (3), (4), (5)]
-}
parens :: (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
parens :: forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
parens = Fmt m b b -> Fmt m a a -> Fmt m a b -> Fmt m a b
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b b
"(" Fmt m a a
")"
{-# INLINE parens #-}

{- | Add braces around the formatted item:

 >>> runFmt ("\\begin" % braces t) "section"
 "\\begin{section}"
-}
braces :: (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
braces :: forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
braces = Fmt m b b -> Fmt m a a -> Fmt m a b -> Fmt m a b
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b b
"{" Fmt m a a
"}"
{-# INLINE braces #-}

{- | Add square brackets around the formatted item:

 >>> runFmt (brackets d) 7
 "[7]"
-}
brackets :: (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
brackets :: forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
brackets = Fmt m b b -> Fmt m a a -> Fmt m a b -> Fmt m a b
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b b
"[" Fmt m a a
"]"
{-# INLINE brackets #-}

{- | Add backticks around the formatted item:

 >>> runLogFmt ("Be sure to run " % backticks builder % " as root.") ":(){:|:&};:"
 "Be sure to run `:(){:|:&};:` as root."
-}
backticks :: (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
backticks :: forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
backticks = Fmt m b b -> Fmt m a a -> Fmt m a b -> Fmt m a b
forall m b2 c a b1.
Semigroup m =>
Fmt m b2 c -> Fmt m a b1 -> Fmt m b1 b2 -> Fmt m a c
enclose Fmt m b b
"`" Fmt m a a
"`"
{-# INLINE backticks #-}

-- Collections

-------------------------

{- | Render the value in a Left with the given formatter, rendering a Right as an empty string:

 >>> runLogFmt (left1 text) (Left "bingo")
 "bingo"

 >>> runLogFmt (left1 text) (Right 16)
 ""
-}
left1 :: IsString m => Fmt1 m m a -> Fmt1 m s (Either a b)
left1 :: forall m a s b. IsString m => Fmt1 m m a -> Fmt1 m s (Either a b)
left1 Fmt1 m m a
f = Fmt1 m m a -> Fmt1 m m b -> Fmt1 m s (Either a b)
forall m a b s. Fmt1 m m a -> Fmt1 m m b -> Fmt1 m s (Either a b)
either1 Fmt1 m m a
f ((b -> m) -> Fmt1 m m b
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((b -> m) -> Fmt1 m m b) -> (b -> m) -> Fmt1 m m b
forall a b. (a -> b) -> a -> b
$ m -> b -> m
forall a b. a -> b -> a
const m
"")
{-# INLINE left1 #-}

{- | Render the value in a Right with the given formatter, rendering a Left as an empty string:

 >>> runLogFmt (right1 text) (Left 16)
 ""

 >>> runLogFmt (right1 text) (Right "bingo")
 "bingo"
-}
right1 :: IsString m => Fmt1 m m b -> Fmt1 m s (Either a b)
right1 :: forall m b s a. IsString m => Fmt1 m m b -> Fmt1 m s (Either a b)
right1 = Fmt1 m m a -> Fmt1 m m b -> Fmt1 m s (Either a b)
forall m a b s. Fmt1 m m a -> Fmt1 m m b -> Fmt1 m s (Either a b)
either1 ((a -> m) -> Fmt1 m m a
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((a -> m) -> Fmt1 m m a) -> (a -> m) -> Fmt1 m m a
forall a b. (a -> b) -> a -> b
$ m -> a -> m
forall a b. a -> b -> a
const m
"")
{-# INLINE right1 #-}

{- | Render the value in an Either:

 >>> runLogFmt (either1 text int) (Left "Error!"
 "Error!"

 >>> runLogFmt (either1 text int) (Right 69)
 "69"
-}
either1 :: Fmt1 m m a -> Fmt1 m m b -> Fmt1 m s (Either a b)
either1 :: forall m a b s. Fmt1 m m a -> Fmt1 m m b -> Fmt1 m s (Either a b)
either1 Fmt1 m m a
l Fmt1 m m b
r = (Either a b -> m) -> Fmt1 m s (Either a b)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((Either a b -> m) -> Fmt1 m s (Either a b))
-> (Either a b -> m) -> Fmt1 m s (Either a b)
forall a b. (a -> b) -> a -> b
$ (a -> m) -> (b -> m) -> Either a b -> m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Fmt1 m m a -> a -> m
forall m a. Fmt m m a -> a
runFmt Fmt1 m m a
l) (Fmt1 m m b -> b -> m
forall m a. Fmt m m a -> a
runFmt Fmt1 m m b
r)
{-# INLINE either1 #-}

{- | Render a Maybe value either as a default (if Nothing) or using the given formatter:

 >>> runLogFmt (maybe1 "Goodbye" text) Nothing
 "Goodbye"

 >>> runLogFmt (maybe1 "Goodbye" text) (Just "Hello")
 "Hello"
-}
maybe1 :: m -> Fmt1 m m a -> Fmt1 m s (Maybe a)
maybe1 :: forall m a s. m -> Fmt1 m m a -> Fmt1 m s (Maybe a)
maybe1 m
def Fmt1 m m a
f = (Maybe a -> m) -> Fmt1 m s (Maybe a)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 ((Maybe a -> m) -> Fmt1 m s (Maybe a))
-> (Maybe a -> m) -> Fmt1 m s (Maybe a)
forall a b. (a -> b) -> a -> b
$ m -> (a -> m) -> Maybe a -> m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m
def (Fmt1 m m a -> a -> m
forall m a. Fmt m m a -> a
runFmt Fmt1 m m a
f)
{-# INLINE maybe1 #-}

{- | Add square brackets around the Foldable (e.g. a list), and separate each formatted item with a comma and space.

 >>> runLogFmt (list1 s) ["one", "two", "three"]
 "[one, two, three]"
 >>> printf (quotes $ list1 d) [1,2,3]
 ["1", "2", "3"]
 >>> printf (quotes $ list1 s) ["one", "two", "three"]
 ["one", "two", "three"]
-}
list1 :: Foldable f => Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
list1 :: forall (f :: * -> *) a s.
Foldable f =>
Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
list1 = ([ByteString] -> ByteString)
-> Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a)
forall (f :: * -> *) str a s.
(Foldable f, ToLogStr str, IsString str) =>
([str] -> str) -> Fmt1 LogStr str a -> Fmt1 LogStr s (f a)
cat1With (ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
", ") (Fmt1 LogStr ByteString a -> Fmt1 LogStr s (f a))
-> (Fmt1 LogStr ByteString a -> Fmt1 LogStr ByteString a)
-> Fmt1 LogStr ByteString a
-> Fmt1 LogStr s (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fmt1 LogStr ByteString a -> Fmt1 LogStr ByteString a
forall m a b. (Semigroup m, IsString m) => Fmt m a b -> Fmt m a b
brackets
{-# INLINE list1 #-}

{- | A JSON-style formatter for lists.

 >>> printf jsonList [1,2,3]
 [
   1
 , 2
 , 3
 ]

 Like 'yamlListF', it handles multiline elements well:

 >>> fmt $ jsonListF ["hello\nworld", "foo\nbar\nquix"]
 [
   hello
   world
 , foo
   bar
   quix
 ]
-}
{-# INLINE jsonList #-}
jsonList :: (Foldable f, ToLogStr a) => Fmt1 LogStr s (f a)
jsonList :: forall (f :: * -> *) a s.
(Foldable f, ToLogStr a) =>
Fmt1 LogStr s (f a)
jsonList = (f a -> LogStr) -> Fmt1 LogStr s (f a)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 f a -> LogStr
forall {b} {t :: * -> *}. (ToLogStr b, Foldable t) => t b -> LogStr
f
  where
    f :: t b -> LogStr
f t b
xs
        | [LogStr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogStr]
items = LogStr
"[]\n"
        | Bool
otherwise = LogStr
"[\n" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat [LogStr]
items LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"]\n"
      where
        items :: [LogStr]
items = (Bool -> b -> LogStr) -> [Bool] -> [b] -> [LogStr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> b -> LogStr
forall {msg}. ToLogStr msg => Bool -> msg -> LogStr
buildItem (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) (t b -> [b]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t b
xs)
        -- Item builder
        --buildItem :: Bool -> a -> B

        buildItem :: Bool -> msg -> LogStr
buildItem Bool
isFirst msg
x =
            case (ByteString -> LogStr) -> [ByteString] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> [ByteString]
B.lines (LogStr -> ByteString
fromLogStr (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
x))) of
                []
                    | Bool
isFirst -> LogStr
"\n"
                    | Bool
otherwise -> LogStr
",\n"
                (LogStr
h : [LogStr]
t) ->
                    [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat ([LogStr] -> LogStr)
-> ([LogStr] -> [LogStr]) -> [LogStr] -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogStr -> LogStr) -> [LogStr] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
map (LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n") ([LogStr] -> LogStr) -> [LogStr] -> LogStr
forall a b. (a -> b) -> a -> b
$
                        if Bool
isFirst
                            then LogStr
"  " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
h LogStr -> [LogStr] -> [LogStr]
forall a. a -> [a] -> [a]
: (LogStr -> LogStr) -> [LogStr] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LogStr
"  " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<>) [LogStr]
t
                            else LogStr
", " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
h LogStr -> [LogStr] -> [LogStr]
forall a. a -> [a] -> [a]
: (LogStr -> LogStr) -> [LogStr] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LogStr
"  " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<>) [LogStr]
t

{- | A multiline formatter for lists.

  >>> printf (yamlList d) [1,2,3]
  - 1
  - 2
  - 3

  Multi-line elements are indented correctly:

  >>> printf (yamlList s) ["hello\nworld", "foo\nbar\nquix"]
  - hello
    world
  - foo
    bar
    quix
-}
{-# INLINE yamlList #-}
yamlList :: (Foldable f, ToLogStr a) => Fmt1 LogStr s (f a)
yamlList :: forall (f :: * -> *) a s.
(Foldable f, ToLogStr a) =>
Fmt1 LogStr s (f a)
yamlList = (f a -> LogStr) -> Fmt1 LogStr s (f a)
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 f a -> LogStr
forall {b} {t :: * -> *}. (ToLogStr b, Foldable t) => t b -> LogStr
f
  where
    f :: t a -> LogStr
f t a
xs = if [LogStr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogStr]
items then LogStr
"[]\n" else [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat [LogStr]
items
      where
        bullet :: LogStr
bullet = LogStr
"-"
        spaces :: LogStr
spaces = LogStr
"  "
        newline :: LogStr
newline = LogStr
"\n"
        items :: [LogStr]
items = (a -> LogStr) -> [a] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
map a -> LogStr
buildItem (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
xs)
        buildItem :: a -> LogStr
buildItem a
x = case ByteString -> [ByteString]
B.lines (LogStr -> ByteString
fromLogStr (a -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr a
x)) of
            [] -> LogStr
bullet LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
newline
            (ByteString
l : [ByteString]
ls) ->
                LogStr
bullet LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
" " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
l LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
newline
                    LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat [LogStr
spaces LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
s LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
newline | ByteString
s <- [ByteString]
ls]

{- | A JSON-like map formatter; works for Map, HashMap, etc, and lists of pairs.

>>> fmt $ jsonMapF [("Odds", jsonListF [1,3]), ("Evens", jsonListF [2,4])]
{
  Odds:
    [
      1
    , 3
    ]
, Evens:
    [
      2
    , 4
    ]
}
-}
{-# INLINE jsonMap #-}
jsonMap :: (ToLogStr k, IsList map, Item map ~ (k, ByteString)) => Fmt1 LogStr s map
jsonMap :: forall k map s.
(ToLogStr k, IsList map, Item map ~ (k, ByteString)) =>
Fmt1 LogStr s map
jsonMap = (map -> LogStr) -> Fmt1 LogStr s map
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 map -> LogStr
forall {l} {msg}.
(Item l ~ (msg, ByteString), ToLogStr msg, IsList l) =>
l -> LogStr
f
  where
    f :: l -> LogStr
f l
xs
        | [LogStr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogStr]
items = LogStr
"{}\n"
        | Bool
otherwise = LogStr
"{\n" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat [LogStr]
items LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}\n"
      where
        items :: [LogStr]
items = (Bool -> (msg, ByteString) -> LogStr)
-> [Bool] -> [(msg, ByteString)] -> [LogStr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> (msg, ByteString) -> LogStr
forall {msg}. ToLogStr msg => Bool -> (msg, ByteString) -> LogStr
buildItem (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) (l -> [Item l]
forall l. IsList l => l -> [Item l]
IsList.toList l
xs)
        -- Item builder
        --buildItem :: Bool -> (k, v) -> B
        buildItem :: Bool -> (msg, ByteString) -> LogStr
buildItem Bool
isFirst (msg
k, ByteString
v) = do
            let kb :: LogStr
kb = (if Bool
isFirst then LogStr
"  " else LogStr
", ") LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
k
            case (ByteString -> LogStr) -> [ByteString] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> [ByteString]
B.lines ByteString
v) of
                [] -> LogStr
kb LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
":\n"
                [LogStr
l] -> LogStr
kb LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
": " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
l LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n"
                [LogStr]
ls ->
                    LogStr
kb LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
":\n"
                        LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat [LogStr
"    " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
s LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n" | LogStr
s <- [LogStr]
ls]

--  | A YAML-like map formatter:
--
-- >>> BL.putStrLn $ BL.toLazyByteString $ yamlMapF id id [("Odds", yamlListF (BL.fromString . show) "-" [1,3]), ("Evens", yamlListF (BL.fromString . show) "-" [2,4])]
-- Odds:
--   - 1
--   - 3
-- Evens:
--   - 2
--   - 4
{-# INLINE yamlMap #-}
yamlMap :: (ToLogStr k, ToLogStr v, IsList map, Item map ~ (k, v)) => Fmt1 LogStr s map
yamlMap :: forall k v map s.
(ToLogStr k, ToLogStr v, IsList map, Item map ~ (k, v)) =>
Fmt1 LogStr s map
yamlMap = (map -> LogStr) -> Fmt1 LogStr s map
forall a m s. (a -> m) -> Fmt1 m s a
fmt1 map -> LogStr
forall {l} {msg} {msg}.
(Item l ~ (msg, msg), ToLogStr msg, ToLogStr msg, IsList l) =>
l -> LogStr
f
  where
    f :: l -> LogStr
f l
xs
        | [LogStr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogStr]
items = LogStr
"{}\n"
        | Bool
otherwise = [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat [LogStr]
items
      where
        items :: [LogStr]
items = ((msg, msg) -> LogStr) -> [(msg, msg)] -> [LogStr]
forall a b. (a -> b) -> [a] -> [b]
map (\(msg
k, msg
v) -> LogStr -> LogStr -> LogStr
nameF (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
k) (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
v)) (l -> [Item l]
forall l. IsList l => l -> [Item l]
IsList.toList l
xs)

nameF :: LogStr -> LogStr -> LogStr
nameF :: LogStr -> LogStr -> LogStr
nameF LogStr
k LogStr
v = case ByteString -> [ByteString]
B.lines (LogStr -> ByteString
fromLogStr LogStr
v) of
    [] -> LogStr
k LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
":\n"
    [ByteString
l] -> LogStr
k LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
": " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
l LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n"
    [ByteString]
ls ->
        LogStr
k LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
":\n"
            LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat [LogStr
"  " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
s LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n" | ByteString
s <- [ByteString]
ls]