{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
module Control.Foldl (
Fold(..)
, FoldM(..)
, fold
, foldM
, scan
, prescan
, postscan
, 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
, genericLength
, genericIndex
, list
, revList
, nub
, eqNub
, set
, hashSet
, map
, foldByKeyMap
, hashMap
, foldByKeyHashMap
, vector
, vectorM
, purely
, purely_
, impurely
, impurely_
, generalize
, simplify
, hoists
, duplicateM
, _Fold1
, premap
, premapM
, postmapM
, prefilter
, prefilterM
, predropWhile
, drop
, dropM
, Handler
, handles
, foldOver
, EndoM(..)
, HandlerM
, handlesM
, foldOverM
, folded
, filtered
, groupBy
, either
, eitherM
, nest
, module Control.Monad.Primitive
, module Data.Foldable
, module Data.Vector.Generic
) where
import Control.Foldl.Optics (_Left, _Right)
import Control.Applicative
import Control.Foldl.Internal (Maybe'(..), lazy, Either'(..), Pair(..), hush)
import Control.Monad ((<=<))
import Control.Monad.Primitive (PrimMonad, RealWorld)
import Control.Comonad
import Data.Foldable (Foldable)
import Data.Functor.Identity (Identity, runIdentity)
import Data.Functor.Contravariant (Contravariant(..))
import Data.HashMap.Strict (HashMap)
import Data.Map.Strict (Map, alter)
import Data.Maybe (fromMaybe)
import Data.Monoid hiding ((<>))
import Data.Semigroupoid (Semigroupoid)
import Data.Functor.Extend (Extend(..))
import Data.Profunctor
import Data.Profunctor.Sieve
import Data.Sequence ((|>))
import Data.Vector.Generic (Vector, Mutable)
import Data.Vector.Generic.Mutable (MVector)
import Data.Hashable (Hashable)
import Data.Traversable
import Numeric.Natural (Natural)
import System.Random (StdGen, newStdGen, uniformR)
import Prelude hiding
( head
, last
, null
, length
, and
, or
, all
, any
, sum
, product
, maximum
, minimum
, elem
, notElem
, lookup
, map
, either
, drop
)
import qualified Data.Foldable as F
import qualified Data.List as List
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.Vector.Generic as V
import qualified Control.Foldl.Util.Vector as V
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Semigroupoid
data Fold a b
= forall x. Fold (x -> a -> x) x (x -> b)
instance Functor (Fold a) where
fmap :: forall a b. (a -> b) -> Fold a a -> Fold a b
fmap a -> b
f (Fold x -> a -> x
step x
begin x -> a
done) = (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 :: forall a b c. (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 :: forall b c a. (b -> c) -> Fold a b -> Fold a c
rmap = (b -> c) -> Fold a b -> Fold a c
forall a b. (a -> b) -> Fold a a -> Fold a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
instance Choice Fold where
right' :: forall a b c. Fold a b -> Fold (Either c a) (Either c b)
right' (Fold x -> a -> x
step x
begin x -> b
done) = (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 a b c.
(a -> b -> c) -> Either c a -> Either c b -> Either c c
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 a b. (a -> b) -> Either c a -> Either c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
done)
{-# INLINE right' #-}
instance Cosieve Fold [] where
cosieve :: forall a b. Fold a b -> [a] -> b
cosieve = Fold a b -> [a] -> b
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold
{-# INLINE cosieve #-}
instance Costrong Fold where
unfirst :: forall a d b. Fold (a, d) (b, d) -> Fold a b
unfirst Fold (a, d) (b, d)
p = ([a] -> b) -> Fold a [a] -> Fold a b
forall a b. (a -> b) -> Fold a a -> Fold a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> b
f Fold a [a]
forall a. Fold a [a]
list
where
f :: [a] -> b
f [a]
as = b
b
where (b
b, d
d) = Fold (a, d) (b, d) -> [(a, d)] -> (b, d)
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold Fold (a, d) (b, d)
p [ (a
a, d
d) | a
a <- [a]
as ]
{-# INLINE unfirst #-}
instance Comonad (Fold a) where
extract :: forall a. Fold a a -> a
extract (Fold x -> a -> x
_ x
begin x -> a
done) = x -> a
done x
begin
{-# INLINE extract #-}
duplicate :: forall a. Fold a a -> Fold a (Fold a a)
duplicate (Fold x -> a -> x
step x
begin x -> a
done) = (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 :: forall a. 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) <*> :: forall a b. Fold a (a -> b) -> Fold a a -> Fold a b
<*> (Fold x -> a -> x
stepR x
beginR x -> a
doneR) =
let step :: Pair x x -> a -> Pair x x
step (Pair x
xL x
xR) a
a = 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 Extend (Fold a) where
duplicated :: forall a. Fold a a -> Fold a (Fold a a)
duplicated = Fold a a -> Fold a (Fold a a)
forall a. Fold a a -> Fold a (Fold a a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate
{-# INLINE duplicated #-}
instance Semigroup b => Semigroup (Fold a b) where
<> :: Fold a b -> Fold a b -> Fold a b
(<>) = (b -> b -> b) -> Fold a b -> Fold a b -> Fold a b
forall a b c. (a -> b -> c) -> Fold a a -> Fold a b -> Fold a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE (<>) #-}
instance Semigroupoid Fold where
o :: forall j k1 i. Fold j k1 -> Fold i j -> Fold i k1
o (Fold x -> j -> x
step1 x
begin1 x -> k1
done1) (Fold x -> i -> x
step2 x
begin2 x -> j
done2) = (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 a. a -> Fold a a
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 = Fold a b -> Fold a b -> Fold a b
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
instance Num b => Num (Fold a b) where
fromInteger :: Integer -> Fold a b
fromInteger = b -> Fold a b
forall a. a -> Fold a a
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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b c. (a -> b -> c) -> Fold a a -> Fold a b -> Fold a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Num a => a -> a -> a
(+)
{-# INLINE (+) #-}
* :: Fold a b -> Fold a b -> Fold a b
(*) = (b -> b -> b) -> Fold a b -> Fold a b -> Fold a b
forall a b c. (a -> b -> c) -> Fold a a -> Fold a b -> Fold a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Num a => a -> a -> a
(*)
{-# INLINE (*) #-}
(-) = (b -> b -> b) -> Fold a b -> Fold a b -> Fold a b
forall a b c. (a -> b -> c) -> Fold a a -> Fold a b -> Fold a c
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 a. a -> Fold a a
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 a b. (a -> b) -> Fold a a -> 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 a b c. (a -> b -> c) -> Fold a a -> Fold a b -> Fold a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Fractional a => a -> a -> a
(/)
{-# INLINE (/) #-}
instance Floating b => Floating (Fold a b) where
pi :: Fold a b
pi = b -> Fold a b
forall a. a -> Fold a a
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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b. (a -> b) -> Fold a a -> 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 a b c. (a -> b -> c) -> Fold a a -> Fold a b -> Fold a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Floating a => a -> a -> a
(**)
{-# INLINE (**) #-}
logBase :: Fold a b -> Fold a b -> Fold a b
logBase = (b -> b -> b) -> Fold a b -> Fold a b -> Fold a b
forall a b c. (a -> b -> c) -> Fold a a -> Fold a b -> Fold a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Floating a => a -> a -> a
logBase
{-# INLINE logBase #-}
data FoldM m a b =
forall x . FoldM (x -> a -> m x) (m x) (x -> m b)
instance Functor m => Functor (FoldM m a) where
fmap :: forall a b. (a -> b) -> FoldM m a a -> FoldM m a b
fmap a -> b
f (FoldM x -> a -> m x
step m x
start x -> m a
done) = (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 a b. (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 :: forall a. 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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\() -> a -> m a
forall a. 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) <*> :: forall a b. FoldM m a (a -> b) -> FoldM m a a -> FoldM m a b
<*> (FoldM x -> a -> m x
stepR m x
beginR x -> m a
doneR) =
let step :: Pair x x -> a -> m (Pair x x)
step (Pair x
xL x
xR) a
a = 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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
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 a b. 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 Monad m => Extend (FoldM m a) where
duplicated :: forall a. FoldM m a a -> FoldM m a (FoldM m a a)
duplicated = FoldM m a a -> FoldM m a (FoldM m a a)
forall (m :: * -> *) a b.
Applicative m =>
FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM
{-# INLINE duplicated #-}
instance Functor m => Profunctor (FoldM m) where
rmap :: forall b c a. (b -> c) -> FoldM m a b -> FoldM m a c
rmap = (b -> c) -> FoldM m a b -> FoldM m a c
forall a b. (a -> b) -> FoldM m a a -> FoldM m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
lmap :: forall a b c. (a -> b) -> FoldM m b c -> FoldM m a c
lmap a -> b
f (FoldM x -> b -> m x
step m x
begin x -> m c
done) = (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 a b c.
(a -> b -> c) -> FoldM m a a -> FoldM m a b -> FoldM m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE (<>) #-}
instance (Monoid b, Monad m) => Monoid (FoldM m a b) where
mempty :: FoldM m a b
mempty = b -> FoldM m a b
forall a. a -> FoldM m a a
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 = FoldM m a b -> FoldM m a b -> FoldM m a b
forall a. Semigroup a => a -> a -> a
(<>)
{-# 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 a. a -> FoldM m a a
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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b c.
(a -> b -> c) -> FoldM m a a -> FoldM m a b -> FoldM m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Num a => a -> a -> a
(+)
{-# INLINE (+) #-}
* :: 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 a b c.
(a -> b -> c) -> FoldM m a a -> FoldM m a b -> FoldM m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Num a => a -> a -> a
(*)
{-# INLINE (*) #-}
(-) = (b -> b -> b) -> FoldM m a b -> FoldM m a b -> FoldM m a b
forall a b c.
(a -> b -> c) -> FoldM m a a -> FoldM m a b -> FoldM m a c
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 a. a -> FoldM m a a
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 a b. (a -> b) -> FoldM m a a -> 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 a b c.
(a -> b -> c) -> FoldM m a a -> FoldM m a b -> FoldM m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Fractional a => a -> a -> a
(/)
{-# INLINE (/) #-}
instance (Monad m, Floating b) => Floating (FoldM m a b) where
pi :: FoldM m a b
pi = b -> FoldM m a b
forall a. a -> FoldM m a a
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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b. (a -> b) -> FoldM m a a -> 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 a b c.
(a -> b -> c) -> FoldM m a a -> FoldM m a b -> FoldM m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Floating a => a -> a -> a
(**)
{-# INLINE (**) #-}
logBase :: 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 a b c.
(a -> b -> c) -> FoldM m a a -> FoldM m a b -> FoldM m a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Floating a => a -> a -> a
logBase
{-# INLINE logBase #-}
fold :: Foldable f => Fold a b -> f a -> b
fold :: forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold (Fold x -> a -> x
step x
begin x -> b
done) f a
as = (a -> (x -> b) -> x -> b) -> (x -> b) -> f a -> x -> b
forall a b. (a -> b -> b) -> b -> f a -> 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 #-}
foldM :: (Foldable f, Monad m) => FoldM m a b -> f a -> m b
foldM :: forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
foldM (FoldM x -> a -> m x
step m x
begin x -> m b
done) f a
as0 = do
x
x0 <- m x
begin
(a -> (x -> m b) -> x -> m b) -> (x -> m b) -> f a -> x -> m b
forall a b. (a -> b -> b) -> b -> f a -> 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 #-}
scan :: Fold a b -> [a] -> [b]
scan :: forall a b. Fold a b -> [a] -> [b]
scan (Fold x -> a -> x
step x
begin x -> b
done) [a]
as = (a -> (x -> [b]) -> x -> [b]) -> (x -> [b]) -> [a] -> x -> [b]
forall a b. (a -> b -> b) -> b -> [a] -> 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 #-}
prescan :: Traversable t => Fold a b -> t a -> t b
prescan :: forall (t :: * -> *) a b. Traversable t => Fold a b -> t a -> t b
prescan (Fold x -> a -> x
step x
begin x -> b
done) t a
as = t b
bs
where
step' :: x -> a -> (x, b)
step' x
x a
a = (x
x', b
b)
where
x' :: x
x' = x -> a -> x
step x
x a
a
b :: b
b = x -> b
done x
x
(x
_, t b
bs) = (x -> a -> (x, b)) -> x -> t a -> (x, t b)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL x -> a -> (x, b)
step' x
begin t a
as
{-# INLINE prescan #-}
postscan :: Traversable t => Fold a b -> t a -> t b
postscan :: forall (t :: * -> *) a b. Traversable t => Fold a b -> t a -> t b
postscan (Fold x -> a -> x
step x
begin x -> b
done) t a
as = t b
bs
where
step' :: x -> a -> (x, b)
step' x
x a
a = (x
x', b
b)
where
x' :: x
x' = x -> a -> x
step x
x a
a
b :: b
b = x -> b
done x
x'
(x
_, t b
bs) = (x -> a -> (x, b)) -> x -> t a -> (x, t b)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL x -> a -> (x, b)
step' x
begin t a
as
{-# INLINE postscan #-}
mconcat :: Monoid a => Fold a a
mconcat :: forall a. Monoid a => 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 #-}
foldMap :: Monoid w => (a -> w) -> (w -> b) -> Fold a b
foldMap :: forall w a b. Monoid w => (a -> w) -> (w -> b) -> Fold a b
foldMap a -> w
to = (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 #-}
head :: Fold a (Maybe a)
head :: forall a. 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 #-}
last :: Fold a (Maybe a)
last :: forall a. 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 #-}
lastDef :: a -> Fold a a
lastDef :: forall a. 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 #-}
lastN :: Int -> Fold a [a]
lastN :: forall a. 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 {a}. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
{-# INLINABLE lastN #-}
null :: Fold a Bool
null :: forall a. 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 #-}
length :: Fold a Int
length :: forall a. Fold a Int
length = Fold a Int
forall b a. Num b => Fold a b
genericLength
{-# INLINABLE length #-}
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 #-}
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 :: (a -> Bool) -> Fold a Bool
all :: forall a. (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 :: (a -> Bool) -> Fold a Bool
any :: forall a. (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 #-}
sum :: Num a => Fold a a
sum :: forall a. Num a => 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 #-}
product :: Num a => Fold a a
product :: forall a. Num a => 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 #-}
mean :: Fractional a => Fold a a
mean :: forall a. Fractional a => 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 #-}
variance :: Fractional a => Fold a a
variance :: forall a. Fractional a => 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 {c}. Fractional c => Pair3 c c c -> c -> Pair3 c c c
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 c c c -> c -> Pair3 c c c
step (Pair3 c
n c
mean_ c
m2) c
x = c -> c -> c -> Pair3 c c c
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 c
n' c
mean' c
m2'
where
n' :: c
n' = c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1
mean' :: c
mean' = (c
n c -> c -> c
forall a. Num a => a -> a -> a
* c
mean_ c -> c -> c
forall a. Num a => a -> a -> a
+ c
x) c -> c -> c
forall a. Fractional a => a -> a -> a
/ (c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)
delta :: c
delta = c
x c -> c -> c
forall a. Num a => a -> a -> a
- c
mean_
m2' :: c
m2' = c
m2 c -> c -> c
forall a. Num a => a -> a -> a
+ c
delta c -> c -> c
forall a. Num a => a -> a -> a
* c
delta c -> c -> c
forall a. Num a => a -> a -> a
* c
n c -> c -> c
forall a. Fractional a => a -> a -> a
/ (c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
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 #-}
std :: Floating a => Fold a a
std :: forall a. Floating a => 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 #-}
maximum :: Ord a => Fold a (Maybe a)
maximum :: forall a. Ord a => 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 #-}
maximumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)
maximumBy :: forall a. (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 #-}
minimum :: Ord a => Fold a (Maybe a)
minimum :: forall a. Ord a => 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 #-}
minimumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)
minimumBy :: forall a. (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 :: Eq a => a -> Fold a Bool
elem :: forall a. Eq a => 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 :: Eq a => a -> Fold a Bool
notElem :: forall a. Eq a => 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 :: (a -> Bool) -> Fold a (Maybe a)
find :: forall a. (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 :: Int -> Fold a (Maybe a)
index :: forall a. 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 :: Eq a => a -> Fold a (Maybe Int)
elemIndex :: forall a. Eq a => 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 :: (a -> Bool) -> Fold a (Maybe Int)
findIndex :: forall a. (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 :: Eq a => a -> Fold (a,b) (Maybe b)
lookup :: forall a b. Eq a => 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
random :: FoldM IO a (Maybe a)
random :: forall a. FoldM IO a (Maybe a)
random = (Pair3 StdGen (Maybe' a) Int
-> a -> IO (Pair3 StdGen (Maybe' a) Int))
-> IO (Pair3 StdGen (Maybe' a) Int)
-> (Pair3 StdGen (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 StdGen (Maybe' a) Int
-> a -> IO (Pair3 StdGen (Maybe' a) Int)
forall {m :: * -> *} {a} {c} {a}.
(Monad m, RandomGen a, UniformRange c, Eq c, Num c) =>
Pair3 a (Maybe' a) c -> a -> m (Pair3 a (Maybe' a) c)
step IO (Pair3 StdGen (Maybe' a) Int)
forall {a}. IO (Pair3 StdGen (Maybe' a) Int)
begin Pair3 StdGen (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 StdGen (Maybe' a) Int)
begin = do
StdGen
g <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
Pair3 StdGen (Maybe' a) Int -> IO (Pair3 StdGen (Maybe' a) Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair3 StdGen (Maybe' a) Int -> IO (Pair3 StdGen (Maybe' a) Int))
-> Pair3 StdGen (Maybe' a) Int -> IO (Pair3 StdGen (Maybe' a) Int)
forall a b. (a -> b) -> a -> b
$! StdGen -> Maybe' a -> Int -> Pair3 StdGen (Maybe' a) Int
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 StdGen
g Maybe' a
forall a. Maybe' a
Nothing' (Int
1 :: Int)
step :: Pair3 a (Maybe' a) c -> a -> m (Pair3 a (Maybe' a) c)
step (Pair3 a
g Maybe' a
Nothing' c
_) a
a = Pair3 a (Maybe' a) c -> m (Pair3 a (Maybe' a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair3 a (Maybe' a) c -> m (Pair3 a (Maybe' a) c))
-> Pair3 a (Maybe' a) c -> m (Pair3 a (Maybe' a) c)
forall a b. (a -> b) -> a -> b
$! a -> Maybe' a -> c -> Pair3 a (Maybe' a) c
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
g (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a) c
2
step (Pair3 a
g (Just' a
a) c
m) a
b = do
let (c
n, a
g') = (c, c) -> a -> (c, a)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (c
1, c
m) a
g
let c :: a
c = if c
n c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
1 then a
b else a
a
Pair3 a (Maybe' a) c -> m (Pair3 a (Maybe' a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair3 a (Maybe' a) c -> m (Pair3 a (Maybe' a) c))
-> Pair3 a (Maybe' a) c -> m (Pair3 a (Maybe' a) c)
forall a b. (a -> b) -> a -> b
$! a -> Maybe' a -> c -> Pair3 a (Maybe' a) c
forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
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 a. a -> m 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
{ forall (v :: * -> *) a. RandomNState v a -> VectorState
_size :: !VectorState
, forall (v :: * -> *) a. RandomNState v a -> Mutable v RealWorld a
_reservoir :: !(Mutable v RealWorld a)
, forall (v :: * -> *) a. RandomNState v a -> Int
_position :: {-# UNPACK #-} !Int
, forall (v :: * -> *) a. RandomNState v a -> StdGen
_gen :: {-# UNPACK #-} !StdGen
}
randomN :: Vector v a => Int -> FoldM IO a (Maybe (v a))
randomN :: forall (v :: * -> *) a.
Vector v a =>
Int -> FoldM IO a (Maybe (v a))
randomN Int
n = (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 :: forall (v :: * -> *) a.
MVector (Mutable v) a =>
RandomNState v a -> a -> IO (RandomNState v a)
step (RandomNState (Incomplete Int
m) Mutable v RealWorld a
mv Int
i StdGen
g) a
a = do
Mutable v (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, 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 a. a -> IO 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 -> StdGen -> RandomNState v a
forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> 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) StdGen
g
step (RandomNState VectorState
Complete Mutable v RealWorld a
mv Int
i StdGen
g) a
a = do
let (Int
r, StdGen
g') = (Int, Int) -> StdGen -> (Int, StdGen)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) StdGen
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
RandomNState v a -> IO (RandomNState v a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> 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) StdGen
g')
begin :: IO (RandomNState v a)
begin = do
Mutable v (PrimState IO) a
mv <- Int -> IO (Mutable v (PrimState IO) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.new Int
n
StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
RandomNState VectorState
s Mutable v RealWorld a
Mutable v (PrimState IO) a
mv Int
1 StdGen
gen)
done :: Vector v a => RandomNState v a -> IO (Maybe (v a))
done :: forall (v :: * -> *) a.
Vector v a =>
RandomNState v a -> IO (Maybe (v a))
done (RandomNState (Incomplete Int
_) Mutable v RealWorld a
_ Int
_ StdGen
_) = Maybe (v a) -> IO (Maybe (v a))
forall a. a -> IO 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
_ StdGen
_) = 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> Maybe (v a)
forall a. a -> Maybe a
Just v a
v)
mapM_ :: Monad m => (a -> m ()) -> FoldM m a ()
mapM_ :: forall (m :: * -> *) a. Monad m => (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_ #-}
sink :: (Monoid w, Monad m) => (a -> m w) -> FoldM m a w
sink :: forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(a -> m w) -> FoldM m a w
sink a -> m w
act = (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 {a}. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
begin :: m w
begin = w -> m w
forall {a}. a -> m a
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 {a}. a -> m a
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 #-}
genericLength :: Num b => Fold a b
genericLength :: forall b a. Num b => 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 #-}
genericIndex :: Integral i => i -> Fold a (Maybe a)
genericIndex :: forall i a. Integral i => 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 #-}
list :: Fold a [a]
list :: forall a. 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 #-}
revList :: Fold a [a]
revList :: forall a. 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 #-}
nub :: Ord a => Fold a [a]
nub :: forall a. Ord a => 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 #-}
eqNub :: Eq a => Fold a [a]
eqNub :: forall a. Eq a => 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 a. Eq a => 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 #-}
set :: Ord a => Fold a (Set.Set a)
set :: forall a. Ord a => 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 #-}
hashSet :: (Eq a, Hashable a) => Fold a (HashSet.HashSet a)
hashSet :: forall a. (Eq a, Hashable a) => 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 #-}
map :: Ord a => Fold (a, b) (Map.Map a b)
map :: forall a b. Ord a => 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 #-}
foldByKeyMap :: forall k a b. Ord k => Fold a b -> Fold (k, a) (Map k b)
foldByKeyMap :: forall k a b. Ord k => Fold a b -> Fold (k, a) (Map k b)
foldByKeyMap Fold a b
f = case Fold a b
f of
Fold (x -> a -> x
step0 :: x -> a -> x) (x
ini0 :: x) (x -> b
end0 :: x -> b) ->
let
step :: Map k x -> (k,a) -> Map k x
step :: Map k x -> (k, a) -> Map k x
step Map k x
mp (k
k,a
a) = (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 a b. (a -> b) -> Map k a -> 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
hashMap :: (Eq a, Hashable a) => Fold (a, b) (HashMap.HashMap a b)
hashMap :: forall a b. (Eq a, Hashable a) => Fold (a, b) (HashMap a b)
hashMap = (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}. 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 #-}
foldByKeyHashMap :: forall k a b. (Hashable k, Eq k) => Fold a b -> Fold (k, a) (HashMap k b)
foldByKeyHashMap :: forall k a b.
(Hashable k, Eq k) =>
Fold a b -> Fold (k, a) (HashMap k b)
foldByKeyHashMap Fold a b
f = case Fold a b
f of
Fold (x -> a -> x
step0 :: x -> a -> x) (x
ini0 :: x) (x -> b
end0 :: x -> b) ->
let
step :: HashMap k x -> (k,a) -> HashMap k x
step :: HashMap k x -> (k, a) -> HashMap k x
step HashMap k x
mp (k
k,a
a) = (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 a b. (a -> b) -> HashMap k a -> 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
vector :: Vector v a => Fold a (v a)
vector :: forall (v :: * -> *) a. Vector v a => 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 a b. Fold a (a -> b) -> Fold a a -> Fold a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
vectorM :: (PrimMonad m, Vector v a) => FoldM m a (v a)
vectorM :: forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
FoldM m a (v a)
vectorM = (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 a. a -> m a
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 a. a -> 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 a. a -> m a
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 a. a -> m 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 #-}
purely :: (forall x . (x -> a -> x) -> x -> (x -> b) -> r) -> Fold a b -> r
purely :: forall a b r.
(forall x. (x -> a -> x) -> x -> (x -> b) -> r) -> Fold a b -> r
purely forall x. (x -> a -> x) -> x -> (x -> b) -> r
f (Fold x -> a -> x
step x
begin x -> b
done) = (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 #-}
purely_ :: (forall x . (x -> a -> x) -> x -> x) -> Fold a b -> b
purely_ :: forall a b. (forall x. (x -> a -> x) -> x -> x) -> Fold a b -> b
purely_ forall x. (x -> a -> x) -> x -> x
f (Fold x -> a -> x
step x
begin x -> b
done) = x -> b
done ((x -> a -> x) -> x -> x
forall x. (x -> a -> x) -> x -> x
f x -> a -> x
step x
begin)
{-# INLINABLE purely_ #-}
impurely
:: (forall x . (x -> a -> m x) -> m x -> (x -> m b) -> r)
-> FoldM m a b
-> r
impurely :: forall a (m :: * -> *) b r.
(forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r)
-> FoldM m a b -> r
impurely forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r
f (FoldM x -> a -> m x
step m x
begin x -> m b
done) = (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 #-}
impurely_
:: Monad m
=> (forall x . (x -> a -> m x) -> m x -> m x) -> FoldM m a b -> m b
impurely_ :: forall (m :: * -> *) a b.
Monad m =>
(forall x. (x -> a -> m x) -> m x -> m x) -> FoldM m a b -> m b
impurely_ forall x. (x -> a -> m x) -> m x -> m x
f (FoldM x -> a -> m x
step m x
begin x -> m b
done) = do
x
x <- (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 :: Monad m => Fold a b -> FoldM m a b
generalize :: forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
generalize (Fold x -> a -> x
step x
begin x -> b
done) = (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 a. a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return x
begin
done' :: x -> m b
done' x
x = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x)
{-# INLINABLE generalize #-}
simplify :: FoldM Identity a b -> Fold a b
simplify :: forall a b. FoldM Identity a b -> Fold a b
simplify (FoldM x -> a -> Identity x
step Identity x
begin x -> Identity b
done) = (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 #-}
hoists :: (forall x . m x -> n x) -> FoldM m a b -> FoldM n a b
hoists :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> FoldM m a b -> FoldM n a b
hoists forall x. m x -> n x
phi (FoldM x -> a -> m x
step m x
begin x -> m b
done) = (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 #-}
duplicateM :: Applicative m => FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM :: forall (m :: * -> *) a b.
Applicative m =>
FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM (FoldM x -> a -> m x
step m x
begin x -> m b
done) =
(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 a. a -> m a
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x) x -> m b
done))
{-# INLINABLE duplicateM #-}
_Fold1 :: (a -> a -> a) -> Fold a (Maybe a)
_Fold1 :: forall a. (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 :: (a -> b) -> Fold b r -> Fold a r
premap :: forall a b c. (a -> b) -> Fold b c -> Fold a c
premap a -> b
f (Fold x -> b -> x
step x
begin x -> r
done) = (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 :: Monad m => (a -> m b) -> FoldM m b r -> FoldM m a r
premapM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> FoldM m b r -> FoldM m a r
premapM a -> m b
f (FoldM x -> b -> m x
step m x
begin x -> m r
done) = (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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> b -> m x
step x
x
{-# INLINABLE premapM #-}
postmapM :: Monad m => (a -> m r) -> FoldM m x a -> FoldM m x r
postmapM :: forall (m :: * -> *) a r x.
Monad m =>
(a -> m r) -> FoldM m x a -> FoldM m x r
postmapM a -> m r
f (FoldM x -> x -> m x
step m x
begin x -> m a
done) = (x -> x -> m x) -> m x -> (x -> m r) -> FoldM m x r
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> x -> m x
step m x
begin x -> m r
done'
where done' :: x -> m r
done' x
x = x -> m a
done x
x m a -> (a -> m r) -> m r
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m r
f
{-# INLINABLE postmapM #-}
prefilter :: (a -> Bool) -> Fold a r -> Fold a r
prefilter :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
prefilter a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = (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 :: (Monad m) => (a -> m Bool) -> FoldM m a r -> FoldM m a r
prefilterM :: forall (m :: * -> *) a r.
Monad m =>
(a -> m Bool) -> FoldM m a r -> FoldM m a r
prefilterM a -> m Bool
f (FoldM x -> a -> m x
step m x
begin x -> m r
done) = (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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
{-# INLINABLE prefilterM #-}
predropWhile :: (a -> Bool) -> Fold a r -> Fold a r
predropWhile :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
predropWhile a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = (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 :: Natural -> Fold a b -> Fold a b
drop :: forall a b. Natural -> Fold a b -> Fold a b
drop Natural
n (Fold x -> a -> x
step x
begin x -> b
done) = ((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 :: Monad m => Natural -> FoldM m a b -> FoldM m a b
dropM :: forall (m :: * -> *) a b.
Monad m =>
Natural -> FoldM m a b -> FoldM m a b
dropM Natural
n (FoldM x -> a -> m x
step m x
begin x -> m b
done) = ((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 a b. (a -> b) -> m a -> m b
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 a b. (a -> b) -> m a -> m b
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 a. a -> m a
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 #-}
type Handler a b =
forall x . (b -> Const (Dual (Endo x)) b) -> a -> Const (Dual (Endo x)) a
handles :: Handler a b -> Fold b r -> Fold a r
handles :: forall a b r. Handler a b -> Fold b r -> Fold a r
handles Handler a b
k (Fold x -> b -> x
step x
begin x -> r
done) = (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 {k} a (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 :: Handler s a -> Fold a b -> s -> b
foldOver :: forall s a b. Handler s a -> Fold a b -> s -> b
foldOver Handler s a
l (Fold x -> a -> x
step x
begin x -> b
done) =
x -> b
done (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 {k} a (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 #-}
newtype EndoM m a = EndoM { forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM :: a -> m a }
instance Monad m => Semigroup (EndoM m a) where
(EndoM a -> m a
f) <> :: EndoM m a -> EndoM m a -> EndoM m a
<> (EndoM a -> m a
g) = (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 a. 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 #-}
type HandlerM m a b =
forall x . (b -> Const (Dual (EndoM m x)) b) -> a -> Const (Dual (EndoM m x)) a
handlesM :: HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM :: forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM HandlerM m a b
k (FoldM x -> b -> m x
step m x
begin x -> m r
done) = (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 {k} a (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 :: Monad m => HandlerM m s a -> FoldM m a b -> s -> m b
foldOverM :: forall (m :: * -> *) s a b.
Monad m =>
HandlerM m s a -> FoldM m a b -> s -> m b
foldOverM HandlerM m s a
l (FoldM x -> a -> m x
step m x
begin x -> m b
done) s
s = do
x
b <- m x
begin
x
r <- ((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 {k} a (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
:: (Contravariant f, Applicative f, Foldable t)
=> (a -> f a) -> (t a -> f (t a))
folded :: forall (f :: * -> *) (t :: * -> *) a.
(Contravariant f, Applicative f, Foldable t) =>
(a -> f a) -> t a -> f (t a)
folded a -> f a
k t a
ts = (t a -> ()) -> f () -> f (t a)
forall a' a. (a' -> a) -> f a -> f a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\t a
_ -> ()) ((a -> f a) -> t a -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
F.traverse_ a -> f a
k t a
ts)
{-# INLINABLE folded #-}
filtered :: Monoid m => (a -> Bool) -> (a -> m) -> a -> m
filtered :: forall m a. Monoid m => (a -> Bool) -> (a -> m) -> a -> m
filtered a -> Bool
p a -> m
k a
x
| a -> Bool
p a
x = a -> m
k a
x
| Bool
otherwise = m
forall a. Monoid a => a
mempty
{-# INLINABLE filtered #-}
groupBy :: Ord g => (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy :: forall g a r. Ord g => (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy a -> g
grouper (Fold x -> a -> x
f x
i x -> r
e) = (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 a b. (a -> b) -> Map g a -> Map g b
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 #-}
either :: Fold a1 b1 -> Fold a2 b2 -> Fold (Either a1 a2) (b1, b2)
either :: forall a1 b1 a2 b2.
Fold a1 b1 -> Fold a2 b2 -> Fold (Either a1 a2) (b1, b2)
either Fold a1 b1
l Fold a2 b2
r = (,) (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 (a1 -> Const (Dual (Endo x)) a1)
-> Either a1 a2 -> Const (Dual (Endo x)) (Either a1 a2)
Handler (Either a1 a2) a1
forall a c b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either a c) (f (Either b c))
_Left Fold a1 b1
l Fold (Either a1 a2) (b2 -> (b1, b2))
-> Fold (Either a1 a2) b2 -> Fold (Either a1 a2) (b1, b2)
forall a b.
Fold (Either a1 a2) (a -> b)
-> Fold (Either a1 a2) a -> Fold (Either a1 a2) b
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 (a2 -> Const (Dual (Endo x)) a2)
-> Either a1 a2 -> Const (Dual (Endo x)) (Either a1 a2)
Handler (Either a1 a2) a2
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right Fold a2 b2
r
{-# INLINABLE either #-}
eitherM :: Monad m => FoldM m a1 b1 -> FoldM m a2 b2 -> FoldM m (Either a1 a2) (b1, b2)
eitherM :: forall (m :: * -> *) a1 b1 a2 b2.
Monad m =>
FoldM m a1 b1 -> FoldM m a2 b2 -> FoldM m (Either a1 a2) (b1, b2)
eitherM FoldM m a1 b1
l FoldM m a2 b2
r = (,) (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 (a1 -> Const (Dual (EndoM m x)) a1)
-> Either a1 a2 -> Const (Dual (EndoM m x)) (Either a1 a2)
HandlerM m (Either a1 a2) a1
forall a c b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either a c) (f (Either b c))
_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 a b.
FoldM m (Either a1 a2) (a -> b)
-> FoldM m (Either a1 a2) a -> FoldM m (Either a1 a2) b
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 (a2 -> Const (Dual (EndoM m x)) a2)
-> Either a1 a2 -> Const (Dual (EndoM m x)) (Either a1 a2)
HandlerM m (Either a1 a2) a2
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right FoldM m a2 b2
r
{-# INLINABLE eitherM #-}
nest :: Applicative f => Fold a b -> Fold (f a) (f b)
nest :: forall (f :: * -> *) a b.
Applicative f =>
Fold a b -> Fold (f a) (f b)
nest (Fold x -> a -> x
s x
i x -> b
e) =
(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 a b c. (a -> b -> c) -> f a -> f b -> f c
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 a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
i)
(\f x
xs -> (x -> b) -> f x -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
e f x
xs)
{-# INLINABLE nest #-}