module Fold.Nonempty.Type where

import Control.Applicative (Applicative, liftA2, pure, (<*>))
import Data.Functor (Functor, fmap)
import Data.Monoid (Monoid, mempty)
import Data.Semigroup (Semigroup, (<>))

import qualified Strict

{- | Processes at least one input of type @a@ and results in a value of type @b@ -}
data NonemptyFold a b = forall x. NonemptyFold
    { ()
initial :: a -> x
    , ()
step :: x -> a -> x
    , ()
extract :: x -> b
    }

instance Functor (NonemptyFold a) where
    fmap :: forall a b. (a -> b) -> NonemptyFold a a -> NonemptyFold a b
fmap a -> b
f NonemptyFold{ x -> a -> x
step :: x -> a -> x
step :: ()
step, a -> x
initial :: a -> x
initial :: ()
initial, x -> a
extract :: x -> a
extract :: ()
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 -> b
extract = \x
x -> a -> b
f (x -> a
extract x
x) }

instance Applicative (NonemptyFold a) where
    pure :: forall a. a -> NonemptyFold a a
pure a
b = NonemptyFold{ initial :: a -> ()
initial = \a
_ -> (), step :: () -> a -> ()
step = \() a
_ -> (), extract :: () -> a
extract = \() -> a
b }

    <*> :: forall a b.
NonemptyFold a (a -> b) -> NonemptyFold a a -> NonemptyFold a b
(<*>)
        NonemptyFold{ initial :: ()
initial = a -> x
initialL, step :: ()
step = x -> a -> x
stepL, extract :: ()
extract = x -> a -> b
extractL }
        NonemptyFold{ initial :: ()
initial = a -> x
initialR, step :: ()
step = x -> a -> x
stepR, extract :: ()
extract = x -> a
extractR } =
          NonemptyFold
            { initial :: a -> Tuple2 x x
initial = \a
a -> forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 (a -> x
initialL a
a) (a -> x
initialR a
a)
            , step :: Tuple2 x x -> a -> Tuple2 x x
step = \(Strict.Tuple2 x
xL x
xR) a
a -> forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 (x -> a -> x
stepL x
xL a
a) (x -> a -> x
stepR x
xR a
a)
            , extract :: Tuple2 x x -> b
extract = \(Strict.Tuple2 x
xL x
xR) -> x -> a -> b
extractL x
xL (x -> a
extractR x
xR)
            }

instance Semigroup b => Semigroup (NonemptyFold a b) where
    <> :: NonemptyFold a b -> NonemptyFold a b -> NonemptyFold a b
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid b => Monoid (NonemptyFold a b) where
    mempty :: NonemptyFold a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty