module Zinza.Writer (
    Writer,
    execWriter,
    tell,
    ) where

-- | 'String' writer monad.
newtype Writer a = Writer { forall a. Writer a -> ShowS -> (ShowS, a)
unWriter :: ShowS -> (ShowS, a) }

-- | Get the written string.
execWriter :: Writer a -> String
execWriter :: forall a. Writer a -> String
execWriter Writer a
w = (ShowS, a) -> ShowS
forall a b. (a, b) -> a
fst (Writer a -> ShowS -> (ShowS, a)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer a
w ShowS
forall a. a -> a
id) String
""

-- | Tell 'String'.
tell :: String -> Writer ()
tell :: String -> Writer ()
tell String
x = (ShowS -> (ShowS, ())) -> Writer ()
forall a. (ShowS -> (ShowS, a)) -> Writer a
Writer ((ShowS -> (ShowS, ())) -> Writer ())
-> (ShowS -> (ShowS, ())) -> Writer ()
forall a b. (a -> b) -> a -> b
$ \ShowS
s -> (ShowS
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
x, ())

instance Functor Writer where
    fmap :: forall a b. (a -> b) -> Writer a -> Writer b
fmap a -> b
f Writer a
m = (ShowS -> (ShowS, b)) -> Writer b
forall a. (ShowS -> (ShowS, a)) -> Writer a
Writer ((ShowS -> (ShowS, b)) -> Writer b)
-> (ShowS -> (ShowS, b)) -> Writer b
forall a b. (a -> b) -> a -> b
$ \ShowS
s -> (a -> b) -> (ShowS, a) -> (ShowS, b)
forall a b. (a -> b) -> (ShowS, a) -> (ShowS, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Writer a -> ShowS -> (ShowS, a)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer a
m ShowS
s)

instance Applicative Writer where
    pure :: forall a. a -> Writer a
pure a
x = (ShowS -> (ShowS, a)) -> Writer a
forall a. (ShowS -> (ShowS, a)) -> Writer a
Writer ((ShowS -> (ShowS, a)) -> Writer a)
-> (ShowS -> (ShowS, a)) -> Writer a
forall a b. (a -> b) -> a -> b
$ \ShowS
s -> (ShowS
s, a
x)
    {-# INLINE pure #-}

    Writer a
x *> :: forall a b. Writer a -> Writer b -> Writer b
*> Writer b
y = (ShowS -> (ShowS, b)) -> Writer b
forall a. (ShowS -> (ShowS, a)) -> Writer a
Writer ((ShowS -> (ShowS, b)) -> Writer b)
-> (ShowS -> (ShowS, b)) -> Writer b
forall a b. (a -> b) -> a -> b
$ \ShowS
s1 ->
        let (ShowS
s2, a
_) = Writer a -> ShowS -> (ShowS, a)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer a
x ShowS
s1
        in Writer b -> ShowS -> (ShowS, b)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer b
y ShowS
s2
    {-# INLINE (*>) #-}

    Writer a
x <* :: forall a b. Writer a -> Writer b -> Writer a
<* Writer b
y = (ShowS -> (ShowS, a)) -> Writer a
forall a. (ShowS -> (ShowS, a)) -> Writer a
Writer ((ShowS -> (ShowS, a)) -> Writer a)
-> (ShowS -> (ShowS, a)) -> Writer a
forall a b. (a -> b) -> a -> b
$ \ShowS
s1 ->
        let (ShowS
s2, a
x') = Writer a -> ShowS -> (ShowS, a)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer a
x ShowS
s1
            (ShowS
s3, b
_)  = Writer b -> ShowS -> (ShowS, b)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer b
y ShowS
s2
            in (ShowS
s3, a
x')
    {-# INLINE (<*) #-}

    Writer (a -> b)
f <*> :: forall a b. Writer (a -> b) -> Writer a -> Writer b
<*> Writer a
x = (ShowS -> (ShowS, b)) -> Writer b
forall a. (ShowS -> (ShowS, a)) -> Writer a
Writer ((ShowS -> (ShowS, b)) -> Writer b)
-> (ShowS -> (ShowS, b)) -> Writer b
forall a b. (a -> b) -> a -> b
$ \ShowS
s1 ->
        let (ShowS
s2, a -> b
f') = Writer (a -> b) -> ShowS -> (ShowS, a -> b)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer (a -> b)
f ShowS
s1
            (ShowS
s3, a
x') = Writer a -> ShowS -> (ShowS, a)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer a
x ShowS
s2
            in (ShowS
s3, a -> b
f' a
x')
    {-# INLINE (<*>) #-}

instance Monad Writer where
    return :: forall a. a -> Writer a
return = a -> Writer a
forall a. a -> Writer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

    >> :: forall a b. Writer a -> Writer b -> Writer b
(>>) = Writer a -> Writer b -> Writer b
forall a b. Writer a -> Writer b -> Writer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    {-# INLINE (>>) #-}

    Writer a
m >>= :: forall a b. Writer a -> (a -> Writer b) -> Writer b
>>= a -> Writer b
k = (ShowS -> (ShowS, b)) -> Writer b
forall a. (ShowS -> (ShowS, a)) -> Writer a
Writer ((ShowS -> (ShowS, b)) -> Writer b)
-> (ShowS -> (ShowS, b)) -> Writer b
forall a b. (a -> b) -> a -> b
$ \ShowS
s1 ->
        let (ShowS
s2, a
x) = Writer a -> ShowS -> (ShowS, a)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter Writer a
m ShowS
s1
        in Writer b -> ShowS -> (ShowS, b)
forall a. Writer a -> ShowS -> (ShowS, a)
unWriter (a -> Writer b
k a
x) ShowS
s2
    {-# INLINE (>>=) #-}