{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}

{-| 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`.

    Import this module qualified to avoid clashing with the Prelude:

>>> import qualified Control.Foldl.NonEmpty as Foldl1

    Use 'fold1' to apply a 'Fold1' to a non-empty list:

>>> Foldl1.fold1 Foldl1.last (1 :| [2..10])
10

-}

module Control.Foldl.NonEmpty (
    -- * Fold Types
      Fold1(.., Fold1_)

    -- * Folding
    , Control.Foldl.NonEmpty.fold1

    -- * Conversion between Fold and Fold1
    , fromFold
    , toFold

    -- * Folds
    , sconcat
    , head
    , last
    , maximum
    , maximumBy
    , minimum
    , minimumBy

    -- ** Non-empty Container Folds
    , nonEmpty

    -- * Utilities
    , purely
    , purely_
    , premap
    , FromMaybe(..)
    , Handler1
    , handles
    , foldOver
    , folded1
    ) where

import Control.Applicative (liftA2, Const(..))
import Control.Foldl (Fold(..))
import Control.Foldl.Internal (Either'(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid (Dual(..))
import Data.Functor.Apply (Apply)
import Data.Profunctor (Profunctor(..))
import Data.Semigroup.Foldable (Foldable1(..), traverse1_)
import Data.Functor.Contravariant (Contravariant(..))

import Prelude hiding (head, last, minimum, maximum)

import qualified Control.Foldl as Foldl

{- $setup

>>> import qualified Control.Foldl.NonEmpty as Foldl1
>>> import qualified Data.List.NonEmpty as NonEmpty
>>> import Data.Functor.Apply (Apply(..))
>>> import Data.Semigroup.Traversable (Traversable1(..))
>>> import Data.Monoid (Sum(..))

>>> _2 f (x, y) = fmap (\i -> (x, i)) (f y)

>>> both f (x, y) = (,) <$> f x <.> f y

-}

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

{-| @Fold1_@ is an alternative to the @Fold1@ constructor if you need to
    explicitly work with an initial, step and extraction function.

    @Fold1_@ is similar to the @Fold@ constructor, which also works with an
    initial, step and extraction function. However, note that @Fold@ takes the
    step function as the first argument and the initial accumulator as the
    second argument, whereas @Fold1_@ takes them in swapped order:

    @Fold1_ @ @ initial @ @ step @ @ extract@

    While @Fold@ resembles 'Prelude.foldl', @Fold1_@ resembles
    'Data.Foldable1.foldlMap1'.
-}
pattern Fold1_ :: forall a b. forall x. (a -> x) -> (x -> a -> x) -> (x -> b) -> Fold1 a b
pattern $mFold1_ :: forall {r} {a} {b}.
Fold1 a b
-> (forall {x}. (a -> x) -> (x -> a -> x) -> (x -> b) -> r)
-> ((# #) -> r)
-> r
$bFold1_ :: forall a b x. (a -> x) -> (x -> a -> x) -> (x -> b) -> Fold1 a b
Fold1_ begin step done <- (toFold_ -> (begin, step, done))
  where Fold1_ a -> x
begin x -> a -> x
step x -> b
done = (a -> Fold a b) -> Fold1 a b
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 ((a -> Fold a b) -> Fold1 a b) -> (a -> Fold a b) -> Fold1 a b
forall a b. (a -> b) -> a -> b
$ \a
a -> (x -> a -> x) -> x -> (x -> b) -> Fold a b
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step (a -> x
begin a
a) x -> b
done
#if __GLASGOW_HASKELL__ >= 902
{-# INLINABLE Fold1_ #-}
#endif
{-# COMPLETE Fold1_ :: Fold1 #-}

toFold_ :: Fold1 a b -> (a -> Fold a b, Fold a b -> a -> Fold a b, Fold a b -> b)
toFold_ :: forall a b.
Fold1 a b
-> (a -> Fold a b, Fold a b -> a -> Fold a b, Fold a b -> b)
toFold_ (Fold1 (a -> Fold a b
f :: a -> Fold a b)) = (a -> Fold a b
begin', Fold a b -> a -> Fold a b
step', Fold a b -> b
done')
  where
    done' :: Fold a b -> b
    done' :: Fold a b -> b
done' (Fold x -> a -> x
_step x
begin x -> b
done) = x -> b
done x
begin

    step' :: Fold a b -> a -> Fold a b
    step' :: Fold a b -> a -> Fold a b
step' (Fold x -> a -> x
step x
begin x -> b
done) a
a = (x -> a -> x) -> x -> (x -> b) -> Fold a b
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

    begin' :: a -> Fold a b
    begin' :: a -> Fold a b
begin' = a -> Fold a b
f
{-# INLINABLE toFold_ #-}

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) = (a -> Fold a b) -> Fold1 a b
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 ((Fold a a -> Fold a b) -> (a -> Fold a a) -> a -> Fold a b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Fold a a -> Fold a b
forall a b. (a -> b) -> Fold a a -> Fold a b
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) -> Fold1 b c -> Fold1 a c
forall a b c. (a -> b) -> Fold1 b c -> Fold1 a c
premap
    {-# INLINE lmap #-}

    rmap :: forall b c a. (b -> c) -> Fold1 a b -> Fold1 a c
rmap = (b -> c) -> Fold1 a b -> Fold1 a c
forall a b. (a -> b) -> Fold1 a a -> Fold1 a b
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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (Fold a a -> a -> Fold a a
forall a. a -> a -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Fold a a
forall a. a -> Fold a a
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 = (a -> Fold a b) -> Fold1 a b
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 ((Fold a (a -> b) -> Fold a a -> Fold a b)
-> (a -> Fold a (a -> b)) -> (a -> Fold a a) -> a -> Fold a b
forall a b c. (a -> b -> c) -> (a -> a) -> (a -> b) -> a -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Fold a (a -> b) -> Fold a a -> Fold a b
forall a b. Fold a (a -> b) -> Fold a a -> Fold a b
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
(<>) = (b -> b -> b) -> Fold1 a b -> Fold1 a b -> Fold1 a b
forall a b c. (a -> b -> c) -> Fold1 a a -> Fold1 a b -> Fold1 a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE (<>) #-}

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

    mappend :: Fold1 a b -> Fold1 a b -> Fold1 a b
mappend = Fold1 a b -> Fold1 a b -> Fold1 a b
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

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

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

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

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

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

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

    (-) = (b -> b -> b) -> Fold1 a b -> Fold1 a b -> Fold1 a b
forall a b c. (a -> b -> c) -> Fold1 a a -> Fold1 a b -> Fold1 a c
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 = b -> Fold1 a b
forall a. a -> Fold1 a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Fold1 a b) -> (Rational -> b) -> Rational -> Fold1 a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> b
forall a. Fractional a => Rational -> a
fromRational
    {-# INLINE fromRational #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    logBase :: Fold1 a b -> Fold1 a b -> Fold1 a b
logBase = (b -> b -> b) -> Fold1 a b -> Fold1 a b -> Fold1 a b
forall a b c. (a -> b -> c) -> Fold1 a a -> Fold1 a b -> Fold1 a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
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 = Fold a b -> [a] -> b
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 = f a -> NonEmpty a
forall a. f a -> NonEmpty a
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) = (a -> Fold a b) -> Fold1 a b
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
a -> (x -> a -> x) -> x -> (x -> b) -> Fold a b
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) = (Either' (a -> Fold a b) (Fold a b)
 -> a -> Either' (a -> Fold a b) (Fold a b))
-> Either' (a -> Fold a b) (Fold a b)
-> (Either' (a -> Fold a b) (Fold a b) -> Maybe b)
-> Fold a (Maybe b)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Either' (a -> Fold a b) (Fold a b)
-> a -> Either' (a -> Fold a b) (Fold a b)
forall {a} {b} {a}.
Either' (a -> Fold a b) (Fold a b) -> a -> Either' a (Fold a b)
step Either' (a -> Fold a b) (Fold a b)
forall {b}. Either' (a -> Fold a b) b
begin Either' (a -> Fold a b) (Fold a b) -> Maybe b
forall {a} {a} {a}. Either' a (Fold a a) -> Maybe a
done
  where
    begin :: Either' (a -> Fold a b) b
begin = (a -> Fold a b) -> Either' (a -> Fold a b) b
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 = Fold a b -> Either' a (Fold a b)
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 =
        Fold a b -> Either' a (Fold a b)
forall a b. b -> Either' a b
Right' ((x -> a -> x) -> x -> (x -> b) -> Fold a b
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')) = a -> Maybe a
forall a. a -> Maybe a
Just (x -> a
done' x
begin')
    done (Left' a
_) = Maybe 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 = (a -> Fold a (NonEmpty a)) -> Fold1 a (NonEmpty a)
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
a -> ([a] -> NonEmpty a) -> Fold a [a] -> Fold a (NonEmpty a)
forall a b. (a -> b) -> Fold a a -> Fold a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|) Fold a [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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> (a -> a -> a) -> a -> (a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) a
begin a -> a
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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> (a -> a -> a) -> a -> (a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
forall {p} {p}. p -> p -> p
step a
begin a -> a
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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> (a -> a -> a) -> a -> (a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
forall {p} {p}. p -> p -> p
step a
begin a -> a
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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> (a -> a -> a) -> a -> (a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
forall a. Ord a => a -> a -> a
max a
begin a -> a
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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> (a -> a -> a) -> a -> (a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
max' a
begin a -> a
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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> (a -> a -> a) -> a -> (a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
forall a. Ord a => a -> a -> a
min a
begin a -> a
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 = (a -> Fold a a) -> Fold1 a a
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> (a -> a -> a) -> a -> (a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
min' a
begin a -> a
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 #-}

-- | Upgrade a fold to accept the 'Fold1' type
purely :: (forall x . (a -> x) -> (x -> a -> x) -> (x -> b) -> r) -> Fold1 a b -> r
purely :: forall a b r.
(forall x. (a -> x) -> (x -> a -> x) -> (x -> b) -> r)
-> Fold1 a b -> r
purely forall x. (a -> x) -> (x -> a -> x) -> (x -> b) -> r
f (Fold1_ a -> x
begin x -> a -> x
step x -> b
done) = (a -> x) -> (x -> a -> x) -> (x -> b) -> r
forall x. (a -> x) -> (x -> a -> x) -> (x -> b) -> r
f a -> x
begin x -> a -> x
step x -> b
done
{-# INLINABLE purely #-}

-- | Upgrade a more traditional fold to accept the `Fold1` type
purely_ :: (forall x . (a -> x) -> (x -> a -> x) -> x) -> Fold1 a b -> b
purely_ :: forall a b.
(forall x. (a -> x) -> (x -> a -> x) -> x) -> Fold1 a b -> b
purely_ forall x. (a -> x) -> (x -> a -> x) -> x
f (Fold1_ a -> x
begin x -> a -> x
step x -> b
done) = x -> b
done ((a -> x) -> (x -> a -> x) -> x
forall x. (a -> x) -> (x -> a -> x) -> x
f a -> x
begin x -> a -> x
step)
{-# INLINABLE purely_ #-}

{-| @(premap f folder)@ returns a new 'Fold1' where f is applied at each step

> Foldl1.fold1 (premap f folder) list = Foldl1.fold1 folder (NonEmpty.map f list)

>>> Foldl1.fold1 (premap Sum Foldl1.sconcat) (1 :| [2..10])
Sum {getSum = 55}

>>> Foldl1.fold1 Foldl1.sconcat $ NonEmpty.map Sum (1 :| [2..10])
Sum {getSum = 55}

> premap id = id
>
> premap (f . g) = premap g . premap f

> premap k (pure r) = pure r
>
> premap k (f <*> x) = premap k f <*> premap k x
-}
premap :: (a -> b) -> Fold1 b r -> Fold1 a r
premap :: forall a b c. (a -> b) -> Fold1 b c -> Fold1 a c
premap a -> b
f (Fold1 b -> Fold b r
k) = (a -> Fold a r) -> Fold1 a r
forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 a -> Fold a r
k'
  where
    k' :: a -> Fold a r
k' a
a = (a -> b) -> Fold b r -> Fold a r
forall a b c. (a -> b) -> Fold b c -> Fold a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f (b -> Fold b r
k (a -> b
f a
a))
{-# INLINABLE premap #-}

{-|
> instance Monad m => Semigroup (FromMaybe m a) where
>     mappend (FromMaybe f) (FromMaybe g) = FromMaybeM (f . Just . g)
-}
newtype FromMaybe b = FromMaybe { forall b. FromMaybe b -> Maybe b -> b
appFromMaybe :: Maybe b -> b }

instance Semigroup (FromMaybe b) where
    FromMaybe Maybe b -> b
f <> :: FromMaybe b -> FromMaybe b -> FromMaybe b
<> FromMaybe Maybe b -> b
g = (Maybe b -> b) -> FromMaybe b
forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe (Maybe b -> b
f (Maybe b -> b) -> (Maybe b -> Maybe b) -> Maybe b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$!) (b -> Maybe b) -> (Maybe b -> b) -> Maybe b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> b
g)
    {-# INLINE (<>) #-}

{-| A handler for the upstream input of a `Fold1`

    This is compatible with van Laarhoven optics as defined in the lens package.
    Any lens, fold1 or traversal1 will type-check as a `Handler1`.
-}
type Handler1 a b =
    forall x. (b -> Const (Dual (FromMaybe x)) b) -> a -> Const (Dual (FromMaybe x)) a

{-| @(handles t folder)@ transforms the input of a `Fold1` using a Lens,
    Traversal1, or Fold1 optic:

> handles _1        :: Fold1 a r -> Fold1 (a, b) r
> handles traverse1 :: Traversable1 t => Fold1 a r -> Fold1 (t a) r
> handles folded1   :: Foldable1    t => Fold1 a r -> Fold1 (t a) r

>>> Foldl1.fold1 (handles traverse1 Foldl1.nonEmpty) $ (1 :| [2..4]) :| [ 5 :| [6,7], 8 :| [9,10] ]
1 :| [2,3,4,5,6,7,8,9,10]

>>> Foldl1.fold1 (handles _2 Foldl1.sconcat) $ (1,"Hello ") :| [(2,"World"),(3,"!")]
"Hello World!"

> handles id = id
>
> handles (f . g) = handles f . handles g

> handles t (pure r) = pure r
>
> handles t (f <*> x) = handles t f <*> handles t x
-}
handles :: forall a b r. Handler1 a b -> Fold1 b r -> Fold1 a r
handles :: forall a b r. Handler1 a b -> Fold1 b r -> Fold1 a r
handles Handler1 a b
k (Fold1_ b -> x
begin x -> b -> x
step x -> r
done) = (a -> x) -> (x -> a -> x) -> (x -> r) -> Fold1 a r
forall a b x. (a -> x) -> (x -> a -> x) -> (x -> b) -> Fold1 a b
Fold1_ a -> x
begin' x -> a -> x
step' x -> r
done
  where
    begin' :: a -> x
begin' = Maybe x -> a -> x
stepAfromMaybe Maybe x
forall a. Maybe a
Nothing
    step' :: x -> a -> x
step' x
x = Maybe x -> a -> x
stepAfromMaybe (x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> x -> Maybe x
forall a b. (a -> b) -> a -> b
$! x
x)
    stepAfromMaybe :: Maybe x -> a -> x
stepAfromMaybe = (a -> Maybe x -> x) -> Maybe x -> a -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FromMaybe x -> Maybe x -> x
forall b. FromMaybe b -> Maybe b -> b
appFromMaybe (FromMaybe x -> Maybe x -> x)
-> (a -> FromMaybe x) -> a -> Maybe x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual (FromMaybe x) -> FromMaybe x
forall a. Dual a -> a
getDual (Dual (FromMaybe x) -> FromMaybe x)
-> (a -> Dual (FromMaybe x)) -> a -> FromMaybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Dual (FromMaybe x)) a -> Dual (FromMaybe x)
forall {k} a (b :: k). Const a b -> a
getConst (Const (Dual (FromMaybe x)) a -> Dual (FromMaybe x))
-> (a -> Const (Dual (FromMaybe x)) a) -> a -> Dual (FromMaybe x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Const (Dual (FromMaybe x)) b)
-> a -> Const (Dual (FromMaybe x)) a
Handler1 a b
k (Dual (FromMaybe x) -> Const (Dual (FromMaybe x)) b
forall {k} a (b :: k). a -> Const a b
Const (Dual (FromMaybe x) -> Const (Dual (FromMaybe x)) b)
-> (b -> Dual (FromMaybe x)) -> b -> Const (Dual (FromMaybe x)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromMaybe x -> Dual (FromMaybe x)
forall a. a -> Dual a
Dual (FromMaybe x -> Dual (FromMaybe x))
-> (b -> FromMaybe x) -> b -> Dual (FromMaybe x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe x -> x) -> FromMaybe x
forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe ((Maybe x -> x) -> FromMaybe x)
-> (b -> Maybe x -> x) -> b -> FromMaybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe x -> b -> x) -> b -> Maybe x -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe x -> b -> x
stepBfromMaybe))
    stepBfromMaybe :: Maybe x -> b -> x
stepBfromMaybe = (b -> x) -> (x -> b -> x) -> Maybe x -> b -> x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b -> x
begin x -> b -> x
step
{-# INLINABLE handles #-}

{- | @(foldOver f folder xs)@ folds all values from a Lens, Traversal1 or Fold1 optic with the given folder

>>> foldOver (_2 . both) Foldl1.nonEmpty (1, (2, 3))
2 :| [3]

> Foldl1.foldOver f folder xs == Foldl1.fold1 folder (xs ^.. f)

> Foldl1.foldOver (folded1 . f) folder == Foldl1.fold1 (Foldl1.handles f folder)

> Foldl1.foldOver folded1 == Foldl1.fold1

-}
foldOver :: Handler1 s a -> Fold1 a b -> s -> b
foldOver :: forall s a b. Handler1 s a -> Fold1 a b -> s -> b
foldOver Handler1 s a
l (Fold1_ a -> x
begin x -> a -> x
step x -> b
done) =
    x -> b
done (x -> b) -> (s -> x) -> s -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe x -> s -> x
stepSfromMaybe Maybe x
forall a. Maybe a
Nothing
  where
    stepSfromMaybe :: Maybe x -> s -> x
stepSfromMaybe = (s -> Maybe x -> x) -> Maybe x -> s -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FromMaybe x -> Maybe x -> x
forall b. FromMaybe b -> Maybe b -> b
appFromMaybe (FromMaybe x -> Maybe x -> x)
-> (s -> FromMaybe x) -> s -> Maybe x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual (FromMaybe x) -> FromMaybe x
forall a. Dual a -> a
getDual (Dual (FromMaybe x) -> FromMaybe x)
-> (s -> Dual (FromMaybe x)) -> s -> FromMaybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Dual (FromMaybe x)) s -> Dual (FromMaybe x)
forall {k} a (b :: k). Const a b -> a
getConst (Const (Dual (FromMaybe x)) s -> Dual (FromMaybe x))
-> (s -> Const (Dual (FromMaybe x)) s) -> s -> Dual (FromMaybe x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (Dual (FromMaybe x)) a)
-> s -> Const (Dual (FromMaybe x)) s
Handler1 s a
l (Dual (FromMaybe x) -> Const (Dual (FromMaybe x)) a
forall {k} a (b :: k). a -> Const a b
Const (Dual (FromMaybe x) -> Const (Dual (FromMaybe x)) a)
-> (a -> Dual (FromMaybe x)) -> a -> Const (Dual (FromMaybe x)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromMaybe x -> Dual (FromMaybe x)
forall a. a -> Dual a
Dual (FromMaybe x -> Dual (FromMaybe x))
-> (a -> FromMaybe x) -> a -> Dual (FromMaybe x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe x -> x) -> FromMaybe x
forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe ((Maybe x -> x) -> FromMaybe x)
-> (a -> Maybe x -> x) -> a -> FromMaybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe x -> a -> x) -> a -> Maybe x -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe x -> a -> x
stepAfromMaybe))
    stepAfromMaybe :: Maybe x -> a -> x
stepAfromMaybe = (a -> x) -> (x -> a -> x) -> Maybe x -> a -> x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> x
begin x -> a -> x
step
{-# INLINABLE foldOver #-}

{-|
> handles folded1 :: Foldable1 t => Fold1 a r -> Fold1 (t a) r
-}
folded1
    :: (Contravariant f, Apply f, Foldable1 t)
    => (a -> f a) -> (t a -> f (t a))
folded1 :: forall (f :: * -> *) (t :: * -> *) a.
(Contravariant f, Apply f, Foldable1 t) =>
(a -> f a) -> t a -> f (t a)
folded1 a -> f a
k t a
ts = (t a -> ()) -> f () -> f (t a)
forall a' a. (a' -> a) -> f a -> f a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\t a
_ -> ()) ((a -> f a) -> t a -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable1 t, Apply f) =>
(a -> f b) -> t a -> f ()
traverse1_ a -> f a
k t a
ts)
{-# INLINABLE folded1 #-}