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