{-# LANGUAGE CPP   #-}
{-# LANGUAGE GADTs #-}

-- | Split up input streams into groups with separator values and process the
-- groups with their own 'MachineT'.

module Data.Machine.Group.General
  ( groupingOn
  , groupingOn_
  , groupingN
    -- * Tagging a stream
  , taggedState
  , taggedM
  , taggedOn
  , taggedOnM
  , taggedOn_
  , taggedAt
  , taggedAt_
  , taggedCount
    -- * Reset a machine for each group
  , partitioning
  , partitioning_
    -- * Helpers
  , starve
  , awaitUntil
  ) where

import           Control.Monad (guard)
import           Data.Machine

-- $setup
-- >>> import Control.Monad.Trans.Reader (ask, runReader)
-- >>> import Control.Monad (guard)
-- >>> import Control.Applicative ((<$))
-- >>> import Data.Machine

-- A strict tuple type.
data Strict2 a b = Strict2 !a !b

isLeft :: Either a b -> Bool
isLeft :: Either a b -> Bool
isLeft = (a -> Bool) -> (b -> Bool) -> Either a b -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False)

-- | Using a function to signal group changes, run a machine independently over
-- each group.
groupingOn_ :: Monad m => (a -> a -> Bool) -> ProcessT m a b -> ProcessT m a b
groupingOn_ :: (a -> a -> Bool) -> ProcessT m a b -> ProcessT m a b
groupingOn_ a -> a -> Bool
f ProcessT m a b
m = (a -> a -> Bool) -> ProcessT m a (Either () a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> ProcessT m a (Either () a)
taggedOn_ a -> a -> Bool
f ProcessT m a (Either () a)
-> ProcessT m (Either () a) b -> ProcessT m a b
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> ProcessT m a b -> ProcessT m (Either () a) b
forall (m :: * -> *) a b.
Monad m =>
ProcessT m a b -> ProcessT m (Either () a) b
partitioning_ ProcessT m a b
m
{-# INLINE groupingOn_ #-}

-- | Using a function to signal group changes, run a machine independently over
-- each group with the value returned provided.
groupingOn :: Monad m => i -> (a -> a -> Maybe i) -> (i -> ProcessT m a b) -> ProcessT m a b
groupingOn :: i -> (a -> a -> Maybe i) -> (i -> ProcessT m a b) -> ProcessT m a b
groupingOn i
i0 a -> a -> Maybe i
f i -> ProcessT m a b
m = (a -> a -> Maybe i) -> ProcessT m a (Either i a)
forall (m :: * -> *) a i.
Monad m =>
(a -> a -> Maybe i) -> ProcessT m a (Either i a)
taggedOn a -> a -> Maybe i
f ProcessT m a (Either i a)
-> ProcessT m (Either i a) b -> ProcessT m a b
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> i -> (i -> ProcessT m a b) -> ProcessT m (Either i a) b
forall (m :: * -> *) i a b.
Monad m =>
i -> (i -> ProcessT m a b) -> ProcessT m (Either i a) b
partitioning i
i0 i -> ProcessT m a b
m
{-# INLINE groupingOn #-}

-- | Run a machine repeatedly over 'n'-element segments of the stream, providing
-- an incrementing value to each run.
groupingN :: Monad m => Int -> (Int -> ProcessT m a b) -> ProcessT m a b
groupingN :: Int -> (Int -> ProcessT m a b) -> ProcessT m a b
groupingN Int
n Int -> ProcessT m a b
m = Int -> Int -> (Int -> Int) -> ProcessT m a (Either Int a)
forall (m :: * -> *) s a.
Monad m =>
Int -> s -> (s -> s) -> ProcessT m a (Either s a)
taggedAt Int
n Int
1 Int -> Int
forall a. Enum a => a -> a
succ ProcessT m a (Either Int a)
-> ProcessT m (Either Int a) b -> ProcessT m a b
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> Int -> (Int -> ProcessT m a b) -> ProcessT m (Either Int a) b
forall (m :: * -> *) i a b.
Monad m =>
i -> (i -> ProcessT m a b) -> ProcessT m (Either i a) b
partitioning Int
0 Int -> ProcessT m a b
m
{-# INLINE groupingN #-}

-- | Mark a transition point between two groups when a state passing function
-- returns a 'Just' i.
-- Examples
--
-- >>> runT $ supply [1,3,3,2] (taggedState (-1) (\x y -> (even x <$ guard (x /= y), x)))
-- [Left False,Right 1,Left False,Right 3,Right 3,Left True,Right 2]
taggedState :: Monad m => s -> (a -> s -> (Maybe i, s)) -> ProcessT m a (Either i a)
taggedState :: s -> (a -> s -> (Maybe i, s)) -> ProcessT m a (Either i a)
taggedState s
s0 a -> s -> (Maybe i, s)
f = s -> ProcessT m a (Either i a)
go s
s0
  where
    go :: s -> ProcessT m a (Either i a)
go s
s = Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
      (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> ProcessT m a (Either i a))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ (a -> ProcessT m a (Either i a))
-> Is a a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
x -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
 -> ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ case a -> s -> (Maybe i, s)
f a
x s
s of
                  (Maybe i
Nothing, s
s') -> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a))))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall a b. (a -> b) -> a -> b
$
                    Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> Either i a
forall a b. b -> Either a b
Right a
x) (s -> ProcessT m a (Either i a)
go s
s')
                  (Just i
i, s
s')  -> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a))))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall a b. (a -> b) -> a -> b
$
                    Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (i -> Either i a
forall a b. a -> Either a b
Left i
i) (Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> Either i a
forall a b. b -> Either a b
Right a
x) (s
s' s -> ProcessT m a (Either i a) -> ProcessT m a (Either i a)
`seq` s -> ProcessT m a (Either i a)
go s
s'))))
          Is a a
forall a. Is a a
Refl
          ProcessT m a (Either i a)
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINE taggedState #-}

-- | Mark a transition point between two groups when an action returns a 'Just'
-- i.  Could be useful for breaking up a stream based on time passed.
-- Examples
--
-- >>> let f x = do{ y <- ask; return (even x <$ guard (x > y)) }
-- >>> flip runReader 1 . runT $ supply [1,3,3,2] (taggedM f)
-- [Right 1,Left False,Right 3,Left False,Right 3,Left True,Right 2]
taggedM :: Monad m => (a -> m (Maybe i)) -> ProcessT m a (Either i a)
taggedM :: (a -> m (Maybe i)) -> ProcessT m a (Either i a)
taggedM a -> m (Maybe i)
f = ProcessT m a (Either i a)
go
  where
    go :: ProcessT m a (Either i a)
go = Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
      (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> ProcessT m a (Either i a))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ (a -> ProcessT m a (Either i a))
-> Is a a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
x -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
 -> ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ a -> m (Maybe i)
f a
x m (Maybe i)
-> (Maybe i
    -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a))))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe i
v -> case Maybe i
v of
                  Maybe i
Nothing -> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a))))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall a b. (a -> b) -> a -> b
$
                    Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> Either i a
forall a b. b -> Either a b
Right a
x) ProcessT m a (Either i a)
go
                  Just i
