module Fold.Nonempty.Utilities where

import Fold.Nonempty.Type

import Control.Applicative (Applicative, liftA2)
import Data.Functor (fmap)
import Fold.Pure.Type (Fold (Fold))

import qualified Fold.Pure.Type as Pure

{-| Allows to continue feeding a fold even after passing it to a function
that closes it -}
duplicate :: NonemptyFold a b -> NonemptyFold a (Fold a b)
duplicate :: forall a b. NonemptyFold a b -> NonemptyFold a (Fold a b)
duplicate NonemptyFold{ a -> x
initial :: ()
initial :: a -> x
initial, x -> a -> x
step :: ()
step :: x -> a -> x
step, x -> b
extract :: ()
extract :: x -> b
extract } =
    NonemptyFold{ a -> x
initial :: a -> x
initial :: a -> x
initial, x -> a -> x
step :: x -> a -> x
step :: x -> a -> x
step, extract :: x -> Fold a b
extract = \x
x -> Fold
        { initial :: x
Pure.initial = x
x, x -> a -> x
step :: x -> a -> x
step :: x -> a -> x
Pure.step, x -> b
extract :: x -> b
extract :: x -> b
Pure.extract } }

{-| @(premap f folder)@ returns a new fold where @f@ is applied at each step -}
premap :: (a -> b) -> NonemptyFold b r -> NonemptyFold a r
premap :: forall a b r. (a -> b) -> NonemptyFold b r -> NonemptyFold a r
premap a -> b
f NonemptyFold{ b -> x
initial :: b -> x
initial :: ()
initial, x -> b -> x
step :: x -> b -> x
step :: ()
step, x -> r
extract :: x -> r
extract :: ()
extract } =
    NonemptyFold{ initial :: a -> x
initial = \a
a -> b -> x
initial (a -> b
f a
a),
        step :: x -> a -> x
step = \x
x a
a -> x -> b -> x
step x
x (a -> b
f a
a), x -> r
extract :: x -> r
extract :: x -> r
extract }

{-| Nest a fold in an applicative -}
nest :: Applicative f => NonemptyFold a b -> NonemptyFold (f a) (f b)
nest :: forall (f :: * -> *) a b.
Applicative f =>
NonemptyFold a b -> NonemptyFold (f a) (f b)
nest NonemptyFold{ a -> x
initial :: a -> x
initial :: ()
initial, x -> a -> x
step :: x -> a -> x
step :: ()
step, x -> b
extract :: x -> b
extract :: ()
extract } = NonemptyFold
    { initial :: f a -> f x
initial = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> x
initial, step :: f x -> f a -> f x
step = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> a -> x
step, extract :: f x -> f b
extract = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
extract }