module Fold.Effectful.Type where

import Control.Applicative (Applicative, liftA2, pure, (<*>))
import Control.Monad (Monad)
import Data.Functor (Functor, fmap, (<$>))
import Data.Monoid (Monoid, mempty)
import Data.Semigroup (Semigroup, (<>))
import Prelude (($!))

import qualified Strict

{- | Processes inputs of type @a@ and results in an effectful value of type @m b@ -}
data EffectfulFold m a b = forall x. EffectfulFold
    { ()
initial :: m x
    , ()
step :: x -> a -> m x
    , ()
extract :: x -> m b
    }

instance Functor m => Functor (EffectfulFold m a) where
    fmap :: forall a b. (a -> b) -> EffectfulFold m a a -> EffectfulFold m a b
fmap a -> b
f EffectfulFold{ m x
initial :: m x
initial :: ()
initial, x -> a -> m x
step :: x -> a -> m x
step :: ()
step, x -> m a
extract :: x -> m a
extract :: ()
extract } = EffectfulFold
        { m x
initial :: m x
initial :: m x
initial
        , x -> a -> m x
step :: x -> a -> m x
step :: x -> a -> m x
step
        , extract :: x -> m b
extract = \x
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$! x -> m a
extract x
x
        }

instance Applicative m => Applicative (EffectfulFold m a) where
    pure :: forall a. a -> EffectfulFold m a a
pure a
b = EffectfulFold{ initial :: m ()
initial = forall (f :: * -> *) a. Applicative f => a -> f a
pure (), step :: () -> a -> m ()
step = \() a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (), extract :: () -> m a
extract = \() -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b }

    <*> :: forall a b.
EffectfulFold m a (a -> b)
-> EffectfulFold m a a -> EffectfulFold m a b
(<*>)
        EffectfulFold{ initial :: ()
initial = m x
initialL, step :: ()
step = x -> a -> m x
stepL, extract :: ()
extract = x -> m (a -> b)
extractL }
        EffectfulFold{ initial :: ()
initial = m x
initialR, step :: ()
step = x -> a -> m x
stepR, extract :: ()
extract = x -> m a
extractR } =
          EffectfulFold
            { initial :: m (Tuple2 x x)
initial = forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
initialL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m x
initialR
            , step :: Tuple2 x x -> a -> m (Tuple2 x x)
step = \(Strict.Tuple2 x
xL x
xR) a
a -> forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> a -> m x
stepL x
xL a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> a -> m x
stepR x
xR a
a
            , extract :: Tuple2 x x -> m b
extract = \(Strict.Tuple2 x
xL x
xR) -> x -> m (a -> b)
extractL x
xL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> m a
extractR x
xR
            }

instance (Semigroup b, Monad m) => Semigroup (EffectfulFold m a b) where
    <> :: EffectfulFold m a b -> EffectfulFold m a b -> EffectfulFold m a b
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance (Monoid b, Monad m) => Monoid (EffectfulFold m a b) where
    mempty :: EffectfulFold m a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty