{-| 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 Data.List.NonEmpty (NonEmpty(..))
import Data.Profunctor (Profunctor(..))
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 :: Fold1 a b -> NonEmpty a -> b
fold1 :: forall a b. Fold1 a b -> NonEmpty a -> b
fold1 (Fold1 a -> Fold a b
k) (a
a :| [a]
as) = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold (a -> Fold a b
k a
a) [a]
as
{-# 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 #-}

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