{-| This module provides efficient and streaming left folds that you can combine
    using 'Applicative' style.

    Import this module qualified to avoid clashing with the Prelude:

>>> import qualified Control.Foldl as Foldl

    Use 'fold' to apply a 'Fold' to a list:

>>> Foldl.fold Foldl.sum [1..100]
5050

    'Fold's are 'Applicative's, so you can combine them using 'Applicative'
    combinators:

>>> import Control.Applicative
>>> let average = (/) <$> Foldl.sum <*> Foldl.genericLength

    … or you can use @do@ notation if you enable the @ApplicativeDo@ language
    extension:

>>> :set -XApplicativeDo
>>> let average = do total <- Foldl.sum; count <- Foldl.genericLength; return (total / count)

    … or you can use the fact that the `Fold` type implements `Num` to do this:

>>> let average = Foldl.sum / Foldl.genericLength

    These combined folds will still traverse the list only once, streaming
    efficiently over the list in constant space without space leaks:

>>> Foldl.fold average [1..10000000]
5000000.5
>>> Foldl.fold ((,) <$> Foldl.minimum <*> Foldl.maximum) [1..10000000]
(Just 1,Just 10000000)

    You might want to try enabling the @-flate-dmd-anal@ flag when compiling
    executables that use this library to further improve performance.
-}

