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
import qualified Fold.Pure.Utilities as Pure
import qualified Fold.Pure.Run as Pure.Run
import qualified Fold.Nonempty.Conversion as Nonempty

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

{-| Applies a function to each input before processing -}
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 }

{-| Convert a nonempty fold for a single item (@x@) into a
    nonempty fold for nonempty lists of items (@xs@) -}
repeatedly :: forall x xs result.
    (forall b. NonemptyFold x b -> xs -> b)
        -- ^ A witness to the fact that @xs@ is a nonempty list of @x@
    -> NonemptyFold x result
    -> NonemptyFold xs result
repeatedly :: forall x xs result.
(forall b. NonemptyFold x b -> xs -> b)
-> NonemptyFold x result -> NonemptyFold xs result
repeatedly forall b. NonemptyFold x b -> xs -> b
runXs NonemptyFold x result
foldX =
  NonemptyFold
    { initial :: xs -> Fold x result
initial = forall b. NonemptyFold x b -> xs -> b
runXs (forall a b. NonemptyFold a b -> NonemptyFold a (Fold a b)
duplicate NonemptyFold x result
foldX)
    , step :: Fold x result -> xs -> Fold x result
step = \Fold x result
f -> forall b. NonemptyFold x b -> xs -> b
runXs (forall a b. Fold a b -> NonemptyFold a b
Nonempty.fold (forall a b. Fold a b -> Fold a (Fold a b)
Pure.duplicate Fold x result
f))
    , extract :: Fold x result -> result
extract = \Fold x result
f -> forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Pure.Run.run Fold x result
f []
    }