i  -> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a))))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall a b. (a -> b) -> a -> b
$
                    Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (i -> Either i a
forall a b. a -> Either a b
Left i
i) (Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> Either i a
forall a b. b -> Either a b
Right a
x) ProcessT m a (Either i a)
go))
              )
          Is a a
forall a. Is a a
Refl
          ProcessT m a (Either i a)
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINE taggedM #-}

-- | Mark a transition point between two groups as a function of adjacent
-- elements, and insert the value returned as the separator.
-- Examples
--
-- >>> runT $ supply [1,3,3,2] (taggedOn (\x y -> (x < y) <$ guard (x /= y)))
-- [Right 1,Left True,Right 3,Right 3,Left False,Right 2]
taggedOn :: Monad m => (a -> a -> Maybe i) -> ProcessT m a (Either i a)
taggedOn :: (a -> a -> Maybe i) -> ProcessT m a (Either i a)
taggedOn a -> a -> Maybe i
f = Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
  (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> ProcessT m a (Either i a))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ (a -> ProcessT m a (Either i a))
-> Is a a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
x0 -> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> ProcessT m a (Either i a))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> Either i a
forall a b. b -> Either a b
Right a
x0) (a -> (a -> a -> (Maybe i, a)) -> ProcessT m a (Either i a)
forall (m :: * -> *) s a i.
Monad m =>
s -> (a -> s -> (Maybe i, s)) -> ProcessT m a (Either i a)
taggedState a
x0 (\a
y a
x -> (a -> a -> Maybe i
f a
x a
y, a
y))))
      Is a a
