{-# LANGUAGE CPP #-}
-- |
-- Module      : Streamly.Internal.Data.Scanl.Container
-- Copyright   : (c) 2019 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--

module Streamly.Internal.Data.Scanl.Container
    (
    -- * Set operations
      toSet
    , toIntSet
    , countDistinct
    , countDistinctInt
    , nub
    , nubInt

    -- * 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
    -- | The fold state snapshot returns the key-value container of in-progress
    -- folds.
    , demuxToContainer
    , demuxToContainerIO
    , demuxToMap
    , demuxToMapIO

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

    -- *** Scan of finished fold results
    -- | Like above, but the resulting fold state snapshot contains the key
    -- value container as well as the finished key result if a fold in the
    -- container finished.
    -}
    , demuxGeneric
    , demux
    , demuxGenericIO
    , demuxIO

    -- 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
    -}

    , classifyGeneric
    , classify
    , classifyGenericIO
    , classifyIO
    -- , toContainerSel
    -- , toContainerMin
    )
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.Tuple.Strict (Tuple'(..), Tuple3'(..))

import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import qualified Streamly.Internal.Data.IsMap as IsMap

import Prelude hiding (Foldable(..))
import Streamly.Internal.Data.Scanl.Type
-- import Streamly.Internal.Data.Scanl.Combinators

#include "DocTestDataScanl.hs"

