module Fold.Effectful.Utilities where

import Fold.Effectful.Type

import Control.Applicative (Applicative, pure)
import Control.Monad (Monad, (>>=))
import Data.Bool (Bool)
import Data.Functor (fmap)
import Numeric.Natural (Natural)
import Prelude ((-))

{-| Shift an effectful fold from one monad to another with a morphism such as
    @lift@ or @liftIO@ -}
hoist :: (forall x . m x -> n x) -> EffectfulFold m a b -> EffectfulFold n a b
hoist :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> EffectfulFold m a b -> EffectfulFold n a b
hoist forall x. m x -> n x
f EffectfulFold{ m x
initial :: ()
initial :: m x
initial, x -> a -> m x
step :: ()
step :: x -> a -> m x
step, x -> m b
extract :: ()
extract :: x -> m b
extract } = EffectfulFold
    { initial :: n x
initial = forall x. m x -> n x
f m x
initial
    , step :: x -> a -> n x
step = \x
a a
b -> forall x. m x -> n x
f (x -> a -> m x
step x
a a
b)
    , extract :: x -> n b
extract = \x
x -> forall x. m x -> n x
f (x -> m b
extract x
x)
    }

{-| Allows to continue feeding an effectful fold even after passing it to a
    function that closes it -}
duplicate :: Applicative m => EffectfulFold m a b -> EffectfulFold m a (EffectfulFold m a b)
duplicate :: forall (m :: * -> *) a b.
Applicative m =>
EffectfulFold m a b -> EffectfulFold m a (EffectfulFold m a b)
duplicate EffectfulFold{ m x
initial :: m x
initial :: ()
initial, x -> a -> m x
step :: x -> a -> m x
step :: ()
step, x -> m b
extract :: x -> m b
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 (EffectfulFold m a b)
extract = \x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EffectfulFold{ initial :: m x
initial = forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x, x -> a -> m x
step :: x -> a -> m x
step :: x -> a -> m x
step, x -> m b
extract :: x -> m b
extract :: x -> m b
extract }
    }

{-| Apply a function to each input -}
premap :: Monad m => (a -> m b) -> EffectfulFold m b r -> EffectfulFold m a r
premap :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> EffectfulFold m b r -> EffectfulFold m a r
premap a -> m b
f EffectfulFold{ m x
initial :: m x
initial :: ()
initial, x -> b -> m x
step :: x -> b -> m x
step :: ()
step, x -> m r
extract :: x -> m r
extract :: ()
extract } =
    EffectfulFold{ m x
initial :: m x
initial :: m x
initial, step :: x -> a -> m x
step = \x
x a
a -> a -> m b
f a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> b -> m x
step x
x, x -> m r
extract :: x -> m r
extract :: x -> m r
extract }

{-| Consider only inputs that match an effectful predicate -}
prefilter :: (Monad m) => (a -> m Bool) -> EffectfulFold m a r -> EffectfulFold m a r
prefilter :: forall (m :: * -> *) a r.
Monad m =>
(a -> m Bool) -> EffectfulFold m a r -> EffectfulFold m a r
prefilter a -> m Bool
f EffectfulFold{ m x
initial :: m x
initial :: ()
initial, x -> a -> m x
step :: x -> a -> m x
step :: ()
step, x -> m r
extract :: x -> m r
extract :: ()
extract } = EffectfulFold
    { m x
initial :: m x
initial :: m x
initial
    , step :: x -> a -> m x
step = \x
x a
a -> do{ Bool
use <- a -> m Bool
f a
a; if Bool
use then x -> a -> m x
step x
x a
a else forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x }
    , x -> m r
extract :: x -> m r
extract :: x -> m r
extract
    }

{-| Ignore the first /n/ inputs -}
drop :: Monad m => Natural -> EffectfulFold m a b -> EffectfulFold m a b
drop :: forall (m :: * -> *) a b.
Monad m =>
Natural -> EffectfulFold m a b -> EffectfulFold m a b
drop Natural
n EffectfulFold{ m x
initial :: m x
initial :: ()
initial, x -> a -> m x
step :: x -> a -> m x
step :: ()
step, x -> m b
extract :: x -> m b
extract :: ()
extract } = EffectfulFold
    { initial :: m (Natural, x)
initial = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
s -> (Natural
n, x
s)) m x
initial
    , step :: (Natural, x) -> a -> m (Natural, x)
step = \(Natural
n', x
s) a
x -> case Natural
n' of
          Natural
0 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
s' -> (Natural
0, x
s')) (x -> a -> m x
step x
s a
x)
          Natural
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural
n' forall a. Num a => a -> a -> a
- Natural
1, x
s)
    , extract :: (Natural, x) -> m b
extract = \(Natural
_,  x
s) -> x -> m b
extract x
s
    }