forall a. Is a a
Refl
      ProcessT m a (Either i a)
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINE taggedOn #-}

-- | Mark a transition point between two groups using an action on adjacent
-- elements, and insert the value returned as the separator.
-- Examples
--
-- >>> let f x y = do{ z <- ask; return ((x + y <$ guard (z < x + y))) }
-- >>> flip runReader 5 . runT $ supply [1..5] (taggedOnM f)
-- [Right 1,Right 2,Right 3,Left 7,Right 4,Left 9,Right 5]
taggedOnM :: Monad m => (a -> a -> m (Maybe i)) -> ProcessT m a (Either i a)
taggedOnM :: (a -> a -> m (Maybe i)) -> ProcessT m a (Either i a)
taggedOnM a -> a -> m (Maybe i)
f = Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> ProcessT m a (Either i a))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ (a -> ProcessT m a (Either i a))
-> Is a a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await a -> ProcessT m a (Either i a)
go Is a a
forall a. Is a a
Refl ProcessT m a (Either i a)
forall (k :: * -> *) b. Machine k b
stopped
  where
    go :: a -> ProcessT m a (Either i a)
go a
x = Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
      (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> ProcessT m a (Either i a))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> Either i a
forall a b. b -> Either a b
Right a
x) (ProcessT m a (Either i a)
 -> Step (Is a) (Either i a) (ProcessT m a (Either i a)))
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall a b. (a -> b) -> a -> b
$ Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
          (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> ProcessT m a (Either i a))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ (a -> ProcessT m a (Either i a))
-> Is a a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
y -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
-> ProcessT m a (Either i a)
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
 -> ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
-> ProcessT m a (Either i a)
forall a b. (a -> b) -> a -> b
$ a -> a -> m (Maybe i)
f a
x a
y m (Maybe i)
-> (Maybe i
    -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a))))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe i
v -> case Maybe i
v of
                      Maybe i
Nothing -> ProcessT m a (Either i a)
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (a -> ProcessT m a (Either i a)
go a
y)
                      Just i
z  -> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is a) (Either i a) (ProcessT m a (Either i a))
 -> m (Step (Is a) (Either i a) (ProcessT m a (Either i a))))
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
-> m (Step (Is a) (Either i a) (ProcessT m a (Either i a)))
forall a b. (a -> b) -> a -> b
$ Either i a
-> ProcessT m a (Either i a)
-> Step (Is a) (Either i a) (ProcessT m a (Either i a))
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (i -> Either i a
forall a b. a -> Either a b
Left i
z) (a -> ProcessT m a (Either i a)
go a
y))
              Is a a
forall a. Is a a
Refl
              ProcessT m a (Either i a)
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINE taggedOnM #-}

