{-# 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
, 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) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step x
begin (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
done)
{-# INLINE fmap #-}
instance Profunctor Fold where
lmap :: forall a b c. (a -> b) -> Fold b c -> Fold a c
lmap = forall a b c. (a -> b) -> Fold b c -> Fold a c
premap
rmap :: forall b c a. (b -> c) -> Fold a b -> Fold a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
instance Choice Fold where
right' :: forall a b c. Fold a b -> Fold (Either c a) (Either c b)
right' (Fold x -> a -> x
step x
begin x -> b
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> a -> x
step) (forall a b. b -> Either a b
Right x
begin) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
done)
{-# INLINE right' #-}
instance Cosieve Fold [] where
cosieve :: forall a b. Fold a b -> [a] -> b
cosieve = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold
{-# INLINE cosieve #-}
instance Costrong Fold where
unfirst :: forall a d b. Fold (a, d) (b, d) -> Fold a b
unfirst Fold (a, d) (b, d)
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> b
f forall a. Fold a [a]
list
where
f :: [a] -> b
f [a]
as = b
b
where (b
b, d
d) = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold Fold (a, d) (b, d)
p [ (a
a, d
d) | a
a <- [a]
as ]
{-# INLINE unfirst #-}
instance Comonad (Fold a) where
extract :: forall a. Fold a a -> a
extract (Fold x -> a -> x
_ x
begin x -> a
done) = x -> a
done x
begin
{-# INLINE extract #-}
duplicate :: forall a. Fold a a -> Fold a (Fold a a)
duplicate (Fold x -> a -> x
step x
begin x -> a
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step x
begin (\x
x -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step x
x x -> a
done)
{-# INLINE duplicate #-}
instance Applicative (Fold a) where
pure :: forall a. a -> Fold a a
pure a
b = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\() a
_ -> ()) () (\() -> a
b)
{-# INLINE pure #-}
(Fold x -> a -> x
stepL x
beginL x -> a -> b
doneL) <*> :: forall a b. Fold a (a -> b) -> Fold a a -> Fold a b
<*> (Fold x -> a -> x
stepR x
beginR x -> a
doneR) =
let step :: Pair x x -> a -> Pair x x
step (Pair x
xL x
xR) a
a = forall a b. a -> b -> Pair a b
Pair (x -> a -> x
stepL x
xL a
a) (x -> a -> x
stepR x
xR a
a)
begin :: Pair x x
begin = forall a b. a -> b -> Pair a b
Pair x
beginL x
beginR
done :: Pair x x -> b
done (Pair x
xL x
xR) = x -> a -> b
doneL x
xL (x -> a
doneR x
xR)
in forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair x x -> a -> Pair x x
step Pair x x
begin Pair x x -> b
done
{-# INLINE (<*>) #-}
instance Extend (Fold a) where
duplicated :: forall a. Fold a a -> Fold a (Fold a a)
duplicated = forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate
{-# INLINE duplicated #-}
instance Semigroup b => Semigroup (Fold a b) where
<> :: Fold a b -> Fold a b -> Fold a b
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE (<>) #-}
instance Semigroupoid Fold where
o :: forall j k1 i. Fold j k1 -> Fold i j -> Fold i k1
o (Fold x -> j -> x
step1 x
begin1 x -> k1
done1) (Fold x -> i -> x
step2 x
begin2 x -> j
done2) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold
Pair x x -> i -> Pair x x
step
(forall a b. a -> b -> Pair a b
Pair x
begin1 x
begin2)
(\(Pair x
x x
_) -> x -> k1
done1 x
x)
where
step :: Pair x x -> i -> Pair x x
step (Pair x
c1 x
c2) i
a =
let c2' :: x
c2' = x -> i -> x
step2 x
c2 i
a
c1' :: x
c1' = x -> j -> x
step1 x
c1 (x -> j
done2 x
c2')
in forall a b. a -> b -> Pair a b
Pair x
c1' x
c2'
{-# INLINE o #-}
instance Monoid b => Monoid (Fold a b) where
mempty :: Fold a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
mappend :: Fold a b -> Fold a b -> Fold a b
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
{-# INLINE mappend #-}
instance Num b => Num (Fold a b) where
fromInteger :: Integer -> Fold a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
{-# INLINE fromInteger #-}
negate :: Fold a b -> Fold a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate
{-# INLINE negate #-}
abs :: Fold a b -> Fold a b
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs
{-# INLINE abs #-}
signum :: Fold a b -> Fold a b
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
{-# INLINE signum #-}
+ :: Fold a b -> Fold a b -> Fold a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)
{-# INLINE (+) #-}
* :: Fold a b -> Fold a b -> Fold a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)
{-# INLINE (*) #-}
(-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
{-# INLINE (-) #-}
instance Fractional b => Fractional (Fold a b) where
fromRational :: Rational -> Fold a b
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
{-# INLINE fromRational #-}
recip :: Fold a b -> Fold a b
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip
{-# INLINE recip #-}
/ :: Fold a b -> Fold a b -> Fold a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Fractional a => a -> a -> a
(/)
{-# INLINE (/) #-}
instance Floating b => Floating (Fold a b) where
pi :: Fold a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
{-# INLINE pi #-}
exp :: Fold a b -> Fold a b
exp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
exp
{-# INLINE exp #-}
sqrt :: Fold a b -> Fold a b
sqrt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sqrt
{-# INLINE sqrt #-}
log :: Fold a b -> Fold a b
log = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
log
{-# INLINE log #-}
sin :: Fold a b -> Fold a b
sin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sin
{-# INLINE sin #-}
tan :: Fold a b -> Fold a b
tan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tan
{-# INLINE tan #-}
cos :: Fold a b -> Fold a b
cos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cos
{-# INLINE cos #-}
asin :: Fold a b -> Fold a b
asin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asin
{-# INLINE asin #-}
atan :: Fold a b -> Fold a b
atan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atan
{-# INLINE atan #-}
acos :: Fold a b -> Fold a b
acos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acos
{-# INLINE acos #-}
sinh :: Fold a b -> Fold a b
sinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sinh
{-# INLINE sinh #-}
tanh :: Fold a b -> Fold a b
tanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tanh
{-# INLINE tanh #-}
cosh :: Fold a b -> Fold a b
cosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cosh
{-# INLINE cosh #-}
asinh :: Fold a b -> Fold a b
asinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asinh
{-# INLINE asinh #-}
atanh :: Fold a b -> Fold a b
atanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atanh
{-# INLINE atanh #-}
acosh :: Fold a b -> Fold a b
acosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acosh
{-# INLINE acosh #-}
** :: Fold a b -> Fold a b -> Fold a b
(**) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
(**)
{-# INLINE (**) #-}
logBase :: Fold a b -> Fold a b -> Fold a b
logBase = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
logBase
{-# INLINE logBase #-}
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) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step m x
start x -> m b
done'
where
done' :: x -> m b
done' x
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$! x -> m a
done x
x
{-# INLINE fmap #-}
instance Applicative m => Applicative (FoldM m a) where
pure :: forall a. a -> FoldM m a a
pure a
b = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\() a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\() -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b)
{-# INLINE pure #-}
(FoldM x -> a -> m x
stepL m x
beginL x -> m (a -> b)
doneL) <*> :: forall a b. FoldM m a (a -> b) -> FoldM m a a -> FoldM m a b
<*> (FoldM x -> a -> m x
stepR m x
beginR x -> m a
doneR) =
let step :: Pair x x -> a -> m (Pair x x)
step (Pair x
xL x
xR) a
a = forall a b. a -> b -> Pair a b
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> a -> m x
stepL x
xL a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> a -> m x
stepR x
xR a
a
begin :: m (Pair x x)
begin = forall a b. a -> b -> Pair a b
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
beginL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m x
beginR
done :: Pair x x -> m b
done (Pair x
xL x
xR) = x -> m (a -> b)
doneL x
xL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> m a
doneR x
xR
in forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Pair x x -> a -> m (Pair x x)
step m (Pair x x)
begin Pair x x -> m b
done
{-# INLINE (<*>) #-}
instance Monad m => Extend (FoldM m a) where
duplicated :: forall a. FoldM m a a -> FoldM m a (FoldM m a a)
duplicated = forall (m :: * -> *) a b.
Applicative m =>
FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM
{-# INLINE duplicated #-}
instance Functor m => Profunctor (FoldM m) where
rmap :: forall b c a. (b -> c) -> FoldM m a b -> FoldM m a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
lmap :: forall a b c. (a -> b) -> FoldM m b c -> FoldM m a c
lmap a -> b
f (FoldM x -> b -> m x
step m x
begin x -> m c
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m c
done
where
step' :: x -> a -> m x
step' x
x a
a = x -> b -> m x
step x
x (a -> b
f a
a)
instance (Semigroup b, Monad m) => Semigroup (FoldM m a b) where
<> :: FoldM m a b -> FoldM m a b -> FoldM m a b
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE (<>) #-}
instance (Monoid b, Monad m) => Monoid (FoldM m a b) where
mempty :: FoldM m a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
mappend :: FoldM m a b -> FoldM m a b -> FoldM m a b
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
{-# INLINE mappend #-}
instance (Monad m, Num b) => Num (FoldM m a b) where
fromInteger :: Integer -> FoldM m a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
{-# INLINE fromInteger #-}
negate :: FoldM m a b -> FoldM m a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate
{-# INLINE negate #-}
abs :: FoldM m a b -> FoldM m a b
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs
{-# INLINE abs #-}
signum :: FoldM m a b -> FoldM m a b
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
{-# INLINE signum #-}
+ :: FoldM m a b -> FoldM m a b -> FoldM m a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)
{-# INLINE (+) #-}
* :: FoldM m a b -> FoldM m a b -> FoldM m a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)
{-# INLINE (*) #-}
(-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
{-# INLINE (-) #-}
instance (Monad m, Fractional b) => Fractional (FoldM m a b) where
fromRational :: Rational -> FoldM m a b
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
{-# INLINE fromRational #-}
recip :: FoldM m a b -> FoldM m a b
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip
{-# INLINE recip #-}
/ :: FoldM m a b -> FoldM m a b -> FoldM m a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Fractional a => a -> a -> a
(/)
{-# INLINE (/) #-}
instance (Monad m, Floating b) => Floating (FoldM m a b) where
pi :: FoldM m a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
{-# INLINE pi #-}
exp :: FoldM m a b -> FoldM m a b
exp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
exp
{-# INLINE exp #-}
sqrt :: FoldM m a b -> FoldM m a b
sqrt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sqrt
{-# INLINE sqrt #-}
log :: FoldM m a b -> FoldM m a b
log = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
log
{-# INLINE log #-}
sin :: FoldM m a b -> FoldM m a b
sin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sin
{-# INLINE sin #-}
tan :: FoldM m a b -> FoldM m a b
tan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tan
{-# INLINE tan #-}
cos :: FoldM m a b -> FoldM m a b
cos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cos
{-# INLINE cos #-}
asin :: FoldM m a b -> FoldM m a b
asin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asin
{-# INLINE asin #-}
atan :: FoldM m a b -> FoldM m a b
atan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atan
{-# INLINE atan #-}
acos :: FoldM m a b -> FoldM m a b
acos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acos
{-# INLINE acos #-}
sinh :: FoldM m a b -> FoldM m a b
sinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sinh
{-# INLINE sinh #-}
tanh :: FoldM m a b -> FoldM m a b
tanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tanh
{-# INLINE tanh #-}
cosh :: FoldM m a b -> FoldM m a b
cosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cosh
{-# INLINE cosh #-}
asinh :: FoldM m a b -> FoldM m a b
asinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asinh
{-# INLINE asinh #-}
atanh :: FoldM m a b -> FoldM m a b
atanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atanh
{-# INLINE atanh #-}
acosh :: FoldM m a b -> FoldM m a b
acosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acosh
{-# INLINE acosh #-}
** :: FoldM m a b -> FoldM m a b -> FoldM m a b
(**) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
(**)
{-# INLINE (**) #-}
logBase :: FoldM m a b -> FoldM m a b -> FoldM m a b
logBase = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
logBase
{-# INLINE logBase #-}
fold :: Foldable f => Fold a b -> f a -> b
fold :: forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
fold (Fold x -> a -> x
step x
begin x -> b
done) f a
as = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {b}. a -> (x -> b) -> x -> b
cons x -> b
done f a
as x
begin
where
cons :: a -> (x -> b) -> x -> b
cons a
a x -> b
k x
x = x -> b
k forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a
{-# INLINE fold #-}
foldM :: (Foldable f, Monad m) => FoldM m a b -> f a -> m b
foldM :: forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
foldM (FoldM x -> a -> m x
step m x
begin x -> m b
done) f a
as0 = do
x
x0 <- m x
begin
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {b}. a -> (x -> m b) -> x -> m b
step' x -> m b
done f a
as0 forall a b. (a -> b) -> a -> b
$! x
x0
where
step' :: a -> (x -> m b) -> x -> m b
step' a
a x -> m b
k x
x = do
x
x' <- x -> a -> m x
step x
x a
a
x -> m b
k forall a b. (a -> b) -> a -> b
$! x
x'
{-# INLINE foldM #-}
scan :: Fold a b -> [a] -> [b]
scan :: forall a b. Fold a b -> [a] -> [b]
scan (Fold x -> a -> x
step x
begin x -> b
done) [a]
as = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (x -> [b]) -> x -> [b]
cons x -> [b]
nil [a]
as x
begin
where
nil :: x -> [b]
nil x
x = x -> b
done x
xforall a. a -> [a] -> [a]
:[]
cons :: a -> (x -> [b]) -> x -> [b]
cons a
a x -> [b]
k x
x = x -> b
done x
xforall a. a -> [a] -> [a]
:(x -> [b]
k forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a)
{-# INLINE scan #-}
prescan :: Traversable t => Fold a b -> t a -> t b
prescan :: forall (t :: * -> *) a b. Traversable t => Fold a b -> t a -> t b
prescan (Fold x -> a -> x
step x
begin x -> b
done) t a
as = t b
bs
where
step' :: x -> a -> (x, b)
step' x
x a
a = (x
x', b
b)
where
x' :: x
x' = x -> a -> x
step x
x a
a
b :: b
b = x -> b
done x
x
(x
_, t b
bs) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL x -> a -> (x, b)
step' x
begin t a
as
{-# INLINE prescan #-}
postscan :: Traversable t => Fold a b -> t a -> t b
postscan :: forall (t :: * -> *) a b. Traversable t => Fold a b -> t a -> t b
postscan (Fold x -> a -> x
step x
begin x -> b
done) t a
as = t b
bs
where
step' :: x -> a -> (x, b)
step' x
x a
a = (x
x', b
b)
where
x' :: x
x' = x -> a -> x
step x
x a
a
b :: b
b = x -> b
done x
x'
(x
_, t b
bs) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL x -> a -> (x, b)
step' x
begin t a
as
{-# INLINE postscan #-}
mconcat :: Monoid a => Fold a a
mconcat :: forall a. Monoid a => Fold a a
mconcat = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
mempty forall a. a -> a
id
{-# INLINABLE mconcat #-}
foldMap :: Monoid w => (a -> w) -> (w -> b) -> Fold a b
foldMap :: forall w a b. Monoid w => (a -> w) -> (w -> b) -> Fold a b
foldMap a -> w
to = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\w
x a
a -> forall a. Monoid a => a -> a -> a
mappend w
x (a -> w
to a
a)) forall a. Monoid a => a
mempty
{-# INLINABLE foldMap #-}
head :: Fold a (Maybe a)
head :: forall a. Fold a (Maybe a)
head = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 forall a b. a -> b -> a
const
{-# INLINABLE head #-}
last :: Fold a (Maybe a)
last :: forall a. Fold a (Maybe a)
last = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const)
{-# INLINABLE last #-}
lastDef :: a -> Fold a a
lastDef :: forall a. a -> Fold a a
lastDef a
a = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\a
_ a
a' -> a
a') a
a forall a. a -> a
id
{-# INLINABLE lastDef #-}
lastN :: Int -> Fold a [a]
lastN :: forall a. Int -> Fold a [a]
lastN Int
n = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. Seq a -> a -> Seq a
step forall {a}. Seq a
begin forall {a}. Seq a -> [a]
done
where
step :: Seq a -> a -> Seq a
step Seq a
s a
a = Seq a
s' forall {a}. Seq a -> a -> Seq a
|> a
a
where
s' :: Seq a
s' =
if forall a. Seq a -> Int
Seq.length Seq a
s forall a. Ord a => a -> a -> Bool
< Int
n
then Seq a
s
else forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq a
s
begin :: Seq a
begin = forall {a}. Seq a
Seq.empty
done :: Seq a -> [a]
done = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
{-# INLINABLE lastN #-}
null :: Fold a Bool
null :: forall a. Fold a Bool
null = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Bool
_ a
_ -> Bool
False) Bool
True forall a. a -> a
id
{-# INLINABLE null #-}
length :: Fold a Int
length :: forall a. Fold a Int
length = forall b a. Num b => Fold a b
genericLength
{-# INLINABLE length #-}
and :: Fold Bool Bool
and :: Fold Bool Bool
and = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Bool -> Bool -> Bool
(&&) Bool
True forall a. a -> a
id
{-# INLINABLE and #-}
or :: Fold Bool Bool
or :: Fold Bool Bool
or = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Bool -> Bool -> Bool
(||) Bool
False forall a. a -> a
id
{-# INLINABLE or #-}
all :: (a -> Bool) -> Fold a Bool
all :: forall a. (a -> Bool) -> Fold a Bool
all a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Bool
x a
a -> Bool
x Bool -> Bool -> Bool
&& a -> Bool
predicate a
a) Bool
True forall a. a -> a
id
{-# INLINABLE all #-}
any :: (a -> Bool) -> Fold a Bool
any :: forall a. (a -> Bool) -> Fold a Bool
any a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Bool
x a
a -> Bool
x Bool -> Bool -> Bool
|| a -> Bool
predicate a
a) Bool
False forall a. a -> a
id
{-# INLINABLE any #-}
sum :: Num a => Fold a a
sum :: forall a. Num a => Fold a a
sum = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Num a => a -> a -> a
(+) a
0 forall a. a -> a
id
{-# INLINABLE sum #-}
product :: Num a => Fold a a
product :: forall a. Num a => Fold a a
product = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Num a => a -> a -> a
(*) a
1 forall a. a -> a
id
{-# INLINABLE product #-}
mean :: Fractional a => Fold a a
mean :: forall a. Fractional a => Fold a a
mean = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {b}. Fractional b => Pair b b -> b -> Pair b b
step Pair a a
begin forall {a} {b}. Pair a b -> a
done
where
begin :: Pair a a
begin = forall a b. a -> b -> Pair a b
Pair a
0 a
0
step :: Pair b b -> b -> Pair b b
step (Pair b
x b
n) b
y = let n' :: b
n' = b
nforall a. Num a => a -> a -> a
+b
1 in forall a b. a -> b -> Pair a b
Pair (b
x forall a. Num a => a -> a -> a
+ (b
y forall a. Num a => a -> a -> a
- b
x) forall a. Fractional a => a -> a -> a
/b
n') b
n'
done :: Pair a b -> a
done (Pair a
x b
_) = a
x
{-# INLINABLE mean #-}
variance :: Fractional a => Fold a a
variance :: forall a. Fractional a => Fold a a
variance = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {c}. Fractional c => Pair3 c c c -> c -> Pair3 c c c
step Pair3 a a a
begin forall {a} {b}. Fractional a => Pair3 a b a -> a
done
where
begin :: Pair3 a a a
begin = forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
0 a
0 a
0
step :: Pair3 c c c -> c -> Pair3 c c c
step (Pair3 c
n c
mean_ c
m2) c
x = forall a b c. a -> b -> c -> Pair3 a b c
Pair3 c
n' c
mean' c
m2'
where
n' :: c
n' = c
n forall a. Num a => a -> a -> a
+ c
1
mean' :: c
mean' = (c
n forall a. Num a => a -> a -> a
* c
mean_ forall a. Num a => a -> a -> a
+ c
x) forall a. Fractional a => a -> a -> a
/ (c
n forall a. Num a => a -> a -> a
+ c
1)
delta :: c
delta = c
x forall a. Num a => a -> a -> a
- c
mean_
m2' :: c
m2' = c
m2 forall a. Num a => a -> a -> a
+ c
delta forall a. Num a => a -> a -> a
* c
delta forall a. Num a => a -> a -> a
* c
n forall a. Fractional a => a -> a -> a
/ (c
n forall a. Num a => a -> a -> a
+ c
1)
done :: Pair3 a b a -> a
done (Pair3 a
n b
_ a
m2) = a
m2 forall a. Fractional a => a -> a -> a
/ a
n
{-# INLINABLE variance #-}
std :: Floating a => Fold a a
std :: forall a. Floating a => Fold a a
std = forall a. Floating a => a -> a
sqrt forall a. Fractional a => Fold a a
variance
{-# INLINABLE std #-}
maximum :: Ord a => Fold a (Maybe a)
maximum :: forall a. Ord a => Fold a (Maybe a)
maximum = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 forall a. Ord a => a -> a -> a
max
{-# INLINABLE maximum #-}
maximumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)
maximumBy :: forall a. (a -> a -> Ordering) -> Fold a (Maybe a)
maximumBy a -> a -> Ordering
cmp = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
max'
where
max' :: a -> a -> a
max' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
Ordering
GT -> a
x
Ordering
_ -> a
y
{-# INLINABLE maximumBy #-}
minimum :: Ord a => Fold a (Maybe a)
minimum :: forall a. Ord a => Fold a (Maybe a)
minimum = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 forall a. Ord a => a -> a -> a
min
{-# INLINABLE minimum #-}
minimumBy :: (a -> a -> Ordering) -> Fold a (Maybe a)
minimumBy :: forall a. (a -> a -> Ordering) -> Fold a (Maybe a)
minimumBy a -> a -> Ordering
cmp = forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
min'
where
min' :: a -> a -> a
min' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
Ordering
GT -> a
y
Ordering
_ -> a
x
{-# INLINABLE minimumBy #-}
elem :: Eq a => a -> Fold a Bool
elem :: forall a. Eq a => a -> Fold a Bool
elem a
a = forall a. (a -> Bool) -> Fold a Bool
any (a
a forall a. Eq a => a -> a -> Bool
==)
{-# INLINABLE elem #-}
notElem :: Eq a => a -> Fold a Bool
notElem :: forall a. Eq a => a -> Fold a Bool
notElem a
a = forall a. (a -> Bool) -> Fold a Bool
all (a
a forall a. Eq a => a -> a -> Bool
/=)
{-# INLINABLE notElem #-}
find :: (a -> Bool) -> Fold a (Maybe a)
find :: forall a. (a -> Bool) -> Fold a (Maybe a)
find a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe' a -> a -> Maybe' a
step forall a. Maybe' a
Nothing' forall a. Maybe' a -> Maybe a
lazy
where
step :: Maybe' a -> a -> Maybe' a
step Maybe' a
x a
a = case Maybe' a
x of
Maybe' a
Nothing' -> if a -> Bool
predicate a
a then forall a. a -> Maybe' a
Just' a
a else forall a. Maybe' a
Nothing'
Maybe' a
_ -> Maybe' a
x
{-# INLINABLE find #-}
index :: Int -> Fold a (Maybe a)
index :: forall a. Int -> Fold a (Maybe a)
index = forall i a. Integral i => i -> Fold a (Maybe a)
genericIndex
{-# INLINABLE index #-}
elemIndex :: Eq a => a -> Fold a (Maybe Int)
elemIndex :: forall a. Eq a => a -> Fold a (Maybe Int)
elemIndex a
a = forall a. (a -> Bool) -> Fold a (Maybe Int)
findIndex (a
a forall a. Eq a => a -> a -> Bool
==)
{-# INLINABLE elemIndex #-}
findIndex :: (a -> Bool) -> Fold a (Maybe Int)
findIndex :: forall a. (a -> Bool) -> Fold a (Maybe Int)
findIndex a -> Bool
predicate = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. Num a => Either' a a -> a -> Either' a a
step (forall a b. a -> Either' a b
Left' Int
0) forall a b. Either' a b -> Maybe b
hush
where
step :: Either' a a -> a -> Either' a a
step Either' a a
x a
a = case Either' a a
x of
Left' a
i ->
if a -> Bool
predicate a
a
then forall a b. b -> Either' a b
Right' a
i
else forall a b. a -> Either' a b
Left' (a
i forall a. Num a => a -> a -> a
+ a
1)
Either' a a
_ -> Either' a a
x
{-# INLINABLE findIndex #-}
lookup :: Eq a => a -> Fold (a,b) (Maybe b)
lookup :: forall a b. Eq a => a -> Fold (a, b) (Maybe b)
lookup a
a0 = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. Maybe' a -> (a, a) -> Maybe' a
step forall a. Maybe' a
Nothing' forall a. Maybe' a -> Maybe a
lazy
where
step :: Maybe' a -> (a, a) -> Maybe' a
step Maybe' a
x (a
a,a
b) = case Maybe' a
x of
Maybe' a
Nothing' -> if a
a forall a. Eq a => a -> a -> Bool
== a
a0
then forall a. a -> Maybe' a
Just' a
b
else forall a. Maybe' a
Nothing'
Maybe' a
_ -> Maybe' a
x
{-# INLINABLE lookup #-}
data Pair3 a b c = Pair3 !a !b !c
random :: FoldM IO a (Maybe a)
random :: forall a. FoldM IO a (Maybe a)
random = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {m :: * -> *} {c} {a} {a}.
(Monad m, RandomGen a, UniformRange c, Eq c, Num c) =>
Pair3 a (Maybe' a) c -> a -> m (Pair3 a (Maybe' a) c)
step forall {a}. IO (Pair3 StdGen (Maybe' a) Int)
begin forall {m :: * -> *} {a} {a} {c}.
Monad m =>
Pair3 a (Maybe' a) c -> m (Maybe a)
done
where
begin :: IO (Pair3 StdGen (Maybe' a) Int)
begin = do
StdGen
g <- forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b c. a -> b -> c -> Pair3 a b c
Pair3 StdGen
g forall a. Maybe' a
Nothing' (Int
1 :: Int)
step :: Pair3 a (Maybe' a) c -> a -> m (Pair3 a (Maybe' a) c)
step (Pair3 a
g Maybe' a
Nothing' c
_) a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
g (forall a. a -> Maybe' a
Just' a
a) c
2
step (Pair3 a
g (Just' a
a) c
m) a
b = do
let (c
n, a
g') = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (c
1, c
m) a
g
let c :: a
c = if c
n forall a. Eq a => a -> a -> Bool
== c
1 then a
b else a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b c. a -> b -> c -> Pair3 a b c
Pair3 a
g' (forall a. a -> Maybe' a
Just' a
c) (c
m forall a. Num a => a -> a -> a
+ c
1)
done :: Pair3 a (Maybe' a) c -> m (Maybe a)
done (Pair3 a
_ Maybe' a
ma c
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe' a -> Maybe a
lazy Maybe' a
ma)
{-# INLINABLE random #-}
data VectorState = Incomplete {-# UNPACK #-} !Int | Complete
data RandomNState v a = RandomNState
{ forall (v :: * -> *) a. RandomNState v a -> VectorState
_size :: !VectorState
, forall (v :: * -> *) a. RandomNState v a -> Mutable v RealWorld a
_reservoir :: !(Mutable v RealWorld a)
, forall (v :: * -> *) a. RandomNState v a -> Int
_position :: {-# UNPACK #-} !Int
, forall (v :: * -> *) a. RandomNState v a -> StdGen
_gen :: {-# UNPACK #-} !StdGen
}
randomN :: Vector v a => Int -> FoldM IO a (Maybe (v a))
randomN :: forall (v :: * -> *) a.
Vector v a =>
Int -> FoldM IO a (Maybe (v a))
randomN Int
n = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall (v :: * -> *) a.
MVector (Mutable v) a =>
RandomNState v a -> a -> IO (RandomNState v a)
step IO (RandomNState v a)
begin forall (v :: * -> *) a.
Vector v a =>
RandomNState v a -> IO (Maybe (v a))
done
where
step
:: MVector (Mutable v) a
=> RandomNState v a -> a -> IO (RandomNState v a)
step :: forall (v :: * -> *) a.
MVector (Mutable v) a =>
RandomNState v a -> a -> IO (RandomNState v a)
step (RandomNState (Incomplete Int
m) Mutable v RealWorld a
mv Int
i StdGen
g) a
a = do
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.write Mutable v RealWorld a
mv Int
m a
a
let m' :: Int
m' = Int
m forall a. Num a => a -> a -> a
+ Int
1
let s :: VectorState
s = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
m' then VectorState
Complete else Int -> VectorState
Incomplete Int
m'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
RandomNState VectorState
s Mutable v RealWorld a
mv (Int
i forall a. Num a => a -> a -> a
+ Int
1) StdGen
g
step (RandomNState VectorState
Complete Mutable v RealWorld a
mv Int
i StdGen
g) a
a = do
let (Int
r, StdGen
g') = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0, Int
i forall a. Num a => a -> a -> a
- Int
1) StdGen
g
if Int
r forall a. Ord a => a -> a -> Bool
< Int
n
then forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite Mutable v RealWorld a
mv Int
r a
a
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
RandomNState VectorState
Complete Mutable v RealWorld a
mv (Int
i forall a. Num a => a -> a -> a
+ Int
1) StdGen
g')
begin :: IO (RandomNState v a)
begin = do
Mutable v (PrimState IO) a
mv <- forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.new Int
n
StdGen
gen <- forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
let s :: VectorState
s = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 then VectorState
Complete else Int -> VectorState
Incomplete Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (v :: * -> *) a.
VectorState
-> Mutable v RealWorld a -> Int -> StdGen -> RandomNState v a
RandomNState VectorState
s Mutable v (PrimState IO) a
mv Int
1 StdGen
gen)
done :: Vector v a => RandomNState v a -> IO (Maybe (v a))
done :: forall (v :: * -> *) a.
Vector v a =>
RandomNState v a -> IO (Maybe (v a))
done (RandomNState (Incomplete Int
_) Mutable v RealWorld a
_ Int
_ StdGen
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
done (RandomNState VectorState
Complete Mutable v RealWorld a
mv Int
_ StdGen
_) = do
v a
v <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
V.freeze Mutable v RealWorld a
mv
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just v a
v)
mapM_ :: Monad m => (a -> m ()) -> FoldM m a ()
mapM_ :: forall (m :: * -> *) a. Monad m => (a -> m ()) -> FoldM m a ()
mapM_ = forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(a -> m w) -> FoldM m a w
sink
{-# INLINABLE mapM_ #-}
sink :: (Monoid w, Monad m) => (a -> m w) -> FoldM m a w
sink :: forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(a -> m w) -> FoldM m a w
sink a -> m w
act = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM w -> a -> m w
step m w
begin forall {a}. a -> m a
done where
done :: a -> m a
done = forall (m :: * -> *) a. Monad m => a -> m a
return
begin :: m w
begin = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
step :: w -> a -> m w
step w
m a
a = do
w
m' <- a -> m w
act a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a -> a -> a
mappend w
m w
m'
{-# INLINABLE sink #-}
genericLength :: Num b => Fold a b
genericLength :: forall b a. Num b => Fold a b
genericLength = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\b
n a
_ -> b
n forall a. Num a => a -> a -> a
+ b
1) b
0 forall a. a -> a
id
{-# INLINABLE genericLength #-}
genericIndex :: Integral i => i -> Fold a (Maybe a)
genericIndex :: forall i a. Integral i => i -> Fold a (Maybe a)
genericIndex i
i = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {b}. Either' i b -> b -> Either' i b
step (forall a b. a -> Either' a b
Left' i
0) forall a b. Either' a b -> Maybe b
done
where
step :: Either' i b -> b -> Either' i b
step Either' i b
x b
a = case Either' i b
x of
Left' i
j -> if i
i forall a. Eq a => a -> a -> Bool
== i
j then forall a b. b -> Either' a b
Right' b
a else forall a b. a -> Either' a b
Left' (i
j forall a. Num a => a -> a -> a
+ i
1)
Either' i b
_ -> Either' i b
x
done :: Either' a a -> Maybe a
done Either' a a
x = case Either' a a
x of
Left' a
_ -> forall a. Maybe a
Nothing
Right' a
a -> forall a. a -> Maybe a
Just a
a
{-# INLINABLE genericIndex #-}
list :: Fold a [a]
list :: forall a. Fold a [a]
list = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\[a] -> [a]
x a
a -> [a] -> [a]
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
aforall a. a -> [a] -> [a]
:)) forall a. a -> a
id (forall a b. (a -> b) -> a -> b
$ [])
{-# INLINABLE list #-}
revList :: Fold a [a]
revList :: forall a. Fold a [a]
revList = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\[a]
x a
a -> a
aforall a. a -> [a] -> [a]
:[a]
x) [] forall a. a -> a
id
{-# INLINABLE revList #-}
nub :: Ord a => Fold a [a]
nub :: forall a. Ord a => Fold a [a]
nub = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a} {c}.
Ord a =>
Pair (Set a) ([a] -> c) -> a -> Pair (Set a) ([a] -> c)
step (forall a b. a -> b -> Pair a b
Pair forall a. Set a
Set.empty forall a. a -> a
id) forall {a} {a} {t}. Pair a ([a] -> t) -> t
fin
where
step :: Pair (Set a) ([a] -> c) -> a -> Pair (Set a) ([a] -> c)
step (Pair Set a
s [a] -> c
r) a
a = if forall a. Ord a => a -> Set a -> Bool
Set.member a
a Set a
s
then forall a b. a -> b -> Pair a b
Pair Set a
s [a] -> c
r
else forall a b. a -> b -> Pair a b
Pair (forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
s) ([a] -> c
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall a. a -> [a] -> [a]
:))
fin :: Pair a ([a] -> t) -> t
fin (Pair a
_ [a] -> t
r) = [a] -> t
r []
{-# INLINABLE nub #-}
eqNub :: Eq a => Fold a [a]
eqNub :: forall a. Eq a => Fold a [a]
eqNub = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a} {c}.
Eq a =>
Pair [a] ([a] -> c) -> a -> Pair [a] ([a] -> c)
step (forall a b. a -> b -> Pair a b
Pair [] forall a. a -> a
id) forall {a} {a} {t}. Pair a ([a] -> t) -> t
fin
where
step :: Pair [a] ([a] -> c) -> a -> Pair [a] ([a] -> c)
step (Pair [a]
known [a] -> c
r) a
a = if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem a
a [a]
known
then forall a b. a -> b -> Pair a b
Pair [a]
known [a] -> c
r
else forall a b. a -> b -> Pair a b
Pair (a
a forall a. a -> [a] -> [a]
: [a]
known) ([a] -> c
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall a. a -> [a] -> [a]
:))
fin :: Pair a ([a] -> t) -> t
fin (Pair a
_ [a] -> t
r) = [a] -> t
r []
{-# INLINABLE eqNub #-}
set :: Ord a => Fold a (Set.Set a)
set :: forall a. Ord a => Fold a (Set a)
set = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.insert) forall a. Set a
Set.empty forall a. a -> a
id
{-# INLINABLE set #-}
hashSet :: (Eq a, Hashable a) => Fold a (HashSet.HashSet a)
hashSet :: forall a. (Eq a, Hashable a) => Fold a (HashSet a)
hashSet = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert) forall a. HashSet a
HashSet.empty forall a. a -> a
id
{-# INLINABLE hashSet #-}
map :: Ord a => Fold (a, b) (Map.Map a b)
map :: forall a b. Ord a => Fold (a, b) (Map a b)
map = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {k} {a}. Ord k => Map k a -> (k, a) -> Map k a
step Map a b
begin forall a. a -> a
done
where
begin :: Map a b
begin = forall a. Monoid a => a
mempty
step :: Map k a -> (k, a) -> Map k a
step Map k a
m (k
k, a
v) = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k a
v Map k a
m
done :: a -> a
done = forall a. a -> a
id
{-# INLINABLE map #-}
foldByKeyMap :: forall k a b. Ord k => Fold a b -> Fold (k, a) (Map k b)
foldByKeyMap :: forall k a b. Ord k => Fold a b -> Fold (k, a) (Map k b)
foldByKeyMap Fold a b
f = case Fold a b
f of
Fold (x -> a -> x
step0 :: x -> a -> x) (x
ini0 :: x) (x -> b
end0 :: x -> b) ->
let
step :: Map k x -> (k,a) -> Map k x
step :: Map k x -> (k, a) -> Map k x
step Map k x
mp (k
k,a
a) = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe x -> Maybe x
addToMap k
k Map k x
mp where
addToMap :: Maybe x -> Maybe x
addToMap Maybe x
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
ini0 a
a
addToMap (Just x
existing) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
existing a
a
ini :: Map k x
ini :: Map k x
ini = forall k a. Map k a
Map.empty
end :: Map k x -> Map k b
end :: Map k x -> Map k b
end = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
end0
in forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Map k x -> (k, a) -> Map k x
step Map k x
ini Map k x -> Map k b
end where
hashMap :: (Eq a, Hashable a) => Fold (a, b) (HashMap.HashMap a b)
hashMap :: forall a b. (Eq a, Hashable a) => Fold (a, b) (HashMap a b)
hashMap = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {k} {v}. Hashable k => HashMap k v -> (k, v) -> HashMap k v
step HashMap a b
begin forall a. a -> a
done
where
begin :: HashMap a b
begin = forall a. Monoid a => a
mempty
step :: HashMap k v -> (k, v) -> HashMap k v
step HashMap k v
m (k
k, v
v) = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
k v
v HashMap k v
m
done :: a -> a
done = forall a. a -> a
id
{-# INLINABLE hashMap #-}
foldByKeyHashMap :: forall k a b. (Hashable k, Eq k) => Fold a b -> Fold (k, a) (HashMap k b)
foldByKeyHashMap :: forall k a b.
(Hashable k, Eq k) =>
Fold a b -> Fold (k, a) (HashMap k b)
foldByKeyHashMap Fold a b
f = case Fold a b
f of
Fold (x -> a -> x
step0 :: x -> a -> x) (x
ini0 :: x) (x -> b
end0 :: x -> b) ->
let
step :: HashMap k x -> (k,a) -> HashMap k x
step :: HashMap k x -> (k, a) -> HashMap k x
step HashMap k x
mp (k
k,a
a) = forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMap.alter Maybe x -> Maybe x
addToHashMap k
k HashMap k x
mp where
addToHashMap :: Maybe x -> Maybe x
addToHashMap Maybe x
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
ini0 a
a
addToHashMap (Just x
existing) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ x -> a -> x
step0 x
existing a
a
ini :: HashMap k x
ini :: HashMap k x
ini = forall k v. HashMap k v
HashMap.empty
end :: HashMap k x -> HashMap k b
end :: HashMap k x -> HashMap k b
end = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
end0
in forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold HashMap k x -> (k, a) -> HashMap k x
step HashMap k x
ini HashMap k x -> HashMap k b
end where
vector :: Vector v a => Fold a (v a)
vector :: forall (v :: * -> *) a. Vector v a => Fold a (v a)
vector = forall (v :: * -> *) a. Vector v a => Int -> [a] -> v a
V.fromReverseListN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Fold a Int
length forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Fold a [a]
revList
{-# INLINABLE vector #-}
maxChunkSize :: Int
maxChunkSize :: Int
maxChunkSize = Int
8 forall a. Num a => a -> a -> a
* Int
1024 forall a. Num a => a -> a -> a
* Int
1024
vectorM :: (PrimMonad m, Vector v a) => FoldM m a (v a)
vectorM :: forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
FoldM m a (v a)
vectorM = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {m :: * -> *} {v :: * -> * -> *} {a}.
(PrimMonad m, MVector v a) =>
Pair (v (PrimState m) a) Int
-> a -> m (Pair (v (PrimState m) a) Int)
step m (Pair (Mutable v (PrimState m) a) Int)
begin forall {m :: * -> *} {v :: * -> *} {a}.
(PrimMonad m, Vector v a) =>
Pair (Mutable v (PrimState m) a) Int -> m (v a)
done
where
begin :: m (Pair (Mutable v (PrimState m) a) Int)
begin = do
Mutable v (PrimState m) a
mv <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
M.unsafeNew Int
10
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair Mutable v (PrimState m) a
mv Int
0)
step :: Pair (v (PrimState m) a) Int
-> a -> m (Pair (v (PrimState m) a) Int)
step (Pair v (PrimState m) a
mv Int
idx) a
a = do
let len :: Int
len = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.length v (PrimState m) a
mv
v (PrimState m) a
mv' <- if Int
idx forall a. Ord a => a -> a -> Bool
>= Int
len
then forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.unsafeGrow v (PrimState m) a
mv (forall a. Ord a => a -> a -> a
min Int
len Int
maxChunkSize)
else forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) a
mv
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite v (PrimState m) a
mv' Int
idx a
a
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair v (PrimState m) a
mv' (Int
idx forall a. Num a => a -> a -> a
+ Int
1))
done :: Pair (Mutable v (PrimState m) a) Int -> m (v a)
done (Pair Mutable v (PrimState m) a
mv Int
idx) = do
v a
v <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
V.freeze Mutable v (PrimState m) a
mv
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
V.unsafeTake Int
idx v a
v)
{-# INLINABLE vectorM #-}
purely :: (forall x . (x -> a -> x) -> x -> (x -> b) -> r) -> Fold a b -> r
purely :: forall a b r.
(forall x. (x -> a -> x) -> x -> (x -> b) -> r) -> Fold a b -> r
purely forall x. (x -> a -> x) -> x -> (x -> b) -> r
f (Fold x -> a -> x
step x
begin x -> b
done) = forall x. (x -> a -> x) -> x -> (x -> b) -> r
f x -> a -> x
step x
begin x -> b
done
{-# INLINABLE purely #-}
purely_ :: (forall x . (x -> a -> x) -> x -> x) -> Fold a b -> b
purely_ :: forall a b. (forall x. (x -> a -> x) -> x -> x) -> Fold a b -> b
purely_ forall x. (x -> a -> x) -> x -> x
f (Fold x -> a -> x
step x
begin x -> b
done) = x -> b
done (forall x. (x -> a -> x) -> x -> x
f x -> a -> x
step x
begin)
{-# INLINABLE purely_ #-}
impurely
:: (forall x . (x -> a -> m x) -> m x -> (x -> m b) -> r)
-> FoldM m a b
-> r
impurely :: forall a (m :: * -> *) b r.
(forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r)
-> FoldM m a b -> r
impurely forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r
f (FoldM x -> a -> m x
step m x
begin x -> m b
done) = forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r
f x -> a -> m x
step m x
begin x -> m b
done
{-# INLINABLE impurely #-}
impurely_
:: Monad m
=> (forall x . (x -> a -> m x) -> m x -> m x) -> FoldM m a b -> m b
impurely_ :: forall (m :: * -> *) a b.
Monad m =>
(forall x. (x -> a -> m x) -> m x -> m x) -> FoldM m a b -> m b
impurely_ forall x. (x -> a -> m x) -> m x -> m x
f (FoldM x -> a -> m x
step m x
begin x -> m b
done) = do
x
x <- forall x. (x -> a -> m x) -> m x -> m x
f x -> a -> m x
step m x
begin
x -> m b
done x
x
{-# INLINABLE impurely_ #-}
generalize :: Monad m => Fold a b -> FoldM m a b
generalize :: forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
generalize (Fold x -> a -> x
step x
begin x -> b
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {m :: * -> *}. Monad m => x -> a -> m x
step' m x
begin' forall {m :: * -> *}. Monad m => x -> m b
done'
where
step' :: x -> a -> m x
step' x
x a
a = forall (m :: * -> *) a. Monad m => a -> m a
return (x -> a -> x
step x
x a
a)
begin' :: m x
begin' = forall (m :: * -> *) a. Monad m => a -> m a
return x
begin
done' :: x -> m b
done' x
x = forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x)
{-# INLINABLE generalize #-}
simplify :: FoldM Identity a b -> Fold a b
simplify :: forall a b. FoldM Identity a b -> Fold a b
simplify (FoldM x -> a -> Identity x
step Identity x
begin x -> Identity b
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin' x -> b
done'
where
step' :: x -> a -> x
step' x
x a
a = forall a. Identity a -> a
runIdentity (x -> a -> Identity x
step x
x a
a)
begin' :: x
begin' = forall a. Identity a -> a
runIdentity Identity x
begin
done' :: x -> b
done' x
x = forall a. Identity a -> a
runIdentity (x -> Identity b
done x
x)
{-# INLINABLE simplify #-}
hoists :: (forall x . m x -> n x) -> FoldM m a b -> FoldM n a b
hoists :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> FoldM m a b -> FoldM n a b
hoists forall x. m x -> n x
phi (FoldM x -> a -> m x
step m x
begin x -> m b
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\x
a a
b -> forall x. m x -> n x
phi (x -> a -> m x
step x
a a
b)) (forall x. m x -> n x
phi m x
begin) (forall x. m x -> n x
phi forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m b
done)
{-# INLINABLE hoists #-}
duplicateM :: Applicative m => FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM :: forall (m :: * -> *) a b.
Applicative m =>
FoldM m a b -> FoldM m a (FoldM m a b)
duplicateM (FoldM x -> a -> m x
step m x
begin x -> m b
done) =
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step m x
begin (\x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step (forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x) x -> m b
done))
{-# INLINABLE duplicateM #-}
_Fold1 :: (a -> a -> a) -> Fold a (Maybe a)
_Fold1 :: forall a. (a -> a -> a) -> Fold a (Maybe a)
_Fold1 a -> a -> a
step = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Maybe' a -> a -> Maybe' a
step_ forall a. Maybe' a
Nothing' forall a. Maybe' a -> Maybe a
lazy
where
step_ :: Maybe' a -> a -> Maybe' a
step_ Maybe' a
mx a
a = forall a. a -> Maybe' a
Just' (case Maybe' a
mx of
Maybe' a
Nothing' -> a
a
Just' a
x -> a -> a -> a
step a
x a
a)
{-# INLINABLE _Fold1 #-}
premap :: (a -> b) -> Fold b r -> Fold a r
premap :: forall a b c. (a -> b) -> Fold b c -> Fold a c
premap a -> b
f (Fold x -> b -> x
step x
begin x -> r
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin x -> r
done
where
step' :: x -> a -> x
step' x
x a
a = x -> b -> x
step x
x (a -> b
f a
a)
{-# INLINABLE premap #-}
premapM :: Monad m => (a -> m b) -> FoldM m b r -> FoldM m a r
premapM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> FoldM m b r -> FoldM m a r
premapM a -> m b
f (FoldM x -> b -> m x
step m x
begin x -> m r
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m r
done
where
step' :: x -> a -> m x
step' x
x a
a = a -> m b
f a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> b -> m x
step x
x
{-# INLINABLE premapM #-}
prefilter :: (a -> Bool) -> Fold a r -> Fold a r
prefilter :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
prefilter a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin x -> r
done
where
step' :: x -> a -> x
step' x
x a
a = if a -> Bool
f a
a then x -> a -> x
step x
x a
a else x
x
{-# INLINABLE prefilter #-}
prefilterM :: (Monad m) => (a -> m Bool) -> FoldM m a r -> FoldM m a r
prefilterM :: forall (m :: * -> *) a r.
Monad m =>
(a -> m Bool) -> FoldM m a r -> FoldM m a r
prefilterM a -> m Bool
f (FoldM x -> a -> m x
step m x
begin x -> m r
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m r
done
where
step' :: x -> a -> m x
step' x
x a
a = do
Bool
use <- a -> m Bool
f a
a
if Bool
use then x -> a -> m x
step x
x a
a else forall (m :: * -> *) a. Monad m => a -> m a
return x
x
{-# INLINABLE prefilterM #-}
predropWhile :: (a -> Bool) -> Fold a r -> Fold a r
predropWhile :: forall a r. (a -> Bool) -> Fold a r -> Fold a r
predropWhile a -> Bool
f (Fold x -> a -> x
step x
begin x -> r
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair Bool x -> a -> Pair Bool x
step' Pair Bool x
begin' forall {a}. Pair a x -> r
done'
where
step' :: Pair Bool x -> a -> Pair Bool x
step' (Pair Bool
dropping x
x) a
a = if Bool
dropping Bool -> Bool -> Bool
&& a -> Bool
f a
a
then forall a b. a -> b -> Pair a b
Pair Bool
True x
x
else forall a b. a -> b -> Pair a b
Pair Bool
False (x -> a -> x
step x
x a
a)
begin' :: Pair Bool x
begin' = forall a b. a -> b -> Pair a b
Pair Bool
True x
begin
done' :: Pair a x -> r
done' (Pair a
_ x
state) = x -> r
done x
state
{-# INLINABLE predropWhile #-}
drop :: Natural -> Fold a b -> Fold a b
drop :: forall a b. Natural -> Fold a b -> Fold a b
drop Natural
n (Fold x -> a -> x
step x
begin x -> b
done) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a}. (Eq a, Num a) => (a, x) -> a -> (a, x)
step' (Natural, x)
begin' forall {a}. (a, x) -> b
done'
where
begin' :: (Natural, x)
begin' = (Natural
n, x
begin)
step' :: (a, x) -> a -> (a, x)
step' (a
0, x
s) a
x = (a
0, x -> a -> x
step x
s a
x)
step' (a
n', x
s) a
_ = (a
n' forall a. Num a => a -> a -> a
- a
1, x
s)
done' :: (a, x) -> b
done' (a
_, x
s) = x -> b
done x
s
{-# INLINABLE drop #-}
dropM :: Monad m => Natural -> FoldM m a b -> FoldM m a b
dropM :: forall (m :: * -> *) a b.
Monad m =>
Natural -> FoldM m a b -> FoldM m a b
dropM Natural
n (FoldM x -> a -> m x
step m x
begin x -> m b
done) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM forall {a}. (Eq a, Num a) => (a, x) -> a -> m (a, x)
step' m (Natural, x)
begin' forall {a}. (a, x) -> m b
done'
where
begin' :: m (Natural, x)
begin' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
s -> (Natural
n, x
s)) m x
begin
step' :: (a, x) -> a -> m (a, x)
step' (a
0, x
s) a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
s' -> (a
0, x
s')) (x -> a -> m x
step x
s a
x)
step' (a
n', x
s) a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (a
n' forall a. Num a => a -> a -> a
- a
1, x
s)
done' :: (a, x) -> m b
done' (a
_, x
s) = x -> m b
done x
s
{-# INLINABLE dropM #-}
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) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin x -> r
done
where
step' :: x -> a -> x
step' = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler a b
k (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> b -> x
step))
{-# INLINABLE handles #-}
foldOver :: Handler s a -> Fold a b -> s -> b
foldOver :: forall s a b. Handler s a -> Fold a b -> s -> b
foldOver Handler s a
l (Fold x -> a -> x
step x
begin x -> b
done) =
x -> b
done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo x
begin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler s a
l (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> a -> x
step)
{-# INLINABLE foldOver #-}
newtype EndoM m a = EndoM { forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM :: a -> m a }
instance Monad m => Semigroup (EndoM m a) where
(EndoM a -> m a
f) <> :: EndoM m a -> EndoM m a -> EndoM m a
<> (EndoM a -> m a
g) = forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM (a -> m a
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m a
g)
{-# INLINE (<>) #-}
instance Monad m => Monoid (EndoM m a) where
mempty :: EndoM m a
mempty = forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE mempty #-}
mappend :: EndoM m a -> EndoM m a -> EndoM m a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
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) = forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m r
done
where
step' :: x -> a -> m x
step' = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerM m a b
k (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> b -> m x
step))
{-# INLINABLE handlesM #-}
foldOverM :: Monad m => HandlerM m s a -> FoldM m a b -> s -> m b
foldOverM :: forall (m :: * -> *) s a b.
Monad m =>
HandlerM m s a -> FoldM m a b -> s -> m b
foldOverM HandlerM m s a
l (FoldM x -> a -> m x
step m x
begin x -> m b
done) s
s = do
x
b <- m x
begin
x
r <- (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. EndoM m a -> a -> m a
appEndoM x
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerM m s a
l (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (a -> m a) -> EndoM m a
EndoM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> a -> m x
step)) s
s
x -> m b
done x
r
{-# INLINABLE foldOverM #-}
folded
:: (Contravariant f, Applicative f, Foldable t)
=> (a -> f a) -> (t a -> f (t a))
folded :: forall (f :: * -> *) (t :: * -> *) a.
(Contravariant f, Applicative f, Foldable t) =>
(a -> f a) -> t a -> f (t a)
folded a -> f a
k t a
ts = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (\t a
_ -> ()) (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
F.traverse_ a -> f a
k t a
ts)
{-# INLINABLE folded #-}
filtered :: Monoid m => (a -> Bool) -> (a -> m) -> a -> m
filtered :: forall m a. Monoid m => (a -> Bool) -> (a -> m) -> a -> m
filtered a -> Bool
p a -> m
k a
x
| a -> Bool
p a
x = a -> m
k a
x
| Bool
otherwise = forall a. Monoid a => a
mempty
{-# INLINABLE filtered #-}
groupBy :: Ord g => (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy :: forall g a r. Ord g => (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy a -> g
grouper (Fold x -> a -> x
f x
i x -> r
e) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Map g x -> a -> Map g x
f' forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> r
e)
where
f' :: Map g x -> a -> Map g x
f' !Map g x
m !a
a = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter (\Maybe x
o -> forall a. a -> Maybe a
Just (x -> a -> x
f (forall a. a -> Maybe a -> a
fromMaybe x
i Maybe x
o) a
a)) (a -> g
grouper a
a) Map g x
m
{-# INLINABLE groupBy #-}
either :: Fold a1 b1 -> Fold a2 b2 -> Fold (Either a1 a2) (b1, b2)
either :: forall a1 b1 a2 b2.
Fold a1 b1 -> Fold a2 b2 -> Fold (Either a1 a2) (b1, b2)
either Fold a1 b1
l Fold a2 b2
r = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b r. Handler a b -> Fold b r -> Fold a r
handles forall a c b. Prism (Either a c) (Either b c) a b
_Left Fold a1 b1
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b r. Handler a b -> Fold b r -> Fold a r
handles forall c a b. Prism (Either c a) (Either c b) a b
_Right Fold a2 b2
r
{-# INLINABLE either #-}
eitherM :: Monad m => FoldM m a1 b1 -> FoldM m a2 b2 -> FoldM m (Either a1 a2) (b1, b2)
eitherM :: forall (m :: * -> *) a1 b1 a2 b2.
Monad m =>
FoldM m a1 b1 -> FoldM m a2 b2 -> FoldM m (Either a1 a2) (b1, b2)
eitherM FoldM m a1 b1
l FoldM m a2 b2
r = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM forall a c b. Prism (Either a c) (Either b c) a b
_Left FoldM m a1 b1
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
handlesM forall c a b. Prism (Either c a) (Either c b) a b
_Right FoldM m a2 b2
r
{-# INLINABLE eitherM #-}
nest :: Applicative f => Fold a b -> Fold (f a) (f b)
nest :: forall (f :: * -> *) a b.
Applicative f =>
Fold a b -> Fold (f a) (f b)
nest (Fold x -> a -> x
s x
i x -> b
e) =
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\f x
xs f a
as -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> a -> x
s f x
xs f a
as)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure x
i)
(\f x
xs -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> b
e f x
xs)
{-# INLINABLE nest #-}