module Fold.Pure.Utilities where

import Fold.Pure.Type

import Control.Applicative (Applicative, liftA2, pure)
import Data.Bool (Bool (False, True), (&&))
import Data.Functor (fmap)
import Numeric.Natural (Natural)
import Prelude ((-))

import qualified Strict

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

{-| Applies a function to each input before processing -}
premap :: (a -> b) -> Fold b r -> Fold a r
premap :: forall a b r. (a -> b) -> Fold b r -> Fold a r
premap a -> b
f Fold{ x
initial :: x
initial :: ()
initial, x -> b -> x
step :: x -> b -> x
step :: ()
step, x -> r
extract :: x -> r
extract :: ()
extract } =
    Fold{ x
initial :: x
initial :: x
initial, 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 }

{-| Consider only inputs that match a predicate -}
prefilter :: (a -> Bool) -> Fold a r -> Fold a r
prefilter :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
prefilter a -> Bool
f Fold{ x -> a -> x
step :: x -> a -> x
step :: ()
step, x
initial :: x
initial :: ()
initial, x -> r
extract :: x -> r
extract :: ()
extract } =
    Fold{ x
initial :: x
initial :: x
initial, step :: x -> a -> x
step = \x
x a
a -> if a -> Bool
f a
a then x -> a -> x
step x
x a
a else x
x, x -> r
extract :: x -> r
extract :: x -> r
extract }

{-| Ignores inputs until they stop satisfying a predicate -}
predropWhile :: (a -> Bool) -> Fold a r -> Fold a r
predropWhile :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
predropWhile a -> Bool
f Fold{ x
initial :: x
initial :: ()
initial, x -> a -> x
step :: x -> a -> x
step :: ()
step, x -> r
extract :: x -> r
extract :: ()
extract } = Fold
    { initial :: Tuple2 Bool x
initial = forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 Bool
True x
initial
    , step :: Tuple2 Bool x -> a -> Tuple2 Bool x
step = \(Strict.Tuple2 Bool
dropping x
x) a
a ->
          if Bool
dropping Bool -> Bool -> Bool
&& a -> Bool
f a
a
          then forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 Bool
True x
x
          else forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 Bool
False (x -> a -> x
step x
x a
a)
    , extract :: Tuple2 Bool x -> r
extract = \(Strict.Tuple2 Bool
_ x
state) -> x -> r
extract x
state
    }

{-| Ignores the first /n/ inputs -}
drop :: Natural -> Fold a b -> Fold a b
drop :: forall a b. Natural -> Fold a b -> Fold a b
drop Natural
n Fold{ x
initial :: x
initial :: ()
initial, x -> a -> x
step :: x -> a -> x
step :: ()
step, x -> b
extract :: x -> b
extract :: ()
extract } = Fold
    { initial :: (Natural, x)
initial = (Natural
n, x
initial)
    , step :: (Natural, x) -> a -> (Natural, x)
step = \(Natural
n', x
s) a
x -> case Natural
n' of
          Natural
0 -> (Natural
0, x -> a -> x
step x
s a
x)
          Natural
_ -> (Natural
n' forall a. Num a => a -> a -> a
- Natural
1, x
s)
    , extract :: (Natural, x) -> b
extract = \(Natural
_,  x
s) -> x -> b
extract x
s
    }

{-| Nest a fold in an applicative -}
nest :: Applicative f => Fold a b -> Fold (f a) (f b)
nest :: forall (f :: * -> *) a b.
Applicative f =>
Fold a b -> Fold (f a) (f b)
nest Fold{ x
initial :: x
initial :: ()
initial, x -> a -> x
step :: x -> a -> x
step :: ()
step, x -> b
extract :: x -> b
extract :: ()
extract } = Fold
    { initial :: f x
initial = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 }