{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE Trustworthy               #-}

module Control.Foldl (
    -- * Fold Types
      Fold(..)
    , FoldM(..)

    -- * Folding
    , fold
    , foldM
    , scan
    , prescan
    , postscan

    -- * Folds
    , Control.Foldl.mconcat
    , Control.Foldl.foldMap
    , head
    , last
    , lastDef
    , lastN
    , null
    , length
    , and
    , or
    , all
    , any
    , sum
    , product
    , mean
    , variance
    , std
    , maximum
    , maximumBy
    , minimum
    , minimumBy
    , elem
    , notElem
    , find
    , index
    , lookup
    , elemIndex
    , findIndex
    , random
    , randomN
    , Control.Foldl.mapM_
    , sink

    -- * Generic Folds
    , genericLength
    , genericIndex

    -- * Container folds
    , list
    , revList
    , nub
    , eqNub
    , set
    , hashSet
    , map
    , foldByKeyMap
    , hashMap
    , foldByKeyHashMap
    , vector
    , vectorM

    -- * Utilities
    -- $utilities
    , purely
    , purely_
    , impurely
    , impurely_
    , generalize
    , simplify
    , hoists
    , duplicateM
    , _Fold1
    , premap
    , premapM
    , prefilter
    , prefilterM
    , predropWhile
    , drop
    , dropM
    , Handler
    , handles
    , foldOver
    , EndoM(..)
    , HandlerM
    , handlesM
    , foldOverM
    , folded
    , filtered
    , groupBy
    , either
    , eitherM
    , nest

    -- * Re-exports
    -- $reexports
    , module Control.Monad.Primitive
    , module Data.Foldable
    , module Data.Vector.Generic
    ) where

import Control.Foldl.Optics (_Left, _Right)
import Control.Applicative
import Control.Foldl.Internal (Maybe'(..), lazy, Either'(..), Pair(..), hush)
import Control.Monad ((<=<))
import Control.Monad.Primitive (PrimMonad, RealWorld)
import Control.Comonad
import Data.Foldable (Foldable)
import Data.Functor.Identity (Identity, runIdentity)
import Data.Functor.Contravariant (Contravariant(..))
import Data.HashMap.Strict (HashMap)
import Data.Map.Strict (Map, alter)
import Data.Maybe (fromMaybe)
import Data.Monoid hiding ((<>))
import Data.Semigroupoid (Semigroupoid)
import Data.Functor.Extend (Extend(..))
import Data.Profunctor
import Data.Profunctor.Sieve
import Data.Sequence ((|>))
import Data.Vector.Generic (Vector, Mutable)
import Data.Vector.Generic.Mutable (MVector)
import Data.Hashable (Hashable)
import Data.Traversable
import Numeric.Natural (Natural)
import System.Random (StdGen, newStdGen, uniformR)
import Prelude hiding
    ( head
    , last
    , null
    , length
    , and
    , or
    , all
    , any
    , sum
    , product
    , maximum
    , minimum
    , elem
    , notElem
    , lookup
    , map
    , either
    , drop
    )

import qualified Data.Foldable               as F
import qualified Data.List                   as List
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as Set
import qualified Data.Map.Strict             as Map
import qualified Data.HashMap.Strict         as HashMap
import qualified Data.HashSet                as HashSet
import qualified Data.Vector.Generic         as V
import qualified Control.Foldl.Util.Vector   as V
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Semigroupoid

{- $setup

>>> import qualified Control.Foldl as Foldl

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

>>> :{
>>> _Just = let maybeEither Nothing = Left Nothing
>>>             maybeEither (Just x) = Right x
>>>         in Control.Foldl.Optics.prism Just maybeEither
>>> :}

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

-}

{-| Efficient representation of a left fold that preserves the fold's step
    function, initial accumulator, and extraction function

    This allows the 'Applicative' instance to assemble derived folds that
    traverse the container only once

    A \''Fold' a b\' processes elements of type __a__ and results in a
    value of type __b__.
-}
data Fold a b
  -- | @Fold @ @ step @ @ initial @ @ extract@
  = forall x. Fold (x -> a -> x) x (x -> b)

instance Functor (Fold a) where
    fmap :: forall a b. (a -> b) -> Fold a a -> Fold a b
fmap a -> b
f (Fold x -> a -> x
step x
begin x -> a
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step x
begin (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
done)
    {-# INLINE fmap #-}

instance Profunctor Fold where
    lmap :: forall a b c. (a -> b) -> Fold b c -> Fold a c
lmap = forall a b c. (a -> b) -> Fold b c -> Fold a c
premap
    rmap :: forall b c a. (b -> c) -> Fold a b -> Fold a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Choice Fold where
    right' :: forall a b c. Fold a b -> Fold (Either c a) (Either c b)
right' (Fold x -> a -> x
step x
begin x -> b
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> a -> x
step) (forall a b. b -> Either a b
Right x
begin) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
done)
    {-# INLINE right' #-}

instance Cosieve Fold [] where
    cosieve :: forall a b. Fold a b -> [a] -> b
cosieve = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold
    {-# INLINE cosieve #-}

instance Costrong Fold where
    unfirst :: forall a d b. Fold (a, d) (b, d) -> Fold a b
unfirst Fold (a, d) (b, d)
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> b
f forall a. Fold a [a]
list
      where
        f :: [a] -> b
f [a]
as = b
b
          where (b
b, d
d) = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold Fold (a, d) (b, d)
p [ (a
a, d
d) | a
a <- [a]
as ]
    {-# INLINE unfirst #-}

instance Comonad (Fold a) where
    extract :: forall a. Fold a a -> a
extract (Fold x -> a -> x
_ x
begin x -> a
done) = x -> a
done x
begin
    {-#  INLINE extract #-}

    duplicate :: forall a. Fold a a -> Fold a (Fold a a)
duplicate (Fold x -> a -> x
step x
begin x -> a
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step x
begin (\x
x -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step x
x x -> a
done)
    {-#  INLINE duplicate #-}

instance Applicative (Fold a) where
    pure :: forall a. a -> Fold a a
pure a
b    = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\() a
_ -> ()) () (\() -> a
b)
    {-# INLINE pure #-}

    (Fold x -> a -> x
stepL x
beginL x -> a -> b
doneL) <*> :: forall a b. Fold a (a -> b) -> Fold a a -> Fold a b
<*> (Fold x -> a -> x
stepR x
beginR x -> a
doneR) =
        let step :: Pair x x -> a -> Pair x x
step (Pair x
xL x
xR) a
a = forall a b. a -> b -> Pair a b
Pair (x -> a -> x
stepL x
xL a
a) (x -> a -> x
stepR x
xR a
a)
            begin :: Pair x x
begin = forall a b. a -> b -> Pair a b
Pair x
beginL x
beginR
            done :: Pair x x -> b
done (Pair x
xL x
xR) = x -> a -> b
doneL x
xL (x -> a
doneR x
xR)
        in  forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair x x -> a -> Pair x x
step Pair x x
begin Pair x x -> b
done
    {-# INLINE (<*>) #-}

instance Extend (Fold a) where
    duplicated :: forall a. Fold a a -> Fold a (Fold a a)
duplicated = forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate
    {-# INLINE duplicated #-}

instance Semigroup b => Semigroup (Fold a b) where
    <> :: Fold a b -> Fold a b -> Fold 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 Semigroupoid Fold where
    o :: forall j k1 i. Fold j k1 -> Fold i j -> Fold i k1
o (Fold x -> j -> x
step1 x
begin1 x -> k1
done1) (Fold x -> i -> x
step2 x
begin2 x -> j
done2) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold
        Pair x x -> i -> Pair x x
step
        (forall a b. a -> b -> Pair a b
Pair x
begin1 x
begin2)
        (\(Pair x
x x
_) -> x -> k1
done1 x
x)
      where
        step :: Pair x x -> i -> Pair x x
step (Pair x
c1 x
c2) i
a =
            let c2' :: x
c2' = x -> i -> x
step2 x
c2 i
a
                c1' :: x
c1' = x -> j -> x
step1 x
c1 (x -> j
done2 x
c2')
            in  forall a b. a -> b -> Pair a b
Pair x
c1' x
c2'
    {-# INLINE o #-}

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

    mappend :: Fold a b -> Fold a b -> Fold 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 (Fold a b) where
    fromInteger :: Integer -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 #-}

    + :: Fold a b -> Fold a b -> Fold 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 (+) #-}

    * :: Fold a b -> Fold a b -> Fold 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 (Fold a b) where
    fromRational :: Rational -> Fold 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 :: Fold a b -> Fold 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 #-}

    / :: Fold a b -> Fold a b -> Fold 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 (Fold a b) where
    pi :: Fold a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
    {-# INLINE pi #-}

    exp :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 :: Fold a b -> Fold 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 #-}

    ** :: Fold a b -> Fold a b -> Fold 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 :: Fold a b -> Fold a b -> Fold 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 #-}

{-| Like 'Fold', but monadic.

    A \''FoldM' m a b\' processes elements of type __a__ and
    results in a monadic value of type __m b__.
-}
data FoldM m a b =
  -- | @FoldM @ @ step @ @ initial @ @ extract@
  forall x . FoldM (x -> a -> m x) (m x) (x -> m b)

instance Functor m => Functor (FoldM m a) where
    fmap :: forall a b. (a -> b) -> FoldM m a a -> FoldM m a b
fmap a -> b
f (FoldM x -> a -> m x
step m x
start x -> m a
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step m x
start x -> m b
done'
      where
        done' :: x -> m b
done' x
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$! x -> m a
done x
x
    {-# INLINE fmap #-}

instance Applicative m => Applicative (FoldM m a) where
    pure :: forall a. a -> FoldM m a a
pure a
b = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\() a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\() -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b)
    {-# INLINE pure #-}

    (FoldM x -> a -> m x
stepL m x
beginL x -> m (a -> b)
doneL) <*> :: forall a b. FoldM m a (a -> b) -> FoldM m a a -> FoldM m a b
<*> (FoldM x -> a -> m x
stepR m x
beginR x -> m a
doneR) =
        let step :: Pair x x -> a -> m (Pair x x)
step (Pair x
xL x
xR) a
a = forall a b. a -> b -> Pair a b
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> a -> m x
stepL x
xL a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> a -> m x
stepR x
xR a
a
            begin :: m (Pair x x)
begin = forall a b. a -> b -> Pair a b
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
beginL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m x
beginR
            done :: Pair x x -> m b
done (Pair x
xL x
xR) = x -> m (a -> b)
doneL x
xL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> m a
doneR x
xR
        in  forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Pair x x -> a -> m (Pair x x)
step m (Pair x x)
begin Pair x x -> m b
done
    {-# INLINE (<*>) #-}

instance Monad m => Extend (FoldM m a) where
    duplicated :: forall a. FoldM m a a -> FoldM m a (FoldM m a a)
duplicated = forall (m :: * -> *) a b.
Applicative m =>
FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM
    {-# INLINE duplicated #-}

instance Functor m => Profunctor (FoldM m) where
    rmap :: forall b c a. (b -> c) -> FoldM m a b -> FoldM m a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    lmap :: forall a b c. (a -> b) -> FoldM m b c -> FoldM m a c
lmap a -> b
f (FoldM x -> b -> m x
step m x
begin x -> m c
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m c
done
      where
        step' :: x -> a -> m x
step' x
x a
a = x -> b -> m x
step x
x (a -> b
f a
a)

instance (Semigroup b, Monad m) => Semigroup (FoldM m a b) where
    <> :: FoldM m a b -> FoldM m a b -> FoldM m 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, Monad m) => Monoid (FoldM m a b) where
    mempty :: FoldM m a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

    mappend :: FoldM m a b -> FoldM m a b -> FoldM m 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 (Monad m, Num b) => Num (FoldM m a b) where
    fromInteger :: Integer -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 #-}

    + :: FoldM m a b -> FoldM m a b -> FoldM m 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 (+) #-}

    * :: FoldM m a b -> FoldM m a b -> FoldM m 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 (Monad m, Fractional b) => Fractional (FoldM m a b) where
    fromRational :: Rational -> FoldM m 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 :: FoldM m a b -> FoldM m 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 #-}

    / :: FoldM m a b -> FoldM m a b -> FoldM m 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 (Monad m, Floating b) => Floating (FoldM m a b) where
    pi :: FoldM m a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
    {-# INLINE pi #-}

    exp :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m 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 #-}

    ** :: FoldM m a b -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b -> FoldM m 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 'Fold' to a 'Foldable' container
fold :: Foldable f => Fold a b -> f a -> b
fold :: forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold (Fold x -> a -> x
step x
begin x -> b
done) f a
as = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {b}. a -> (x -> b) -> x -> b
cons x -> b
done f a
as x
begin
  where
    cons :: a -> (x -> b) -> x -> b
cons a
a x -> b
k x
x = x -> b
k forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a
{-# INLINE fold #-}

-- | Like 'fold', but monadic
foldM :: (Foldable f, Monad m) => FoldM m a b -> f a -> m b
foldM :: forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
foldM (FoldM x -> a -> m x
step m x
begin x -> m b
done) f a
as0 = do
    x
x0 <- m x
begin
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {b}. a -> (x -> m b) -> x -> m b
step' x -> m b
done f a
as0 forall a b. (a -> b) -> a -> b
$! x
x0
  where
    step' :: a -> (x -> m b) -> x -> m b
step' a
a x -> m b
k x
x = do
        x
x' <- x -> a -> m x
step x
x a
a
        x -> m b
k forall a b. (a -> b) -> a -> b
$! x
x'
{-# INLINE foldM #-}

{-| Convert a strict left 'Fold' into a scan

    >>> Foldl.scan Foldl.length [1..5]
    [0,1,2,3,4,5]
-}
scan :: Fold a b -> [a] -> [b]
scan :: forall a b. Fold a b -> [a] -> [b]
scan (Fold x -> a -> x
step x
begin x -> b
done) [a]
as = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (x -> [b]) -> x -> [b]
cons x -> [b]
nil [a]
as x
begin
  where
    nil :: x -> [b]
nil      x
x = x -> b
done x
xforall a. a -> [a] -> [a]
:[]
    cons :: a -> (x -> [b]) -> x -> [b]
cons a
a x -> [b]
k x
x = x -> b
done x
xforall a. a -> [a] -> [a]
:(x -> [b]
k forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a)
{-# INLINE scan #-}

{-| Convert a `Fold` into a prescan for any `Traversable` type

    \"Prescan\" means that the last element of the scan is not included

    >>> Foldl.prescan Foldl.length [1..5]
    [0,1,2,3,4]
-}
prescan :: Traversable t => Fold a b -> t a -> t b
prescan :: forall (t :: * -> *) a b. Traversable t => Fold a b -> t a -> t b
prescan (Fold x -> a -> x
step x
begin x -> b
done) t a
as = t b
bs
  where
    step' :: x -> a -> (x, b)
step' x
x a
a = (x
x', b
b)
      where
        x' :: x
x' = x -> a -> x
step x
x a
a
        b :: b
b  = x -> b
done x
x
    (x
_, t b
bs) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL x -> a -> (x, b)
step' x
begin t a
as
{-# INLINE prescan #-}

{-| Convert a `Fold` into a postscan for any `Traversable` type

    \"Postscan\" means that the first element of the scan is not included

    >>> Foldl.postscan Foldl.length [1..5]
    [1,2,3,4,5]
-}
postscan :: Traversable t => Fold a b -> t a -> t b
postscan :: forall (t :: * -> *) a b. Traversable t => Fold a b -> t a -> t b
postscan (Fold x -> a -> x
step x
begin x -> b
done) t a
as = t b
bs
  where
    step' :: x -> a -> (x, b)
step' x
x a
a = (x
x', b
b)
      where
        x' :: x
x' = x -> a -> x
step x
x a
a
        b :: b
b  = x -> b
done x
x'
    (x
_, t b
bs) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL x -> a -> (x, b)
step' x
begin t a
as
{-# INLINE postscan #-}

-- | Fold all values within a container using 'mappend' and 'mempty'
mconcat :: Monoid a => Fold a a
mconcat :: forall a. Monoid a => Fold a a
mconcat = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
mempty forall a. a -> a
id
{-# INLINABLE mconcat #-}

-- | Convert a \"@foldMap@\" to a 'Fold'
foldMap :: Monoid w => (a -> w) -> (w -> b) -> Fold a b
foldMap :: forall w a b. Monoid w => (a -> w) -> (w -> b) -> Fold a b
foldMap a -> w
to = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\w
x a
a -> forall a. Monoid a => a -> a -> a
mappend w
x (a -> w
to a
a)) forall a. Monoid a => a
mempty
{-# INLINABLE foldMap #-}

{-| Get the first element of a container or return 'Nothing' if the container is
    empty
-}
head :: Fold a (Maybe a)
head :: forall a. Fold a (Maybe a)
head = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 forall a b. a -> b -> a
const
{-# INLINABLE head #-}

{-| Get the last element of a container or return 'Nothing' if the container is
    empty
-}
last :: Fold a (Maybe a)
last :: forall a. Fold a (Maybe a)
last = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const)
{-# INLINABLE last #-}

{-| Get the last element of a container or return a default value if the container
    is empty
-}
lastDef :: a -> Fold a a
lastDef :: forall a. a -> Fold a a
lastDef a
a = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\a
_ a
a' -> a
a') a
a forall a. a -> a
id
{-# INLINABLE lastDef #-}

{-| Return the last N elements

-}
lastN :: Int -> Fold a [a]
lastN :: forall a. Int -> Fold a [a]
lastN Int
n = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. Seq a -> a -> Seq a
step forall {a}. Seq a
begin forall {a}. Seq a -> [a]
done
  where
    step :: Seq a -> a -> Seq a
step Seq a
s a
a = Seq a
s' forall {a}. Seq a -> a -> Seq a
|> a
a
      where
        s' :: Seq a
s' =
            if forall a. Seq a -> Int
Seq.length Seq a
s forall a. Ord a => a -> a -> Bool
< Int
n
            then Seq a
s
            else forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq a
s
    begin :: Seq a
begin = forall {a}. Seq a
Seq.empty
    done :: Seq a -> [a]
done  = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
{-# INLINABLE lastN #-}

-- | Returns 'True' if the container is empty, 'False' otherwise
null :: Fold a Bool
null :: forall a. Fold a Bool
null = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Bool
_ a
_ -> Bool
False) Bool
True forall a. a -> a
id
{-# INLINABLE null #-}

-- | Return the length of the container
length :: Fold a Int
length :: forall a. Fold a Int
length = forall b a. Num b => Fold a b
genericLength
{- Technically, 'length' is just 'genericLength' specialized to 'Int's.  I keep
   the two separate so that I can later provide an 'Int'-specialized
   implementation of 'length' for performance reasons like "GHC.List" does
   without breaking backwards compatibility.
-}
{-# INLINABLE length #-}

-- | Returns 'True' if all elements are 'True', 'False' otherwise
and :: Fold Bool Bool
and :: Fold Bool Bool
and = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Bool -> Bool -> Bool
(&&) Bool
True forall a. a -> a
id
{-# INLINABLE and #-}

-- | Returns 'True' if any element is 'True', 'False' otherwise
or :: Fold Bool Bool
or :: Fold Bool Bool
or = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Bool -> Bool -> Bool
(||) Bool
False forall a. a -> a
id
{-# INLINABLE or #-}

{-| @(all predicate)@ returns 'True' if all elements satisfy the predicate,
    'False' otherwise
-}
all :: (a -> Bool) -> Fold a Bool
all :: forall a. (a -> Bool) -> Fold a Bool
all a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Bool
x a
a -> Bool
x Bool -> Bool -> Bool
&& a -> Bool
predicate a
a) Bool
True forall a. a -> a
id
{-# INLINABLE all #-}

{-| @(any predicate)@ returns 'True' if any element satisfies the predicate,
    'False' otherwise
-}
any :: (a -> Bool) -> Fold a Bool
any :: forall a. (a -> Bool) -> Fold a Bool
any a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Bool
x a
a -> Bool
x Bool -> Bool -> Bool
|| a -> Bool
predicate a
a) Bool
False forall a. a -> a
id
{-# INLINABLE any #-}

-- | Computes the sum of all elements
sum :: Num a => Fold a a
sum :: forall a. Num a => Fold a a
sum = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Num a => a -> a -> a
(+) a
0 forall a. a -> a
id
{-# INLINABLE sum #-}

-- | Computes the product of all elements
product :: Num a => Fold a a
product :: forall a. Num a => Fold a a
product = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Num a => a -> a -> a
(*) a
1 forall a. a -> a
id
{-# INLINABLE product #-}

-- | Compute a numerically stable arithmetic mean of all elements
mean :: Fractional a => Fold a a
mean :: forall a. Fractional a => Fold a a
mean = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {b}. Fractional b => Pair b b -> b -> Pair b b
step Pair a a
begin forall {a} {b}. Pair a b -> a
done
  where
    begin :: Pair a a
begin = forall a b. a -> b -> Pair a b
Pair a
0 a
0
    step :: Pair b b -> b -> Pair b b
step (Pair b
x b
n) b
y = let n' :: b
n' = b
nforall a. Num a => a -> a -> a
+b
1 in forall a b. a -> b -> Pair a b
Pair (b
x forall a. Num a => a -> a -> a
+ (b
y forall a. Num a => a -> a -> a
- b
x) forall a. Fractional a => a -> a -> a
/b
n') b
n'
    done :: Pair a b -> a
done (Pair a
x b
_) = a
x
{-# INLINABLE mean #-}

-- | Compute a numerically stable (population) variance over all elements
variance :: Fractional a => Fold a a
variance :: forall a. Fractional a => Fold a a
variance = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {c}. Fractional c => Pair3 c c c -> c -> Pair3 c c c
step Pair3 a a a
begin forall {a} {b}. Fractional a => Pair3 a b a -> a
done
  where
    begin :: Pair3 a a a
begin = forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
0 a
0 a
0

    step :: Pair3 c c c -> c -> Pair3 c c c
step (Pair3 c
n c
mean_ c
m2) c
x = forall a b c. a -> b -> c -> Pair3 a b c
Pair3 c
n' c
mean' c
m2'
      where
        n' :: c
n'     = c
n forall a. Num a => a -> a -> a
+ c
1
        mean' :: c
mean'  = (c
n forall a. Num a => a -> a -> a
* c
mean_ forall a. Num a => a -> a -> a
+ c
x) forall a. Fractional a => a -> a -> a
/ (c
n forall a. Num a => a -> a -> a
+ c
1)
        delta :: c
delta  = c
x forall a. Num a => a -> a -> a
- c
mean_
        m2' :: c
m2'    = c
m2 forall a. Num a => a -> a -> a
+ c
delta forall a. Num a => a -> a -> a
* c
delta forall a. Num a => a -> a -> a
* c
n forall a. Fractional a => a -> a -> a
/ (c
n forall a. Num a => a -> a -> a
+ c
1)

    done :: Pair3 a b a -> a
done (Pair3 a
n b
_ a
m2) = a
m2 forall a. Fractional a => a -> a -> a
/ a
n
{-# INLINABLE variance #-}

{-| Compute a numerically stable (population) standard deviation over all
    elements
-}
std :: Floating a => Fold a a
std :: forall a. Floating a => Fold a a
std = forall a. Floating a => a -> a
sqrt forall a. Fractional a => Fold a a
variance
{-# INLINABLE std #-}

-- | Computes the maximum element
maximum :: Ord a => Fold a (Maybe a)
maximum :: forall a. Ord a => Fold a (Maybe a)
maximum = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 forall a. Ord a => a -> a -> a
max
{-# INLINABLE maximum #-}

{-| Computes the maximum element with respect to the given comparison
    function
-}
maximumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)
maximumBy :: forall a. (a -> a -> Ordering) -> Fold a (Maybe a)
maximumBy a -> a -> Ordering
cmp = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
max'
  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 => Fold a (Maybe a)
minimum :: forall a. Ord a => Fold a (Maybe a)
minimum = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 forall a. Ord a => a -> a -> a
min
{-# INLINABLE minimum #-}

{-| Computes the minimum element with respect to the given comparison
    function
-}
minimumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)
minimumBy :: forall a. (a -> a -> Ordering) -> Fold a (Maybe a)
minimumBy a -> a -> Ordering
cmp = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
min'
  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 #-}

{-| @(elem a)@ returns 'True' if the container has an element equal to @a@,
    'False' otherwise
-}
elem :: Eq a => a -> Fold a Bool
elem :: forall a. Eq a => a -> Fold a Bool
elem a
a = forall a. (a -> Bool) -> Fold a Bool
any (a
a forall a. Eq a => a -> a -> Bool
==)
{-# INLINABLE elem #-}

{-| @(notElem a)@ returns 'False' if the container has an element equal to @a@,
    'True' otherwise
-}
notElem :: Eq a => a -> Fold a Bool
notElem :: forall a. Eq a => a -> Fold a Bool
notElem a
a = forall a. (a -> Bool) -> Fold a Bool
all (a
a forall a. Eq a => a -> a -> Bool
/=)
{-# INLINABLE notElem #-}

{-| @(find predicate)@ returns the first element that satisfies the predicate or
    'Nothing' if no element satisfies the predicate
-}
find :: (a -> Bool) -> Fold a (Maybe a)
find :: forall a. (a -> Bool) -> Fold a (Maybe a)
find a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe' a -> a -> Maybe' a
step forall a. Maybe' a
Nothing' forall a. Maybe' a -> Maybe a
lazy
  where
    step :: Maybe' a -> a -> Maybe' a
step Maybe' a
x a
a = case Maybe' a
x of
        Maybe' a
Nothing' -> if a -> Bool
predicate a
a then forall a. a -> Maybe' a
Just' a
a else forall a. Maybe' a
Nothing'
        Maybe' a
_        -> Maybe' a
x
{-# INLINABLE find #-}

{-| @(index n)@ returns the @n@th element of the container, or 'Nothing' if the
    container has an insufficient number of elements
-}
index :: Int -> Fold a (Maybe a)
index :: forall a. Int -> Fold a (Maybe a)
index = forall i a. Integral i => i -> Fold a (Maybe a)
genericIndex
{-# INLINABLE index #-}

{-| @(elemIndex a)@ returns the index of the first element that equals @a@, or
    'Nothing' if no element matches
-}
elemIndex :: Eq a => a -> Fold a (Maybe Int)
elemIndex :: forall a. Eq a => a -> Fold a (Maybe Int)
elemIndex a
a = forall a. (a -> Bool) -> Fold a (Maybe Int)
findIndex (a
a forall a. Eq a => a -> a -> Bool
==)
{-# INLINABLE elemIndex #-}

{-| @(findIndex predicate)@ returns the index of the first element that
    satisfies the predicate, or 'Nothing' if no element satisfies the predicate
-}
findIndex :: (a -> Bool) -> Fold a (Maybe Int)
findIndex :: forall a. (a -> Bool) -> Fold a (Maybe Int)
findIndex a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. Num a => Either' a a -> a -> Either' a a
step (forall a b. a -> Either' a b
Left' Int
0) forall a b. Either' a b -> Maybe b
hush
  where
    step :: Either' a a -> a -> Either' a a
step Either' a a
x a
a = case Either' a a
x of
        Left' a
i ->
            if a -> Bool
predicate a
a
            then forall a b. b -> Either' a b
Right' a
i
            else forall a b. a -> Either' a b
Left' (a
i forall a. Num a => a -> a -> a
+ a
1)
        Either' a a
_       -> Either' a a
x
{-# INLINABLE findIndex #-}


{-| @(lookup a)@ returns the element paired with the first matching item, or
    'Nothing' if none matches
-}
lookup :: Eq a => a -> Fold (a,b) (Maybe b)
lookup :: forall a b. Eq a => a -> Fold (a, b) (Maybe b)
lookup a
a0 = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. Maybe' a -> (a, a) -> Maybe' a
step forall a. Maybe' a
Nothing' forall a. Maybe' a -> Maybe a
lazy
  where
    step :: Maybe' a -> (a, a) -> Maybe' a
step Maybe' a
x (a
a,a
b) = case Maybe' a
x of
      Maybe' a
Nothing' -> if a
a forall a. Eq a => a -> a -> Bool
== a
a0
        then forall a. a -> Maybe' a
Just' a
b
        else forall a. Maybe' a
Nothing'
      Maybe' a
_ -> Maybe' a
x
{-# INLINABLE lookup #-}

data Pair3 a b c = Pair3 !a !b !c

-- | Pick a random element, using reservoir sampling
random :: FoldM IO a (Maybe a)
random :: forall a. FoldM IO a (Maybe a)
random = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {m :: * -> *} {c} {a} {a}.
(Monad m, RandomGen a, UniformRange c, Eq c, Num c) =>
Pair3 a (Maybe' a) c -> a -> m (Pair3 a (Maybe' a) c)
step forall {a}. IO (Pair3 StdGen (Maybe' a) Int)
begin forall {m :: * -> *} {a} {a} {c}.
Monad m =>
Pair3 a (Maybe' a) c -> m (Maybe a)
done
  where
    begin :: IO (Pair3 StdGen (Maybe' a) Int)
begin = do
        StdGen
g <- forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b c. a -> b -> c -> Pair3 a b c
Pair3 StdGen
g forall a. Maybe' a
Nothing' (Int
1 :: Int)

    step :: Pair3 a (Maybe' a) c -> a -> m (Pair3 a (Maybe' a) c)
step (Pair3 a
g Maybe' a
Nothing'  c
_) a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
g (forall a. a -> Maybe' a
Just' a
a) c
2
    step (Pair3 a
g (Just' a
a) c
m) a
b = do
        let (c
n, a
g') = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (c
1, c
m) a
g
        let c :: a
c = if c
n forall a. Eq a => a -> a -> Bool
== c
1 then a
b else a
a
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
g' (forall a. a -> Maybe' a
Just' a
c) (c
m forall a. Num a => a -> a -> a
+ c
1)

    done :: Pair3 a (Maybe' a) c -> m (Maybe a)
done (Pair3 a
_ Maybe' a
ma c
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe' a -> Maybe a
lazy Maybe' a
ma)
{-# INLINABLE random #-}

data VectorState = Incomplete {-# UNPACK #-} !Int | Complete

data RandomNState v a = RandomNState
    { forall (v :: * -> *) a. RandomNState v a -> VectorState
_size      ::                !VectorState
    , forall (v :: * -> *) a. RandomNState v a -> Mutable v RealWorld a
_reservoir ::                !(Mutable v RealWorld a)
    , forall (v :: * -> *) a. RandomNState v a -> Int
_position  :: {-# UNPACK #-} !Int
    , forall (v :: * -> *) a. RandomNState v a -> StdGen
_gen       :: {-# UNPACK #-} !StdGen
    }

-- | Pick several random elements, using reservoir sampling
randomN :: Vector v a => Int -> FoldM IO a (Maybe (v a))
randomN :: forall (v :: * -> *) a.
Vector v a =>
Int -> FoldM IO a (Maybe (v a))
randomN Int
n = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall (v :: * -> *) a.
MVector (Mutable v) a =>
RandomNState v a -> a -> IO (RandomNState v a)
step IO (RandomNState v a)
begin forall (v :: * -> *) a.
Vector v a =>
RandomNState v a -> IO (Maybe (v a))
done
  where
    step
        :: MVector (Mutable v) a
        => RandomNState v a -> a -> IO (RandomNState v a)
    step :: forall (v :: * -> *) a.
MVector (Mutable v) a =>
RandomNState v a -> a -> IO (RandomNState v a)
step (RandomNState (Incomplete Int
m) Mutable v RealWorld a
mv Int
i StdGen
g) a
a = do
        forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.write Mutable v RealWorld a
mv Int
m a
a
        let m' :: Int
m' = Int
m forall a. Num a => a -> a -> a
+ Int
1
        let s :: VectorState
s  = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
m' then VectorState
Complete else Int -> VectorState
Incomplete Int
m'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
RandomNState VectorState
s Mutable v RealWorld a
mv (Int
i forall a. Num a => a -> a -> a
+ Int
1) StdGen
g
    step (RandomNState  VectorState
Complete      Mutable v RealWorld a
mv Int
i StdGen
g) a
a = do
        let (Int
r, StdGen
g') = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0, Int
i forall a. Num a => a -> a -> a
- Int
1) StdGen
g
        if Int
r forall a. Ord a => a -> a -> Bool
< Int
n
            then forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite Mutable v RealWorld a
mv Int
r a
a
            else forall (m :: * -> *) a. Monad m => a -> m a
return ()
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
RandomNState VectorState
Complete Mutable v RealWorld a
mv (Int
i forall a. Num a => a -> a -> a
+ Int
1) StdGen
g')

    begin :: IO (RandomNState v a)
begin = do
        Mutable v (PrimState IO) a
mv  <- forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.new Int
n
        StdGen
gen <- forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
        let s :: VectorState
s = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 then VectorState
Complete else Int -> VectorState
Incomplete Int
0
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
RandomNState VectorState
s Mutable v (PrimState IO) a
mv Int
1 StdGen
gen)

    done :: Vector v a => RandomNState v a -> IO (Maybe (v a))
    done :: forall (v :: * -> *) a.
Vector v a =>
RandomNState v a -> IO (Maybe (v a))
done (RandomNState (Incomplete Int
_) Mutable v RealWorld a
_  Int
_ StdGen
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    done (RandomNState  VectorState
Complete      Mutable v RealWorld a
mv Int
_ StdGen
_) = do
        v a
v <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
V.freeze Mutable v RealWorld a
mv
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just v a
v)

-- | Converts an effectful function to a fold. Specialized version of 'sink'.
mapM_ :: Monad m => (a -> m ()) -> FoldM m a ()
mapM_ :: forall (m :: * -> *) a. Monad m => (a -> m ()) -> FoldM m a ()
mapM_ = forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(a -> m w) -> FoldM m a w
sink
{-# INLINABLE mapM_ #-}

{-| Converts an effectful function to a fold

> sink (f <> g) = sink f <> sink g -- if `(<>)` is commutative
> sink mempty = mempty
-}


sink ::  (Monoid w, Monad m) => (a -> m w) -> FoldM m a w
sink :: forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(a -> m w) -> FoldM m a w
sink a -> m w
act = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM w -> a -> m w
step m w
begin forall {a}. a -> m a
done  where
  done :: a -> m a
done = forall (m :: * -> *) a. Monad m => a -> m a
return
  begin :: m w
begin = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  step :: w -> a -> m w
step w
m a
a = do
    w
m' <- a -> m w
act a
a
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a -> a -> a
mappend w
m w
m'
{-# INLINABLE sink #-}

-- | Like 'length', except with a more general 'Num' return value
genericLength :: Num b => Fold a b
genericLength :: forall b a. Num b => Fold a b
genericLength = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\b
n a
_ -> b
n forall a. Num a => a -> a -> a
+ b
1) b
0 forall a. a -> a
id
{-# INLINABLE genericLength #-}

-- | Like 'index', except with a more general 'Integral' argument
genericIndex :: Integral i => i -> Fold a (Maybe a)
genericIndex :: forall i a. Integral i => i -> Fold a (Maybe a)
genericIndex i
i = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {b}. Either' i b -> b -> Either' i b
step (forall a b. a -> Either' a b
Left' i
0) forall a b. Either' a b -> Maybe b
done
  where
    step :: Either' i b -> b -> Either' i b
step Either' i b
x b
a = case Either' i b
x of
        Left'  i
j -> if i
i forall a. Eq a => a -> a -> Bool
== i
j then forall a b. b -> Either' a b
Right' b
a else forall a b. a -> Either' a b
Left' (i
j forall a. Num a => a -> a -> a
+ i
1)
        Either' i b
_        -> Either' i b
x
    done :: Either' a a -> Maybe a
done Either' a a
x = case Either' a a
x of
        Left'  a
_ -> forall a. Maybe a
Nothing
        Right' a
a -> forall a. a -> Maybe a
Just a
a
{-# INLINABLE genericIndex #-}

-- | Fold all values into a list
list :: Fold a [a]
list :: forall a. Fold a [a]
list = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\[a] -> [a]
x a
a -> [a] -> [a]
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
aforall a. a -> [a] -> [a]
:)) forall a. a -> a
id (forall a b. (a -> b) -> a -> b
$ [])
{-# INLINABLE list #-}

-- | Fold all values into a list, in reverse order
revList :: Fold a [a]
revList :: forall a. Fold a [a]
revList = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\[a]
x a
a -> a
aforall a. a -> [a] -> [a]
:[a]
x) [] forall a. a -> a
id
{-# INLINABLE revList #-}

{-| /O(n log n)/.  Fold values into a list with duplicates removed, while
    preserving their first occurrences
-}
nub :: Ord a => Fold a [a]
nub :: forall a. Ord a => Fold a [a]
nub = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a} {c}.
Ord a =>
Pair (Set a) ([a] -> c) -> a -> Pair (Set a) ([a] -> c)
step (forall a b. a -> b -> Pair a b
Pair forall a. Set a
Set.empty forall a. a -> a
id) forall {a} {a} {t}. Pair a ([a] -> t) -> t
fin
  where
    step :: Pair (Set a) ([a] -> c) -> a -> Pair (Set a) ([a] -> c)
step (Pair Set a
s [a] -> c
r) a
a = if forall a. Ord a => a -> Set a -> Bool
Set.member a
a Set a
s
      then forall a b. a -> b -> Pair a b
Pair Set a
s [a] -> c
r
      else forall a b. a -> b -> Pair a b
Pair (forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
s) ([a] -> c
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall a. a -> [a] -> [a]
:))
    fin :: Pair a ([a] -> t) -> t
fin (Pair a
_ [a] -> t
r) = [a] -> t
r []
{-# INLINABLE nub #-}

{-| /O(n^2)/.  Fold values into a list with duplicates removed, while preserving
    their first occurrences
-}
eqNub :: Eq a => Fold a [a]
eqNub :: forall a. Eq a => Fold a [a]
eqNub = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a} {c}.
Eq a =>
Pair [a] ([a] -> c) -> a -> Pair [a] ([a] -> c)
step (forall a b. a -> b -> Pair a b
Pair [] forall a. a -> a
id) forall {a} {a} {t}. Pair a ([a] -> t) -> t
fin
  where
    step :: Pair [a] ([a] -> c) -> a -> Pair [a] ([a] -> c)
step (Pair [a]
known [a] -> c
r) a
a = if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem a
a [a]
known
      then forall a b. a -> b -> Pair a b
Pair [a]
known [a] -> c
r
      else forall a b. a -> b -> Pair a b
Pair (a
a forall a. a -> [a] -> [a]
: [a]
known) ([a] -> c
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall a. a -> [a] -> [a]
:))
    fin :: Pair a ([a] -> t) -> t
fin (Pair a
_ [a] -> t
r) = [a] -> t
r []
{-# INLINABLE eqNub #-}

-- | Fold values into a set
set :: Ord a => Fold a (Set.Set a)
set :: forall a. Ord a => Fold a (Set a)
set = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.insert) forall a. Set a
Set.empty forall a. a -> a
id
{-# INLINABLE set #-}

-- | Fold values into a hash-set
hashSet :: (Eq a, Hashable a) => Fold a (HashSet.HashSet a)
hashSet :: forall a. (Eq a, Hashable a) => Fold a (HashSet a)
hashSet = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert) forall a. HashSet a
HashSet.empty forall a. a -> a
id
{-# INLINABLE hashSet #-}

{-|
Fold pairs into a map.
-}
map :: Ord a => Fold (a, b) (Map.Map a b)
map :: forall a b. Ord a => Fold (a, b) (Map a b)
map = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {k} {a}. Ord k => Map k a -> (k, a) -> Map k a
step Map a b
begin forall a. a -> a
done
  where
    begin :: Map a b
begin = forall a. Monoid a => a
mempty
    step :: Map k a -> (k, a) -> Map k a
step Map k a
m (k
k, a
v) = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k a
v Map k a
m
    done :: a -> a
done = forall a. a -> a
id
{-# INLINABLE map #-}


{- | Given a 'Fold', produces a 'Map' which applies that fold to each @a@ separated by key @k@.

>>> fold (foldByKeyMap Control.Foldl.sum) [("a",1), ("b",2), ("b",20), ("a",10)]
fromList [("a",11),("b",22)]
-}
foldByKeyMap :: forall k a b. Ord k => Fold a b -> Fold (k, a) (Map k b)
foldByKeyMap :: forall k a b. Ord k => Fold a b -> Fold (k, a) (Map k b)
foldByKeyMap Fold a b
f = case Fold a b
f of
  Fold (x -> a -> x
step0 :: x -> a -> x) (x
ini0 :: x) (x -> b
end0 :: x -> b) ->
    let
      step :: Map k x -> (k,a) -> Map k x
      step :: Map k x -> (k, a) -> Map k x
step Map k x
mp (k
k,a
a) = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe x -> Maybe x
addToMap k
k Map k x
mp where
        addToMap :: Maybe x -> Maybe x
addToMap Maybe x
Nothing         = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
ini0 a
a
        addToMap (Just x
existing) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
existing a
a

      ini :: Map k x
      ini :: Map k x
ini = forall k a. Map k a
Map.empty

      end :: Map k x -> Map k b
      end :: Map k x -> Map k b
end = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
end0
    in forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Map k x -> (k, a) -> Map k x
step Map k x
ini Map k x -> Map k b
end where

{-|
Fold pairs into a hash-map.
-}
hashMap :: (Eq a, Hashable a) => Fold (a, b) (HashMap.HashMap a b)
hashMap :: forall a b. (Eq a, Hashable a) => Fold (a, b) (HashMap a b)
hashMap = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {k} {v}. Hashable k => HashMap k v -> (k, v) -> HashMap k v
step HashMap a b
begin forall a. a -> a
done
  where
    begin :: HashMap a b
begin = forall a. Monoid a => a
mempty
    step :: HashMap k v -> (k, v) -> HashMap k v
step HashMap k v
m (k
k, v
v) = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
k v
v HashMap k v
m
    done :: a -> a
done = forall a. a -> a
id
{-# INLINABLE hashMap #-}

{- | Given a 'Fold', produces a 'HashMap' which applies that fold to each @a@ separated by key @k@.

>>> List.sort (HashMap.toList (fold (foldByKeyHashMap Control.Foldl.sum) [("a",1), ("b",2), ("b",20), ("a",10)]))
[("a",11),("b",22)]
-}
foldByKeyHashMap :: forall k a b. (Hashable k, Eq k) => Fold a b -> Fold (k, a) (HashMap k b)
foldByKeyHashMap :: forall k a b.
(Hashable k, Eq k) =>
Fold a b -> Fold (k, a) (HashMap k b)
foldByKeyHashMap Fold a b
f = case Fold a b
f of
  Fold (x -> a -> x
step0 :: x -> a -> x) (x
ini0 :: x) (x -> b
end0 :: x -> b) ->
    let
      step :: HashMap k x -> (k,a) -> HashMap k x
      step :: HashMap k x -> (k, a) -> HashMap k x
step HashMap k x
mp (k
k,a
a) = forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMap.alter Maybe x -> Maybe x
addToHashMap k
k HashMap k x
mp where
        addToHashMap :: Maybe x -> Maybe x
addToHashMap Maybe x
Nothing         = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
ini0 a
a
        addToHashMap (Just x
existing) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
existing a
a

      ini :: HashMap k x
      ini :: HashMap k x
ini = forall k v. HashMap k v
HashMap.empty

      end :: HashMap k x -> HashMap k b
      end :: HashMap k x -> HashMap k b
end = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
end0
    in forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold HashMap k x -> (k, a) -> HashMap k x
step HashMap k x
ini HashMap k x -> HashMap k b
end where

-- | Fold all values into a vector
vector :: Vector v a => Fold a (v a)
vector :: forall (v :: * -> *) a. Vector v a => Fold a (v a)
vector = forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
V.fromReverseListN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Fold a Int
length forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Fold a [a]
revList
{-# INLINABLE vector #-}

maxChunkSize :: Int
maxChunkSize :: Int
maxChunkSize = Int
8 forall a. Num a => a -> a -> a
* Int
1024 forall a. Num a => a -> a -> a
* Int
1024

{-| Fold all values into a vector

    This is more efficient than `vector` but is impure
-}
vectorM :: (PrimMonad m, Vector v a) => FoldM m a (v a)
vectorM :: forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
FoldM m a (v a)
vectorM = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {m :: * -> *} {v :: * -> * -> *} {a}.
(PrimMonad m, MVector v a) =>
Pair (v (PrimState m) a) Int
-> a -> m (Pair (v (PrimState m) a) Int)
step m (Pair (Mutable v (PrimState m) a) Int)
begin forall {m :: * -> *} {v :: * -> *} {a}.
(PrimMonad m, Vector v a) =>
Pair (Mutable v (PrimState m) a) Int -> m (v a)
done
  where
    begin :: m (Pair (Mutable v (PrimState m) a) Int)
begin = do
        Mutable v (PrimState m) a
mv <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.unsafeNew Int
10
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair Mutable v (PrimState m) a
mv Int
0)
    step :: Pair (v (PrimState m) a) Int
-> a -> m (Pair (v (PrimState m) a) Int)
step (Pair v (PrimState m) a
mv Int
idx) a
a = do
        let len :: Int
len = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.length v (PrimState m) a
mv
        v (PrimState m) a
mv' <- if Int
idx forall a. Ord a => a -> a -> Bool
>= Int
len
            then forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.unsafeGrow v (PrimState m) a
mv (forall a. Ord a => a -> a -> a
min Int
len Int
maxChunkSize)
            else forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) a
mv
        forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite v (PrimState m) a
mv' Int
idx a
a
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair v (PrimState m) a
mv' (Int
idx forall a. Num a => a -> a -> a
+ Int
1))
    done :: Pair (Mutable v (PrimState m) a) Int -> m (v a)
done (Pair Mutable v (PrimState m) a
mv Int
idx) = do
        v a
v <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
V.freeze Mutable v (PrimState m) a
mv
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.unsafeTake Int
idx v a
v)
{-# INLINABLE vectorM #-}

{- $utilities
    'purely' and 'impurely' allow you to write folds compatible with the @foldl@
    library without incurring a @foldl@ dependency.  Write your fold to accept
    three parameters corresponding to the step function, initial
    accumulator, and extraction function and then users can upgrade your
    function to accept a 'Fold' or 'FoldM' using the 'purely' or 'impurely'
    combinators.

    For example, the @pipes@ library implements @fold@ and @foldM@ functions in
    @Pipes.Prelude@ with the following type:

> Pipes.Prelude.fold
>     :: Monad m
>     -> (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
>
> Pipes.Prelude.foldM
>     :: Monad m
>     => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b

    Both @fold@ and @foldM@ is set up so that you can wrap them with either
    'purely' or 'impurely' to accept a 'Fold' or 'FoldM', respectively:

> purely Pipes.Prelude.fold
>     :: Monad m => Fold a b -> Producer a m () -> m b
>
> impurely Pipes.Prelude.foldM
>     :: Monad m => FoldM m a b -> Producer a m () -> m b

    Other streaming libraries supporting 'purely' and 'impurely' include @io-streams@ and @streaming@.
    So for example we have:

> purely System.IO.Streams.fold_
>     :: Fold a b -> Streams.InputStream a -> IO b
>
> impurely System.IO.Streams.foldM_
>     :: FoldM IO a b -> Streams.InputStream a -> IO b

    The @monotraversable@ package makes it convenient to apply a
    'Fold' or 'FoldM' to pure containers that do not allow
    a general 'Foldable' instance, like unboxed vectors:

> purely ofoldlUnwrap
>     :: MonoFoldable mono
>     => Fold (Element mono) b -> mono -> b
>
> impurely ofoldMUnwrap
>     :: MonoFoldable mono
>     => FoldM m (Element mono) b -> mono -> m b
-}

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

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

-- | Upgrade a monadic fold to accept the 'FoldM' type
impurely
    :: (forall x . (x -> a -> m x) -> m x -> (x -> m b) -> r)
    -> FoldM m a b
    -> r
impurely :: forall a (m :: * -> *) b r.
(forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r)
-> FoldM m a b -> r
impurely forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r
f (FoldM x -> a -> m x
step m x
begin x -> m b
done) = forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r
f x -> a -> m x
step m x
begin x -> m b
done
{-# INLINABLE impurely #-}

-- | Upgrade a more traditional monadic fold to accept the `FoldM` type
impurely_
    :: Monad m
    => (forall x . (x -> a -> m x) -> m x -> m x) -> FoldM m a b -> m b
impurely_ :: forall (m :: * -> *) a b.
Monad m =>
(forall x. (x -> a -> m x) -> m x -> m x) -> FoldM m a b -> m b
impurely_ forall x. (x -> a -> m x) -> m x -> m x
f (FoldM x -> a -> m x
step m x
begin x -> m b
done) = do
    x
x <- forall x. (x -> a -> m x) -> m x -> m x
f x -> a -> m x
step m x
begin
    x -> m b
done x
x
{-# INLINABLE impurely_ #-}

{-| Generalize a `Fold` to a `FoldM`

> generalize (pure r) = pure r
>
> generalize (f <*> x) = generalize f <*> generalize x
-}
generalize :: Monad m => Fold a b -> FoldM m a b
generalize :: forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
generalize (Fold x -> a -> x
step x
begin x -> b
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {m :: * -> *}. Monad m => x -> a -> m x
step' m x
begin' forall {m :: * -> *}. Monad m => x -> m b
done'
  where
    step' :: x -> a -> m x
step' x
x a
a = forall (m :: * -> *) a. Monad m => a -> m a
return (x -> a -> x
step x
x a
a)
    begin' :: m x
begin'    = forall (m :: * -> *) a. Monad m => a -> m a
return  x
begin
    done' :: x -> m b
done' x
x   = forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x)
{-# INLINABLE generalize #-}

{-| Simplify a pure `FoldM` to a `Fold`

> simplify (pure r) = pure r
>
> simplify (f <*> x) = simplify f <*> simplify x
-}
simplify :: FoldM Identity a b -> Fold a b
simplify :: forall a b. FoldM Identity a b -> Fold a b
simplify (FoldM x -> a -> Identity x
step Identity x
begin x -> Identity b
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin' x -> b
done'
  where
    step' :: x -> a -> x
step' x
x a
a = forall a. Identity a -> a
runIdentity (x -> a -> Identity x
step x
x a
a)
    begin' :: x
begin'    = forall a. Identity a -> a
runIdentity  Identity x
begin
    done' :: x -> b
done' x
x   = forall a. Identity a -> a
runIdentity (x -> Identity b
done x
x)
{-# INLINABLE simplify #-}

{- | Shift a 'FoldM' from one monad to another with a morphism such as 'lift' or 'liftIO';
     the effect is the same as 'Control.Monad.Morph.hoist'.
-}
hoists :: (forall x . m x -> n x) -> FoldM m a b -> FoldM n a b
hoists :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> FoldM m a b -> FoldM n a b
hoists forall x. m x -> n x
phi (FoldM x -> a -> m x
step m x
begin x -> m b
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\x
a a
b -> forall x. m x -> n x
phi (x -> a -> m x
step x
a a
b)) (forall x. m x -> n x
phi m x
begin) (forall x. m x -> n x
phi forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m b
done)
{-# INLINABLE hoists #-}

{-| Allows to continue feeding a 'FoldM' even after passing it to a function
that closes it.

For pure 'Fold's, this is provided by the 'Control.Comonad.Comonad' instance.
-}
duplicateM :: Applicative m => FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM :: forall (m :: * -> *) a b.
Applicative m =>
FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM (FoldM x -> a -> m x
step m x
begin x -> m b
done) =
    forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step m x
begin (\x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step (forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x) x -> m b
done))
{-# INLINABLE duplicateM #-}

{-| @_Fold1 step@ returns a new 'Fold' using just a step function that has the
same type for the accumulator and the element. The result type is the
accumulator type wrapped in 'Maybe'. The initial accumulator is retrieved from
the 'Foldable', the result is 'None' for empty containers.
 -}
_Fold1 :: (a -> a -> a) -> Fold a (Maybe a)
_Fold1 :: forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
step = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe' a -> a -> Maybe' a
step_ forall a. Maybe' a
Nothing' forall a. Maybe' a -> Maybe a
lazy
  where
    step_ :: Maybe' a -> a -> Maybe' a
step_ Maybe' a
mx a
a = forall a. a -> Maybe' a
Just' (case Maybe' a
mx of
        Maybe' a
Nothing' -> a
a
        Just' a
x -> a -> a -> a
step a
x a
a)
{-# INLINABLE _Fold1 #-}

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

> fold (premap f folder) list = fold folder (List.map f list)

>>> fold (premap Sum Foldl.mconcat) [1..10]
Sum {getSum = 55}

>>> fold Foldl.mconcat (List.map Sum [1..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) -> Fold b r -> Fold a r
premap :: forall a b c. (a -> b) -> Fold b c -> Fold a c
premap a -> b
f (Fold x -> b -> x
step x
begin x -> r
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin x -> r
done
  where
    step' :: x -> a -> x
step' x
x a
a = x -> b -> x
step x
x (a -> b
f a
a)
{-# INLINABLE premap #-}

{-| @(premapM f folder)@ returns a new 'FoldM' where f is applied to each input
    element

> premapM return = id
>
> premapM (f <=< g) = premap g . premap f

> premapM k (pure r) = pure r
>
> premapM k (f <*> x) = premapM k f <*> premapM k x
-}
premapM :: Monad m => (a -> m b) -> FoldM m b r -> FoldM m a r
premapM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> FoldM m b r -> FoldM m a r
premapM a -> m b
f (FoldM x -> b -> m x
step m x
begin x -> m r
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m r
done
  where
    step' :: x -> a -> m x
step' x
x a
a = a -> m b
f a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> b -> m x
step x
x
{-# INLINABLE premapM #-}

{-| @(prefilter f folder)@ returns a new 'Fold' where the folder's input is used
  only when the input satisfies a predicate f

  This can also be done with 'handles' (@handles (filtered f)@) but @prefilter@
  does not need you to depend on a lens library.

> fold (prefilter p folder) list = fold folder (filter p list)

>>> fold (prefilter (>5) Control.Foldl.sum) [1..10]
40

>>> fold Control.Foldl.sum (filter (>5) [1..10])
40
-}
prefilter :: (a -> Bool) -> Fold a r -> Fold a r
prefilter :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
prefilter a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin x -> r
done
  where
    step' :: x -> a -> x
step' x
x a
a = if a -> Bool
f a
a then x -> a -> x
step x
x a
a else x
x
{-# INLINABLE prefilter #-}

{-| @(prefilterM f folder)@ returns a new 'FoldM' where the folder's input is used
  only when the input satisfies a monadic predicate f.
-}
prefilterM :: (Monad m) => (a -> m Bool) -> FoldM m a r -> FoldM m a r
prefilterM :: forall (m :: * -> *) a r.
Monad m =>
(a -> m Bool) -> FoldM m a r -> FoldM m a r
prefilterM a -> m Bool
f (FoldM x -> a -> m x
step m x
begin x -> m r
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m r
done
  where
    step' :: x -> a -> m x
step' x
x a
a = do
      Bool
use <- a -> m Bool
f a
a
      if Bool
use then x -> a -> m x
step x
x a
a else forall (m :: * -> *) a. Monad m => a -> m a
return x
x
{-# INLINABLE prefilterM #-}

{-| Transforms a 'Fold' into one which ignores elements
    until they stop satisfying a predicate

> fold (predropWhile p folder) list = fold folder (dropWhile p list)

>>> fold (predropWhile (>5) Control.Foldl.sum) [10,9,5,9]
14
-}
predropWhile :: (a -> Bool) -> Fold a r -> Fold a r
predropWhile :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
predropWhile a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair Bool x -> a -> Pair Bool x
step' Pair Bool x
begin' forall {a}. Pair a x -> r
done'
  where
    step' :: Pair Bool x -> a -> Pair Bool x
step' (Pair Bool
dropping x
x) a
a = if Bool
dropping Bool -> Bool -> Bool
&& a -> Bool
f a
a
      then forall a b. a -> b -> Pair a b
Pair Bool
True x
x
      else forall a b. a -> b -> Pair a b
Pair Bool
False (x -> a -> x
step x
x a
a)
    begin' :: Pair Bool x
begin' = forall a b. a -> b -> Pair a b
Pair Bool
True x
begin
    done' :: Pair a x -> r
done' (Pair a
_ x
state) = x -> r
done x
state
{-# INLINABLE predropWhile #-}

{-| @(drop n folder)@ returns a new 'Fold' that ignores the first @n@ inputs but
otherwise behaves the same as the original fold.

> fold (drop n folder) list = fold folder (Data.List.genericDrop n list)

>>> Foldl.fold (Foldl.drop 3 Foldl.sum) [10, 20, 30, 1, 2, 3]
6

>>> Foldl.fold (Foldl.drop 10 Foldl.sum) [10, 20, 30, 1, 2, 3]
0
-}

drop :: Natural -> Fold a b -> Fold a b
drop :: forall a b. Natural -> Fold a b -> Fold a b
drop Natural
n (Fold x -> a -> x
step x
begin x -> b
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. (Eq a, Num a) => (a, x) -> a -> (a, x)
step' (Natural, x)
begin' forall {a}. (a, x) -> b
done'
  where
    begin' :: (Natural, x)
begin'          = (Natural
n, x
begin)
    step' :: (a, x) -> a -> (a, x)
step' (a
0,  x
s) a
x = (a
0, x -> a -> x
step x
s a
x)
    step' (a
n', x
s) a
_ = (a
n' forall a. Num a => a -> a -> a
- a
1, x
s)
    done' :: (a, x) -> b
done' (a
_,  x
s)   = x -> b
done x
s
{-# INLINABLE drop #-}

{-| @(dropM n folder)@ returns a new 'FoldM' that ignores the first @n@ inputs but
otherwise behaves the same as the original fold.

> foldM (dropM n folder) list = foldM folder (Data.List.genericDrop n list)

>>> Foldl.foldM (Foldl.dropM 3 (Foldl.generalize Foldl.sum)) [10, 20, 30, 1, 2, 3]
6

>>> Foldl.foldM (Foldl.dropM 10 (Foldl.generalize Foldl.sum)) [10, 20, 30, 1, 2, 3]
0
-}

dropM :: Monad m => Natural -> FoldM m a b -> FoldM m a b
dropM :: forall (m :: * -> *) a b.
Monad m =>
Natural -> FoldM m a b -> FoldM m a b
dropM Natural
n (FoldM x -> a -> m x
step m x
begin x -> m b
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {a}. (Eq a, Num a) => (a, x) -> a -> m (a, x)
step' m (Natural, x)
begin' forall {a}. (a, x) -> m b
done'
  where
    begin' :: m (Natural, x)
begin'          = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
s  -> (Natural
n, x
s))  m x
begin
    step' :: (a, x) -> a -> m (a, x)
step' (a
0,  x
s) a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
s' -> (a
0, x
s')) (x -> a -> m x
step x
s a
x)
    step' (a
n', x
s) a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (a
n' forall a. Num a => a -> a -> a
- a
1, x
s)
    done' :: (a, x) -> m b
done' (a
_,  x
s)   = x -> m b
done x
s
{-# INLINABLE dropM #-}

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

    Any lens, traversal, or prism will type-check as a `Handler`
-}
type Handler a b =
    forall x . (b -> Const (Dual (Endo x)) b) -> a -> Const (Dual (Endo x)) a

{-| @(handles t folder)@ transforms the input of a `Fold` using a lens,
    traversal, or prism:

> handles _1       :: Fold a r -> Fold (a, b) r
> handles _Left    :: Fold a r -> Fold (Either a b) r
> handles traverse :: Traversable t => Fold a r -> Fold (t a) r
> handles folded   :: Foldable    t => Fold a r -> Fold (t a) r

>>> fold (handles traverse sum) [[1..5],[6..10]]
55

>>> fold (handles (traverse.traverse) sum) [[Nothing, Just 2, Just 7],[Just 13, Nothing, Just 20]]
42

>>> fold (handles (filtered even) sum) [1..10]
30

>>> fold (handles _2 Foldl.mconcat) [(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 :: Handler a b -> Fold b r -> Fold a r
handles :: forall a b r. Handler a b -> Fold b r -> Fold a r
handles Handler a b
k (Fold x -> b -> x
step x
begin x -> r
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin x -> r
done
  where
    step' :: x -> a -> x
step' = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler a b
k (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> b -> x
step))
{-# INLINABLE handles #-}

{- | @(foldOver f folder xs)@ folds all values from a Lens, Traversal, Prism or Fold with the given folder

>>> foldOver (_Just . both) Foldl.sum (Just (2, 3))
5

>>> foldOver (_Just . both) Foldl.sum Nothing
0

> Foldl.foldOver f folder xs == Foldl.fold folder (xs^..f)

> Foldl.foldOver (folded.f) folder == Foldl.fold (handles f folder)

> Foldl.foldOver folded == Foldl.fold

-}
foldOver :: Handler s a -> Fold a b -> s -> b
foldOver :: forall s a b. Handler s a -> Fold a b -> s -> b
foldOver Handler s a
l (Fold x -> a -> x
step x
begin x -> b
done) =
  x -> b
done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo x
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler s a
l (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> a -> x
step)
{-# INLINABLE foldOver #-}

{-|
> instance Monad m => Monoid (EndoM m a) where
>     mempty = EndoM return
>     mappend (EndoM f) (EndoM g) = EndoM (f <=< g)
-}
newtype EndoM m a = EndoM { forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM :: a -> m a }

instance Monad m => Semigroup (EndoM m a) where
    (EndoM a -> m a
f) <> :: EndoM m a -> EndoM m a -> EndoM m a
<> (EndoM a -> m a
g) = forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM (a -> m a
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m a
g)
    {-# INLINE (<>) #-}

instance Monad m => Monoid (EndoM m a) where
    mempty :: EndoM m a
mempty = forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# INLINE mempty #-}

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

{-| A Handler for the upstream input of `FoldM`

    Any lens, traversal, or prism will type-check as a `HandlerM`
-}
type HandlerM m a b =
    forall x . (b -> Const (Dual (EndoM m x)) b) -> a -> Const (Dual (EndoM m x)) a

{-| @(handlesM t folder)@ transforms the input of a `FoldM` using a lens,
    traversal, or prism:

> handlesM _1       :: FoldM m a r -> FoldM (a, b) r
> handlesM _Left    :: FoldM m a r -> FoldM (Either a b) r
> handlesM traverse :: Traversable t => FoldM m a r -> FoldM m (t a) r
> handlesM folded   :: Foldable    t => FoldM m a r -> FoldM m (t a) r

    `handlesM` obeys these laws:

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

> handlesM t (pure r) = pure r
>
> handlesM t (f <*> x) = handlesM t f <*> handlesM t x
-}
handlesM :: HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM :: forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM HandlerM m a b
k (FoldM x -> b -> m x
step m x
begin x -> m r
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m r
done
  where
    step' :: x -> a -> m x
step' = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerM m a b
k (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> b -> m x
step))
{-# INLINABLE handlesM #-}

{- | @(foldOverM f folder xs)@ folds all values from a Lens, Traversal, Prism or Fold monadically with the given folder

> Foldl.foldOverM (folded.f) folder == Foldl.foldM (handlesM f folder)

> Foldl.foldOverM folded == Foldl.foldM

-}
foldOverM :: Monad m => HandlerM m s a -> FoldM m a b -> s -> m b
foldOverM :: forall (m :: * -> *) s a b.
Monad m =>
HandlerM m s a -> FoldM m a b -> s -> m b
foldOverM HandlerM m s a
l (FoldM x -> a -> m x
step m x
begin x -> m b
done) s
s = do
  x
b <- m x
begin
  x
r <- (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM x
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerM m s a
l (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> a -> m x
step)) s
s
  x -> m b
done x
r
{-# INLINABLE foldOverM #-}

{-|
> folded :: Foldable t => Fold (t a) a
>
> handles folded :: Foldable t => Fold a r -> Fold (t a) r
-}
folded
    :: (Contravariant f, Applicative f, Foldable t)
    => (a -> f a) -> (t a -> f (t a))
folded :: forall (f :: * -> *) (t :: * -> *) a.
(Contravariant f, Applicative f, Foldable t) =>
(a -> f a) -> t a -> f (t a)
folded a -> f a
k t a
ts = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\t a
_ -> ()) (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
F.traverse_ a -> f a
k t a
ts)
{-# INLINABLE folded #-}

{-|
>>> fold (handles (filtered even) sum) [1..10]
30

>>> foldM (handlesM (filtered even) (Foldl.mapM_ print)) [1..10]
2
4
6
8
10

-}
filtered :: Monoid m => (a -> Bool) -> (a -> m) -> a -> m
filtered :: forall m a. Monoid m => (a -> Bool) -> (a -> m) -> a -> m
filtered a -> Bool
p a -> m
k a
x
    | a -> Bool
p a
x = a -> m
k a
x
    | Bool
otherwise = forall a. Monoid a => a
mempty
{-# INLINABLE filtered #-}

{-| Perform a 'Fold' while grouping the data according to a specified group
projection function. Returns the folded result grouped as a map keyed by the
group.

-}
groupBy :: Ord g => (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy :: forall g a r. Ord g => (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy a -> g
grouper (Fold x -> a -> x
f x
i x -> r
e) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Map g x -> a -> Map g x
f' forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> r
e)
  where
    f' :: Map g x -> a -> Map g x
f' !Map g x
m !a
a = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter (\Maybe x
o -> forall a. a -> Maybe a
Just (x -> a -> x
f (forall a. a -> Maybe a -> a
fromMaybe x
i Maybe x
o) a
a)) (a -> g
grouper a
a) Map g x
m
{-# INLINABLE groupBy #-}

{-| Combine two folds into a fold over inputs for either of them.
-}
either :: Fold a1 b1 -> Fold a2 b2 -> Fold (Either a1 a2) (b1, b2)
either :: forall a1 b1 a2 b2.
Fold a1 b1 -> Fold a2 b2 -> Fold (Either a1 a2) (b1, b2)
either Fold a1 b1
l Fold a2 b2
r = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b r. Handler a b -> Fold b r -> Fold a r
handles forall a c b. Prism (Either a c) (Either b c) a b
_Left Fold a1 b1
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b r. Handler a b -> Fold b r -> Fold a r
handles forall c a b. Prism (Either c a) (Either c b) a b
_Right Fold a2 b2
r
{-# INLINABLE either #-}

{-| Combine two monadic folds into a fold over inputs for either of them.
-}
eitherM :: Monad m => FoldM m a1 b1 -> FoldM m a2 b2 -> FoldM m (Either a1 a2) (b1, b2)
eitherM :: forall (m :: * -> *) a1 b1 a2 b2.
Monad m =>
FoldM m a1 b1 -> FoldM m a2 b2 -> FoldM m (Either a1 a2) (b1, b2)
eitherM FoldM m a1 b1
l FoldM m a2 b2
r = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM forall a c b. Prism (Either a c) (Either b c) a b
_Left FoldM m a1 b1
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM forall c a b. Prism (Either c a) (Either c b) a b
_Right FoldM m a2 b2
r
{-# INLINABLE eitherM #-}

{-| Nest a fold in an applicative.
-}
nest :: Applicative f => Fold a b -> Fold (f a) (f b)
nest :: forall (f :: * -> *) a b.
Applicative f =>
Fold a b -> Fold (f a) (f b)
nest (Fold x -> a -> x
s x
i x -> b
e) =
    forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\f x
xs f a
as -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> a -> x
s f x
xs f a
as)
         (forall (f :: * -> *) a. Applicative f => a -> f a
pure x
i)
         (\f x
xs -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
e f x
xs)
{-# INLINABLE nest #-}

{- $reexports
    @Control.Monad.Primitive@ re-exports the 'PrimMonad' type class

    @Data.Foldable@ re-exports the 'Foldable' type class

    @Data.Vector.Generic@ re-exports the 'Vector' type class
-}