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

-- | Type-safe formatting as an indexed continuation profunctor.
--
-- @Fmt m a b = (m -> a) -> b@ is @Costar ((->) m)@, giving it
-- 'Category', 'Arrow', and profunctor instances for free.
--
-- @
-- person :: Fmt2 String String Int
-- person = "Person's name is " % t % ", age is " % d
--
-- runFmt person "Anne" 22
-- -- "Person's name is Anne, age is 22"
-- @
module Data.Fmt.Type (
    -- * Type
    Fmt (..),
    runFmt,

    -- * Fmt1 / Fmt2
    Fmt1,
    Fmt2,
    Fmt3,
    fmt1,
    fmt2,
    fmt1_,
    fmt2_,
    (.%),
    cat1,

    -- * Construction
    fmt,
    (%),
    apply,
    bind,
    cat,
    refmt,

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

    -- * Collections
    left1,
    right1,
    either1,
    maybe1,
) where

import Control.Arrow
import Control.Category (Category ())
import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import Data.String
import qualified Control.Category as C

-- | An indexed continuation formatter.
--
-- @Fmt m a b = (m -> a) -> b@ — the monoid @m@ accumulates formatted
-- output, @a@ is the result type, and @b@ captures the arguments.
--
-- This is @Costar ((->) m)@ from @profunctors@, giving 'Profunctor',
-- 'Closed', 'Costrong', 'Cochoice', 'Category', and 'Arrow' instances.
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 Cosieve (Fmt m) ((->) m) where
    cosieve :: forall a b. Fmt m a b -> (m -> a) -> b
cosieve (Fmt (m -> a) -> b
f) m -> a
g = (m -> a) -> b
f m -> a
g

instance Corepresentable (Fmt m) where
    type Corep (Fmt m) = (->) m
    cotabulate :: forall d c. (Corep (Fmt m) d -> c) -> Fmt m d c
cotabulate Corep (Fmt m) d -> c
f = ((m -> d) -> c) -> Fmt m d c
forall m a b. ((m -> a) -> b) -> Fmt m a b
Fmt Corep (Fmt m) d -> c
(m -> d) -> c
f

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

---------------------------------------------------------------------
-- Running
---------------------------------------------------------------------

-- | 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

---------------------------------------------------------------------
-- Construction
---------------------------------------------------------------------

-- | Format a constant value.
{-# 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)

-- | 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 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)

---------------------------------------------------------------------
-- Fmt1 / Fmt2
---------------------------------------------------------------------

-- | A unary formatter: @Fmt1 m s a ~ (m -> s) -> a -> s@
type Fmt1 m s a = Fmt m s (a -> s)

-- | A binary 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 formatter.
type Fmt3 m s a b c = Fmt m s (a -> b -> c -> s)

-- | Format a value using a function @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

-- | Format two values.
{-# 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

-- | Ignore the input, use a constant formatter.
{-# 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

-- | Ignore two inputs.
{-# 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) -> a -> s) -> Fmt1 m s a)
-> ((m -> s) -> a -> s) -> Fmt1 m s a
forall a b. (a -> b) -> a -> b
$ \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 and concatenate.
{-# 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)

---------------------------------------------------------------------
-- Formatting
---------------------------------------------------------------------

-- | Add the given prefix.
{-# INLINE prefix #-}
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

-- | Add the given suffix.
{-# INLINE suffix #-}
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

-- | Enclose with prefix and suffix.
{-# INLINE enclose #-}
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

-- | Format a pair in parentheses.
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
", "

-- | Double quotes.
{-# INLINE quotes #-}
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
"\""

-- | Single quotes.
{-# INLINE quotes' #-}
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
"'"

-- | Parentheses.
{-# INLINE parens #-}
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
")"

-- | Braces.
{-# INLINE braces #-}
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
"}"

-- | Square brackets.
{-# INLINE brackets #-}
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
"]"

-- | Backticks.
{-# INLINE backticks #-}
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
"`"

-- | Indent by @n@ spaces.
{-# INLINEABLE indent #-}
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
' '

---------------------------------------------------------------------
-- Collections
---------------------------------------------------------------------

-- | Format a Left, rendering Right as empty.
{-# INLINE left1 #-}
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
"")

-- | Format a Right, rendering Left as empty.
{-# INLINE right1 #-}
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
"")

-- | Format an Either.
{-# INLINE either1 #-}
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)

-- | Format a Maybe with a default.
{-# INLINE maybe1 #-}
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)