-- | Mark a transition point between two groups as a function of adjacent
-- elements.
-- Examples
--
-- >>> runT $ supply [1,2,2] (taggedOn_ (==))
-- [Right 1,Left (),Right 2,Right 2]
taggedOn_ :: Monad m => (a -> a -> Bool) -> ProcessT m a (Either () a)
taggedOn_ :: (a -> a -> Bool) -> ProcessT m a (Either () a)
taggedOn_ a -> a -> Bool
f = (a -> a -> Maybe ()) -> ProcessT m a (Either () a)
forall (m :: * -> *) a i.
Monad m =>
(a -> a -> Maybe i) -> ProcessT m a (Either i a)
taggedOn (\a
x a
y -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (a -> a -> Bool
f a
x a
y)))
{-# INLINE taggedOn_ #-}

-- | Mark a transition point between two groups at every 'n' values, stepping
-- the separator by a function.
-- Examples
--
-- >>> runT $ supply [1..5] (taggedAt 2 True not)
-- [Right 1,Right 2,Left True,Right 3,Right 4,Left False,Right 5]
taggedAt :: Monad m => Int -> s -> (s -> s) -> ProcessT m a (Either s a)
taggedAt :: Int -> s -> (s -> s) -> ProcessT m a (Either s a)
taggedAt Int
n s
s0 s -> s
f = Strict2 Int s
-> (a -> Strict2 Int s -> (Maybe s, Strict2 Int s))
-> ProcessT m a (Either s a)
forall (m :: * -> *) s a i.
Monad m =>
s -> (a -> s -> (Maybe i, s)) -> ProcessT m a (Either i a)
taggedState (Int -> s -> Strict2 Int s
forall a b. a -> b -> Strict2 a b
Strict2 Int
n s
s0) a -> Strict2 Int s -> (Maybe s, Strict2 Int s)
g
  where
    g :: a -> Strict2 Int s -> (Maybe s, Strict2 Int s)
g a
_ (Strict2 Int
i s
s) =
      if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then (s -> Maybe s
forall a. a -> Maybe a
Just s
s, Int -> s -> Strict2 Int s
forall a b. a -> b -> Strict2 a b
Strict2 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (s -> s
f s
s))
        else (Maybe s
forall a. Maybe a
Nothing, Int -> s -> Strict2 Int s
forall a b. a -> b -> Strict2 a b
Strict2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) s
s)
{-# INLINE taggedAt #-}

-- | Mark a transition point between two groups at every 'n' values.
-- Examples
--
-- >>> runT $ supply [1..5] (taggedAt_ 2)
-- [Right 1,Right 2,Left (),Right 3,Right 4,Left (),Right 5]
taggedAt_ :: Monad m => Int -> ProcessT m a (Either () a)
taggedAt_ :: Int -> ProcessT m a (Either () a)
taggedAt_ Int
n = Int -> () -> (() -> ()) -> ProcessT m a (Either () a)
forall (m :: * -> *) s a.
Monad m =>
Int -> s -> (s -> s) -> ProcessT m a (Either s a)
taggedAt Int
n () () -> ()
forall a. a -> a
id
{-# INLINE taggedAt_ #-}

-- | Mark a transition point between two groups at every 'n' values, using the
-- counter as the separator.
-- Examples
--
-- >>> runT $ supply [1..5] (taggedCount 2)
-- [Right 1,Right 2,Left 1,Right 3,Right 4,Left 2,Right 5]
taggedCount :: Monad m => Int -> ProcessT m a (Either Int a)
taggedCount :: Int -> ProcessT m a (Either Int a)
taggedCount Int
n = Int -> Int -> (Int -> Int) -> ProcessT m a (Either Int a)
forall (m :: * -> *) s a.
Monad m =>
Int -> s -> (s -> s) -> ProcessT m a (Either s a)
taggedAt Int
n Int
1 Int -> Int
forall a. Enum a => a -> a
succ
{-# INLINE taggedCount #-}

-- | Run a machine multiple times over partitions of the input stream specified
-- by 'Left' () values.
-- Examples
--
-- >>> let input = [Right 1,Left (),Right 3,Right 4,Left ()]
-- >>> runT $ supply input (partitioning_ (fold (flip (:)) []))
-- [[1],[4,3],[]]
partitioning_ :: Monad m => ProcessT m a b -> ProcessT m (Either () a) b
partitioning_ :: ProcessT m a b -> ProcessT m (Either () a) b
partitioning_ ProcessT m a b
m = () -> (() -> ProcessT m a b) -> ProcessT m (Either () a) b
forall (m :: * -> *) i a b.
Monad m =>
i -> (i -> ProcessT m a b) -> ProcessT m (Either i a) b
partitioning () (ProcessT m a b -> () -> ProcessT m a b
forall a b. a -> b -> a
const ProcessT m a b
m)
{-# INLINE partitioning_ #-}

-- | Run a machine multiple times over partitions of the input stream specified
-- by 'Left' i values, passing the 'i's to each 'MachineT' run.
-- Examples
--
-- >>> let input = [Right 1, Right 2,Left 1, Right 3,Left 2, Right 4]
-- >>> runT $ supply input (partitioning 0 (\x -> mapping (\y -> (x,y))))
-- [(0,1),(0,2),(1,3),(2,4)]
partitioning :: Monad m => i -> (i -> ProcessT m a b) -> ProcessT m (Either i a) b
partitioning :: i -> (i -> ProcessT m a b) -> ProcessT m (Either i a) b
partitioning i
i0 i -> ProcessT m a b
k0 = ProcessT m a b -> ProcessT m (Either i a) b
go (i -> ProcessT m a b
k0 i
i0) where
  go :: ProcessT m a b -> ProcessT m (Either i a) b
go ProcessT m a b
m = m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
-> ProcessT m (Either i a) b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
 -> ProcessT m (Either i a) b)
-> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
-> ProcessT m (Either i a) b
forall a b. (a -> b) -> a -> b
$ ProcessT m a b -> m (Step (Is a) b (ProcessT m a b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT ProcessT m a b
m m (Step (Is a) b (ProcessT m a b))
-> (Step (Is a) b (ProcessT m a b)
    -> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b)))
-> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Is a) b (ProcessT m a b)
v -> case Step (Is a) b (ProcessT m a b)
v of
    -- Machine stops (possibly before inputs)
    Step (Is a) b (ProcessT m a b)
Stop -> ProcessT m (Either i a) b
-> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (ProcessT m (Either i a) b
 -> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b)))
