{-| This module provides a `Fold1` type that is a \"non-empty\" analog of the
    `Fold` type, meaning that it requires at least one input element in order to
    produce a result

    This module does not provide all of the same utilities as the
    "Control.Foldl" module.  Instead, this module only provides the utilities
    which can make use of the non-empty input guarantee (e.g. `head`).  For
    all other utilities you can convert them from the equivalent `Fold` using
    `fromFold`.
-}

module Control.Foldl.NonEmpty where

import Control.Applicative (liftA2)
import Control.Foldl (Fold(..))
import Control.Foldl.Internal (Either'(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Profunctor (Profunctor(..))
import Data.Semigroup.Foldable (Foldable1(..))
import Prelude hiding (head, last, minimum, maximum)

import qualified Control.Foldl as Foldl

{-| A `Fold1` is like a `Fold` except that it consumes at least one input
    element
-}
data Fold1 a b = Fold1 (a -> Fold a b)

instance Functor (Fold1 a) where
    fmap :: forall a b. (a -> b) -> Fold1 a a -> Fold1 a b
fmap a -> b
f (Fold1 a -> Fold a a
k) = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) a -> Fold a a
k)
    {-# INLINE fmap #-}

instance Profunctor Fold1 where
    lmap :: forall a b c. (a -> b) -> Fold1 b c -> Fold1 a c
lmap a -> b
f (Fold1 b -> Fold b c
k) = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 a -> Fold a c
k'
      where
        k' :: a -> Fold a c
k' a
a = forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f (b -> Fold b c
k (a -> b
f a
a))
    {-# INLINE lmap #-}

    rmap :: forall b c a. (b -> c) -> Fold1 a b -> Fold1 a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    {-# INLINE rmap #-}

instance Applicative (Fold1 a) where
    pure :: forall a. a -> Fold1 a a
pure a
b = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b))
    {-# INLINE pure #-}

    Fold1 a -> Fold a (a -> b)
l <*> :: forall a b. Fold1 a (a -> b) -> Fold1 a a -> Fold1 a b
<*> Fold1 a -> Fold a a
r = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) a -> Fold a (a -> b)
l a -> Fold a a
r)
    {-# INLINE (<*>) #-}

instance Semigroup b => Semigroup (Fold1 a b) where
    <> :: Fold1 a b -> Fold1 a b -> Fold1 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
(<>)
    {-# INLINE (<>) #-}

instance Monoid b => Monoid (Fold1 a b) where
    mempty :: Fold1 a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

    mappend :: Fold1 a b -> Fold1 a b -> Fold1 a b
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
    {-# INLINE mappend #-}

instance Num b => Num (Fold1 a b) where
    fromInteger :: Integer -> Fold1 a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
    {-# INLINE fromInteger #-}

    negate :: Fold1 a b -> Fold1 a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate
    {-# INLINE negate #-}

    abs :: Fold1 a b -> Fold1 a b
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs
    {-# INLINE abs #-}

    signum :: Fold1 a b -> Fold1 a b
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
    {-# INLINE signum #-}

    + :: Fold1 a b -> Fold1 a b -> Fold1 a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}

    * :: Fold1 a b -> Fold1 a b -> Fold1 a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}

    (-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
    {-# INLINE (-) #-}

instance Fractional b => Fractional (Fold1 a b) where
    fromRational :: Rational -> Fold1 a b
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
    {-# INLINE fromRational #-}

    recip :: Fold1 a b -> Fold1 a b
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip
    {-# INLINE recip #-}

    / :: Fold1 a b -> Fold1 a b -> Fold1 a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Fractional a => a -> a -> a
(/)
    {-# INLINE (/) #-}

instance Floating b => Floating (Fold1 a b) where
    pi :: Fold1 a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
    {-# INLINE pi #-}

    exp :: Fold1 a b -> Fold1 a b
exp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
exp
    {-# INLINE exp #-}

    sqrt :: Fold1 a b -> Fold1 a b
sqrt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sqrt
    {-# INLINE sqrt #-}

    log :: Fold1 a b -> Fold1 a b
log = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
log
    {-# INLINE log #-}

    sin :: Fold1 a b -> Fold1 a b
sin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sin
    {-# INLINE sin #-}

    tan :: Fold1 a b -> Fold1 a b
tan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tan
    {-# INLINE tan #-}

    cos :: Fold1 a b -> Fold1 a b
cos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cos
    {-# INLINE cos #-}

    asin :: Fold1 a b -> Fold1 a b
asin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asin
    {-# INLINE asin #-}

    atan :: Fold1 a b -> Fold1 a b
atan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atan
    {-# INLINE atan #-}

    acos :: Fold1 a b -> Fold1 a b
acos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acos
    {-# INLINE acos #-}

    sinh :: Fold1 a b -> Fold1 a b
sinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sinh
    {-# INLINE sinh #-}

    tanh :: Fold1 a b -> Fold1 a b
tanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tanh
    {-# INLINE tanh #-}

    cosh :: Fold1 a b -> Fold1 a b
cosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cosh
    {-# INLINE cosh #-}

    asinh :: Fold1 a b -> Fold1 a b
asinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asinh
    {-# INLINE asinh #-}

    atanh :: Fold1 a b -> Fold1 a b
atanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atanh
    {-# INLINE atanh #-}

    acosh :: Fold1 a b -> Fold1 a b
acosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acosh
    {-# INLINE acosh #-}

    ** :: Fold1 a b -> Fold1 a b -> Fold1 a b
(**) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}

    logBase :: Fold1 a b -> Fold1 a b -> Fold1 a b
logBase = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
logBase
    {-# INLINE logBase #-}

-- | Apply a strict left `Fold1` to a `NonEmpty` list
fold1 :: Foldable1 f => Fold1 a b -> f a -> b
fold1 :: forall (f :: * -> *) a b. Foldable1 f => Fold1 a b -> f a -> b
fold1 (Fold1 a -> Fold a b
k) f a
as1 = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold (a -> Fold a b
k a
a) [a]
as
  where
    a
a :| [a]
as = forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f a
as1
{-# INLINABLE fold1 #-}

-- | Promote any `Fold` to an equivalent `Fold1`
fromFold :: Fold a b -> Fold1 a b
fromFold :: forall a b. Fold a b -> Fold1 a b
fromFold (Fold x -> a -> x
step x
begin x -> b
done) = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
a -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step (x -> a -> x
step x
begin a
a) x -> b
done)
{-# INLINABLE fromFold #-}

-- | Promote any `Fold1` to an equivalent `Fold`
toFold :: Fold1 a b -> Fold a (Maybe b)
toFold :: forall a b. Fold1 a b -> Fold a (Maybe b)
toFold (Fold1 a -> Fold a b
k0) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a} {b} {a}.
Either' (a -> Fold a b) (Fold a b) -> a -> Either' a (Fold a b)
step forall {b}. Either' (a -> Fold a b) b
begin forall {a} {a} {a}. Either' a (Fold a a) -> Maybe a
done
  where
    begin :: Either' (a -> Fold a b) b
begin = forall a b. a -> Either' a b
Left' a -> Fold a b
k0

    step :: Either' (a -> Fold a b) (Fold a b) -> a -> Either' a (Fold a b)
step (Left' a -> Fold a b
k) a
a = forall a b. b -> Either' a b
Right' (a -> Fold a b
k a
a)
    step (Right' (Fold x -> a -> x
step' x
begin' x -> b
done')) a
a =
        forall a b. b -> Either' a b
Right' (forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' (x -> a -> x
step' x
begin' a
a) x -> b
done')

    done :: Either' a (Fold a a) -> Maybe a
done (Right' (Fold x -> a -> x
_ x
begin' x -> a
done')) = forall a. a -> Maybe a
Just (x -> a
done' x
begin')
    done (Left' a
_) = forall a. Maybe a
Nothing
{-# INLINABLE toFold #-}

-- | Fold all values within a non-empty container into a `NonEmpty` list
nonEmpty :: Fold1 a (NonEmpty a)
nonEmpty :: forall a. Fold1 a (NonEmpty a)
nonEmpty = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
a -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
a forall a. a -> [a] -> NonEmpty a
:|) forall a. Fold a [a]
Foldl.list)
{-# INLINEABLE nonEmpty #-}

-- | Fold all values within a non-empty container using (`<>`)
sconcat :: Semigroup a => Fold1 a a
sconcat :: forall a. Semigroup a => Fold1 a a
sconcat = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Semigroup a => a -> a -> a
(<>) a
begin forall a. a -> a
id)
{-# INLINABLE sconcat #-}

-- | Get the first element of a non-empty container
head :: Fold1 a a
head :: forall a. Fold1 a a
head = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {p} {p}. p -> p -> p
step a
begin forall a. a -> a
id)
  where
    step :: p -> p -> p
step p
a p
_ = p
a
{-# INLINABLE head #-}

-- | Get the last element of a non-empty container
last :: Fold1 a a
last :: forall a. Fold1 a a
last = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {p} {p}. p -> p -> p
step a
begin forall a. a -> a
id)
  where
    step :: p -> p -> p
step p
_ p
a = p
a
{-# INLINABLE last #-}

-- | Computes the maximum element
maximum :: Ord a => Fold1 a a
maximum :: forall a. Ord a => Fold1 a a
maximum = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Ord a => a -> a -> a
max a
begin forall a. a -> a
id)
{-# INLINABLE maximum #-}

-- | Computes the maximum element with respect to the given comparison function
maximumBy :: (a -> a -> Ordering) -> Fold1 a a
maximumBy :: forall a. (a -> a -> Ordering) -> Fold1 a a
maximumBy a -> a -> Ordering
cmp = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
max' a
begin forall a. a -> a
id)
  where
    max' :: a -> a -> a
max' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
        Ordering
GT -> a
x
        Ordering
_  -> a
y
{-# INLINABLE maximumBy #-}

-- | Computes the minimum element
minimum :: Ord a => Fold1 a a
minimum :: forall a. Ord a => Fold1 a a
minimum = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Ord a => a -> a -> a
min a
begin forall a. a -> a
id)
{-# INLINABLE minimum #-}

-- | Computes the minimum element with respect to the given comparison function
minimumBy :: (a -> a -> Ordering) -> Fold1 a a
minimumBy :: forall a. (a -> a -> Ordering) -> Fold1 a a
minimumBy a -> a -> Ordering
cmp = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
min' a
begin forall a. a -> a
id)
  where
    min' :: a -> a -> a
min' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
        Ordering
GT -> a
y
        Ordering
_  -> a
x
{-# INLINABLE minimumBy #-}