{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Streamly.Internal.Data.Fold.Container
(
toSet
, toIntSet
, countDistinct
, countDistinctInt
, nub
, nubInt
, frequency
, demuxerToContainer
, demuxerToContainerIO
, demuxerToMap
, demuxerToMapIO
, demuxKvToContainer
, demuxKvToMap
, demuxScanGeneric
, demuxScan
, demuxScanGenericIO
, demuxScanIO
, kvToMap
, toContainer
, toContainerIO
, toMap
, toMapIO
, classifyScanGeneric
, classifyScan
, classifyScanGenericIO
, classifyScanIO
, demuxGeneric
, demux
, demuxGenericIO
, demuxIO
, demuxToContainer
, demuxToContainerIO
, demuxToMap
, demuxToMapIO
, classifyGeneric
, classify
, classifyGenericIO
, classifyIO
)
where
#include "inline.hs"
#include "ArrayMacros.h"
import Control.Monad.IO.Class (MonadIO(..))
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Map.Strict (Map)
import Data.IntSet (IntSet)
import Data.Set (Set)
import Streamly.Internal.Data.IsMap (IsMap(..))
import Streamly.Internal.Data.Scanl.Type (Scanl(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
import qualified Data.Set as Set
import qualified Streamly.Internal.Data.IsMap as IsMap
import qualified Streamly.Internal.Data.Scanl.Container as Scanl
import Prelude hiding (Foldable(..))
import Streamly.Internal.Data.Fold.Type
#include "DocTestDataFold.hs"
{-# INLINE toSet #-}
toSet :: (Monad m, Ord a) => Fold m a (Set a)
toSet :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Set a)
toSet = Scanl m a (Set a) -> Fold m a (Set a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a (Set a)
forall (m :: * -> *) a. (Monad m, Ord a) => Scanl m a (Set a)
Scanl.toSet
{-# INLINE toIntSet #-}
toIntSet :: Monad m => Fold m Int IntSet
toIntSet :: forall (m :: * -> *). Monad m => Fold m Int IntSet
toIntSet = Scanl m Int IntSet -> Fold m Int IntSet
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m Int IntSet
forall (m :: * -> *). Monad m => Scanl m Int IntSet
Scanl.toIntSet
{-# INLINE nub #-}
nub :: (Monad m, Ord a) => Fold m a (Maybe a)
nub :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Maybe a)
nub = Scanl m a (Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a (Maybe a)
forall (m :: * -> *) a. (Monad m, Ord a) => Scanl m a (Maybe a)
Scanl.nub
{-# INLINE nubInt #-}
nubInt :: Monad m => Fold m Int (Maybe Int)
nubInt :: forall (m :: * -> *). Monad m => Fold m Int (Maybe Int)
nubInt = Scanl m Int (Maybe Int) -> Fold m Int (Maybe Int)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m Int (Maybe Int)
forall (m :: * -> *). Monad m => Scanl m Int (Maybe Int)
Scanl.nubInt
{-# INLINE countDistinct #-}
countDistinct :: (Monad m, Ord a) => Fold m a Int
countDistinct :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a Int
countDistinct = Scanl m a Int -> Fold m a Int
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a Int
forall (m :: * -> *) a. (Monad m, Ord a) => Scanl m a Int
Scanl.countDistinct
{-# INLINE countDistinctInt #-}
countDistinctInt :: Monad m => Fold m Int Int
countDistinctInt :: forall (m :: * -> *). Monad m => Fold m Int Int
countDistinctInt = Scanl m Int Int -> Fold m Int Int
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m Int Int
forall (m :: * -> *). Monad m => Scanl m Int Int
Scanl.countDistinctInt
{-# DEPRECATED demuxGeneric "Use demuxScanGeneric instead" #-}
{-# INLINE demuxGeneric #-}
demuxGeneric :: (Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b))
-> Fold m a (m (f b), Maybe (Key f, b))
demuxGeneric :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
demuxGeneric a -> Key f
getKey a -> m (Fold m a b)
getFold =
(Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Fold m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple' (f (Fold m a b)) (Maybe (Key f, b))
s a
a -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> a -> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {b}.
(Key f ~ Key f, IsMap f) =>
Tuple' (f (Fold m a b)) b
-> a -> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
step Tuple' (f (Fold m a b)) (Maybe (Key f, b))
s a
a) (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {a} {a}. m (Tuple' (f a) (Maybe a))
initial) Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, Monad m) =>
Tuple' (t (Fold m a b)) b -> m (m (t b), b)
extract Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, Monad m) =>
Tuple' (t (Fold m a b)) b -> m (m (t b), b)
final
where
initial :: m (Tuple' (f a) (Maybe a))
initial = Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a)))
-> Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe a -> Tuple' (f a) (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Maybe a
forall a. Maybe a
Nothing
{-# INLINE runFold #-}
runFold :: f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
runFold f (Fold m a b)
kv (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ case Step s b
res1 of
Partial s
_ ->
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
extract1 s -> m b
final1
in f (Fold m a b)
-> Maybe (Key f, b) -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> Fold m a b -> f (Fold m a b) -> f (Fold m a b)
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k Fold m a b
fld f (Fold m a b)
kv) Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b -> f (Fold m a b)
-> Maybe (Key f, b) -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> f (Fold m a b) -> f (Fold m a b)
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
k f (Fold m a b)
kv) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b ->
Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (Fold m a b)
-> Maybe (Key f, b) -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (Fold m a b)
kv ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
step :: Tuple' (f (Fold m a b)) b
-> a -> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
step (Tuple' f (Fold m a b)
kv b
_) a
a = do
let k :: Key f
k = a -> Key f
getKey a
a
case Key f -> f (Fold m a b) -> Maybe (Fold m a b)
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (Fold m a b)
kv of
Maybe (Fold m a b)
Nothing -> do
Fold m a b
fld <- a -> m (Fold m a b)
getFold a
a
f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {m :: * -> *} {a} {b}.
(IsMap f, Monad m) =>
f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
runFold f (Fold m a b)
kv Fold m a b
fld (Key f
Key f
k, a
a)
Just Fold m a b
f -> f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {m :: * -> *} {a} {b}.
(IsMap f, Monad m) =>
f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
runFold f (Fold m a b)
kv Fold m a b
f (Key f
Key f
k, a
a)
extract :: Tuple' (t (Fold m a b)) b -> m (m (t b), b)
extract (Tuple' t (Fold m a b)
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Fold m a b -> m b) -> t (Fold m a b) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM Fold m a b -> m b
forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
f t (Fold m a b)
kv, b
x)
where
f :: Fold m a b -> m b
f (Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
e s -> m b
_) = do
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
e s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGeneric: unreachable code"
final :: Tuple' (t (Fold m a b)) b -> m (m (t b), b)
final (Tuple' t (Fold m a b)
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Fold m a b -> m b) -> t (Fold m a b) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM Fold m a b -> m b
forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
f t (Fold m a b)
kv, b
x)
where
f :: Fold m a b -> m b
f (Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin) = do
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
fin s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGeneric: unreachable code"
{-# INLINE demuxerToContainer #-}
demuxerToContainer :: (Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Fold m a (f b)
demuxerToContainer :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Fold m a (f b)
demuxerToContainer a -> Key f
getKey Key f -> m (Maybe (Fold m a b))
getFold =
(Tuple' (f (Fold m a b)) (f b)
-> a -> m (Step (Tuple' (f (Fold m a b)) (f b)) (f b)))
-> m (Step (Tuple' (f (Fold m a b)) (f b)) (f b))
-> (Tuple' (f (Fold m a b)) (f b) -> m (f b))
-> (Tuple' (f (Fold m a b)) (f b) -> m (f b))
-> Fold m a (f b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple' (f (Fold m a b)) (f b)
s a
a -> Tuple' (f (Fold m a b)) (f b)
-> Step (Tuple' (f (Fold m a b)) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f (Fold m a b)) (f b)
-> Step (Tuple' (f (Fold m a b)) (f b)) (f b))
-> m (Tuple' (f (Fold m a b)) (f b))
-> m (Step (Tuple' (f (Fold m a b)) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f (Fold m a b)) (f b)
-> a -> m (Tuple' (f (Fold m a b)) (f b))
forall {f :: * -> *} {f :: * -> *}.
(Key f ~ Key f, Key f ~ Key f, IsMap f, IsMap f) =>
Tuple' (f (Fold m a b)) (f b)
-> a -> m (Tuple' (f (Fold m a b)) (f b))
step Tuple' (f (Fold m a b)) (f b)
s a
a) (Tuple' (f (Fold m a b)) (f b)
-> Step (Tuple' (f (Fold m a b)) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f (Fold m a b)) (f b)
-> Step (Tuple' (f (Fold m a b)) (f b)) (f b))
-> m (Tuple' (f (Fold m a b)) (f b))
-> m (Step (Tuple' (f (Fold m a b)) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f (Fold m a b)) (f b))
forall {a} {a}. m (Tuple' (f a) (f a))
initial) Tuple' (f (Fold m a b)) (f b) -> m (f b)
forall a. HasCallStack => a
undefined Tuple' (f (Fold m a b)) (f b) -> m (f b)
forall {m :: * -> *} {f :: * -> *} {a} {a}.
(Monad m, Traversable f, IsMap f) =>
Tuple' (f (Fold m a a)) (f a) -> m (f a)
final
where
initial :: m (Tuple' (f a) (f a))
initial = Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (f a) -> m (Tuple' (f a) (f a)))
-> Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a b. (a -> b) -> a -> b
$ f a -> f a -> Tuple' (f a) (f a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty
{-# INLINE runFold #-}
runFold :: f (Fold m a b)
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (f b))
runFold f (Fold m a b)
kv f b
kv1 (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
_ s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple' (f (Fold m a b)) (f b) -> m (Tuple' (f (Fold m a b)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple' (f (Fold m a b)) (f b)
-> m (Tuple' (f (Fold m a b)) (f b)))
-> Tuple' (f (Fold m a b)) (f b)
-> m (Tuple' (f (Fold m a b)) (f b))
forall a b. (a -> b) -> a -> b
$ case Step s b
res1 of
Partial s
_ ->
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
forall a. HasCallStack => a
undefined s -> m b
final1
in f (Fold m a b) -> f b -> Tuple' (f (Fold m a b)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> Fold m a b -> f (Fold m a b) -> f (Fold m a b)
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k Fold m a b
fld f (Fold m a b)
kv) f b
kv1
Done b
b ->
f (Fold m a b) -> f b -> Tuple' (f (Fold m a b)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple'
(Key f -> f (Fold m a b) -> f (Fold m a b)
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
k f (Fold m a b)
kv)
(Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
Done b
b ->
Tuple' (f (Fold m a b)) (f b) -> m (Tuple' (f (Fold m a b)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (Fold m a b)) (f b)
-> m (Tuple' (f (Fold m a b)) (f b)))
-> Tuple' (f (Fold m a b)) (f b)
-> m (Tuple' (f (Fold m a b)) (f b))
forall a b. (a -> b) -> a -> b
$ f (Fold m a b) -> f b -> Tuple' (f (Fold m a b)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (Fold m a b)
kv (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
step :: Tuple' (f (Fold m a b)) (f b)
-> a -> m (Tuple' (f (Fold m a b)) (f b))
step (Tuple' f (Fold m a b)
kv f b
kv1) a
a = do
let k :: Key f
k = a -> Key f
getKey a
a
case Key f -> f (Fold m a b) -> Maybe (Fold m a b)
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (Fold m a b)
kv of
Maybe (Fold m a b)
Nothing -> do
Maybe (Fold m a b)
mfld <- Key f -> m (Maybe (Fold m a b))
getFold Key f
k
case Maybe (Fold m a b)
mfld of
Maybe (Fold m a b)
Nothing -> Tuple' (f (Fold m a b)) (f b) -> m (Tuple' (f (Fold m a b)) (f b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tuple' (f (Fold m a b)) (f b)
-> m (Tuple' (f (Fold m a b)) (f b)))
-> Tuple' (f (Fold m a b)) (f b)
-> m (Tuple' (f (Fold m a b)) (f b))
forall a b. (a -> b) -> a -> b
$ f (Fold m a b) -> f b -> Tuple' (f (Fold m a b)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (Fold m a b)
kv f b
kv1
Just Fold m a b
fld -> f (Fold m a b)
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (f b))
forall {f :: * -> *} {f :: * -> *} {m :: * -> *} {a} {b}.
(Key f ~ Key f, IsMap f, IsMap f, Monad m) =>
f (Fold m a b)
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (f b))
runFold f (Fold m a b)
kv f b
kv1 Fold m a b
fld (Key f
Key f
k, a
a)
Just Fold m a b
f -> f (Fold m a b)
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (f b))
forall {f :: * -> *} {f :: * -> *} {m :: * -> *} {a} {b}.
(Key f ~ Key f, IsMap f, IsMap f, Monad m) =>
f (Fold m a b)
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (f b))
runFold f (Fold m a b)
kv f b
kv1 Fold m a b
f (Key f
Key f
k, a
a)
final :: Tuple' (f (Fold m a a)) (f a) -> m (f a)
final (Tuple' f (Fold m a a)
kv f a
kv1) = do
f a
r <- (Fold m a a -> m a) -> f (Fold m a a) -> m (f a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
Prelude.mapM Fold m a a -> m a
forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
f f (Fold m a a)
kv
f a -> m (f a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> m (f a)) -> f a -> m (f a)
forall a b. (a -> b) -> a -> b
$ f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. IsMap f => f a -> f a -> f a
IsMap.mapUnion f a
r f a
kv1
where
f :: Fold m a b -> m b
f (Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin) = do
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
fin s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxerToContainer: unreachable code"
{-# INLINE demuxScanGeneric #-}
demuxScanGeneric :: (Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxScanGeneric :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxScanGeneric a -> Key f
getKey Key f -> m (Maybe (Fold m a b))
getFold =
(Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b
Scanl (\Tuple' (f (Fold m a b)) (Maybe (Key f, b))
s a
a -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> a -> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {b}.
(Key f ~ Key f, IsMap f) =>
Tuple' (f (Fold m a b)) b
-> a -> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
step Tuple' (f (Fold m a b)) (Maybe (Key f, b))
s a
a) (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {a} {a}. m (Tuple' (f a) (Maybe a))
initial) Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, Monad m) =>
Tuple' (t (Fold m a b)) b -> m (m (t b), b)
extract Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, Monad m) =>
Tuple' (t (Fold m a b)) b -> m (m (t b), b)
final
where
initial :: m (Tuple' (f a) (Maybe a))
initial = Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a)))
-> Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe a -> Tuple' (f a) (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Maybe a
forall a. Maybe a
Nothing
{-# INLINE runFold #-}
runFold :: f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
runFold f (Fold m a b)
kv (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ case Step s b
res1 of
Partial s
_ ->
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
extract1 s -> m b
final1
in f (Fold m a b)
-> Maybe (Key f, b) -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> Fold m a b -> f (Fold m a b) -> f (Fold m a b)
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k Fold m a b
fld f (Fold m a b)
kv) Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b -> f (Fold m a b)
-> Maybe (Key f, b) -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> f (Fold m a b) -> f (Fold m a b)
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
k f (Fold m a b)
kv) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b ->
Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (Fold m a b)
-> Maybe (Key f, b) -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (Fold m a b)
kv ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
step :: Tuple' (f (Fold m a b)) b
-> a -> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
step (Tuple' f (Fold m a b)
kv b
_) a
a = do
let k :: Key f
k = a -> Key f
getKey a
a
case Key f -> f (Fold m a b) -> Maybe (Fold m a b)
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (Fold m a b)
kv of
Maybe (Fold m a b)
Nothing -> do
Maybe (Fold m a b)
mfld <- Key f -> m (Maybe (Fold m a b))
getFold Key f
k
case Maybe (Fold m a b)
mfld of
Maybe (Fold m a b)
Nothing -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (Fold m a b)
-> Maybe (Key f, b) -> Tuple' (f (Fold m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (Fold m a b)
kv Maybe (Key f, b)
forall a. Maybe a
Nothing
Just Fold m a b
fld -> f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {m :: * -> *} {a} {b}.
(IsMap f, Monad m) =>
f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
runFold f (Fold m a b)
kv Fold m a b
fld (Key f
Key f
k, a
a)
Just Fold m a b
f -> f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {m :: * -> *} {a} {b}.
(IsMap f, Monad m) =>
f (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (Fold m a b)) (Maybe (Key f, b)))
runFold f (Fold m a b)
kv Fold m a b
f (Key f
Key f
k, a
a)
extract :: Tuple' (t (Fold m a b)) b -> m (m (t b), b)
extract (Tuple' t (Fold m a b)
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Fold m a b -> m b) -> t (Fold m a b) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM Fold m a b -> m b
forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
f t (Fold m a b)
kv, b
x)
where
f :: Fold m a b -> m b
f (Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
e s -> m b
_) = do
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
e s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGeneric: unreachable code"
final :: Tuple' (t (Fold m a b)) b -> m (m (t b), b)
final (Tuple' t (Fold m a b)
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Fold m a b -> m b) -> t (Fold m a b) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM Fold m a b -> m b
forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
f t (Fold m a b)
kv, b
x)
where
f :: Fold m a b -> m b
f (Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin) = do
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
fin s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGeneric: unreachable code"
{-# DEPRECATED demux "Use demuxScan instead" #-}
{-# INLINE demux #-}
demux :: (Monad m, Ord k) =>
(a -> k)
-> (a -> m (Fold m a b))
-> Fold m a (m (Map k b), Maybe (k, b))
demux :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k)
-> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))
demux = (a -> k)
-> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> (a -> m (Fold m a b))
-> Fold m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
demuxGeneric
{-# INLINE demuxUsingMap #-}
demuxUsingMap :: (Monad m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMap :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMap = (a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> (Key (Map k) -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxScanGeneric
{-# INLINE demuxScan #-}
demuxScan :: (Monad m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (Maybe (k, b))
demuxScan :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b))) -> Scanl m a (Maybe (k, b))
demuxScan a -> k
getKey = ((m (Map k b), Maybe (k, b)) -> Maybe (k, b))
-> Scanl m a (m (Map k b), Maybe (k, b))
-> Scanl m a (Maybe (k, b))
forall a b. (a -> b) -> Scanl m a a -> Scanl m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (Map k b), Maybe (k, b)) -> Maybe (k, b)
forall a b. (a, b) -> b
snd (Scanl m a (m (Map k b), Maybe (k, b)) -> Scanl m a (Maybe (k, b)))
-> ((k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b)))
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMap a -> k
getKey
{-# DEPRECATED demuxGenericIO "Use demuxScanGenericIO instead" #-}
{-# INLINE demuxGenericIO #-}
demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b))
-> Fold m a (m (f b), Maybe (Key f, b))
demuxGenericIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
demuxGenericIO a -> Key f
getKey a -> m (Fold m a b)
getFold =
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Fold m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
s a
a -> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> a -> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {f :: * -> *} {b}.
(Key f ~ Key f, IsMap f) =>
Tuple' (f (IORef (Fold m a b))) b
-> a -> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
step Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
s a
a) (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {a} {a}. m (Tuple' (f a) (Maybe a))
initial) Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, MonadIO m) =>
Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
extract Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, MonadIO m) =>
Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
final
where
initial :: m (Tuple' (f a) (Maybe a))
initial = Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a)))
-> Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe a -> Tuple' (f a) (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Maybe a
forall a. Maybe a
Nothing
{-# INLINE initFold #-}
initFold :: f (IORef (Fold m a b))
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
initFold f (IORef (Fold m a b))
kv (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
res1 of
Partial s
_ -> do
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
extract1 s -> m b
final1
IORef (Fold m a b)
ref <- IO (IORef (Fold m a b)) -> m (IORef (Fold m a b))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Fold m a b)) -> m (IORef (Fold m a b)))
-> IO (IORef (Fold m a b)) -> m (IORef (Fold m a b))
forall a b. (a -> b) -> a -> b
$ Fold m a b -> IO (IORef (Fold m a b))
forall a. a -> IO (IORef a)
newIORef Fold m a b
fld
Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f
-> IORef (Fold m a b)
-> f (IORef (Fold m a b))
-> f (IORef (Fold m a b))
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k IORef (Fold m a b)
ref f (IORef (Fold m a b))
kv) Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b -> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b -> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
{-# INLINE runFold #-}
runFold :: f a
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f a) (Maybe (Key f, b)))
runFold f a
kv IORef (Fold m a b)
ref (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
res1 of
Partial s
_ -> do
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
extract1 s -> m b
final1
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> Fold m a b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Fold m a b)
ref Fold m a b
fld
Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b))))
-> Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe (Key f, b) -> Tuple' (f a) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f a
kv Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
let kv1 :: f a
kv1 = Key f -> f a -> f a
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
k f a
kv
in Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b))))
-> Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe (Key f, b) -> Tuple' (f a) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f a
kv1 ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
_ -> [Char] -> m (Tuple' (f a) (Maybe (Key f, b)))
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable"
step :: Tuple' (f (IORef (Fold m a b))) b
-> a -> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
step (Tuple' f (IORef (Fold m a b))
kv b
_) a
a = do
let k :: Key f
k = a -> Key f
getKey a
a
case Key f -> f (IORef (Fold m a b)) -> Maybe (IORef (Fold m a b))
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (IORef (Fold m a b))
kv of
Maybe (IORef (Fold m a b))
Nothing -> do
Fold m a b
f <- a -> m (Fold m a b)
getFold a
a
f (IORef (Fold m a b))
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {m :: * -> *} {f :: * -> *} {a} {b}.
(MonadIO m, IsMap f) =>
f (IORef (Fold m a b))
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
initFold f (IORef (Fold m a b))
kv Fold m a b
f (Key f
Key f
k, a
a)
Just IORef (Fold m a b)
ref -> do
Fold m a b
f <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
f (IORef (Fold m a b))
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {m :: * -> *} {f :: * -> *} {a} {a} {b}.
(MonadIO m, IsMap f) =>
f a
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f a) (Maybe (Key f, b)))
runFold f (IORef (Fold m a b))
kv IORef (Fold m a b)
ref Fold m a b
f (Key f
Key f
k, a
a)
extract :: Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
extract (Tuple' t (IORef (Fold m a b))
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef (Fold m a b) -> m b) -> t (IORef (Fold m a b)) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM IORef (Fold m a b) -> m b
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Fold m a b) -> m b
f t (IORef (Fold m a b))
kv, b
x)
where
f :: IORef (Fold m a b) -> m b
f IORef (Fold m a b)
ref = do
Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
e s -> m b
_ <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
e s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable code"
final :: Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
final (Tuple' t (IORef (Fold m a b))
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef (Fold m a b) -> m b) -> t (IORef (Fold m a b)) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM IORef (Fold m a b) -> m b
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Fold m a b) -> m b
f t (IORef (Fold m a b))
kv, b
x)
where
f :: IORef (Fold m a b) -> m b
f IORef (Fold m a b)
ref = do
Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
fin s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable code"
{-# INLINE demuxerToContainerIO #-}
demuxerToContainerIO :: (MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Fold m a (f b)
demuxerToContainerIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Fold m a (f b)
demuxerToContainerIO a -> Key f
getKey Key f -> m (Maybe (Fold m a b))
getFold =
(Tuple' (f (IORef (Fold m a b))) (f b)
-> a -> m (Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b)))
-> m (Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b))
-> (Tuple' (f (IORef (Fold m a b))) (f b) -> m (f b))
-> (Tuple' (f (IORef (Fold m a b))) (f b) -> m (f b))
-> Fold m a (f b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple' (f (IORef (Fold m a b))) (f b)
s a
a -> Tuple' (f (IORef (Fold m a b))) (f b)
-> Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f (IORef (Fold m a b))) (f b)
-> Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b))
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
-> m (Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f (IORef (Fold m a b))) (f b)
-> a -> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall {f :: * -> *} {f :: * -> *}.
(Key f ~ Key f, Key f ~ Key f, IsMap f, IsMap f) =>
Tuple' (f (IORef (Fold m a b))) (f b)
-> a -> m (Tuple' (f (IORef (Fold m a b))) (f b))
step Tuple' (f (IORef (Fold m a b))) (f b)
s a
a) (Tuple' (f (IORef (Fold m a b))) (f b)
-> Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f (IORef (Fold m a b))) (f b)
-> Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b))
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
-> m (Step (Tuple' (f (IORef (Fold m a b))) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall {a} {a}. m (Tuple' (f a) (f a))
initial) Tuple' (f (IORef (Fold m a b))) (f b) -> m (f b)
forall a. HasCallStack => a
undefined Tuple' (f (IORef (Fold m a b))) (f b) -> m (f b)
forall {m :: * -> *} {f :: * -> *} {a} {a}.
(Traversable f, MonadIO m, IsMap f) =>
Tuple' (f (IORef (Fold m a a))) (f a) -> m (f a)
final
where
initial :: m (Tuple' (f a) (f a))
initial = Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (f a) -> m (Tuple' (f a) (f a)))
-> Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a b. (a -> b) -> a -> b
$ f a -> f a -> Tuple' (f a) (f a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty
{-# INLINE initFold #-}
initFold :: f (IORef (Fold m a b))
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
initFold f (IORef (Fold m a b))
kv f b
kv1 (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
_ s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
res1 of
Partial s
_ -> do
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
forall a. HasCallStack => a
undefined s -> m b
final1
IORef (Fold m a b)
ref <- IO (IORef (Fold m a b)) -> m (IORef (Fold m a b))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Fold m a b)) -> m (IORef (Fold m a b)))
-> IO (IORef (Fold m a b)) -> m (IORef (Fold m a b))
forall a b. (a -> b) -> a -> b
$ Fold m a b -> IO (IORef (Fold m a b))
forall a. a -> IO (IORef a)
newIORef Fold m a b
fld
Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b)))
-> Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> f b -> Tuple' (f (IORef (Fold m a b))) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' (Key f
-> IORef (Fold m a b)
-> f (IORef (Fold m a b))
-> f (IORef (Fold m a b))
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k IORef (Fold m a b)
ref f (IORef (Fold m a b))
kv) f b
kv1
Done b
b -> Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b)))
-> Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> f b -> Tuple' (f (IORef (Fold m a b))) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
Done b
b -> Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b)))
-> Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> f b -> Tuple' (f (IORef (Fold m a b))) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
{-# INLINE runFold #-}
runFold :: f a
-> f b
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f a) (f b))
runFold f a
kv f b
kv1 IORef (Fold m a b)
ref (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
_ s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
res1 of
Partial s
_ -> do
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
forall a. HasCallStack => a
undefined s -> m b
final1
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> Fold m a b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Fold m a b)
ref Fold m a b
fld
Tuple' (f a) (f b) -> m (Tuple' (f a) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (f b) -> m (Tuple' (f a) (f b)))
-> Tuple' (f a) (f b) -> m (Tuple' (f a) (f b))
forall a b. (a -> b) -> a -> b
$ f a -> f b -> Tuple' (f a) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f a
kv f b
kv1
Done b
b ->
let r :: f a
r = Key f -> f a -> f a
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
k f a
kv
in Tuple' (f a) (f b) -> m (Tuple' (f a) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (f b) -> m (Tuple' (f a) (f b)))
-> Tuple' (f a) (f b) -> m (Tuple' (f a) (f b))
forall a b. (a -> b) -> a -> b
$ f a -> f b -> Tuple' (f a) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f a
r (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
Done b
_ -> [Char] -> m (Tuple' (f a) (f b))
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable"
step :: Tuple' (f (IORef (Fold m a b))) (f b)
-> a -> m (Tuple' (f (IORef (Fold m a b))) (f b))
step (Tuple' f (IORef (Fold m a b))
kv f b
kv1) a
a = do
let k :: Key f
k = a -> Key f
getKey a
a
case Key f -> f (IORef (Fold m a b)) -> Maybe (IORef (Fold m a b))
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (IORef (Fold m a b))
kv of
Maybe (IORef (Fold m a b))
Nothing -> do
Maybe (Fold m a b)
res <- Key f -> m (Maybe (Fold m a b))
getFold Key f
k
case Maybe (Fold m a b)
res of
Maybe (Fold m a b)
Nothing -> Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b)))
-> Tuple' (f (IORef (Fold m a b))) (f b)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> f b -> Tuple' (f (IORef (Fold m a b))) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv f b
kv1
Just Fold m a b
f -> f (IORef (Fold m a b))
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall {f :: * -> *} {f :: * -> *} {m :: * -> *} {a} {b}.
(Key f ~ Key f, MonadIO m, IsMap f, IsMap f) =>
f (IORef (Fold m a b))
-> f b
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
initFold f (IORef (Fold m a b))
kv f b
kv1 Fold m a b
f (Key f
Key f
k, a
a)
Just IORef (Fold m a b)
ref -> do
Fold m a b
f <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
f (IORef (Fold m a b))
-> f b
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (f b))
forall {f :: * -> *} {f :: * -> *} {m :: * -> *} {a} {b} {a}.
(Key f ~ Key f, MonadIO m, IsMap f, IsMap f) =>
f a
-> f b
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f a) (f b))
runFold f (IORef (Fold m a b))
kv f b
kv1 IORef (Fold m a b)
ref Fold m a b
f (Key f
Key f
k, a
a)
final :: Tuple' (f (IORef (Fold m a a))) (f a) -> m (f a)
final (Tuple' f (IORef (Fold m a a))
kv f a
kv1) = do
f a
r <- (IORef (Fold m a a) -> m a) -> f (IORef (Fold m a a)) -> m (f a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
Prelude.mapM IORef (Fold m a a) -> m a
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Fold m a b) -> m b
f f (IORef (Fold m a a))
kv
f a -> m (f a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> m (f a)) -> f a -> m (f a)
forall a b. (a -> b) -> a -> b
$ f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. IsMap f => f a -> f a -> f a
IsMap.mapUnion f a
r f a
kv1
where
f :: IORef (Fold m a b) -> m b
f IORef (Fold m a b)
ref = do
Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
fin s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable code"
{-# INLINE demuxScanGenericIO #-}
demuxScanGenericIO :: (MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxScanGenericIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxScanGenericIO a -> Key f
getKey Key f -> m (Maybe (Fold m a b))
getFold =
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b
Scanl (\Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
s a
a -> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> a -> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {f :: * -> *} {b}.
(Key f ~ Key f, IsMap f) =>
Tuple' (f (IORef (Fold m a b))) b
-> a -> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
step Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
s a
a) (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
-> m (Step
(Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {a} {a}. m (Tuple' (f a) (Maybe a))
initial) Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, MonadIO m) =>
Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
extract Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {m :: * -> *} {a} {b} {b}.
(Traversable t, Monad m, MonadIO m) =>
Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
final
where
initial :: m (Tuple' (f a) (Maybe a))
initial = Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a)))
-> Tuple' (f a) (Maybe a) -> m (Tuple' (f a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe a -> Tuple' (f a) (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Maybe a
forall a. Maybe a
Nothing
{-# INLINE initFold #-}
initFold :: f (IORef (Fold m a b))
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
initFold f (IORef (Fold m a b))
kv (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
res1 of
Partial s
_ -> do
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
extract1 s -> m b
final1
IORef (Fold m a b)
ref <- IO (IORef (Fold m a b)) -> m (IORef (Fold m a b))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Fold m a b)) -> m (IORef (Fold m a b)))
-> IO (IORef (Fold m a b)) -> m (IORef (Fold m a b))
forall a b. (a -> b) -> a -> b
$ Fold m a b -> IO (IORef (Fold m a b))
forall a. a -> IO (IORef a)
newIORef Fold m a b
fld
Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f
-> IORef (Fold m a b)
-> f (IORef (Fold m a b))
-> f (IORef (Fold m a b))
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k IORef (Fold m a b)
ref f (IORef (Fold m a b))
kv) Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b -> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b -> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
{-# INLINE runFold #-}
runFold :: f a
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f a) (Maybe (Key f, b)))
runFold f a
kv IORef (Fold m a b)
ref (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) (Key f
k, a
a) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
res1 <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
res1 of
Partial s
_ -> do
let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res1) s -> m b
extract1 s -> m b
final1
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> Fold m a b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Fold m a b)
ref Fold m a b
fld
Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b))))
-> Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe (Key f, b) -> Tuple' (f a) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f a
kv Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
let kv1 :: f a
kv1 = Key f -> f a -> f a
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
k f a
kv
in Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b))))
-> Tuple' (f a) (Maybe (Key f, b))
-> m (Tuple' (f a) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f a -> Maybe (Key f, b) -> Tuple' (f a) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f a
kv1 ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
_ -> [Char] -> m (Tuple' (f a) (Maybe (Key f, b)))
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable"
step :: Tuple' (f (IORef (Fold m a b))) b
-> a -> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
step (Tuple' f (IORef (Fold m a b))
kv b
_) a
a = do
let k :: Key f
k = a -> Key f
getKey a
a
case Key f -> f (IORef (Fold m a b)) -> Maybe (IORef (Fold m a b))
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (IORef (Fold m a b))
kv of
Maybe (IORef (Fold m a b))
Nothing -> do
Maybe (Fold m a b)
res <- Key f -> m (Maybe (Fold m a b))
getFold Key f
k
case Maybe (Fold m a b)
res of
Maybe (Fold m a b)
Nothing -> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Fold m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Fold m a b))
kv Maybe (Key f, b)
forall a. Maybe a
Nothing
Just Fold m a b
f -> f (IORef (Fold m a b))
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {m :: * -> *} {f :: * -> *} {a} {b}.
(MonadIO m, IsMap f) =>
f (IORef (Fold m a b))
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
initFold f (IORef (Fold m a b))
kv Fold m a b
f (Key f
Key f
k, a
a)
Just IORef (Fold m a b)
ref -> do
Fold m a b
f <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
f (IORef (Fold m a b))
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Fold m a b))) (Maybe (Key f, b)))
forall {m :: * -> *} {f :: * -> *} {a} {a} {b}.
(MonadIO m, IsMap f) =>
f a
-> IORef (Fold m a b)
-> Fold m a b
-> (Key f, a)
-> m (Tuple' (f a) (Maybe (Key f, b)))
runFold f (IORef (Fold m a b))
kv IORef (Fold m a b)
ref Fold m a b
f (Key f
Key f
k, a
a)
extract :: Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
extract (Tuple' t (IORef (Fold m a b))
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef (Fold m a b) -> m b) -> t (IORef (Fold m a b)) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM IORef (Fold m a b) -> m b
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Fold m a b) -> m b
f t (IORef (Fold m a b))
kv, b
x)
where
f :: IORef (Fold m a b) -> m b
f IORef (Fold m a b)
ref = do
Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
e s -> m b
_ <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
e s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable code"
final :: Tuple' (t (IORef (Fold m a b))) b -> m (m (t b), b)
final (Tuple' t (IORef (Fold m a b))
kv b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef (Fold m a b) -> m b) -> t (IORef (Fold m a b)) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM IORef (Fold m a b) -> m b
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Fold m a b) -> m b
f t (IORef (Fold m a b))
kv, b
x)
where
f :: IORef (Fold m a b) -> m b
f IORef (Fold m a b)
ref = do
Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin <- IO (Fold m a b) -> m (Fold m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Fold m a b) -> m (Fold m a b))
-> IO (Fold m a b) -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Fold m a b) -> IO (Fold m a b)
forall a. IORef a -> IO a
readIORef IORef (Fold m a b)
ref
Step s b
r <- m (Step s b)
i
case Step s b
r of
Partial s
s -> s -> m b
fin s
s
Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable code"
{-# DEPRECATED demuxIO "Use demuxScanIO instead" #-}
{-# INLINE demuxIO #-}
demuxIO :: (MonadIO m, Ord k) =>
(a -> k)
-> (a -> m (Fold m a b))
-> Fold m a (m (Map k b), Maybe (k, b))
demuxIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k)
-> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))
demuxIO = (a -> k)
-> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> (a -> m (Fold m a b))
-> Fold m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
demuxGenericIO
{-# INLINE demuxUsingMapIO #-}
demuxUsingMapIO :: (MonadIO m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMapIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMapIO = (a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> (Key (Map k) -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Fold m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxScanGenericIO
{-# INLINE demuxScanIO #-}
demuxScanIO :: (MonadIO m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (Maybe (k, b))
demuxScanIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b))) -> Scanl m a (Maybe (k, b))
demuxScanIO a -> k
getKey = ((m (Map k b), Maybe (k, b)) -> Maybe (k, b))
-> Scanl m a (m (Map k b), Maybe (k, b))
-> Scanl m a (Maybe (k, b))
forall a b. (a -> b) -> Scanl m a a -> Scanl m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (Map k b), Maybe (k, b)) -> Maybe (k, b)
forall a b. (a, b) -> b
snd (Scanl m a (m (Map k b), Maybe (k, b)) -> Scanl m a (Maybe (k, b)))
-> ((k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b)))
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Fold m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMapIO a -> k
getKey
{-# INLINE kvToMapOverwriteGeneric #-}
kvToMapOverwriteGeneric :: (Monad m, IsMap f) => Fold m (Key f, a) (f a)
kvToMapOverwriteGeneric :: forall (m :: * -> *) (f :: * -> *) a.
(Monad m, IsMap f) =>
Fold m (Key f, a) (f a)
kvToMapOverwriteGeneric =
(f a -> (Key f, a) -> f a) -> f a -> Fold m (Key f, a) (f a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (\f a
kv (Key f
k, a
v) -> Key f -> a -> f a -> f a
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k a
v f a
kv) f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty
{-# DEPRECATED demuxToContainer "Use demuxerToContainer instead" #-}
{-# INLINE demuxToContainer #-}
demuxToContainer :: (Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)
demuxToContainer :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)
demuxToContainer a -> Key f
getKey a -> m (Fold m a b)
getFold =
let
classifier :: Fold m a (m (f b), Maybe (Key f, b))
classifier = (a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
demuxGeneric a -> Key f
getKey a -> m (Fold m a b)
getFold
getMap :: Maybe (f (f a)) -> f (f a)
getMap Maybe (f (f a))
Nothing = f a -> f (f a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty
getMap (Just f (f a)
action) = f (f a)
action
aggregator :: Fold m (m (f a), Maybe (Key f, a)) (f a)
aggregator =
(f a -> f a -> f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. IsMap f => f a -> f a -> f a
IsMap.mapUnion
((Maybe (m (f a)) -> m (f a))
-> Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM Maybe (m (f a)) -> m (f a)
forall {f :: * -> *} {f :: * -> *} {a}.
(Applicative f, IsMap f) =>
Maybe (f (f a)) -> f (f a)
getMap (Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (f a))
-> Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall a b. (a -> b) -> a -> b
$ ((m (f a), Maybe (Key f, a)) -> m (f a))
-> Fold m (m (f a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (m (f a), Maybe (Key f, a)) -> m (f a)
forall a b. (a, b) -> a
fst Fold m (m (f a)) (Maybe (m (f a)))
forall (m :: * -> *) a. Monad m => Fold m a (Maybe a)
latest)
(((m (f a), Maybe (Key f, a)) -> Maybe (Key f, a))
-> Fold m (Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (m (f a), Maybe (Key f, a)) -> Maybe (Key f, a)
forall a b. (a, b) -> b
snd (Fold m (Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a))
-> Fold m (Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall a b. (a -> b) -> a -> b
$ Fold m (Key f, a) (f a) -> Fold m (Maybe (Key f, a)) (f a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m (Maybe a) b
catMaybes Fold m (Key f, a) (f a)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, IsMap f) =>
Fold m (Key f, a) (f a)
kvToMapOverwriteGeneric)
in Fold m a (m (f b), Maybe (Key f, b))
-> Fold m (m (f b), Maybe (Key f, b)) (f b) -> Fold m a (f b)
forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
postscan Fold m a (m (f b), Maybe (Key f, b))
classifier Fold m (m (f b), Maybe (Key f, b)) (f b)
forall {a}. Fold m (m (f a), Maybe (Key f, a)) (f a)
aggregator
{-# DEPRECATED demuxToMap "Use demuxerToMap instead" #-}
{-# INLINE demuxToMap #-}
demuxToMap :: (Monad m, Ord k) =>
(a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
demuxToMap :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
demuxToMap = (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
(a -> Key (Map k)) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)
demuxToContainer
{-# INLINE demuxerToMap #-}
demuxerToMap :: (Monad m, Ord k) =>
(a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
demuxerToMap :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
demuxerToMap = (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
(a -> Key (Map k))
-> (Key (Map k) -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Fold m a (f b)
demuxerToContainer
{-# DEPRECATED demuxToContainerIO "Use demuxerToContainerIO instead" #-}
{-# INLINE demuxToContainerIO #-}
demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)
demuxToContainerIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)
demuxToContainerIO a -> Key f
getKey a -> m (Fold m a b)
getFold =
let
classifier :: Fold m a (m (f b), Maybe (Key f, b))
classifier = (a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))
demuxGenericIO a -> Key f
getKey a -> m (Fold m a b)
getFold
getMap :: Maybe (f (f a)) -> f (f a)
getMap Maybe (f (f a))
Nothing = f a -> f (f a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty
getMap (Just f (f a)
action) = f (f a)
action
aggregator :: Fold m (m (f a), Maybe (Key f, a)) (f a)
aggregator =
(f a -> f a -> f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. IsMap f => f a -> f a -> f a
IsMap.mapUnion
((Maybe (m (f a)) -> m (f a))
-> Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM Maybe (m (f a)) -> m (f a)
forall {f :: * -> *} {f :: * -> *} {a}.
(Applicative f, IsMap f) =>
Maybe (f (f a)) -> f (f a)
getMap (Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (f a))
-> Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall a b. (a -> b) -> a -> b
$ ((m (f a), Maybe (Key f, a)) -> m (f a))
-> Fold m (m (f a)) (Maybe (m (f a)))
-> Fold m (m (f a), Maybe (Key f, a)) (Maybe (m (f a)))
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (m (f a), Maybe (Key f, a)) -> m (f a)
forall a b. (a, b) -> a
fst Fold m (m (f a)) (Maybe (m (f a)))
forall (m :: * -> *) a. Monad m => Fold m a (Maybe a)
latest)
(((m (f a), Maybe (Key f, a)) -> Maybe (Key f, a))
-> Fold m (Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (m (f a), Maybe (Key f, a)) -> Maybe (Key f, a)
forall a b. (a, b) -> b
snd (Fold m (Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a))
-> Fold m (Maybe (Key f, a)) (f a)
-> Fold m (m (f a), Maybe (Key f, a)) (f a)
forall a b. (a -> b) -> a -> b
$ Fold m (Key f, a) (f a) -> Fold m (Maybe (Key f, a)) (f a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m (Maybe a) b
catMaybes Fold m (Key f, a) (f a)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, IsMap f) =>
Fold m (Key f, a) (f a)
kvToMapOverwriteGeneric)
in Fold m a (m (f b), Maybe (Key f, b))
-> Fold m (m (f b), Maybe (Key f, b)) (f b) -> Fold m a (f b)
forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
postscan Fold m a (m (f b), Maybe (Key f, b))
classifier Fold m (m (f b), Maybe (Key f, b)) (f b)
forall {a}. Fold m (m (f a), Maybe (Key f, a)) (f a)
aggregator
{-# DEPRECATED demuxToMapIO "Use demuxerToMapIO instead" #-}
{-# INLINE demuxToMapIO #-}
demuxToMapIO :: (MonadIO m, Ord k) =>
(a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
demuxToMapIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
demuxToMapIO = (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
(a -> Key (Map k)) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)
demuxToContainerIO
{-# INLINE demuxerToMapIO #-}
demuxerToMapIO :: (MonadIO m, Ord k) =>
(a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
demuxerToMapIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
demuxerToMapIO = (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
(a -> Key (Map k))
-> (Key (Map k) -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Fold m a (f b)
demuxerToContainerIO
{-# INLINE demuxKvToContainer #-}
demuxKvToContainer :: (Monad m, IsMap f, Traversable f) =>
(Key f -> m (Maybe (Fold m a b))) -> Fold m (Key f, a) (f b)
demuxKvToContainer :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(Key f -> m (Maybe (Fold m a b))) -> Fold m (Key f, a) (f b)
demuxKvToContainer Key f -> m (Maybe (Fold m a b))
f = ((Key f, a) -> Key f)
-> (Key f -> m (Maybe (Fold m (Key f, a) b)))
-> Fold m (Key f, a) (f b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Fold m a (f b)
demuxerToContainer (Key f, a) -> Key f
forall a b. (a, b) -> a
fst ((Maybe (Fold m a b) -> Maybe (Fold m (Key f, a) b))
-> m (Maybe (Fold m a b)) -> m (Maybe (Fold m (Key f, a) b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Fold m a b -> Fold m (Key f, a) b)
-> Maybe (Fold m a b) -> Maybe (Fold m (Key f, a) b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Key f, a) -> a) -> Fold m a b -> Fold m (Key f, a) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (Key f, a) -> a
forall a b. (a, b) -> b
snd)) (m (Maybe (Fold m a b)) -> m (Maybe (Fold m (Key f, a) b)))
-> (Key f -> m (Maybe (Fold m a b)))
-> Key f
-> m (Maybe (Fold m (Key f, a) b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key f -> m (Maybe (Fold m a b))
f)
{-# INLINE demuxKvToMap #-}
demuxKvToMap :: (Monad m, Ord k) =>
(k -> m (Maybe (Fold m a b))) -> Fold m (k, a) (Map k b)
demuxKvToMap :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(k -> m (Maybe (Fold m a b))) -> Fold m (k, a) (Map k b)
demuxKvToMap = (k -> m (Maybe (Fold m a b))) -> Fold m (k, a) (Map k b)
(Key (Map k) -> m (Maybe (Fold m a b)))
-> Fold m (Key (Map k), a) (Map k b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(Key f -> m (Maybe (Fold m a b))) -> Fold m (Key f, a) (f b)
demuxKvToContainer
{-# DEPRECATED classifyGeneric "Use classifyScanGeneric instead" #-}
{-# INLINE classifyGeneric #-}
classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))
classifyGeneric :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))
classifyGeneric a -> Key f
f (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Fold m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
s a
a -> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> a -> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *} {c}.
(Key f ~ Key f, IsMap f) =>
Tuple3' (f s) (Set (Key f)) c
-> a -> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
step Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
s a
a) (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall {a} {a} {a}. m (Tuple3' (f a) (Set a) (Maybe a))
initial) Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {b} {b}.
(Traversable t, Monad m) =>
Tuple3' (t s) b b -> m (m (t b), b)
extract Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {m :: * -> *} {f :: * -> *} {b}.
(Monad m, IsMap f, Ord (Key f)) =>
Tuple3' (f s) (Set (Key f)) b -> m (m (f b), b)
final
where
initial :: m (Tuple3' (f a) (Set a) (Maybe a))
initial = Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a)))
-> Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Set a -> Maybe a -> Tuple3' (f a) (Set a) (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Set a
forall a. Set a
Set.empty Maybe a
forall a. Maybe a
Nothing
{-# INLINE initFold #-}
initFold :: f s
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
initFold f s
kv Set (Key f)
set Key f
k a
a = do
Step s b
x <- m (Step s b)
initial1
case Step s b
x of
Partial s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial s
s1 ->
f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (Key f -> s -> f s -> f s
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k s
s1 f s
kv) Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv Set (Key f)
set ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b -> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b)))
step :: Tuple3' (f s) (Set (Key f)) c
-> a -> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
step (Tuple3' f s
kv Set (Key f)
set c
_) a
a = do
let k :: Key f
k = a -> Key f
f a
a
case Key f -> f s -> Maybe s
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f s
kv of
Maybe s
Nothing -> do
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing)
else f s
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *}.
(IsMap f, Ord (Key f)) =>
f s
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
initFold f s
kv Set (Key f)
Set (Key f)
set Key f
Key f
k a
a
Just s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial s
s1 ->
f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (Key f -> s -> f s -> f s
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k s
s1 f s
kv) Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
let kv1 :: f s
kv1 = Key f -> f s -> f s
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
Key f
k f s
kv
in f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv1 (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
extract :: Tuple3' (t s) b b -> m (m (t b), b)
extract (Tuple3' t s
kv b
_ b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((s -> m b) -> t s -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM s -> m b
extract1 t s
kv, b
x)
final :: Tuple3' (f s) (Set (Key f)) b -> m (m (f b), b)
final (Tuple3' f s
kv Set (Key f)
set b
x) = (m (f b), b) -> m (m (f b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key f -> s -> m b) -> f s -> m (f b)
forall (f :: * -> *) (t :: * -> *) a b.
(IsMap f, Applicative t) =>
(Key f -> a -> t b) -> f a -> t (f b)
forall (t :: * -> *) a b.
Applicative t =>
(Key f -> a -> t b) -> f a -> t (f b)
IsMap.mapTraverseWithKey Key f -> s -> m b
f1 f s
kv, b
x)
where
f1 :: Key f -> s -> m b
f1 Key f
k s
s = do
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then s -> m b
extract1 s
s
else s -> m b
final1 s
s
{-# INLINE toContainer #-}
toContainer :: (Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainer :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainer a -> Key f
f (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
_ s -> m b
final1) =
(Tuple' (f s) (f b) -> a -> m (Step (Tuple' (f s) (f b)) (f b)))
-> m (Step (Tuple' (f s) (f b)) (f b))
-> (Tuple' (f s) (f b) -> m (f b))
-> (Tuple' (f s) (f b) -> m (f b))
-> Fold m a (f b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple' (f s) (f b)
s a
a -> Tuple' (f s) (f b) -> Step (Tuple' (f s) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f s) (f b) -> Step (Tuple' (f s) (f b)) (f b))
-> m (Tuple' (f s) (f b)) -> m (Step (Tuple' (f s) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f s) (f b) -> a -> m (Tuple' (f s) (f b))
forall {f :: * -> *} {f :: * -> *}.
(Key f ~ Key f, Key f ~ Key f, IsMap f, IsMap f) =>
Tuple' (f s) (f b) -> a -> m (Tuple' (f s) (f b))
step Tuple' (f s) (f b)
s a
a) (Tuple' (f s) (f b) -> Step (Tuple' (f s) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f s) (f b) -> Step (Tuple' (f s) (f b)) (f b))
-> m (Tuple' (f s) (f b)) -> m (Step (Tuple' (f s) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f s) (f b))
forall {a} {a}. m (Tuple' (f a) (f a))
initial) Tuple' (f s) (f b) -> m (f b)
forall a. HasCallStack => a
undefined Tuple' (f s) (f b) -> m (f b)
forall {f :: * -> *}.
(Traversable f, IsMap f) =>
Tuple' (f s) (f b) -> m (f b)
final
where
initial :: m (Tuple' (f a) (f a))
initial = Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (f a) -> m (Tuple' (f a) (f a)))
-> Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a b. (a -> b) -> a -> b
$ f a -> f a -> Tuple' (f a) (f a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty
{-# INLINE initFold #-}
initFold :: f s -> f b -> Key f -> a -> m (Tuple' (f s) (f b))
initFold f s
kv f b
kv1 Key f
k a
a = do
Step s b
x <- m (Step s b)
initial1
case Step s b
x of
Partial s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple' (f s) (f b) -> m (Tuple' (f s) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple' (f s) (f b) -> m (Tuple' (f s) (f b)))
-> Tuple' (f s) (f b) -> m (Tuple' (f s) (f b))
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial s
s1 ->
f s -> f b -> Tuple' (f s) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> s -> f s -> f s
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k s
s1 f s
kv) f b
kv1
Done b
b ->
f s -> f b -> Tuple' (f s) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f s
kv (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
Done b
b -> Tuple' (f s) (f b) -> m (Tuple' (f s) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f s -> f b -> Tuple' (f s) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f s
kv (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1))
step :: Tuple' (f s) (f b) -> a -> m (Tuple' (f s) (f b))
step (Tuple' f s
kv f b
kv1) a
a = do
let k :: Key f
k = a -> Key f
f a
a
case Key f -> f s -> Maybe s
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f s
kv of
Maybe s
Nothing -> do
case Key f -> f b -> Maybe b
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f b
kv1 of
Maybe b
Nothing -> f s -> f b -> Key f -> a -> m (Tuple' (f s) (f b))
forall {f :: * -> *} {f :: * -> *}.
(Key f ~ Key f, IsMap f, IsMap f) =>
f s -> f b -> Key f -> a -> m (Tuple' (f s) (f b))
initFold f s
kv f b
kv1 Key f
Key f
k a
a
Just b
_ -> Tuple' (f s) (f b) -> m (Tuple' (f s) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f s -> f b -> Tuple' (f s) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f s
kv f b
kv1)
Just s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple' (f s) (f b) -> m (Tuple' (f s) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple' (f s) (f b) -> m (Tuple' (f s) (f b)))
-> Tuple' (f s) (f b) -> m (Tuple' (f s) (f b))
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial s
s1 ->
f s -> f b -> Tuple' (f s) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> s -> f s -> f s
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k s
s1 f s
kv) f b
kv1
Done b
b ->
let res :: f s
res = Key f -> f s -> f s
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
Key f
k f s
kv
in f s -> f b -> Tuple' (f s) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f s
res (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
final :: Tuple' (f s) (f b) -> m (f b)
final (Tuple' f s
kv f b
kv1) = do
f b
r <- (s -> m b) -> f s -> m (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
Prelude.mapM s -> m b
final1 f s
kv
f b -> m (f b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f b -> m (f b)) -> f b -> m (f b)
forall a b. (a -> b) -> a -> b
$ f b -> f b -> f b
forall a. f a -> f a -> f a
forall (f :: * -> *) a. IsMap f => f a -> f a -> f a
IsMap.mapUnion f b
r f b
kv1
{-# INLINE classifyScanGeneric #-}
classifyScanGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyScanGeneric :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyScanGeneric a -> Key f
f (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b
Scanl (\Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
s a
a -> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> a -> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *} {c}.
(Key f ~ Key f, IsMap f) =>
Tuple3' (f s) (Set (Key f)) c
-> a -> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
step Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
s a
a) (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall {a} {a} {a}. m (Tuple3' (f a) (Set a) (Maybe a))
initial) Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {b} {b}.
(Traversable t, Monad m) =>
Tuple3' (t s) b b -> m (m (t b), b)
extract Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {m :: * -> *} {f :: * -> *} {b}.
(Monad m, IsMap f, Ord (Key f)) =>
Tuple3' (f s) (Set (Key f)) b -> m (m (f b), b)
final
where
initial :: m (Tuple3' (f a) (Set a) (Maybe a))
initial = Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a)))
-> Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Set a -> Maybe a -> Tuple3' (f a) (Set a) (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Set a
forall a. Set a
Set.empty Maybe a
forall a. Maybe a
Nothing
{-# INLINE initFold #-}
initFold :: f s
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
initFold f s
kv Set (Key f)
set Key f
k a
a = do
Step s b
x <- m (Step s b)
initial1
case Step s b
x of
Partial s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial s
s1 ->
f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (Key f -> s -> f s -> f s
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k s
s1 f s
kv) Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv Set (Key f)
set ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b -> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b)))
step :: Tuple3' (f s) (Set (Key f)) c
-> a -> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
step (Tuple3' f s
kv Set (Key f)
set c
_) a
a = do
let k :: Key f
k = a -> Key f
f a
a
case Key f -> f s -> Maybe s
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f s
kv of
Maybe s
Nothing -> do
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing)
else f s
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *}.
(IsMap f, Ord (Key f)) =>
f s
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
initFold f s
kv Set (Key f)
Set (Key f)
set Key f
Key f
k a
a
Just s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial s
s1 ->
f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (Key f -> s -> f s -> f s
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k s
s1 f s
kv) Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
let kv1 :: f s
kv1 = Key f -> f s -> f s
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
Key f
k f s
kv
in f s
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f s) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f s
kv1 (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
extract :: Tuple3' (t s) b b -> m (m (t b), b)
extract (Tuple3' t s
kv b
_ b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((s -> m b) -> t s -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM s -> m b
extract1 t s
kv, b
x)
final :: Tuple3' (f s) (Set (Key f)) b -> m (m (f b), b)
final (Tuple3' f s
kv Set (Key f)
set b
x) = (m (f b), b) -> m (m (f b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key f -> s -> m b) -> f s -> m (f b)
forall (f :: * -> *) (t :: * -> *) a b.
(IsMap f, Applicative t) =>
(Key f -> a -> t b) -> f a -> t (f b)
forall (t :: * -> *) a b.
Applicative t =>
(Key f -> a -> t b) -> f a -> t (f b)
IsMap.mapTraverseWithKey Key f -> s -> m b
f1 f s
kv, b
x)
where
f1 :: Key f -> s -> m b
f1 Key f
k s
s = do
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then s -> m b
extract1 s
s
else s -> m b
final1 s
s
{-# DEPRECATED classify "Use classifyScan instead" #-}
{-# INLINE classify #-}
classify :: (Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))
classify :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))
classify = (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> Fold m a b -> Fold m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))
classifyGeneric
{-# INLINE classifyUsingMap #-}
classifyUsingMap :: (Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMap :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMap = (a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> Fold m a b -> Scanl m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyScanGeneric
{-# INLINE classifyScan #-}
classifyScan :: (MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))
classifyScan :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))
classifyScan a -> k
getKey = ((m (Map k b), Maybe (k, b)) -> Maybe (k, b))
-> Scanl m a (m (Map k b), Maybe (k, b))
-> Scanl m a (Maybe (k, b))
forall a b. (a -> b) -> Scanl m a a -> Scanl m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (Map k b), Maybe (k, b)) -> Maybe (k, b)
forall a b. (a, b) -> b
snd (Scanl m a (m (Map k b), Maybe (k, b)) -> Scanl m a (Maybe (k, b)))
-> (Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b)))
-> Fold m a b
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMap a -> k
getKey
{-# DEPRECATED classifyGenericIO "Use classifyGenericIO from Scanl module" #-}
{-# INLINE classifyGenericIO #-}
classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))
classifyGenericIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))
classifyGenericIO a -> Key f
f (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Fold m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
s a
a -> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> a -> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *} {c}.
(Key f ~ Key f, IsMap f) =>
Tuple3' (f (IORef s)) (Set (Key f)) c
-> a -> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
step Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
s a
a) (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall {a} {a} {a}. m (Tuple3' (f a) (Set a) (Maybe a))
initial) Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {b} {b}.
(Traversable t, Monad m) =>
Tuple3' (t (IORef s)) b b -> m (m (t b), b)
extract Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {f :: * -> *} {m :: * -> *} {b}.
(IsMap f, Monad m, Ord (Key f)) =>
Tuple3' (f (IORef s)) (Set (Key f)) b -> m (m (f b), b)
final
where
initial :: m (Tuple3' (f a) (Set a) (Maybe a))
initial = Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a)))
-> Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Set a -> Maybe a -> Tuple3' (f a) (Set a) (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Set a
forall a. Set a
Set.empty Maybe a
forall a. Maybe a
Nothing
{-# INLINE initFold #-}
initFold :: f (IORef s)
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
initFold f (IORef s)
kv Set (Key f)
set Key f
k a
a = do
Step s b
x <- m (Step s b)
initial1
case Step s b
x of
Partial s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
r of
Partial s
s1 -> do
IORef s
ref <- IO (IORef s) -> m (IORef s)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef s) -> m (IORef s)) -> IO (IORef s) -> m (IORef s)
forall a b. (a -> b) -> a -> b
$ s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s1
Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (Key f -> IORef s -> f (IORef s) -> f (IORef s)
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k IORef s
ref f (IORef s)
kv) Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv Set (Key f)
set ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b -> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b)))
step :: Tuple3' (f (IORef s)) (Set (Key f)) c
-> a -> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
step (Tuple3' f (IORef s)
kv Set (Key f)
set c
_) a
a = do
let k :: Key f
k = a -> Key f
f a
a
case Key f -> f (IORef s) -> Maybe (IORef s)
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (IORef s)
kv of
Maybe (IORef s)
Nothing -> do
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing)
else f (IORef s)
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *}.
(IsMap f, Ord (Key f)) =>
f (IORef s)
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
initFold f (IORef s)
kv Set (Key f)
Set (Key f)
set Key f
Key f
k a
a
Just IORef s
ref -> do
s
s <- IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
r of
Partial s
s1 -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef s
ref s
s1
Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
let kv1 :: f (IORef s)
kv1 = Key f -> f (IORef s) -> f (IORef s)
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
Key f
k f (IORef s)
kv
in Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv1 (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
extract :: Tuple3' (t (IORef s)) b b -> m (m (t b), b)
extract (Tuple3' t (IORef s)
kv b
_ b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef s -> m b) -> t (IORef s) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM IORef s -> m b
g t (IORef s)
kv, b
x)
where
g :: IORef s -> m b
g IORef s
ref = IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref) m s -> (s -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m b
extract1
final :: Tuple3' (f (IORef s)) (Set (Key f)) b -> m (m (f b), b)
final (Tuple3' f (IORef s)
kv Set (Key f)
set b
x) = (m (f b), b) -> m (m (f b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key f -> IORef s -> m b) -> f (IORef s) -> m (f b)
forall (f :: * -> *) (t :: * -> *) a b.
(IsMap f, Applicative t) =>
(Key f -> a -> t b) -> f a -> t (f b)
forall (t :: * -> *) a b.
Applicative t =>
(Key f -> a -> t b) -> f a -> t (f b)
IsMap.mapTraverseWithKey Key f -> IORef s -> m b
g f (IORef s)
kv, b
x)
where
g :: Key f -> IORef s -> m b
g Key f
k IORef s
ref = do
s
s <- IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then s -> m b
extract1 s
s
else s -> m b
final1 s
s
{-# INLINE toContainerIO #-}
toContainerIO :: (MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainerIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainerIO a -> Key f
f (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
_ s -> m b
final1) =
(Tuple' (f (IORef s)) (f b)
-> a -> m (Step (Tuple' (f (IORef s)) (f b)) (f b)))
-> m (Step (Tuple' (f (IORef s)) (f b)) (f b))
-> (Tuple' (f (IORef s)) (f b) -> m (f b))
-> (Tuple' (f (IORef s)) (f b) -> m (f b))
-> Fold m a (f b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\Tuple' (f (IORef s)) (f b)
s a
a -> Tuple' (f (IORef s)) (f b)
-> Step (Tuple' (f (IORef s)) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f (IORef s)) (f b)
-> Step (Tuple' (f (IORef s)) (f b)) (f b))
-> m (Tuple' (f (IORef s)) (f b))
-> m (Step (Tuple' (f (IORef s)) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple' (f (IORef s)) (f b) -> a -> m (Tuple' (f (IORef s)) (f b))
forall {f :: * -> *} {f :: * -> *}.
(Key f ~ Key f, Key f ~ Key f, IsMap f, IsMap f) =>
Tuple' (f (IORef s)) (f b) -> a -> m (Tuple' (f (IORef s)) (f b))
step Tuple' (f (IORef s)) (f b)
s a
a) (Tuple' (f (IORef s)) (f b)
-> Step (Tuple' (f (IORef s)) (f b)) (f b)
forall s b. s -> Step s b
Partial (Tuple' (f (IORef s)) (f b)
-> Step (Tuple' (f (IORef s)) (f b)) (f b))
-> m (Tuple' (f (IORef s)) (f b))
-> m (Step (Tuple' (f (IORef s)) (f b)) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple' (f (IORef s)) (f b))
forall {a} {a}. m (Tuple' (f a) (f a))
initial) Tuple' (f (IORef s)) (f b) -> m (f b)
forall a. HasCallStack => a
undefined Tuple' (f (IORef s)) (f b) -> m (f b)
forall {f :: * -> *}.
(Traversable f, IsMap f) =>
Tuple' (f (IORef s)) (f b) -> m (f b)
final
where
initial :: m (Tuple' (f a) (f a))
initial = Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f a) (f a) -> m (Tuple' (f a) (f a)))
-> Tuple' (f a) (f a) -> m (Tuple' (f a) (f a))
forall a b. (a -> b) -> a -> b
$ f a -> f a -> Tuple' (f a) (f a)
forall a b. a -> b -> Tuple' a b
Tuple' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty
{-# INLINE initFold #-}
initFold :: f (IORef s) -> f b -> Key f -> a -> m (Tuple' (f (IORef s)) (f b))
initFold f (IORef s)
kv f b
kv1 Key f
k a
a = do
Step s b
x <- m (Step s b)
initial1
case Step s b
x of
Partial s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
r of
Partial s
s1 -> do
IORef s
ref <- IO (IORef s) -> m (IORef s)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef s) -> m (IORef s)) -> IO (IORef s) -> m (IORef s)
forall a b. (a -> b) -> a -> b
$ s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s1
Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b)))
-> Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef s) -> f b -> Tuple' (f (IORef s)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> IORef s -> f (IORef s) -> f (IORef s)
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k IORef s
ref f (IORef s)
kv) f b
kv1
Done b
b ->
Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b)))
-> Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef s) -> f b -> Tuple' (f (IORef s)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef s)
kv (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
Done b
b -> Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (IORef s) -> f b -> Tuple' (f (IORef s)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef s)
kv (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1))
step :: Tuple' (f (IORef s)) (f b) -> a -> m (Tuple' (f (IORef s)) (f b))
step (Tuple' f (IORef s)
kv f b
kv1) a
a = do
let k :: Key f
k = a -> Key f
f a
a
case Key f -> f (IORef s) -> Maybe (IORef s)
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (IORef s)
kv of
Maybe (IORef s)
Nothing -> do
case Key f -> f b -> Maybe b
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f b
kv1 of
Maybe b
Nothing -> f (IORef s) -> f b -> Key f -> a -> m (Tuple' (f (IORef s)) (f b))
forall {f :: * -> *} {f :: * -> *}.
(Key f ~ Key f, IsMap f, IsMap f) =>
f (IORef s) -> f b -> Key f -> a -> m (Tuple' (f (IORef s)) (f b))
initFold f (IORef s)
kv f b
kv1 Key f
Key f
k a
a
Just b
_ -> Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b)))
-> Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef s) -> f b -> Tuple' (f (IORef s)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef s)
kv f b
kv1
Just IORef s
ref -> do
s
s <- IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
r of
Partial s
s1 -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef s
ref s
s1
Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b)))
-> Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef s) -> f b -> Tuple' (f (IORef s)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef s)
kv f b
kv1
Done b
b ->
let res :: f (IORef s)
res = Key f -> f (IORef s) -> f (IORef s)
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
Key f
k f (IORef s)
kv
in Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b)))
-> Tuple' (f (IORef s)) (f b) -> m (Tuple' (f (IORef s)) (f b))
forall a b. (a -> b) -> a -> b
$ f (IORef s) -> f b -> Tuple' (f (IORef s)) (f b)
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef s)
res (Key f -> b -> f b -> f b
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
Key f
k b
b f b
kv1)
final :: Tuple' (f (IORef s)) (f b) -> m (f b)
final (Tuple' f (IORef s)
kv f b
kv1) = do
f b
r <- (IORef s -> m b) -> f (IORef s) -> m (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
Prelude.mapM IORef s -> m b
g f (IORef s)
kv
f b -> m (f b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f b -> m (f b)) -> f b -> m (f b)
forall a b. (a -> b) -> a -> b
$ f b -> f b -> f b
forall a. f a -> f a -> f a
forall (f :: * -> *) a. IsMap f => f a -> f a -> f a
IsMap.mapUnion f b
r f b
kv1
where
g :: IORef s -> m b
g IORef s
ref = IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref) m s -> (s -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m b
final1
{-# INLINE classifyScanGenericIO #-}
classifyScanGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyScanGenericIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyScanGenericIO a -> Key f
f (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> a
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))))
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b
Scanl (\Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
s a
a -> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> a -> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *} {c}.
(Key f ~ Key f, IsMap f) =>
Tuple3' (f (IORef s)) (Set (Key f)) c
-> a -> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
step Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
s a
a) (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
-> m (Step
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
(m (f b), Maybe (Key f, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall {a} {a} {a}. m (Tuple3' (f a) (Set a) (Maybe a))
initial) Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {t :: * -> *} {m :: * -> *} {b} {b}.
(Traversable t, Monad m) =>
Tuple3' (t (IORef s)) b b -> m (m (t b), b)
extract Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (m (f b), Maybe (Key f, b))
forall {f :: * -> *} {m :: * -> *} {b}.
(IsMap f, Monad m, Ord (Key f)) =>
Tuple3' (f (IORef s)) (Set (Key f)) b -> m (m (f b), b)
final
where
initial :: m (Tuple3' (f a) (Set a) (Maybe a))
initial = Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a)))
-> Tuple3' (f a) (Set a) (Maybe a)
-> m (Tuple3' (f a) (Set a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ f a -> Set a -> Maybe a -> Tuple3' (f a) (Set a) (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f a
forall a. f a
forall (f :: * -> *) a. IsMap f => f a
IsMap.mapEmpty Set a
forall a. Set a
Set.empty Maybe a
forall a. Maybe a
Nothing
{-# INLINE initFold #-}
initFold :: f (IORef s)
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
initFold f (IORef s)
kv Set (Key f)
set Key f
k a
a = do
Step s b
x <- m (Step s b)
initial1
case Step s b
x of
Partial s
s -> do
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
r of
Partial s
s1 -> do
IORef s
ref <- IO (IORef s) -> m (IORef s)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef s) -> m (IORef s)) -> IO (IORef s) -> m (IORef s)
forall a b. (a -> b) -> a -> b
$ s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s1
Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (Key f -> IORef s -> f (IORef s) -> f (IORef s)
forall a. Key f -> a -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> a -> f a -> f a
IsMap.mapInsert Key f
k IORef s
ref f (IORef s)
kv) Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv Set (Key f)
set ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
Done b
b -> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b)))
step :: Tuple3' (f (IORef s)) (Set (Key f)) c
-> a -> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
step (Tuple3' f (IORef s)
kv Set (Key f)
set c
_) a
a = do
let k :: Key f
k = a -> Key f
f a
a
case Key f -> f (IORef s) -> Maybe (IORef s)
forall a. Key f -> f a -> Maybe a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> Maybe a
IsMap.mapLookup Key f
Key f
k f (IORef s)
kv of
Maybe (IORef s)
Nothing -> do
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing)
else f (IORef s)
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall {f :: * -> *}.
(IsMap f, Ord (Key f)) =>
f (IORef s)
-> Set (Key f)
-> Key f
-> a
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
initFold f (IORef s)
kv Set (Key f)
Set (Key f)
set Key f
Key f
k a
a
Just IORef s
ref -> do
s
s <- IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
case Step s b
r of
Partial s
s1 -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef s
ref s
s1
Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv Set (Key f)
set Maybe (Key f, b)
forall a. Maybe a
Nothing
Done b
b ->
let kv1 :: f (IORef s)
kv1 = Key f -> f (IORef s) -> f (IORef s)
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
Key f
k f (IORef s)
kv
in Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv1 (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
extract :: Tuple3' (t (IORef s)) b b -> m (m (t b), b)
extract (Tuple3' t (IORef s)
kv b
_ b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef s -> m b) -> t (IORef s) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM IORef s -> m b
g t (IORef s)
kv, b
x)
where
g :: IORef s -> m b
g IORef s
ref = IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref) m s -> (s -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m b
extract1
final :: Tuple3' (f (IORef s)) (Set (Key f)) b -> m (m (f b), b)
final (Tuple3' f (IORef s)
kv Set (Key f)
set b
x) = (m (f b), b) -> m (m (f b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key f -> IORef s -> m b) -> f (IORef s) -> m (f b)
forall (f :: * -> *) (t :: * -> *) a b.
(IsMap f, Applicative t) =>
(Key f -> a -> t b) -> f a -> t (f b)
forall (t :: * -> *) a b.
Applicative t =>
(Key f -> a -> t b) -> f a -> t (f b)
IsMap.mapTraverseWithKey Key f -> IORef s -> m b
g f (IORef s)
kv, b
x)
where
g :: Key f -> IORef s -> m b
g Key f
k IORef s
ref = do
s
s <- IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
then s -> m b
extract1 s
s
else s -> m b
final1 s
s
{-# DEPRECATED classifyIO "Use classifyScanIO instead" #-}
{-# INLINE classifyIO #-}
classifyIO :: (MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))
classifyIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))
classifyIO = (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> Fold m a b -> Fold m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))
classifyGenericIO
{-# INLINE classifyUsingMapIO #-}
classifyUsingMapIO :: (MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMapIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMapIO = (a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> Fold m a b -> Scanl m a (m (Map k b), Maybe (Key (Map k), b))
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
(a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyScanGenericIO
{-# INLINE classifyScanIO #-}
classifyScanIO :: (MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))
classifyScanIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))
classifyScanIO a -> k
getKey = ((m (Map k b), Maybe (k, b)) -> Maybe (k, b))
-> Scanl m a (m (Map k b), Maybe (k, b))
-> Scanl m a (Maybe (k, b))
forall a b. (a -> b) -> Scanl m a a -> Scanl m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m (Map k b), Maybe (k, b)) -> Maybe (k, b)
forall a b. (a, b) -> b
snd (Scanl m a (m (Map k b), Maybe (k, b)) -> Scanl m a (Maybe (k, b)))
-> (Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b)))
-> Fold m a b
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMapIO a -> k
getKey
{-# INLINE toMap #-}
toMap :: (Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
toMap :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
toMap = (a -> k) -> Fold m a b -> Fold m a (Map k b)
(a -> Key (Map k)) -> Fold m a b -> Fold m a (Map k b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainer
{-# INLINE toMapIO #-}
toMapIO :: (MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
toMapIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
toMapIO = (a -> k) -> Fold m a b -> Fold m a (Map k b)
(a -> Key (Map k)) -> Fold m a b -> Fold m a (Map k b)
forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainerIO
{-# INLINE kvToMap #-}
kvToMap :: (Monad m, Ord k) => Fold m a b -> Fold m (k, a) (Map k b)
kvToMap :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
Fold m a b -> Fold m (k, a) (Map k b)
kvToMap = ((k, a) -> k) -> Fold m (k, a) b -> Fold m (k, a) (Map k b)
forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
toMap (k, a) -> k
forall a b. (a, b) -> a
fst (Fold m (k, a) b -> Fold m (k, a) (Map k b))
-> (Fold m a b -> Fold m (k, a) b)
-> Fold m a b
-> Fold m (k, a) (Map k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> a) -> Fold m a b -> Fold m (k, a) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (k, a) -> a
forall a b. (a, b) -> b
snd
{-# INLINE frequency #-}
frequency :: (Monad m, Ord a) => Fold m a (Map a Int)
frequency :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Map a Int)
frequency = (a -> a) -> Fold m a Int -> Fold m a (Map a Int)
forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
toMap a -> a
forall a. a -> a
id Fold m a Int
forall (m :: * -> *) a. Monad m => Fold m a Int
length