{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
-- Must come after TypeFamilies, otherwise it is re-enabled.
-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.
{-# LANGUAGE NoMonoLocalBinds #-}

{-# OPTIONS_GHC -Wno-deprecations #-}

-- |
-- Module      : Streamly.Internal.Data.Fold.Container
-- Copyright   : (c) 2019 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--

module Streamly.Internal.Data.Fold.Container
    (
    -- * Set operations
      toSet
    , toIntSet
    , countDistinct
    , countDistinctInt
    , nub -- XXX deprecate in favor of scan
    , nubInt -- XXX deprecate in favor of scan

    -- * Map operations
    , frequency

    -- ** Demultiplexing
    -- | Direct values in the input stream to different folds using an n-ary
    -- fold selector. 'demux' is a generalization of 'classify' (and
    -- 'partition') where each key of the classifier can use a different fold.
    --
    -- You need to see only 'demux' if you are looking to find the capabilities
    -- of these combinators, all others are variants of that.

    -- *** Output is a container
    -- | Use key specific folds to fold corresponding values to a key-value
    -- container.
    , demuxerToContainer
    , demuxerToContainerIO
    , demuxerToMap
    , demuxerToMapIO

    -- *** Input is explicit key-value tuple
    -- | Like above but inputs are in explicit key-value pair form.
    , demuxKvToContainer
    , demuxKvToMap

    -- *** Scan of finished fold results
    -- | Use key specific folds to fold corresponding values to a key-value
    -- stream, restarts the fold again after it terminates, thus resulting in a
    -- stream of values for each key.
    , demuxScanGeneric
    , demuxScan
    , demuxScanGenericIO
    , demuxScanIO

    -- TODO: These can be implemented using the above operations
    -- , demuxSel -- Stop when the fold for the specified key stops
    -- , demuxMin -- Stop when any of the folds stop
    -- , demuxAll -- Stop when all the folds stop (run once)

    -- ** Classifying
    -- | In an input stream of key value pairs fold values for different keys
    -- in individual output buckets using the given fold. 'classify' is a
    -- special case of 'demux' where all the branches of the demultiplexer use
    -- the same fold.
    --
    -- Different types of maps can be used with these combinators via the IsMap
    -- type class. Hashmap performs better when there are more collisions, trie
    -- Map performs better otherwise. Trie has an advantage of sorting the keys
    -- at the same time.  For example if we want to store a dictionary of words
    -- and their meanings then trie Map would be better if we also want to
    -- display them in sorted order.

    , kvToMap

    , toContainer
    , toContainerIO
    , toMap
    , toMapIO

    , classifyScanGeneric
    , classifyScan
    , classifyScanGenericIO
    , classifyScanIO
    -- , toContainerSel
    -- , toContainerMin

    -- * Deprecated
    , 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"

-- | Fold the input to a set.
--
-- Definition:
--
-- >>> toSet = Fold.foldl' (flip Set.insert) Set.empty
--
{-# 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

-- | Fold the input to an int set. For integer inputs this performs better than
-- 'toSet'.
--
-- Definition:
--
-- >>> toIntSet = Fold.foldl' (flip IntSet.insert) IntSet.empty
--
{-# 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

-- XXX Name as nubOrd? Or write a nubGeneric

-- | Used as a scan. Returns 'Just' for the first occurrence of an element,
-- returns 'Nothing' for any other occurrences.
--
-- Example:
--
-- >>> stream = Stream.fromList [1::Int,1,2,3,4,4,5,1,5,7]
--
-- >> Stream.toList $ Stream.scanMaybe Fold.nub stream
-- [1,2,3,4,5,7]
--
-- /Pre-release/
{-# 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

-- | Like 'nub' but specialized to a stream of 'Int', for better performance.
--
-- /Pre-release/
{-# 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

-- XXX Try Hash set
-- XXX Add a countDistinct window fold
-- XXX Add a bloom filter fold

-- | Count non-duplicate elements in the stream.
--
-- Definition:
--
-- >>> countDistinct = fmap Set.size Fold.toSet
-- >>> countDistinct = Fold.postscanl Scanl.nub $ Fold.catMaybes $ Fold.length
--
-- The memory used is proportional to the number of distinct elements in the
-- stream, to guard against using too much memory use it as a scan and
-- terminate if the count reaches more than a threshold.
--
-- /Space/: \(\mathcal{O}(n)\)
--
-- /Pre-release/
--
{-# INLINE countDistinct #-}
countDistinct :: (Monad m, Ord a) => Fold m a Int
-- countDistinct = postscan nub $ catMaybes length
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
{-
countDistinct = fmap (\(Tuple' _ n) -> n) $ foldl' step initial

    where

    initial = Tuple' Set.empty 0

    step (Tuple' set n) x = do
        if Set.member x set
        then
            Tuple' set n
        else
            let cnt = n + 1
             in Tuple' (Set.insert x set) cnt
-}

-- | Like 'countDistinct' but specialized to a stream of 'Int', for better
-- performance.
--
-- Definition:
--
-- >>> countDistinctInt = fmap IntSet.size Fold.toIntSet
-- >>> countDistinctInt = Fold.postscanl Scanl.nubInt $ Fold.catMaybes $ Fold.length
--
-- /Pre-release/
{-# INLINE countDistinctInt #-}
countDistinctInt :: Monad m => Fold m Int Int
-- countDistinctInt = postscan nubInt $ catMaybes length
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
{-
countDistinctInt = fmap (\(Tuple' _ n) -> n) $ foldl' step initial

    where

    initial = Tuple' IntSet.empty 0

    step (Tuple' set n) x = do
        if IntSet.member x set
        then
            Tuple' set n
        else
            let cnt = n + 1
             in Tuple' (IntSet.insert x set) cnt
 -}

------------------------------------------------------------------------------
-- demux: in a key value stream fold each key sub-stream with a different fold
------------------------------------------------------------------------------

-- TODO Demultiplex an input element into a number of typed variants. We want
-- to statically restrict the target values within a set of predefined types,
-- an enumeration of a GADT.
--
-- This is the consumer side dual of the producer side 'mux' operation (XXX to
-- be implemented).
--
-- XXX If we use Refold in it, it can perhaps fuse/be more efficient. For
-- example we can store just the result rather than storing the whole fold in
-- the Map. This would be similar to a refold based classify.
--
-- Note: There are separate functions to determine Key and Fold from the input
-- because key is to be determined on each input whereas fold is to be
-- determined only once for a key.
--
-- XXX Should we use (k -> m (Fold m a b)) instead since the fold is key
-- specific? This should give better safety.

-- | This is the most general of all demux, classify operations.
--
-- See 'demux' for documentation.
{-# 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 ->
                -- Done in "initial" is possible only for the very first time
                -- the fold is initialized, and in that case we have not yet
                -- inserted it in the Map, so we do not need to delete it.
                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"

-- XXX There seem to be a significant difference in demux and classify. In
-- demux once a key is done we again restart it and give the result of the
-- last one. In classify, we do not restart once it is done. To keep it
-- simple we should use the classify behavior.

-- | This is the most general of all demux, classify operations.
--
-- See 'demux' for documentation.
{-# 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 ->
                -- Done in "initial" is possible only for the very first time
                -- the fold is initialized, and in that case we have not yet
                -- inserted it in the Map, so we do not need to delete it.
                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"

-- | Scanning variant of 'demuxerToContainer'.
{-# 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 ->
                -- Done in "initial" is possible only for the very first time
                -- the fold is initialized, and in that case we have not yet
                -- inserted it in the Map, so we do not need to delete it.
                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"

-- | @demux getKey getFold@: In a key value stream, fold values corresponding
-- to each key using a key specific fold. @getFold@ is invoked to generate a
-- key specific fold when a key is encountered for the first time in the
-- stream.
--
-- The first component of the output tuple is a key-value Map of in-progress
-- folds. The fold returns the fold result as the second component of the
-- output tuple whenever a fold terminates.
--
-- If a fold terminates, another instance of the fold is started upon receiving
-- an input with that key, @getFold@ is invoked again whenever the key is
-- encountered again.
--
-- This can be used to scan a stream and collect the results from the scan
-- output.
--
-- Since the fold generator function is monadic we can add folds dynamically.
-- For example, we can maintain a Map of keys to folds in an IORef and lookup
-- the fold from that corresponding to a key. This Map can be changed
-- dynamically, folds for new keys can be added or folds for old keys can be
-- deleted or modified.
--
-- Compare with 'classify', the fold in 'classify' is a static fold.
--
-- /Pre-release/
--
{-# 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

-- | Scanning variant of 'demuxerToMap'.
--
-- TODO: To drain the final in-progress folds this requires the drain step of
-- Scanl to be streaming.
--
{-# 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

-- | This is specialized version of 'demuxGeneric' that uses mutable IO cells
-- as fold accumulators for better performance.
{-# 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
                        -- XXX Instead of using a Fold type here use a custom
                        -- type with an IORef (possibly unboxed) for the
                        -- accumulator. That will reduce the allocations.
                        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"

-- | This is a specialized version of 'demuxToContainer' that uses mutable IO cells
-- as fold accumulators for better performance.
{-# 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
                        -- XXX Instead of using a Fold type here use a custom
                        -- type with an IORef (possibly unboxed) for the
                        -- accumulator. That will reduce the allocations.
                        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"

-- | This is a specialized version of 'demux' that uses mutable IO cells as
-- fold accumulators for better performance.
--
-- Keep in mind that the values in the returned Map may be changed by the
-- ongoing fold if you are using those concurrently in another thread.
--
{-# 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
                        -- XXX Instead of using a Fold type here use a custom
                        -- type with an IORef (possibly unboxed) for the
                        -- accumulator. That will reduce the allocations.
                        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"

-- | This is specialized version of 'demux' that uses mutable IO cells as
-- fold accumulators for better performance.
--
-- Keep in mind that the values in the returned Map may be changed by the
-- ongoing fold if you are using those concurrently in another thread.
--
{-# 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

-- | This is a specialized version of 'demuxScan' that uses mutable IO cells as
-- scan accumulators for better performance.
--
-- TODO: To drain the final in-progress folds this requires the drain step of
-- Scanl to be streaming.
--
{-# 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

-- | Fold a key value stream to a key-value Map. If the same key appears
-- multiple times, only the last value is retained.
{-# 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

-- | This collects all the results of 'demux' in a Map.
--
{-# 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

-- | @demuxerToMap getKey getFold@: In a key value stream, fold values
-- corresponding to each key using a key specific fold. @getFold@ is invoked to
-- generate a key specific fold when a key is encountered for the first time in
-- the stream.
--
-- If a fold terminates, another instance of the fold is started upon receiving
-- an input with that key, @getFold@ is invoked again whenever the key is
-- encountered again.
--
-- This combinator can be used to scan a stream and collect the results from
-- the scan output.
--
-- Since the fold generator function is monadic, folds for new keys can be
-- added dynamically or folds for old keys can be deleted or modified. For
-- example, we can maintain a Map of keys to folds in an IORef and lookup the
-- fold from that corresponding to a key. This Map can be changed dynamically.
--
-- Note that this fold never terminates. Inputs that do not correspond to a
-- fold in the map are dropped.
--
-- Compare with 'classify', the fold in 'classify' is a static fold.
--
-- /Pre-release/
--
{-# 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

-- | Same as 'demuxToMap' but uses 'demuxIO' for better performance.
--
{-# 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

-- | Same as 'demuxerToMap' but uses mutable cells for better performance.
--
{-# 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)

-- | Fold a stream of key value pairs using a function that maps keys to folds.
--
-- Definition:
--
-- >>> demuxKvToMap f = Fold.demuxerToContainer fst (Fold.lmap snd . f)
--
-- Example:
--
-- >>> import Data.Map (Map)
-- >>> :{
--  let f "SUM" = return (Just Fold.sum)
--      f _ = return (Just Fold.product)
--      input = Stream.fromList [("SUM",1),("PRODUCT",2),("SUM",3),("PRODUCT",4)]
--   in Stream.fold (Fold.demuxKvToMap f) input :: IO (Map String Int)
-- :}
-- fromList [("PRODUCT",8),("SUM",4)]
--
-- /Pre-release/
{-# 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

------------------------------------------------------------------------------
-- Classify: Like demux but uses the same fold for all keys.
------------------------------------------------------------------------------

-- XXX Change these to make the behavior similar to demux* variants. We can
-- implement this using classifyScanManyWith. Maintain a set of done folds in
-- the underlying monad, and when initial is called look it up, if the fold is
-- done then initial would set a flag in the state to ignore the input or
-- return an error.

-- XXX Use a Refold m k a b so that we can make the fold key specifc.
-- XXX Is using a function (a -> k) better than using the input (k,a)?

{-# DEPRECATED classifyGeneric "Use classifyScanGeneric instead" #-}
{-# INLINE classifyGeneric #-}
classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>
    -- Note: we need to return the Map itself to display the in-progress values
    -- e.g. to implement top. We could possibly create a separate abstraction
    -- for that use case. We return an action because we want it to be lazy so
    -- that the downstream consumers can choose to process or discard it.
    (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
            -- XXX Why are we doing this? If it is in the set then it will not
            -- be in the map and vice-versa.
            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

-- | Scanning variant of 'toContainer'.
--
{-# INLINE classifyScanGeneric #-}
classifyScanGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>
    -- Note: we need to return the Map itself to display the in-progress values
    -- e.g. to implement top. We could possibly create a separate abstraction
    -- for that use case. We return an action because we want it to be lazy so
    -- that the downstream consumers can choose to process or discard it.
    (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
            -- XXX Why are we doing this? If it is in the set then it will not
            -- be in the map and vice-versa.
            then s -> m b
extract1 s
s
            else s -> m b
final1 s
s

-- | Folds the values for each key using the supplied fold. When scanning, as
-- soon as the fold is complete, its result is available in the second
-- component of the tuple.  The first component of the tuple is a snapshot of
-- the in-progress folds.
--
-- Once the fold for a key is done, any future values of the key are ignored.
--
-- Definition:
--
-- >> classify f fld = Fold.demux f (const fld)
--
{-# 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

-- XXX Make it consistent with demux.

-- | Scanning variant of 'toMap'.
--
{-# 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

-- XXX we can use a Prim IORef if we can constrain the state "s" to be Prim
--
-- The code is almost the same as classifyGeneric except the IORef operations.

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

-- XXX we can use a Prim IORef if we can constrain the state "s" to be Prim
--
-- The code is almost the same as classifyGeneric except the IORef operations.

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

-- | Scanning variant of 'classifyGenericIO'.
--
{-# 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

-- | Same as classify except that it uses mutable IORef cells in the
-- Map providing better performance. Be aware that if this is used as a scan,
-- the values in the intermediate Maps would be mutable.
--
-- Definitions:
--
-- >> classifyIO f fld = Fold.demuxIO f (const fld)
--
{-# 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

-- | This is a specialized version of 'classifyScan' that uses mutable IO cells
-- as scan accumulators for better performance.
--
-- TODO: To drain the final in-progress folds this requires the drain step of
-- Scanl to be streaming.
--
{-# 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 toContainer #-}
toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>
    (a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainer f fld =
    let
        classifier = classifyGeneric f fld
        getMap Nothing = pure IsMap.mapEmpty
        getMap (Just action) = action
        aggregator =
            teeWith IsMap.mapUnion
                (rmapM getMap $ lmap fst latest)
                (lmap snd $ catMaybes kvToMapOverwriteGeneric)
    in postscan classifier aggregator
-}

-- | Split the input stream based on a key field and fold each split using the
-- given fold. Useful for map/reduce, bucketizing the input in different bins
-- or for generating histograms.
--
-- Example:
--
-- >>> import Data.Map.Strict (Map)
-- >>> :{
--  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]
--      classify = Fold.toMap fst (Fold.lmap snd Fold.toList)
--   in Stream.fold classify input :: IO (Map String [Double])
-- :}
-- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]
--
-- Once the classifier fold terminates for a particular key any further inputs
-- in that bucket are ignored.
--
-- Space used is proportional to the number of keys seen till now and
-- monotonically increases because it stores whether a key has been seen or
-- not.
--
-- See 'demuxToMap' for a more powerful version where you can use a different
-- fold for each key. A simpler version of 'toMap' retaining only the last
-- value for a key can be written as:
--
-- >>> toMap = Fold.foldl' (\kv (k, v) -> Map.insert k v kv) Map.empty
--
-- /Stops: never/
--
-- /Pre-release/
--
{-# 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 toContainerIO #-}
toContainerIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
    (a -> Key f) -> Fold m a b -> Fold m a (f b)
toContainerIO f fld =
    let
        classifier = classifyGenericIO f fld
        getMap Nothing = pure IsMap.mapEmpty
        getMap (Just action) = action
        aggregator =
            teeWith IsMap.mapUnion
                (rmapM getMap $ lmap fst latest)
                (lmap snd $ catMaybes kvToMapOverwriteGeneric)
    in postscan classifier aggregator
-}

-- | Same as 'toMap' but maybe faster because it uses mutable cells as
-- fold accumulators in the Map.
--
{-# 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

-- | Given an input stream of key value pairs and a fold for values, fold all
-- the values belonging to each key.  Useful for map/reduce, bucketizing the
-- input in different bins or for generating histograms.
--
-- Definition:
--
-- >>> kvToMap = Fold.toMap fst . Fold.lmap snd
--
-- Example:
--
-- >>> :{
--  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]
--   in Stream.fold (Fold.kvToMap Fold.toList) input
-- :}
-- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]
--
-- /Pre-release/
{-# 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

-- | Determine the frequency of each element in the stream.
--
-- You can just collect the keys of the resulting map to get the unique
-- elements in the stream.
--
-- Definition:
--
-- >>> frequency = Fold.toMap id Fold.length
--
{-# 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