-> ProcessT m (Either i a) b
-> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
forall a b. (a -> b) -> a -> b
$ (Either i a -> Bool)
-> (Either i a -> ProcessT m (Either i a) b)
-> ProcessT m (Either i a) b
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> (a -> ProcessT m a b) -> ProcessT m a b
awaitUntil Either i a -> Bool
forall a b. Either a b -> Bool
isLeft (ProcessT m (Either i a) b
-> Either i a -> ProcessT m (Either i a) b
forall a b. a -> b -> a
const (ProcessT m (Either i a) b
 -> Either i a -> ProcessT m (Either i a) b)
-> ProcessT m (Either i a) b
-> Either i a
-> ProcessT m (Either i a) b
forall a b. (a -> b) -> a -> b
$ ProcessT m a b -> ProcessT m (Either i a) b
go (i -> ProcessT m a b
k0 i
i0))

    -- Machine yields a value
    Yield b
o ProcessT m a b
r -> Step (Is (Either i a)) b (ProcessT m (Either i a) b)
-> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is (Either i a)) b (ProcessT m (Either i a) b)
 -> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b)))
-> Step (Is (Either i a)) b (ProcessT m (Either i a) b)
-> m (Step (Is (Either i a)) b (ProcessT m (Either i a) b))
forall a b. (a -> b) -> a -> b
$ b
-> ProcessT m (Either i a) b
-> Step (Is (Either i a)) b (ProcessT m (Either i a) b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield b
o (ProcessT m a b -> ProcessT m (Either i a) b
go ProcessT m a b
r)

    -- Machine waits for a value
    Await t -> ProcessT m a b
f Is a t
Refl ProcessT m a b
r -> Step (Is (Either i t)) b (ProcessT m (Either i a) b)
-> m (Step (Is (Either i t)) b (ProcessT m (Either i a) b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is (Either i t)) b (ProcessT m (Either i a) b)
 -> m (Step (Is (Either i t)) b (ProcessT m (Either i a) b)))
-> Step (Is (Either i t)) b (ProcessT m (Either i a) b)
-> m (Step (Is (Either i t)) b (ProcessT m (Either i a) b))
forall a b. (a -> b) -> a -> b
$ (Either i t -> ProcessT m (Either i a) b)
-> Is (Either i t) (Either i t)
-> ProcessT m (Either i a) b
-> Step (Is (Either i t)) b (ProcessT m (Either i a) b)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await Either i t -> ProcessT m (Either i a) b
g Is (Either i t) (Either i t)
forall a. Is a a
Refl (ProcessT m a b
-> ProcessT m (Either i a) b -> ProcessT m (Either i a) b
forall (m :: * -> *) (k0 :: * -> *) b (k :: * -> *).
Monad m =>
MachineT m k0 b -> MachineT m k b -> MachineT m k b
starve ProcessT m a b
r (ProcessT m (Either i a) b -> ProcessT m (Either i a) b)
-> ProcessT m (Either i a) b -> ProcessT m (Either i a) b
forall a b. (a -> b) -> a -> b
$ Step (Is (Either i a)) b (ProcessT m (Either i a) b)
-> ProcessT m (Either i a) b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Is (Either i a)) b (ProcessT m (Either i a) b)
forall (k :: * -> *) o r. Step k o r
Stop)
      where
        -- No change: unwrap input and give to underlying machine.
        g :: Either i t -> ProcessT m (Either i a) b
