{-| 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 L

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

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

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

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

    Taking the sum, the sum of squares, ..., upto the sum of x^5

>>> import Data.Traversable
>>> let powerSums = sequenceA [L.premap (^n) L.sum | n <- [1..5]]
>>> L.fold powerSums [1..10]
[55,385,3025,25333,220825]

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

>>> L.fold average [1..10000000]
5000000.5
>>> L.fold ((,) <$> L.minimum <*> L.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 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.Semigroup (Semigroup(..))
import Data.Semigroupoid (Semigroupoid)
import Data.Profunctor
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.MWC (GenIO, createSystemRandom, 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 L

>>> _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 :: (a -> b) -> Fold a a -> Fold a b
fmap a -> b
f (Fold x -> a -> x
step x
begin x -> a
done) = (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
begin (a -> b
f (a -> b) -> (x -> a) -> x -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
done)
    {-# INLINE fmap #-}

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

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

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

    duplicate :: Fold a a -> Fold a (Fold a a)
duplicate (Fold x -> a -> x
step x
begin x -> a
done) = (x -> a -> x) -> x -> (x -> Fold a a) -> Fold a (Fold a a)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step x
begin (\x
x -> (x -> a -> x) -> x -> (x -> a) -> Fold a a
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 :: a -> Fold a a
pure a
b    = (() -> a -> ()) -> () -> (() -> a) -> Fold a a
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) <*> :: 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 = x -> x -> Pair x x
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 = x -> x -> Pair x x
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  (Pair x x -> a -> Pair x x)
-> Pair x x -> (Pair x x -> b) -> Fold a b
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 Semigroup b => Semigroup (Fold a b) where
    <> :: Fold a b -> Fold a b -> Fold a b
(<>) = (b -> b -> b) -> 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 b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE (<>) #-}

instance Semigroupoid Fold where
    o :: 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) = (Pair x x -> i -> Pair x x)
-> Pair x x -> (Pair x x -> k1) -> Fold i k1
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold
        Pair x x -> i -> Pair x x
step
        (x -> x -> Pair x x
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  x -> x -> Pair x x
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 = b -> Fold a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

    mappend :: Fold a b -> Fold a b -> Fold a b
mappend = (b -> b -> b) -> 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 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend
    {-# INLINE mappend #-}

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

    negate :: Fold a b -> Fold a b
negate = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
abs = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
signum = (b -> b) -> Fold a b -> Fold 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 #-}

    + :: Fold a b -> Fold a b -> Fold a b
(+) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}

    * :: Fold a b -> Fold a b -> Fold a b
(*) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}

    (-) = (b -> b -> b) -> 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 (-)
    {-# INLINE (-) #-}

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

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

    / :: Fold a b -> Fold a b -> Fold a b
(/) = (b -> b -> b) -> 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 b -> b -> b
forall a. Fractional a => a -> a -> a
(/)
    {-# INLINE (/) #-}

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

    exp :: Fold a b -> Fold a b
exp = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
sqrt = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
log = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
sin = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
tan = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
cos = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
asin = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
atan = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
acos = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
sinh = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
tanh = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
cosh = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
asinh = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
atanh = (b -> b) -> Fold a b -> Fold 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 :: Fold a b -> Fold a b
acosh = (b -> b) -> Fold a b -> Fold 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 #-}

    ** :: Fold a b -> Fold a b -> Fold a b
(**) = (b -> b -> b) -> 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 b -> b -> b
forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}

    logBase :: Fold a b -> Fold a b -> Fold a b
logBase = (b -> b -> b) -> 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 b -> b -> b
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 :: (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) = (x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
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 = (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$! x -> m a
done x
x
    {-# INLINE fmap #-}

instance Applicative m => Applicative (FoldM m a) where
    pure :: a -> FoldM m a a
pure a
b = (() -> a -> m ()) -> m () -> (() -> m a) -> FoldM m a a
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\() a
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\() -> a -> m a
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) <*> :: 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 = x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair (x -> x -> Pair x x) -> m x -> m (x -> Pair x x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> a -> m x
stepL x
xL a
a m (x -> Pair x x) -> m x -> m (Pair x x)
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 = x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair (x -> x -> Pair x x) -> m x -> m (x -> Pair x x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
beginL m (x -> Pair x x) -> m x -> m (Pair x x)
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 m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> m a
doneR x
xR
        in  (Pair x x -> a -> m (Pair x x))
-> m (Pair x x) -> (Pair x x -> m b) -> FoldM m a b
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 Functor m => Profunctor (FoldM m) where
    rmap :: (b -> c) -> FoldM m a b -> FoldM m a c
rmap = (b -> c) -> FoldM m a b -> FoldM m a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    lmap :: (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) = (x -> a -> m x) -> m x -> (x -> m c) -> FoldM m a c
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
(<>) = (b -> b -> b) -> 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 b -> b -> b
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 = b -> FoldM m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

    mappend :: FoldM m a b -> FoldM m a b -> FoldM m a b
mappend = (b -> b -> b) -> 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 b -> b -> b
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 = b -> FoldM m a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> FoldM m a b) -> (Integer -> b) -> Integer -> FoldM m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> b
forall a. Num a => Integer -> a
fromInteger
    {-# INLINE fromInteger #-}

    negate :: FoldM m a b -> FoldM m a b
negate = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
abs = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
signum = (b -> b) -> FoldM m a b -> FoldM m 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 #-}

    + :: FoldM m a b -> FoldM m a b -> FoldM m a b
(+) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(+)
    {-# INLINE (+) #-}

    * :: FoldM m a b -> FoldM m a b -> FoldM m a b
(*) = (b -> b -> b) -> 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 b -> b -> b
forall a. Num a => a -> a -> a
(*)
    {-# INLINE (*) #-}

    (-) = (b -> b -> b) -> 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 (-)
    {-# INLINE (-) #-}

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

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

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

    exp :: FoldM m a b -> FoldM m a b
exp = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
sqrt = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
log = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
sin = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
tan = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
cos = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
asin = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
atan = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
acos = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
sinh = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
tanh = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
cosh = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
asinh = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
atanh = (b -> b) -> FoldM m a b -> FoldM m 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 :: FoldM m a b -> FoldM m a b
acosh = (b -> b) -> FoldM m a b -> FoldM m 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 #-}

    ** :: FoldM m a b -> FoldM m a b -> FoldM m a b
(**) = (b -> b -> b) -> 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 b -> b -> b
forall a. Floating a => a -> a -> a
(**)
    {-# INLINE (**) #-}

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

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

    >>> L.scan L.length [1..5]
    [0,1,2,3,4,5]
-}
scan :: Fold a b -> [a] -> [b]
scan :: Fold a b -> [a] -> [b]
scan (Fold x -> a -> x
step x
begin x -> b
done) [a]
as = (a -> (x -> [b]) -> x -> [b]) -> (x -> [b]) -> [a] -> x -> [b]
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
xb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[]
    cons :: a -> (x -> [b]) -> x -> [b]
cons a
a x -> [b]
k x
x = x -> b
done x
xb -> [b] -> [b]
forall a. a -> [a] -> [a]
:(x -> [b]
k (x -> [b]) -> x -> [b]
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

    >>> L.prescan L.length [1..5]
    [0,1,2,3,4]
-}
prescan :: Traversable t => Fold a b -> t a -> t b
prescan :: 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) = (x -> a -> (x, b)) -> x -> t a -> (x, t b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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

    >>> L.postscan L.length [1..5]
    [1,2,3,4,5]
-}
postscan :: Traversable t => Fold a b -> t a -> t b
postscan :: 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) = (x -> a -> (x, b)) -> x -> t a -> (x, t b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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 :: Fold a a
mconcat = (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. Monoid a => a -> a -> a
mappend a
forall a. Monoid a => a
mempty a -> a
forall a. a -> a
id
{-# INLINABLE mconcat #-}

-- | Convert a \"@foldMap@\" to a 'Fold'
foldMap :: Monoid w => (a -> w) -> (w -> b) -> Fold a b
foldMap :: (a -> w) -> (w -> b) -> Fold a b
foldMap a -> w
to = (w -> a -> w) -> w -> (w -> b) -> Fold a b
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\w
x a
a -> w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
x (a -> w
to a
a)) w
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 :: Fold a (Maybe a)
head = (a -> a -> a) -> Fold a (Maybe a)
forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
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 :: Fold a (Maybe a)
last = (a -> a -> a) -> Fold a (Maybe a)
forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
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 :: a -> Fold a a
lastDef a
a = (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' -> a
a') a
a a -> a
forall a. a -> a
id
{-# INLINABLE lastDef #-}

{-| Return the last N elements

-}
lastN :: Int -> Fold a [a]
lastN :: Int -> Fold a [a]
lastN Int
n = (Seq a -> a -> Seq a) -> Seq a -> (Seq a -> [a]) -> Fold a [a]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
step Seq a
forall a. Seq a
begin Seq a -> [a]
forall a. Seq a -> [a]
done
  where
    step :: Seq a -> a -> Seq a
step Seq a
s a
a = Seq a
s' Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a
      where
        s' :: Seq a
s' =
            if Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
            then Seq a
s
            else Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq a
s
    begin :: Seq a
begin = Seq a
forall a. Seq a
Seq.empty
    done :: Seq a -> [a]
done  = Seq a -> [a]
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 :: Fold a Bool
null = (Bool -> a -> Bool) -> Bool -> (Bool -> Bool) -> Fold a Bool
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Bool
_ a
_ -> Bool
False) Bool
True Bool -> Bool
forall a. a -> a
id
{-# INLINABLE null #-}

-- | Return the length of the container
length :: Fold a Int
length :: Fold a Int
length = Fold a Int
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 = (Bool -> Bool -> Bool) -> Bool -> (Bool -> Bool) -> Fold Bool Bool
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Bool -> Bool -> Bool
(&&) Bool
True Bool -> Bool
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 = (Bool -> Bool -> Bool) -> Bool -> (Bool -> Bool) -> Fold Bool Bool
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Bool -> Bool -> Bool
(||) Bool
False Bool -> Bool
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 :: (a -> Bool) -> Fold a Bool
all a -> Bool
predicate = (Bool -> a -> Bool) -> Bool -> (Bool -> Bool) -> Fold a Bool
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 Bool -> Bool
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 :: (a -> Bool) -> Fold a Bool
any a -> Bool
predicate = (Bool -> a -> Bool) -> Bool -> (Bool -> Bool) -> Fold a Bool
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 Bool -> Bool
forall a. a -> a
id
{-# INLINABLE any #-}

-- | Computes the sum of all elements
sum :: Num a => Fold a a
sum :: Fold a a
sum = (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. Num a => a -> a -> a
(+) a
0 a -> a
forall a. a -> a
id
{-# INLINABLE sum #-}

-- | Computes the product of all elements
product :: Num a => Fold a a
product :: Fold a a
product = (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. Num a => a -> a -> a
(*) a
1 a -> a
forall a. a -> a
id
{-# INLINABLE product #-}

-- | Compute a numerically stable arithmetic mean of all elements
mean :: Fractional a => Fold a a
mean :: Fold a a
mean = (Pair a a -> a -> Pair a a)
-> Pair a a -> (Pair a a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair a a -> a -> Pair a a
forall b. Fractional b => Pair b b -> b -> Pair b b
step Pair a a
begin Pair a a -> a
forall a b. Pair a b -> a
done
  where
    begin :: Pair a a
begin = a -> a -> Pair a a
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
nb -> b -> b
forall a. Num a => a -> a -> a
+b
1 in b -> b -> Pair b b
forall a b. a -> b -> Pair a b
Pair (b
x b -> b -> b
forall a. Num a => a -> a -> a
+ (b
y b -> b -> b
forall a. Num a => a -> a -> a
- b
x) b -> b -> b
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 :: Fold a a
variance = (Pair3 a a a -> a -> Pair3 a a a)
-> Pair3 a a a -> (Pair3 a a a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair3 a a a -> a -> Pair3 a a a
forall b. Fractional b => Pair3 b b b -> b -> Pair3 b b b
step Pair3 a a a
begin Pair3 a a a -> a
forall a b. Fractional a => Pair3 a b a -> a
done
  where
    begin :: Pair3 a a a
begin = a -> a -> a -> Pair3 a a a
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
0 a
0 a
0

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

    done :: Pair3 a b a -> a
done (Pair3 a
n b
_ a
m2) = a
m2 a -> a -> a
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 :: Fold a a
std = Fold a a -> Fold a a
forall a. Floating a => a -> a
sqrt Fold a a
forall a. Fractional a => Fold a a
variance
{-# INLINABLE std #-}

-- | Computes the maximum element
maximum :: Ord a => Fold a (Maybe a)
maximum :: Fold a (Maybe a)
maximum = (a -> a -> a) -> Fold a (Maybe a)
forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
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 :: (a -> a -> Ordering) -> Fold a (Maybe a)
maximumBy a -> a -> Ordering
cmp = (a -> a -> a) -> Fold a (Maybe a)
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 :: Fold a (Maybe a)
minimum = (a -> a -> a) -> Fold a (Maybe a)
forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
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 :: (a -> a -> Ordering) -> Fold a (Maybe a)
minimumBy a -> a -> Ordering
cmp = (a -> a -> a) -> Fold a (Maybe a)
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 :: a -> Fold a Bool
elem a
a = (a -> Bool) -> Fold a Bool
forall a. (a -> Bool) -> Fold a Bool
any (a
a a -> a -> Bool
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 :: a -> Fold a Bool
notElem a
a = (a -> Bool) -> Fold a Bool
forall a. (a -> Bool) -> Fold a Bool
all (a
a a -> a -> Bool
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 :: (a -> Bool) -> Fold a (Maybe a)
find a -> Bool
predicate = (Maybe' a -> a -> Maybe' a)
-> Maybe' a -> (Maybe' a -> Maybe a) -> Fold a (Maybe a)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe' a -> a -> Maybe' a
step Maybe' a
forall a. Maybe' a
Nothing' Maybe' a -> Maybe a
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 a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a else Maybe' a
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 :: Int -> Fold a (Maybe a)
index = Int -> Fold a (Maybe a)
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 :: a -> Fold a (Maybe Int)
elemIndex a
a = (a -> Bool) -> Fold a (Maybe Int)
forall a. (a -> Bool) -> Fold a (Maybe Int)
findIndex (a
a a -> a -> Bool
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 :: (a -> Bool) -> Fold a (Maybe Int)
findIndex a -> Bool
predicate = (Either' Int Int -> a -> Either' Int Int)
-> Either' Int Int
-> (Either' Int Int -> Maybe Int)
-> Fold a (Maybe Int)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Either' Int Int -> a -> Either' Int Int
forall a. Num a => Either' a a -> a -> Either' a a
step (Int -> Either' Int Int
forall a b. a -> Either' a b
Left' Int
0) Either' Int Int -> Maybe Int
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 a -> Either' a a
forall a b. b -> Either' a b
Right' a
i
            else a -> Either' a a
forall a b. a -> Either' a b
Left' (a
i a -> a -> a
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 :: a -> Fold (a, b) (Maybe b)
lookup a
a0 = (Maybe' b -> (a, b) -> Maybe' b)
-> Maybe' b -> (Maybe' b -> Maybe b) -> Fold (a, b) (Maybe b)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe' b -> (a, b) -> Maybe' b
forall a. Maybe' a -> (a, a) -> Maybe' a
step Maybe' b
forall a. Maybe' a
Nothing' Maybe' b -> Maybe b
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a0
        then a -> Maybe' a
forall a. a -> Maybe' a
Just' a
b
        else Maybe' a
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 :: FoldM IO a (Maybe a)
random = (Pair3 (Gen RealWorld) (Maybe' a) Int
 -> a -> IO (Pair3 (Gen RealWorld) (Maybe' a) Int))
-> IO (Pair3 (Gen RealWorld) (Maybe' a) Int)
-> (Pair3 (Gen RealWorld) (Maybe' a) Int -> IO (Maybe a))
-> FoldM IO a (Maybe a)
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Pair3 (Gen RealWorld) (Maybe' a) Int
-> a -> IO (Pair3 (Gen RealWorld) (Maybe' a) Int)
forall (m :: * -> *) c a.
(Variate c, PrimMonad m, Eq c, Num c) =>
Pair3 (Gen (PrimState m)) (Maybe' a) c
-> a -> m (Pair3 (Gen (PrimState m)) (Maybe' a) c)
step IO (Pair3 (Gen RealWorld) (Maybe' a) Int)
forall a. IO (Pair3 (Gen RealWorld) (Maybe' a) Int)
begin Pair3 (Gen RealWorld) (Maybe' a) Int -> IO (Maybe a)
forall (m :: * -> *) a a c.
Monad m =>
Pair3 a (Maybe' a) c -> m (Maybe a)
done
  where
    begin :: IO (Pair3 (Gen RealWorld) (Maybe' a) Int)
begin = do
        Gen RealWorld
g <- IO (Gen RealWorld)
IO GenIO
createSystemRandom
        Pair3 (Gen RealWorld) (Maybe' a) Int
-> IO (Pair3 (Gen RealWorld) (Maybe' a) Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair3 (Gen RealWorld) (Maybe' a) Int
 -> IO (Pair3 (Gen RealWorld) (Maybe' a) Int))
-> Pair3 (Gen RealWorld) (Maybe' a) Int
-> IO (Pair3 (Gen RealWorld) (Maybe' a) Int)
forall a b. (a -> b) -> a -> b
$! Gen RealWorld
-> Maybe' a -> Int -> Pair3 (Gen RealWorld) (Maybe' a) Int
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 Gen RealWorld
g Maybe' a
forall a. Maybe' a
Nothing' (Int
1 :: Int)

    step :: Pair3 (Gen (PrimState m)) (Maybe' a) c
-> a -> m (Pair3 (Gen (PrimState m)) (Maybe' a) c)
step (Pair3 Gen (PrimState m)
g Maybe' a
Nothing'  c
_) a
a = Pair3 (Gen (PrimState m)) (Maybe' a) c
-> m (Pair3 (Gen (PrimState m)) (Maybe' a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair3 (Gen (PrimState m)) (Maybe' a) c
 -> m (Pair3 (Gen (PrimState m)) (Maybe' a) c))
-> Pair3 (Gen (PrimState m)) (Maybe' a) c
-> m (Pair3 (Gen (PrimState m)) (Maybe' a) c)
forall a b. (a -> b) -> a -> b
$! Gen (PrimState m)
-> Maybe' a -> c -> Pair3 (Gen (PrimState m)) (Maybe' a) c
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 Gen (PrimState m)
g (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a) c
2
    step (Pair3 Gen (PrimState m)
g (Just' a
a) c
m) a
b = do
        c
n <- (c, c) -> Gen (PrimState m) -> m c
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (c
1, c
m) Gen (PrimState m)
g
        let c :: a
c = if c
n c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
1 then a
b else a
a
        Pair3 (Gen (PrimState m)) (Maybe' a) c
-> m (Pair3 (Gen (PrimState m)) (Maybe' a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair3 (Gen (PrimState m)) (Maybe' a) c
 -> m (Pair3 (Gen (PrimState m)) (Maybe' a) c))
-> Pair3 (Gen (PrimState m)) (Maybe' a) c
-> m (Pair3 (Gen (PrimState m)) (Maybe' a) c)
forall a b. (a -> b) -> a -> b
$! Gen (PrimState m)
-> Maybe' a -> c -> Pair3 (Gen (PrimState m)) (Maybe' a) c
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 Gen (PrimState m)
g (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
c) (c
m c -> c -> c
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
_) = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe' a -> Maybe a
forall a. Maybe' a -> Maybe a
lazy Maybe' a
ma)
{-# INLINABLE random #-}

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

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

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

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

    done :: Vector v a => RandomNState v a -> IO (Maybe (v a))
    done :: RandomNState v a -> IO (Maybe (v a))
done (RandomNState (Incomplete Int
_) Mutable v RealWorld a
_  Int
_ GenIO
_) = Maybe (v a) -> IO (Maybe (v a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (v a)
forall a. Maybe a
Nothing
    done (RandomNState  VectorState
Complete      Mutable v RealWorld a
mv Int
_ GenIO
_) = do
        v a
v <- Mutable v (PrimState IO) a -> IO (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
V.freeze Mutable v RealWorld a
Mutable v (PrimState IO) a
mv
        Maybe (v a) -> IO (Maybe (v a))
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> Maybe (v a)
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_ :: (a -> m ()) -> FoldM m a ()
mapM_ = (a -> m ()) -> FoldM m a ()
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 :: (a -> m w) -> FoldM m a w
sink a -> m w
act = (w -> a -> m w) -> m w -> (w -> m w) -> FoldM m a w
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 w -> m w
forall a. a -> m a
done  where
  done :: a -> m a
done = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  begin :: m w
begin = w -> m w
forall (m :: * -> *) a. Monad m => a -> m a
return w
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
    w -> m w
forall (m :: * -> *) a. Monad m => a -> m a
return (w -> m w) -> w -> m w
forall a b. (a -> b) -> a -> b
$! w -> w -> w
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 :: Fold a b
genericLength = (b -> a -> b) -> b -> (b -> b) -> Fold a b
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\b
n a
_ -> b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) b
0 b -> b
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 :: i -> Fold a (Maybe a)
genericIndex i
i = (Either' i a -> a -> Either' i a)
-> Either' i a -> (Either' i a -> Maybe a) -> Fold a (Maybe a)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Either' i a -> a -> Either' i a
forall b. Either' i b -> b -> Either' i b
step (i -> Either' i a
forall a b. a -> Either' a b
Left' i
0) Either' i a -> Maybe a
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 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
j then b -> Either' i b
forall a b. b -> Either' a b
Right' b
a else i -> Either' i b
forall a b. a -> Either' a b
Left' (i
j i -> i -> i
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
_ -> Maybe a
forall a. Maybe a
Nothing
        Right' a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
{-# INLINABLE genericIndex #-}

-- | Fold all values into a list
list :: Fold a [a]
list :: Fold a [a]
list = (([a] -> [a]) -> a -> [a] -> [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]
x a
a -> [a] -> [a]
x ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a] -> [a]
forall a. a -> a
id (([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [])
{-# INLINABLE list #-}

-- | Fold all values into a list, in reverse order
revList :: Fold a [a]
revList :: Fold a [a]
revList = ([a] -> a -> [a]) -> [a] -> ([a] -> [a]) -> Fold a [a]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\[a]
x a
a -> a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
x) [] [a] -> [a]
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 :: Fold a [a]
nub = (Pair (Set a) ([a] -> [a]) -> a -> Pair (Set a) ([a] -> [a]))
-> Pair (Set a) ([a] -> [a])
-> (Pair (Set a) ([a] -> [a]) -> [a])
-> Fold a [a]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair (Set a) ([a] -> [a]) -> a -> Pair (Set a) ([a] -> [a])
forall a c.
Ord a =>
Pair (Set a) ([a] -> c) -> a -> Pair (Set a) ([a] -> c)
step (Set a -> ([a] -> [a]) -> Pair (Set a) ([a] -> [a])
forall a b. a -> b -> Pair a b
Pair Set a
forall a. Set a
Set.empty [a] -> [a]
forall a. a -> a
id) Pair (Set a) ([a] -> [a]) -> [a]
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 a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
a Set a
s
      then Set a -> ([a] -> c) -> Pair (Set a) ([a] -> c)
forall a b. a -> b -> Pair a b
Pair Set a
s [a] -> c
r
      else Set a -> ([a] -> c) -> Pair (Set a) ([a] -> c)
forall a b. a -> b -> Pair a b
Pair (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
s) ([a] -> c
r ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a a -> [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 :: Fold a [a]
eqNub = (Pair [a] ([a] -> [a]) -> a -> Pair [a] ([a] -> [a]))
-> Pair [a] ([a] -> [a])
-> (Pair [a] ([a] -> [a]) -> [a])
-> Fold a [a]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair [a] ([a] -> [a]) -> a -> Pair [a] ([a] -> [a])
forall a c. Eq a => Pair [a] ([a] -> c) -> a -> Pair [a] ([a] -> c)
step ([a] -> ([a] -> [a]) -> Pair [a] ([a] -> [a])
forall a b. a -> b -> Pair a b
Pair [] [a] -> [a]
forall a. a -> a
id) Pair [a] ([a] -> [a]) -> [a]
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 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem a
a [a]
known
      then [a] -> ([a] -> c) -> Pair [a] ([a] -> c)
forall a b. a -> b -> Pair a b
Pair [a]
known [a] -> c
r
      else [a] -> ([a] -> c) -> Pair [a] ([a] -> c)
forall a b. a -> b -> Pair a b
Pair (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
known) ([a] -> c
r ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a a -> [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 :: Fold a (Set a)
set = (Set a -> a -> Set a)
-> Set a -> (Set a -> Set a) -> Fold a (Set a)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold ((a -> Set a -> Set a) -> Set a -> a -> Set a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert) Set a
forall a. Set a
Set.empty Set a -> Set a
forall a. a -> a
id
{-# INLINABLE set #-}

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

{-|
Fold pairs into a map.
-}
map :: Ord a => Fold (a, b) (Map.Map a b)
map :: Fold (a, b) (Map a b)
map = (Map a b -> (a, b) -> Map a b)
-> Map a b -> (Map a b -> Map a b) -> Fold (a, b) (Map a b)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Map a b -> (a, b) -> Map a b
forall k a. Ord k => Map k a -> (k, a) -> Map k a
step Map a b
begin Map a b -> Map a b
forall a. a -> a
done
  where
    begin :: Map a b
begin = Map a b
forall a. Monoid a => a
mempty
    step :: Map k a -> (k, a) -> Map k a
step Map k a
m (k
k, a
v) = k -> a -> Map k a -> Map k a
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 = a -> a
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 :: 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) = (Maybe x -> Maybe x) -> k -> Map k x -> Map k x
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         = x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> x -> Maybe x
forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
ini0 a
a
        addToMap (Just x
existing) = x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> x -> Maybe x
forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
existing a
a

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

      end :: Map k x -> Map k b
      end :: Map k x -> Map k b
end = (x -> b) -> Map k x -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
end0
    in (Map k x -> (k, a) -> Map k x)
-> Map k x -> (Map k x -> Map k b) -> Fold (k, a) (Map k b)
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 :: Fold (a, b) (HashMap a b)
hashMap = (HashMap a b -> (a, b) -> HashMap a b)
-> HashMap a b
-> (HashMap a b -> HashMap a b)
-> Fold (a, b) (HashMap a b)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold HashMap a b -> (a, b) -> HashMap a b
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> (k, v) -> HashMap k v
step HashMap a b
begin HashMap a b -> HashMap a b
forall a. a -> a
done
  where
    begin :: HashMap a b
begin = HashMap a b
forall a. Monoid a => a
mempty
    step :: HashMap k v -> (k, v) -> HashMap k v
step HashMap k v
m (k
k, v
v) = k -> v -> HashMap k v -> HashMap k 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 = a -> a
forall a. a -> a
id
{-# INLINABLE hashMap #-}

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

>>> fold (foldByKeyHashMap Control.Foldl.sum) [("a",1), ("b",2), ("b",20), ("a",10)]
fromList [("a",11),("b",22)]
-}
foldByKeyHashMap :: forall k a b. (Hashable k, Eq k) => Fold a b -> Fold (k, a) (HashMap k b)
foldByKeyHashMap :: 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) = (Maybe x -> Maybe x) -> k -> HashMap k x -> HashMap k x
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         = x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> x -> Maybe x
forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
ini0 a
a
        addToHashMap (Just x
existing) = x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> x -> Maybe x
forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
existing a
a

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

      end :: HashMap k x -> HashMap k b
      end :: HashMap k x -> HashMap k b
end = (x -> b) -> HashMap k x -> HashMap k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
end0
    in (HashMap k x -> (k, a) -> HashMap k x)
-> HashMap k x
-> (HashMap k x -> HashMap k b)
-> Fold (k, a) (HashMap k b)
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 :: Fold a (v a)
vector = Int -> [a] -> v a
forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
V.fromReverseListN (Int -> [a] -> v a) -> Fold a Int -> Fold a ([a] -> v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold a Int
forall a. Fold a Int
length Fold a ([a] -> v a) -> Fold a [a] -> Fold a (v a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold a [a]
forall a. Fold a [a]
revList
{-# INLINABLE vector #-}

maxChunkSize :: Int
maxChunkSize :: Int
maxChunkSize = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
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 :: FoldM m a (v a)
vectorM = (Pair (Mutable v (PrimState m) a) Int
 -> a -> m (Pair (Mutable v (PrimState m) a) Int))
-> m (Pair (Mutable v (PrimState m) a) Int)
-> (Pair (Mutable v (PrimState m) a) Int -> m (v a))
-> FoldM m a (v a)
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Pair (Mutable v (PrimState m) a) Int
-> a -> m (Pair (Mutable v (PrimState m) a) Int)
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 Pair (Mutable v (PrimState m) a) Int -> m (v a)
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 <- Int -> m (Mutable v (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.unsafeNew Int
10
        Pair (Mutable v (PrimState m) a) Int
-> m (Pair (Mutable v (PrimState m) a) Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable v (PrimState m) a
-> Int -> Pair (Mutable v (PrimState m) a) Int
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 = v (PrimState m) a -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
            then v (PrimState m) a -> Int -> m (v (PrimState m) a)
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 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len Int
maxChunkSize)
            else v (PrimState m) a -> m (v (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) a
mv
        v (PrimState m) a -> Int -> a -> m ()
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
        Pair (v (PrimState m) a) Int -> m (Pair (v (PrimState m) a) Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (v (PrimState m) a -> Int -> Pair (v (PrimState m) a) Int
forall a b. a -> b -> Pair a b
Pair v (PrimState m) a
mv' (Int
idx Int -> Int -> Int
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 <- Mutable v (PrimState m) a -> m (v a)
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
        v a -> m (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> v a -> v a
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 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) = (x -> a -> x) -> x -> (x -> b) -> r
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 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 ((x -> a -> x) -> x -> x
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 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) = (x -> a -> m x) -> m x -> (x -> m b) -> r
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 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 <- (x -> a -> m x) -> m x -> m 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 :: Fold a b -> FoldM m a b
generalize (Fold x -> a -> x
step x
begin x -> b
done) = (x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
forall (m :: * -> *). Monad m => x -> a -> m x
step' m x
begin' x -> m b
forall (m :: * -> *). Monad m => x -> m b
done'
  where
    step' :: x -> a -> m x
step' x
x a
a = x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> a -> x
step x
x a
a)
    begin' :: m x
begin'    = x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return  x
begin
    done' :: x -> m b
done' x
x   = b -> m b
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 :: FoldM Identity a b -> Fold a b
simplify (FoldM x -> a -> Identity x
step Identity x
begin x -> Identity b
done) = (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
begin' x -> b
done'
  where
    step' :: x -> a -> x
step' x
x a
a = Identity x -> x
forall a. Identity a -> a
runIdentity (x -> a -> Identity x
step x
x a
a)
    begin' :: x
begin'    = Identity x -> x
forall a. Identity a -> a
runIdentity  Identity x
begin
    done' :: x -> b
done' x
x   = Identity b -> b
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 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) = (x -> a -> n x) -> n x -> (x -> n b) -> FoldM n a b
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\x
a a
b -> m x -> n x
forall x. m x -> n x
phi (x -> a -> m x
step x
a a
b)) (m x -> n x
forall x. m x -> n x
phi m x
begin) (m b -> n b
forall x. m x -> n x
phi (m b -> n b) -> (x -> m b) -> x -> n b
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 :: 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) =
    (x -> a -> m x)
-> m x -> (x -> m (FoldM m a b)) -> FoldM m a (FoldM m a b)
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 -> FoldM m a b -> m (FoldM m a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step (x -> m x
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 :: (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
step = (Maybe' a -> a -> Maybe' a)
-> Maybe' a -> (Maybe' a -> Maybe a) -> Fold a (Maybe a)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe' a -> a -> Maybe' a
step_ Maybe' a
forall a. Maybe' a
Nothing' Maybe' a -> Maybe a
forall a. Maybe' a -> Maybe a
lazy
  where
    step_ :: Maybe' a -> a -> Maybe' a
step_ Maybe' a
mx a
a = a -> Maybe' 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 L.mconcat) [1..10]
Sum {getSum = 55}

>>> fold L.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 :: (a -> b) -> Fold b r -> Fold a r
premap a -> b
f (Fold x -> b -> x
step x
begin x -> r
done) = (x -> a -> x) -> x -> (x -> r) -> Fold a r
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 :: (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) = (x -> a -> m x) -> m x -> (x -> m r) -> FoldM m a r
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 m b -> (b -> m x) -> m x
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 :: (a -> Bool) -> Fold a r -> Fold a r
prefilter a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = (x -> a -> x) -> x -> (x -> r) -> Fold a r
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.

> foldM (prefilterM p folder) list = foldM folder (filter p list)
-}
prefilterM :: (Monad m) => (a -> m Bool) -> FoldM m a r -> FoldM m a r
prefilterM :: (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) = (x -> a -> m x) -> m x -> (x -> m r) -> FoldM m a r
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 x -> m x
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 :: (a -> Bool) -> Fold a r -> Fold a r
predropWhile a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = (Pair Bool x -> a -> Pair Bool x)
-> Pair Bool x -> (Pair Bool x -> r) -> Fold a r
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' Pair Bool x -> r
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 Bool -> x -> Pair Bool x
forall a b. a -> b -> Pair a b
Pair Bool
True x
x
      else Bool -> x -> Pair Bool x
forall a b. a -> b -> Pair a b
Pair Bool
False (x -> a -> x
step x
x a
a)
    begin' :: Pair Bool x
begin' = Bool -> x -> Pair Bool x
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)

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

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

drop :: Natural -> Fold a b -> Fold a b
drop :: Natural -> Fold a b -> Fold a b
drop Natural
n (Fold x -> a -> x
step x
begin x -> b
done) = ((Natural, x) -> a -> (Natural, x))
-> (Natural, x) -> ((Natural, x) -> b) -> Fold a b
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (Natural, x) -> a -> (Natural, x)
forall a. (Eq a, Num a) => (a, x) -> a -> (a, x)
step' (Natural, x)
begin' (Natural, x) -> b
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' a -> a -> a
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)

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

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

dropM :: Monad m => Natural -> FoldM m a b -> FoldM m a b
dropM :: 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) = ((Natural, x) -> a -> m (Natural, x))
-> m (Natural, x) -> ((Natural, x) -> m b) -> FoldM m a b
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (Natural, x) -> a -> m (Natural, x)
forall a. (Eq a, Num a) => (a, x) -> a -> m (a, x)
step' m (Natural, x)
begin' (Natural, x) -> m b
forall a. (a, x) -> m b
done'
  where
    begin' :: m (Natural, x)
begin'          = (x -> (Natural, x)) -> m x -> m (Natural, x)
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 = (x -> (a, x)) -> m x -> m (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
_ = (a, x) -> m (a, x)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
n' a -> a -> a
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 L.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 :: Handler a b -> Fold b r -> Fold a r
handles Handler a b
k (Fold x -> b -> x
step x
begin x -> r
done) = (x -> a -> x) -> x -> (x -> r) -> Fold a r
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' = (a -> x -> x) -> x -> a -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Endo x -> x -> x
forall a. Endo a -> a -> a
appEndo (Endo x -> x -> x) -> (a -> Endo x) -> a -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual (Endo x) -> Endo x
forall a. Dual a -> a
getDual (Dual (Endo x) -> Endo x) -> (a -> Dual (Endo x)) -> a -> Endo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Dual (Endo x)) a -> Dual (Endo x)
forall a k (b :: k). Const a b -> a
getConst (Const (Dual (Endo x)) a -> Dual (Endo x))
-> (a -> Const (Dual (Endo x)) a) -> a -> Dual (Endo x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Const (Dual (Endo x)) b) -> a -> Const (Dual (Endo x)) a
Handler a b
k (Dual (Endo x) -> Const (Dual (Endo x)) b
forall k a (b :: k). a -> Const a b
Const (Dual (Endo x) -> Const (Dual (Endo x)) b)
-> (b -> Dual (Endo x)) -> b -> Const (Dual (Endo x)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo x -> Dual (Endo x)
forall a. a -> Dual a
Dual (Endo x -> Dual (Endo x)) -> (b -> Endo x) -> b -> Dual (Endo x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> x) -> Endo x
forall a. (a -> a) -> Endo a
Endo ((x -> x) -> Endo x) -> (b -> x -> x) -> b -> Endo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> b -> x) -> b -> x -> x
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) L.sum (Just (2, 3))
5

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

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

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

> L.foldOver folded == L.fold

-}
foldOver :: Handler s a -> Fold a b -> s -> b
foldOver :: 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 (x -> b) -> (s -> x) -> s -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Endo x -> x -> x) -> x -> Endo x -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo x -> x -> x
forall a. Endo a -> a -> a
appEndo x
begin (Endo x -> x) -> (s -> Endo x) -> s -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual (Endo x) -> Endo x
forall a. Dual a -> a
getDual (Dual (Endo x) -> Endo x) -> (s -> Dual (Endo x)) -> s -> Endo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Dual (Endo x)) s -> Dual (Endo x)
forall a k (b :: k). Const a b -> a
getConst (Const (Dual (Endo x)) s -> Dual (Endo x))
-> (s -> Const (Dual (Endo x)) s) -> s -> Dual (Endo x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (Dual (Endo x)) a) -> s -> Const (Dual (Endo x)) s
Handler s a
l (Dual (Endo x) -> Const (Dual (Endo x)) a
forall k a (b :: k). a -> Const a b
Const (Dual (Endo x) -> Const (Dual (Endo x)) a)
-> (a -> Dual (Endo x)) -> a -> Const (Dual (Endo x)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo x -> Dual (Endo x)
forall a. a -> Dual a
Dual (Endo x -> Dual (Endo x)) -> (a -> Endo x) -> a -> Dual (Endo x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> x) -> Endo x
forall a. (a -> a) -> Endo a
Endo ((x -> x) -> Endo x) -> (a -> x -> x) -> a -> Endo x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> a -> x) -> a -> x -> x
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 { 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) = (a -> m a) -> EndoM m a
forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM (a -> m a
f (a -> m a) -> (a -> m a) -> a -> m a
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 = (a -> m a) -> EndoM m a
forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# INLINE mempty #-}

    mappend :: EndoM m a -> EndoM m a -> EndoM m a
mappend = EndoM m a -> EndoM m a -> EndoM m a
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 :: 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) = (x -> a -> m x) -> m x -> (x -> m r) -> FoldM m a r
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' = (a -> x -> m x) -> x -> a -> m x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (EndoM m x -> x -> m x
forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM (EndoM m x -> x -> m x) -> (a -> EndoM m x) -> a -> x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual (EndoM m x) -> EndoM m x
forall a. Dual a -> a
getDual (Dual (EndoM m x) -> EndoM m x)
-> (a -> Dual (EndoM m x)) -> a -> EndoM m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Dual (EndoM m x)) a -> Dual (EndoM m x)
forall a k (b :: k). Const a b -> a
getConst (Const (Dual (EndoM m x)) a -> Dual (EndoM m x))
-> (a -> Const (Dual (EndoM m x)) a) -> a -> Dual (EndoM m x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Const (Dual (EndoM m x)) b)
-> a -> Const (Dual (EndoM m x)) a
HandlerM m a b
k (Dual (EndoM m x) -> Const (Dual (EndoM m x)) b
forall k a (b :: k). a -> Const a b
Const (Dual (EndoM m x) -> Const (Dual (EndoM m x)) b)
-> (b -> Dual (EndoM m x)) -> b -> Const (Dual (EndoM m x)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndoM m x -> Dual (EndoM m x)
forall a. a -> Dual a
Dual (EndoM m x -> Dual (EndoM m x))
-> (b -> EndoM m x) -> b -> Dual (EndoM m x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> m x) -> EndoM m x
forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM ((x -> m x) -> EndoM m x) -> (b -> x -> m x) -> b -> EndoM m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> b -> m x) -> b -> x -> m x
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

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

> L.foldOverM folded == L.foldM

-}
foldOverM :: Monad m => HandlerM m s a -> FoldM m a b -> s -> m b
foldOverM :: 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 <- ((EndoM m x -> x -> m x) -> x -> EndoM m x -> m x
forall a b c. (a -> b -> c) -> b -> a -> c
flip EndoM m x -> x -> m x
forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM x
b (EndoM m x -> m x) -> (s -> EndoM m x) -> s -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual (EndoM m x) -> EndoM m x
forall a. Dual a -> a
getDual (Dual (EndoM m x) -> EndoM m x)
-> (s -> Dual (EndoM m x)) -> s -> EndoM m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Dual (EndoM m x)) s -> Dual (EndoM m x)
forall a k (b :: k). Const a b -> a
getConst (Const (Dual (EndoM m x)) s -> Dual (EndoM m x))
-> (s -> Const (Dual (EndoM m x)) s) -> s -> Dual (EndoM m x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (Dual (EndoM m x)) a)
-> s -> Const (Dual (EndoM m x)) s
HandlerM m s a
l (Dual (EndoM m x) -> Const (Dual (EndoM m x)) a
forall k a (b :: k). a -> Const a b
Const (Dual (EndoM m x) -> Const (Dual (EndoM m x)) a)
-> (a -> Dual (EndoM m x)) -> a -> Const (Dual (EndoM m x)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndoM m x -> Dual (EndoM m x)
forall a. a -> Dual a
Dual (EndoM m x -> Dual (EndoM m x))
-> (a -> EndoM m x) -> a -> Dual (EndoM m x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> m x) -> EndoM m x
forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM ((x -> m x) -> EndoM m x) -> (a -> x -> m x) -> a -> EndoM m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> a -> m x) -> a -> x -> m x
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 :: (a -> f a) -> t a -> f (t a)
folded a -> f a
k t a
ts = (t a -> ()) -> f () -> f (t a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\t a
_ -> ()) ((a -> f a) -> t a -> f ()
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) (L.mapM_ print)) [1..10]
2
4
6
8
10

-}
filtered :: Monoid m => (a -> Bool) -> (a -> m) -> a -> m
filtered :: (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 = m
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 :: (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy a -> g
grouper (Fold x -> a -> x
f x
i x -> r
e) = (Map g x -> a -> Map g x)
-> Map g x -> (Map g x -> Map g r) -> Fold a (Map g r)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Map g x -> a -> Map g x
f' Map g x
forall a. Monoid a => a
mempty ((x -> r) -> Map g x -> Map g r
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 = (Maybe x -> Maybe x) -> g -> Map g x -> Map g x
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter (\Maybe x
o -> x -> Maybe x
forall a. a -> Maybe a
Just (x -> a -> x
f (x -> Maybe x -> x
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 :: Fold a1 b1 -> Fold a2 b2 -> Fold (Either a1 a2) (b1, b2)
either Fold a1 b1
l Fold a2 b2
r = (,) (b1 -> b2 -> (b1, b2))
-> Fold (Either a1 a2) b1 -> Fold (Either a1 a2) (b2 -> (b1, b2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Either a1 a2) a1 -> Fold a1 b1 -> Fold (Either a1 a2) b1
forall a b r. Handler a b -> Fold b r -> Fold a r
handles Handler (Either a1 a2) a1
forall a c b. Prism (Either a c) (Either b c) a b
_Left Fold a1 b1
l Fold (Either a1 a2) (b2 -> (b1, b2))
-> Fold (Either a1 a2) b2 -> Fold (Either a1 a2) (b1, b2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handler (Either a1 a2) a2 -> Fold a2 b2 -> Fold (Either a1 a2) b2
forall a b r. Handler a b -> Fold b r -> Fold a r
handles Handler (Either a1 a2) a2
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 :: 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 = (,) (b1 -> b2 -> (b1, b2))
-> FoldM m (Either a1 a2) b1
-> FoldM m (Either a1 a2) (b2 -> (b1, b2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandlerM m (Either a1 a2) a1
-> FoldM m a1 b1 -> FoldM m (Either a1 a2) b1
forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM HandlerM m (Either a1 a2) a1
forall a c b. Prism (Either a c) (Either b c) a b
_Left FoldM m a1 b1
l FoldM m (Either a1 a2) (b2 -> (b1, b2))
-> FoldM m (Either a1 a2) b2 -> FoldM m (Either a1 a2) (b1, b2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HandlerM m (Either a1 a2) a2
-> FoldM m a2 b2 -> FoldM m (Either a1 a2) b2
forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM HandlerM m (Either a1 a2) a2
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 :: Fold a b -> Fold (f a) (f b)
nest (Fold x -> a -> x
s x
i x -> b
e) =
    (f x -> f a -> f x) -> f x -> (f x -> f b) -> Fold (f a) (f b)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\f x
xs f a
as -> (x -> a -> x) -> f x -> f a -> f x
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)
         (x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
i)
         (\f x
xs -> (x -> b) -> f x -> f b
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
-}