-- | Scan the input adding it to a set.
--
-- Definition:
--
-- >>> toSet = Scanl.mkScanl (flip Set.insert) Set.empty
--
{-# INLINE toSet #-}
toSet :: (Monad m, Ord a) => Scanl m a (Set a)
toSet :: forall (m :: * -> *) a. (Monad m, Ord a) => Scanl m a (Set a)
toSet = (Set a -> a -> Set a) -> Set a -> Scanl m a (Set a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Scanl m a b
mkScanl ((a -> Set a -> Set a) -> Set a -> a -> Set a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert) Set a
forall a. Set a
Set.empty

-- | Scan the input adding it to an int set. For integer inputs this performs
-- better than 'toSet'.
--
-- Definition:
--
-- >>> toIntSet = Scanl.mkScanl (flip IntSet.insert) IntSet.empty
--
{-# INLINE toIntSet #-}
toIntSet :: Monad m => Scanl m Int IntSet
toIntSet :: forall (m :: * -> *). Monad m => Scanl m Int IntSet
toIntSet = (IntSet -> Int -> IntSet) -> IntSet -> Scanl m Int IntSet
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Scanl m a b
mkScanl ((Int -> IntSet -> IntSet) -> IntSet -> Int -> IntSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntSet -> IntSet
IntSet.insert) IntSet
IntSet.empty

-- XXX Name as nubOrd? Or write a nubGeneric

-- | 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.postscanlMaybe Scanl.nub stream
-- [1,2,3,4,5,7]
--
-- /Pre-release/
{-# INLINE nub #-}
nub :: (Monad m, Ord a) => Scanl m a (Maybe a)
nub :: forall (m :: * -> *) a. (Monad m, Ord a) => Scanl m a (Maybe a)
nub = (Tuple' (Set a) (Maybe a) -> Maybe a)
-> Scanl m a (Tuple' (Set a) (Maybe a)) -> Scanl m a (Maybe a)
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 (\(Tuple' Set a
_ Maybe a
x) -> Maybe a
x) (Scanl m a (Tuple' (Set a) (Maybe a)) -> Scanl m a (Maybe a))
-> Scanl m a (Tuple' (Set a) (Maybe a)) -> Scanl m a (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Tuple' (Set a) (Maybe a) -> a -> Tuple' (Set a) (Maybe a))
-> Tuple' (Set a) (Maybe a) -> Scanl m a (Tuple' (Set a) (Maybe a))
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Scanl m a b
mkScanl Tuple' (Set a) (Maybe a) -> a -> Tuple' (Set a) (Maybe a)
forall {a} {b}.
Ord a =>
Tuple' (Set a) b -> a -> Tuple' (Set a) (Maybe a)
step Tuple' (Set a) (Maybe a)
forall {a} {a}. Tuple' (Set a) (Maybe a)
initial

    where

    initial :: Tuple' (Set a) (Maybe a)
initial = Set a -> Maybe a -> Tuple' (Set a) (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' Set a
forall a. Set a
Set.empty Maybe a
forall a. Maybe a
Nothing

    step :: Tuple' (Set a) b -> a -> Tuple' (Set a) (Maybe a)
step (Tuple' Set a
set b
_) a
x =
        if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x Set a
set
        then Set a -> Maybe a -> Tuple' (Set a) (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' Set a
set Maybe a
forall a. Maybe a
Nothing
        else Set a -> Maybe a -> Tuple' (Set a) (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
set) (a -> Maybe a
forall a. a -> Maybe a
Just a
x)

-- | Like 'nub' but specialized to a stream of 'Int', for better performance.
--
-- /Pre-release/
{-# INLINE nubInt #-}
nubInt :: Monad m => Scanl m Int (Maybe Int)
nubInt :: forall (m :: * -> *). Monad m => Scanl m Int (Maybe Int)
nubInt = (Tuple' IntSet (Maybe Int) -> Maybe Int)
-> Scanl m Int (Tuple' IntSet (Maybe Int))
-> Scanl m Int (Maybe Int)
forall a b. (a -> b) -> Scanl m Int a -> Scanl m Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Tuple' IntSet
_ Maybe Int
x) -> Maybe Int
x) (Scanl m Int (Tuple' IntSet (Maybe Int))
 -> Scanl m Int (Maybe Int))
-> Scanl m Int (Tuple' IntSet (Maybe Int))
-> Scanl m Int (Maybe Int)
forall a b. (a -> b) -> a -> b
$ (Tuple' IntSet (Maybe Int) -> Int -> Tuple' IntSet (Maybe Int))
-> Tuple' IntSet (Maybe Int)
-> Scanl m Int (Tuple' IntSet (Maybe Int))
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Scanl m a b
mkScanl Tuple' IntSet (Maybe Int) -> Int -> Tuple' IntSet (Maybe Int)
forall {b}. Tuple' IntSet b -> Int -> Tuple' IntSet (Maybe Int)
step Tuple' IntSet (Maybe Int)
forall {a}. Tuple' IntSet (Maybe a)
initial

    where

    initial :: Tuple' IntSet (Maybe a)
initial = IntSet -> Maybe a -> Tuple' IntSet (Maybe a)
forall a b. a -> b -> Tuple' a b
Tuple' IntSet
IntSet.empty Maybe a
forall a. Maybe a
Nothing

    step :: Tuple' IntSet b -> Int -> Tuple' IntSet (Maybe Int)
step (Tuple' IntSet
set b
_) Int
x =
        if Int -> IntSet -> Bool
IntSet.member Int
x IntSet
set
        then IntSet -> Maybe Int -> Tuple' IntSet (Maybe Int)
forall a b. a -> b -> Tuple' a b
Tuple' IntSet
set Maybe Int
forall a. Maybe a
Nothing
        else IntSet -> Maybe Int -> Tuple' IntSet (Maybe Int)
forall a b. a -> b -> Tuple' a b
Tuple' (Int -> IntSet -> IntSet
IntSet.insert Int
x IntSet
set) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x)

-- 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 Scanl.toSet
-- >>> countDistinct = Scanl.postscanl Scanl.nub $ Scanl.catMaybes $ Scanl.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) => Scanl m a Int
-- countDistinct = postscan nub $ catMaybes length
countDistinct :: forall (m :: * -> *) a. (Monad m, Ord a) => Scanl m a Int
countDistinct = (Set a -> Int) -> Scanl m a (Set a) -> Scanl m a Int
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 Set a -> Int
forall a. Set a -> Int
Set.size Scanl m a (Set a)
forall (m :: * -> *) a. (Monad m, Ord a) => Scanl m a (Set a)
toSet
{-
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 Scanl.toIntSet
-- >>> countDistinctInt = Scanl.postscanl Scanl.nubInt $ Scanl.catMaybes $ Scanl.length
--
-- /Pre-release/
{-# INLINE countDistinctInt #-}
countDistinctInt :: Monad m => Scanl m Int Int
-- countDistinctInt = postscan nubInt $ catMaybes length
countDistinctInt :: forall (m :: * -> *). Monad m => Scanl m Int Int
countDistinctInt = (IntSet -> Int) -> Scanl m Int IntSet -> Scanl m Int Int
forall a b. (a -> b) -> Scanl m Int a -> Scanl m Int b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IntSet -> Int
IntSet.size Scanl m Int IntSet
forall (m :: * -> *). Monad m => Scanl m Int IntSet
toIntSet
{-
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 If a scan terminates do not start it again? This can be easily done by
-- installing a drain fold after a fold is done.
--
-- XXX We can use the Scan drain step to drain the buffered map in the end.

-- | This is the most general of all demux, classify operations.
--
-- The first component of the output tuple is a key-value Map of in-progress
-- scans. The scan returns the scan result as the second component of the
-- output tuple.
--
-- See 'demux' for documentation.
{-# INLINE demuxGeneric #-}
demuxGeneric :: (Monad m, IsMap f, Traversable f) =>
       (a -> Key f)
    -> (Key f -> m (Maybe (Scanl m a b)))
    -> Scanl m a (m (f b), Maybe (Key f, b))
demuxGeneric :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Scanl m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxGeneric a -> Key f
getKey Key f -> m (Maybe (Scanl m a b))
getFold =
    (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
 -> a
 -> m (Step
         (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
         (m (f b), Maybe (Key f, b))))
-> m (Step
        (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
        (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
    -> m (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (Scanl 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 (Scanl m a b)) (Maybe (Key f, b))
s a
a -> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> Step
     (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
     (m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
 -> Step
      (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
      (m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
-> m (Step
        (Tuple' (f (Scanl 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 (Scanl m a b)) (Maybe (Key f, b))
-> a -> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {b}.
(Key f ~ Key f, IsMap f) =>
Tuple' (f (Scanl m a b)) b
-> a -> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
step Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
s a
a) (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> Step
     (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
     (m (f b), Maybe (Key f, b))
forall s b. s -> Step s b
Partial (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
 -> Step
      (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
      (m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
-> m (Step
        (Tuple' (f (Scanl 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 (Scanl m a b)) (Maybe (Key f, b)))
forall {a} {a}. m (Tuple' (f a) (Maybe a))
initial) Tuple' (f (Scanl 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 (Scanl m a b)) b -> m (m (t b), b)
extract Tuple' (f (Scanl 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 (Scanl 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 (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
runFold f (Scanl m a b)
kv (Scanl 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
ss -> do
                            b
b <- s -> m b
extract1 s
ss
                            let fld :: Scanl m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a 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 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
                            Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                                (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
 -> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (Scanl m a b)
-> Maybe (Key f, b) -> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple'
                                    (Key f -> Scanl m a b -> f (Scanl m a b) -> f (Scanl 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 Scanl m a b
fld f (Scanl 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 (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                                (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
 -> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (Scanl m a b)
-> Maybe (Key f, b) -> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f -> f (Scanl m a b) -> f (Scanl 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 (Scanl 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 (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
 -> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (Scanl m a b)
-> Maybe (Key f, b) -> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (Scanl 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 (Scanl m a b)) b
-> a -> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
step (Tuple' f (Scanl m a b)
kv b
_) a
a = do
        let k :: Key f
k = a -> Key f
getKey a
a
        case Key f -> f (Scanl m a b) -> Maybe (Scanl 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 (Scanl m a b)
kv of
            Maybe (Scanl m a b)
Nothing -> do
                Maybe (Scanl m a b)
mfld <- Key f -> m (Maybe (Scanl m a b))
getFold Key f
k
                case Maybe (Scanl m a b)
mfld of
                    Maybe (Scanl m a b)
Nothing -> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
 -> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b))))
-> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (Scanl m a b)
-> Maybe (Key f, b) -> Tuple' (f (Scanl m a b)) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (Scanl m a b)
kv Maybe (Key f, b)
forall a. Maybe a
Nothing
                    Just Scanl m a b
fld -> f (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {m :: * -> *} {a} {b}.
(IsMap f, Monad m) =>
f (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
runFold f (Scanl m a b)
kv Scanl m a b
fld (Key f
Key f
k, a
a)
            Just Scanl m a b
f -> f (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
forall {f :: * -> *} {m :: * -> *} {a} {b}.
(IsMap f, Monad m) =>
f (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (Scanl m a b)) (Maybe (Key f, b)))
runFold f (Scanl m a b)
kv Scanl m a b
f (Key f
Key f
k, a
a)

    extract :: Tuple' (t (Scanl m a b)) b -> m (m (t b), b)
extract (Tuple' t (Scanl 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 ((Scanl m a b -> m b) -> t (Scanl 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 Scanl m a b -> m b
forall {m :: * -> *} {a} {b}. Monad m => Scanl m a b -> m b
f t (Scanl m a b)
kv, b
x)

        where

        f :: Scanl m a b -> m b
f (Scanl 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 (Scanl m a b)) b -> m (m (t b), b)
final (Tuple' t (Scanl 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 ((Scanl m a b -> m b) -> t (Scanl 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 Scanl m a b -> m b
forall {m :: * -> *} {a} {b}. Monad m => Scanl m a b -> m b
f t (Scanl m a b)
kv, b
x)

        where

        f :: Scanl m a b -> m b
f (Scanl s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin) = do
            Step s b
r <- m (Step s b)
i
            case Step s b
r of
                Partial s
s -> s -> m b
fin s
s
                Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGeneric: unreachable code"

{-# INLINE demuxUsingMap #-}
demuxUsingMap :: (Monad m, Ord k) =>
       (a -> k)
    -> (k -> m (Maybe (Scanl 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 (Scanl m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMap = (a -> k)
-> (k -> m (Maybe (Scanl m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> (Key (Map k) -> m (Maybe (Scanl 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 (Scanl m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxGeneric

-- | @demux getKey getScan@: In a key value stream, scan values corresponding
-- to each key using a key specific scan. @getScan@ is invoked to generate a
-- key specific scan when a key is encountered for the first time in the
-- stream. If a scan does not exist corresponding to the key then 'Nothing' is
-- returned otherwise the result of the scan is returned.
--
-- If a scan terminates, another instance of the scan is started upon receiving
-- an input with that key, @getScan@ is invoked again whenever the key is
-- encountered again.
--
-- This can be used to scan a stream, splitting it based on different keys.
--
-- Since the scan generator function is monadic we can add scans dynamically.
-- For example, we can maintain a Map of keys to scans in an IORef and lookup
-- the scan from that corresponding to a key. This Map can be changed
-- dynamically, scans for new keys can be added or scans for old keys can be
-- deleted or modified.
--
-- Compare with 'classify', the scan in 'classify' is a static scan.
--
-- /Pre-release/
--
{-# INLINE demux #-}
demux :: (Monad m, Ord k) =>
       (a -> k)
    -> (k -> m (Maybe (Scanl m a b)))
    -> Scanl m a (Maybe (k, b))
demux :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Scanl m a b))) -> Scanl m a (Maybe (k, b))
demux 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 (Scanl m a b)))
    -> Scanl m a (m (Map k b), Maybe (k, b)))
-> (k -> m (Maybe (Scanl m a b)))
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k)
-> (k -> m (Maybe (Scanl 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 (Scanl m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMap a -> k
getKey

-- XXX We can use the Scan drain step to drain the buffered map in the end.

-- | This is specialized version of 'demuxGeneric' 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 scan if you are using those concurrently in another thread.
--
{-# INLINE demuxGenericIO #-}
demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) =>
       (a -> Key f)
    -> (Key f -> m (Maybe (Scanl m a b)))
    -> Scanl m a (m (f b), Maybe (Key f, b))
demuxGenericIO :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadIO m, IsMap f, Traversable f) =>
(a -> Key f)
-> (Key f -> m (Maybe (Scanl m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxGenericIO a -> Key f
getKey Key f -> m (Maybe (Scanl m a b))
getFold =
    (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
 -> a
 -> m (Step
         (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
         (m (f b), Maybe (Key f, b))))
-> m (Step
        (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
        (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
    -> m (m (f b), Maybe (Key f, b)))
-> (Tuple' (f (IORef (Scanl 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 (Scanl m a b))) (Maybe (Key f, b))
s a
a -> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> Step
     (Tuple' (f (IORef (Scanl 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 (Scanl m a b))) (Maybe (Key f, b))
 -> Step
      (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
      (m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
-> m (Step
        (Tuple' (f (IORef (Scanl 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 (Scanl m a b))) (Maybe (Key f, b))
-> a -> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall {f :: * -> *} {b}.
(Key f ~ Key f, IsMap f) =>
Tuple' (f (IORef (Scanl m a b))) b
-> a -> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
step Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
s a
a) (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> Step
     (Tuple' (f (IORef (Scanl 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 (Scanl m a b))) (Maybe (Key f, b))
 -> Step
      (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
      (m (f b), Maybe (Key f, b)))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
-> m (Step
        (Tuple' (f (IORef (Scanl 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 (Scanl m a b))) (Maybe (Key f, b)))
forall {a} {a}. m (Tuple' (f a) (Maybe a))
initial) Tuple' (f (IORef (Scanl 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 (Scanl m a b))) b -> m (m (t b), b)
extract Tuple' (f (IORef (Scanl 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 (Scanl 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 (Scanl m a b))
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
initFold f (IORef (Scanl m a b))
kv (Scanl 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
ss -> 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 :: Scanl m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a 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 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 (Scanl m a b)
ref <- IO (IORef (Scanl m a b)) -> m (IORef (Scanl m a b))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Scanl m a b)) -> m (IORef (Scanl m a b)))
-> IO (IORef (Scanl m a b)) -> m (IORef (Scanl m a b))
forall a b. (a -> b) -> a -> b
$ Scanl m a b -> IO (IORef (Scanl m a b))
forall a. a -> IO (IORef a)
newIORef Scanl m a b
fld
                        b
b <- s -> m b
extract1 s
ss
                        Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
 -> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Scanl m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' (Key f
-> IORef (Scanl m a b)
-> f (IORef (Scanl m a b))
-> f (IORef (Scanl 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 (Scanl m a b)
ref f (IORef (Scanl 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 (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
 -> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Scanl m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Scanl 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 (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
 -> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Scanl m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Scanl 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 (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f a) (Maybe (Key f, b)))
runFold f a
kv IORef (Scanl m a b)
ref (Scanl 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
ss -> do
                            let fld :: Scanl m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a 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 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 (Scanl m a b) -> Scanl m a b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Scanl m a b)
ref Scanl m a b
fld
                            b
b <- s -> m b
extract1 s
ss
                            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 ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
                        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 (Scanl m a b))) b
-> a -> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
step (Tuple' f (IORef (Scanl m a b))
kv b
_) a
a = do
        let k :: Key f
k = a -> Key f
getKey a
a
        case Key f -> f (IORef (Scanl m a b)) -> Maybe (IORef (Scanl 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 (Scanl m a b))
kv of
            Maybe (IORef (Scanl m a b))
Nothing -> do
                Maybe (Scanl m a b)
res <- Key f -> m (Maybe (Scanl m a b))
getFold Key f
k
                case Maybe (Scanl m a b)
res of
                    Maybe (Scanl m a b)
Nothing -> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
 -> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))))
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef (Scanl m a b))
-> Maybe (Key f, b)
-> Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b))
forall a b. a -> b -> Tuple' a b
Tuple' f (IORef (Scanl m a b))
kv Maybe (Key f, b)
forall a. Maybe a
Nothing
                    Just Scanl m a b
f -> f (IORef (Scanl m a b))
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall {m :: * -> *} {f :: * -> *} {a} {b}.
(MonadIO m, IsMap f) =>
f (IORef (Scanl m a b))
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
initFold f (IORef (Scanl m a b))
kv Scanl m a b
f (Key f
Key f
k, a
a)
            Just IORef (Scanl m a b)
ref -> do
                Scanl m a b
f <- IO (Scanl m a b) -> m (Scanl m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Scanl m a b) -> m (Scanl m a b))
-> IO (Scanl m a b) -> m (Scanl m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Scanl m a b) -> IO (Scanl m a b)
forall a. IORef a -> IO a
readIORef IORef (Scanl m a b)
ref
                f (IORef (Scanl m a b))
-> IORef (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f (IORef (Scanl m a b))) (Maybe (Key f, b)))
forall {m :: * -> *} {f :: * -> *} {a} {a} {b}.
(MonadIO m, IsMap f) =>
f a
-> IORef (Scanl m a b)
-> Scanl m a b
-> (Key f, a)
-> m (Tuple' (f a) (Maybe (Key f, b)))
runFold f (IORef (Scanl m a b))
kv IORef (Scanl m a b)
ref Scanl m a b
f (Key f
Key f
k, a
a)

    extract :: Tuple' (t (IORef (Scanl m a b))) b -> m (m (t b), b)
extract (Tuple' t (IORef (Scanl 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 (Scanl m a b) -> m b) -> t (IORef (Scanl 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 (Scanl m a b) -> m b
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Scanl m a b) -> m b
f t (IORef (Scanl m a b))
kv, b
x)

        where

        f :: IORef (Scanl m a b) -> m b
f IORef (Scanl m a b)
ref = do
            Scanl s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
e s -> m b
_ <- IO (Scanl m a b) -> m (Scanl m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Scanl m a b) -> m (Scanl m a b))
-> IO (Scanl m a b) -> m (Scanl m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Scanl m a b) -> IO (Scanl m a b)
forall a. IORef a -> IO a
readIORef IORef (Scanl 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 (Scanl m a b))) b -> m (m (t b), b)
final (Tuple' t (IORef (Scanl 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 (Scanl m a b) -> m b) -> t (IORef (Scanl 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 (Scanl m a b) -> m b
forall {m :: * -> *} {a} {b}.
MonadIO m =>
IORef (Scanl m a b) -> m b
f t (IORef (Scanl m a b))
kv, b
x)

        where

        f :: IORef (Scanl m a b) -> m b
f IORef (Scanl m a b)
ref = do
            Scanl s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
_ s -> m b
fin <- IO (Scanl m a b) -> m (Scanl m a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Scanl m a b) -> m (Scanl m a b))
-> IO (Scanl m a b) -> m (Scanl m a b)
forall a b. (a -> b) -> a -> b
$ IORef (Scanl m a b) -> IO (Scanl m a b)
forall a. IORef a -> IO a
readIORef IORef (Scanl m a b)
ref
            Step s b
r <- m (Step s b)
i
            case Step s b
r of
                Partial s
s -> s -> m b
fin s
s
                Step s b
_ -> [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"demuxGenericIO: unreachable code"

{-# INLINE demuxUsingMapIO #-}
demuxUsingMapIO :: (MonadIO m, Ord k) =>
       (a -> k)
    -> (k -> m (Maybe (Scanl 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 (Scanl m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
demuxUsingMapIO = (a -> k)
-> (k -> m (Maybe (Scanl m a b)))
-> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> (Key (Map k) -> m (Maybe (Scanl 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 (Scanl m a b)))
-> Scanl m a (m (f b), Maybe (Key f, b))
demuxGenericIO

-- | This is specialized version of 'demux' that uses mutable IO cells as scan
-- accumulators for better performance.
--
{-# INLINE demuxIO #-}
demuxIO :: (MonadIO m, Ord k) =>
       (a -> k)
    -> (k -> m (Maybe (Scanl m a b)))
    -> Scanl m a (Maybe (k, b))
demuxIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k)
-> (k -> m (Maybe (Scanl m a b))) -> Scanl m a (Maybe (k, b))
demuxIO 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 (Scanl m a b)))
    -> Scanl m a (m (Map k b), Maybe (k, b)))
-> (k -> m (Maybe (Scanl m a b)))
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k)
-> (k -> m (Maybe (Scanl 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 (Scanl 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) => Scanl m (Key f, a) (f a)
kvToMapOverwriteGeneric =
    mkScanl (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty

{-# INLINE demuxToContainer #-}
demuxToContainer :: (Monad m, IsMap f, Traversable f) =>
    (a -> Key f) -> (Key f -> m (Scanl m a b)) -> Scanl m a (f b)
demuxToContainer getKey getFold =
    let
        classifier = demuxGeneric getKey getFold
        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

-- | This collects all the results of 'demux' in a Map.
--
{-# INLINE demuxToMap #-}
demuxToMap :: (Monad m, Ord k) =>
    (a -> k) -> (k -> m (Scanl m a b)) -> Scanl m a (Map k b)
demuxToMap = demuxToContainer

{-# INLINE demuxToContainerIO #-}
demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) =>
    (a -> Key f) -> (Key f -> m (Scanl m a b)) -> Scanl m a (f b)
demuxToContainerIO getKey getFold =
    let
        classifier = demuxGenericIO getKey getFold
        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 'demuxToMap' but uses 'demuxIO' for better performance.
--
{-# INLINE demuxToMapIO #-}
demuxToMapIO :: (MonadIO m, Ord k) =>
    (a -> k) -> (k -> m (Scanl m a b)) -> Scanl m a (Map k b)
demuxToMapIO = demuxToContainerIO

{-# INLINE demuxKvToContainer #-}
demuxKvToContainer :: (Monad m, IsMap f, Traversable f) =>
    (Key f -> m (Scanl m a b)) -> Scanl m (Key f, a) (f b)
demuxKvToContainer f = demuxToContainer fst (fmap (lmap snd) . f)

-- | Fold a stream of key value pairs using a function that maps keys to folds.
--
-- Definition:
--
-- >>> demuxKvToMap f = Fold.demuxToContainer fst (Fold.lmap snd . f)
--
-- Example:
--
-- >>> import Data.Map (Map)
-- >>> :{
--  let f "SUM" = return Fold.sum
--      f _ = return 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 (Scanl m a b)) -> Scanl m (k, a) (Map k b)
demuxKvToMap = 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)?
--
-- XXX We can use the Scan drain step to drain the buffered map in the end.

{-# 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) -> Scanl m a b -> Scanl 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)
-> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyGeneric a -> Key f
f (Scanl 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

    -- XXX Instead of keeping a Set, after a fold terminates just install a
    -- fold that always returns Partial/Nothing.
    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
                case Step s b
r of
                  Partial s
s1 -> do
                    b
b <- s -> m b
extract1 s
s1
                    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
$ 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 ((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 (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
$ 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
                case Step s b
r of
                  Partial s
s1 -> do
                    b
b <- s -> m b
extract1 s
s1
                    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
$ 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 ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k,b
b))
                  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 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
$ 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 classifyUsingMap #-}
classifyUsingMap :: (Monad m, Ord k) =>
    (a -> k) -> Scanl 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) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMap = (a -> k) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> Scanl 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)
-> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyGeneric

-- XXX Make it consistent with denux.

-- | Scans the values for each key using the supplied scan.
--
-- Once the scan for a key terminates, any future values of the key are ignored.
--
-- Equivalent to the following except that the scan is not restarted:
--
-- >>> classify f fld = Scanl.demux f (const fld)
--
{-# INLINE classify #-}
classify :: (MonadIO m, Ord k) =>
    (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))
classify :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))
classify 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)))
-> (Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b)))
-> Scanl m a b
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))
forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Scanl 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.
--
-- XXX We can use the Scan drain step to drain the buffered map in the end.

-- | Be aware that the values in the intermediate Maps would be mutable.
--
{-# INLINE classifyGenericIO #-}
classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
    (a -> Key f) -> Scanl m a b -> Scanl 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)
-> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyGenericIO a -> Key f
f (Scanl 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
                        b
b <- s -> m b
extract1 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 ((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 (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
                        b
b <- s -> m b
extract1 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 ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))
                      Done b
b ->
                        let kv1 :: f (IORef s)
kv1 = Key f -> f (IORef s) -> f (IORef s)
forall a. Key f -> f a -> f a
forall (f :: * -> *) a. IsMap f => Key f -> f a -> f a
IsMap.mapDelete Key f
Key f
k f (IORef s)
kv
                         in Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                                (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
 -> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))))
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
-> m (Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b)))
forall a b. (a -> b) -> a -> b
$ f (IORef s)
-> Set (Key f)
-> Maybe (Key f, b)
-> Tuple3' (f (IORef s)) (Set (Key f)) (Maybe (Key f, b))
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' f (IORef s)
kv1 (Key f -> Set (Key f) -> Set (Key f)
forall a. Ord a => a -> Set a -> Set a
Set.insert Key f
k Set (Key f)
set) ((Key f, b) -> Maybe (Key f, b)
forall a. a -> Maybe a
Just (Key f
k, b
b))

    extract :: Tuple3' (t (IORef s)) b b -> m (m (t b), b)
extract (Tuple3' t (IORef s)
kv b
_ b
x) = (m (t b), b) -> m (m (t b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((IORef s -> m b) -> t (IORef s) -> m (t b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
Prelude.mapM IORef s -> m b
g t (IORef s)
kv, b
x)

        where

        g :: IORef s -> m b
g IORef s
ref = IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref) m s -> (s -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m b
extract1

    final :: Tuple3' (f (IORef s)) (Set (Key f)) b -> m (m (f b), b)
final (Tuple3' f (IORef s)
kv Set (Key f)
set b
x) = (m (f b), b) -> m (m (f b), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key f -> IORef s -> m b) -> f (IORef s) -> m (f b)
forall (f :: * -> *) (t :: * -> *) a b.
(IsMap f, Applicative t) =>
(Key f -> a -> t b) -> f a -> t (f b)
forall (t :: * -> *) a b.
Applicative t =>
(Key f -> a -> t b) -> f a -> t (f b)
IsMap.mapTraverseWithKey Key f -> IORef s -> m b
g f (IORef s)
kv, b
x)

        where

        g :: Key f -> IORef s -> m b
g Key f
k IORef s
ref = do
            s
s <- IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
            if Key f -> Set (Key f) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key f
k Set (Key f)
set
            then s -> m b
extract1 s
s
            else s -> m b
final1 s
s

{-# INLINE classifyUsingMapIO #-}
classifyUsingMapIO :: (MonadIO m, Ord k) =>
    (a -> k) -> Scanl 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) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))
classifyUsingMapIO = (a -> k) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))
(a -> Key (Map k))
-> Scanl 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)
-> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))
classifyGenericIO

-- | Same as classify except that it uses mutable IORef cells in the
-- Map, providing better performance.
--
-- Equivalent to the following except that the scan is not restarted:
--
-- >>> classifyIO f fld = Scanl.demuxIO f (const fld)
--
{-# INLINE classifyIO #-}
classifyIO :: (MonadIO m, Ord k) =>
    (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))
classifyIO :: forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))
classifyIO 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)))
-> (Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b)))
-> Scanl m a b
-> Scanl m a (Maybe (k, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> k) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))
forall (m :: * -> *) k a b.
(MonadIO m, Ord k) =>
(a -> k) -> Scanl 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) -> Scanl m a b -> Scanl 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) -> Scanl m a b -> Scanl m a (Map k b)
toMap = toContainer

{-# INLINE toContainerIO #-}
toContainerIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>
    (a -> Key f) -> Scanl m a b -> Scanl 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) -> Scanl m a b -> Scanl m a (Map k b)
toMapIO = 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) => Scanl m a b -> Scanl m (k, a) (Map k b)
kvToMap = toMap fst . lmap 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) => Scanl m a (Map a Int)
frequency = toMap id length
-}