-- | Getting a 'Fold' from some other type of fold
module Fold.Pure.Conversion where

import Fold.Pure.Type

import Data.Function (($))
import Data.Functor ((<$>))
import Data.Functor.Identity (Identity, runIdentity)
import Data.Maybe (Maybe)
import Fold.Effectful.Type (EffectfulFold (EffectfulFold))
import Fold.Nonempty.Type (NonemptyFold (NonemptyFold))

import qualified Fold.Effectful.Type as Effectful
import qualified Fold.Nonempty.Type as Nonempty
import qualified Strict

{-| Turn an effectful fold into a pure fold -}
effectfulFold :: EffectfulFold Identity a b -> Fold a b
effectfulFold :: forall a b. EffectfulFold Identity a b -> Fold a b
effectfulFold
  EffectfulFold{ Identity x
initial :: ()
initial :: Identity x
Effectful.initial, x -> a -> Identity x
step :: ()
step :: x -> a -> Identity x
Effectful.step, x -> Identity b
extract :: ()
extract :: x -> Identity b
Effectful.extract } =
    Fold
      { initial :: x
initial =         forall a. Identity a -> a
runIdentity ( Identity x
initial   )
      , step :: x -> a -> x
step    = \x
x a
a -> forall a. Identity a -> a
runIdentity ( x -> a -> Identity x
step x
x a
a  )
      , extract :: x -> b
extract = \x
x   -> forall a. Identity a -> a
runIdentity ( x -> Identity b
extract x
x )
      }

{-| Turn a fold that requires at least one input into a fold that returns
'Data.Maybe.Nothing' when there are no inputs -}
nonemptyFold :: NonemptyFold a b -> Fold a (Maybe b)
nonemptyFold :: forall a b. NonemptyFold a b -> Fold a (Maybe b)
nonemptyFold
  NonemptyFold{ a -> x
initial :: ()
initial :: a -> x
Nonempty.initial, x -> a -> x
step :: ()
step :: x -> a -> x
Nonempty.step, x -> b
extract :: ()
extract :: x -> b
Nonempty.extract } =
    Fold
      { initial :: Maybe x
initial = forall a. Maybe a
Strict.Nothing
      , step :: Maybe x -> a -> Maybe x
step = \Maybe x
xm a
a -> forall a. a -> Maybe a
Strict.Just forall a b. (a -> b) -> a -> b
$ case Maybe x
xm of
            Maybe x
Strict.Nothing -> a -> x
initial a
a
            Strict.Just x
x -> x -> a -> x
step x
x a
a
      , extract :: Maybe x -> Maybe b
extract = \Maybe x
xm -> x -> b
extract forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> Maybe a
Strict.lazy Maybe x
xm
      }