g (Right t
a) = ProcessT m a b -> ProcessT m (Either i a) b
go (t -> ProcessT m a b
f t
a)
        -- New group: starve r, then wait for more input, restarting machine
        -- with next input.
        g (Left i
i)  = ProcessT m a b
-> ProcessT m (Either i a) b -> ProcessT m (Either i a) b
forall (m :: * -> *) (k0 :: * -> *) b (k :: * -> *).
Monad m =>
MachineT m k0 b -> MachineT m k b -> MachineT m k b
starve ProcessT m a b
r (ProcessT m (Either i a) b -> ProcessT m (Either i a) b)
-> ProcessT m (Either i a) b -> ProcessT m (Either i a) b
forall a b. (a -> b) -> a -> b
$ ProcessT m a b -> ProcessT m (Either i a) b
go (i -> ProcessT m a b
k0 i
i)

-- | Read inputs until a condition is met, then behave as cont with input
-- matching condition as first input of cont.  If await fails, stop.
awaitUntil :: Monad m => (a -> Bool) -> (a -> ProcessT m a b) -> ProcessT m a b
awaitUntil :: (a -> Bool) -> (a -> ProcessT m a b) -> ProcessT m a b
awaitUntil a -> Bool
f a -> ProcessT m a b
cont = Step (Is a) b (ProcessT m a b) -> ProcessT m a b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (Is a) b (ProcessT m a b) -> ProcessT m a b)
-> Step (Is a) b (ProcessT m a b) -> ProcessT m a b
forall a b. (a -> b) -> a -> b
$ (a -> ProcessT m a b)
-> Is a a -> ProcessT m a b -> Step (Is a) b (ProcessT m a b)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await a -> ProcessT m a b
g Is a a
forall a. Is a a
Refl ProcessT m a b
forall (k :: * -> *) b. Machine k b
stopped
  where g :: a -> ProcessT m a b
g a
a = if a -> Bool
f a
a then a -> ProcessT m a b
cont a
a else (a -> Bool) -> (a -> ProcessT m a b) -> ProcessT m a b
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> (a -> ProcessT m a b) -> ProcessT m a b
awaitUntil a -> Bool
f a -> ProcessT m a b
cont