{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 0
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Machine.Process
-- Copyright   :  (C) 2012 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  Rank 2 Types, GADTs
--
----------------------------------------------------------------------------
module Data.Machine.Process
  (
  -- * Processes
    Process
  , ProcessT
  , Automaton(..)
  , AutomatonM(..)
  , process
  -- ** Common Processes
  , (<~), (~>)
  , echo
  , supply
  , prepended
  , filtered
  , dropping
  , taking
  , droppingWhile
  , takingWhile
  , takingJusts
  , buffered
  , flattened
  , fold
  , fold1
  , scan
  , scan1
  , scanMap
  , asParts
  , sinkPart_
  , autoM
  , final
  , finalOr
  , intersperse
  , largest
  , smallest
  , sequencing
  , mapping
  , traversing
  , reading
  , showing
  , strippingPrefix
  ) where

import Control.Category
import Control.Arrow (Kleisli(..))
import Control.Monad (liftM)
import Data.Foldable hiding (fold)
import Data.Machine.Is
import Data.Machine.Plan
import Data.Machine.Type
import Data.Monoid
import Data.Void
import Prelude
#if !(MIN_VERSION_base(4,8,0))
  hiding (id, (.), foldr)
#else
  hiding (id, (.))
#endif

-- $setup
-- >>> import Data.Machine
-- >>> import Data.Monoid (Sum (..))

infixr 9 <~
infixl 9 ~>

-------------------------------------------------------------------------------
-- Processes
-------------------------------------------------------------------------------

-- | A @'Process' a b@ is a stream transducer that can consume values of type @a@
-- from its input, and produce values of type @b@ for its output.
type Process a b = Machine (Is a) b

-- | A @'ProcessT' m a b@ is a stream transducer that can consume values of type @a@
-- from its input, and produce values of type @b@ and has side-effects in the
-- 'Monad' @m@.
type ProcessT m a b = MachineT m (Is a) b

-- | An 'Automaton' can be automatically lifted into a 'Process'
class Automaton k where
  auto :: k a b -> Process a b

instance Automaton (->) where
  auto :: (a -> b) -> Process a b
auto = (a -> b) -> MachineT m (Is a) b
forall (k :: * -> * -> *) a b.
Category k =>
(a -> b) -> Machine (k a) b
mapping

instance Automaton Is where
  auto :: Is a b -> Process a b
auto Is a b
Refl = MachineT m (Is a) b
forall a. Process a a
echo

class AutomatonM x where
  autoT :: Monad m => x m a b -> ProcessT m a b

instance AutomatonM Kleisli where
  autoT :: Kleisli m a b -> ProcessT m a b
autoT (Kleisli a -> m b
k) = (a -> m b) -> ProcessT m a b
forall (k :: * -> * -> *) (m :: * -> *) a b.
(Category k, Monad m) =>
(a -> m b) -> MachineT m (k a) b
autoM a -> m b
k

-- | The trivial 'Process' that simply repeats each input it receives.
--
-- This can be constructed from a plan with
--
-- @
-- echo :: Process a a
-- echo = repeatedly $ do
--   i <- await
--   yield i
-- @
--
-- Examples:
--
-- >>> run $ echo <~ source [1..5]
-- [1,2,3,4,5]
--
echo :: Process a a
echo :: MachineT m (Is a) a
echo =
    MachineT m (Is a) a
forall o. MachineT m (Is o) o
loop
  where
    loop :: MachineT m (Is o) o
loop = Step (Is o) o (MachineT m (Is o) o) -> MachineT m (Is o) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((o -> MachineT m (Is o) o)
-> Is o o
-> MachineT m (Is o) o
-> Step (Is o) o (MachineT m (Is o) o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\o
t -> Step (Is o) o (MachineT m (Is o) o) -> MachineT m (Is o) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o -> MachineT m (Is o) o -> Step (Is o) o (MachineT m (Is o) o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
t MachineT m (Is o) o
loop)) Is o o
forall a. Is a a
Refl MachineT m (Is o) o
forall (k :: * -> *) b. Machine k b
stopped)
{-# INLINABLE echo #-}

-- | A 'Process' that prepends the elements of a 'Foldable' onto its input, then repeats its input from there.
prepended :: Foldable f => f a -> Process a a
prepended :: f a -> Process a a
prepended f a
f = MachineT m (Is a) a -> PlanT (Is a) a m () -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
MachineT m k o -> PlanT k o m a -> MachineT m k o
before MachineT m (Is a) a
forall a. Process a a
echo (PlanT (Is a) a m () -> MachineT m (Is a) a)
-> PlanT (Is a) a m () -> MachineT m (Is a) a
forall a b. (a -> b) -> a -> b
$ (a -> PlanT (Is a) a m ()) -> f a -> PlanT (Is a) a m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\a
x -> a -> Plan (Is a) a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
x) f a
f

-- | A 'Process' that only passes through inputs that match a predicate.
--
-- This can be constructed from a plan with
--
-- @
-- filtered :: (a -> Bool) -> Process a a
-- filtered p = repeatedly $ do
--   i <- await
--   when (p i) $ yield i
-- @
--
-- Examples:
--
-- >>> run $ filtered even <~ source [1..5]
-- [2,4]
--
filtered :: (a -> Bool) -> Process a a
filtered :: (a -> Bool) -> Process a a
filtered a -> Bool
p =
    MachineT m (Is a) a
loop
  where
    loop :: MachineT m (Is a) a
loop = Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
         (Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a)
-> Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (Is a) a)
-> Is a a
-> MachineT m (Is a) a
-> Step (Is a) a (MachineT m (Is a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
a -> if a -> Bool
p a
a then Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (a -> MachineT m (Is a) a -> Step (Is a) a (MachineT m (Is a) a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
a MachineT m (Is a) a
loop) else MachineT m (Is a) a
loop)
           Is a a
forall a. Is a a
Refl
           MachineT m (Is a) a
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE filtered #-}

-- | A 'Process' that drops the first @n@, then repeats the rest.
--
-- This can be constructed from a plan with
--
-- @
-- dropping n = before echo $ replicateM_ n await
-- @
--
-- Examples:
--
-- >>> run $ dropping 3 <~ source [1..5]
-- [4,5]
--
dropping :: Int -> Process a a
dropping :: Int -> Process a a
dropping Int
i =
    Int -> MachineT m (Is a) a
forall t (m :: * -> *) a.
(Ord t, Num t, Monad m) =>
t -> MachineT m (Is a) a
loop Int
i
  where
    loop :: t -> MachineT m (Is a) a
loop t
cnt
      | t
cnt t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
      = MachineT m (Is a) a
forall a. Process a a
echo
      | Bool
otherwise
      = Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((a -> MachineT m (Is a) a)
-> Is a a
-> MachineT m (Is a) a
-> Step (Is a) a (MachineT m (Is a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
_ -> t -> MachineT m (Is a) a
loop (t
cnt t -> t -> t
forall a. Num a => a -> a -> a
- t
1)) Is a a
forall a. Is a a
Refl MachineT m (Is a) a
forall (k :: * -> *) b. Machine k b
stopped)
{-# INLINABLE dropping #-}

-- | A 'Process' that passes through the first @n@ elements from its input then stops
--
-- This can be constructed from a plan with
--
-- @
-- taking n = construct . replicateM_ n $ await >>= yield
-- @
--
-- Examples:
--
-- >>> run $ taking 3 <~ source [1..5]
-- [1,2,3]
--
taking :: Int -> Process a a
taking :: Int -> Process a a
taking Int
i =
    Int -> MachineT m (Is a) a
forall t (m :: * -> *) a.
(Ord t, Num t, Monad m) =>
t -> MachineT m (Is a) a
loop Int
i
  where
    loop :: t -> MachineT m (Is b) b
loop t
cnt
      | t
cnt t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
      = MachineT m (Is b) b
forall (k :: * -> *) b. Machine k b
stopped
      | Bool
otherwise
      = Step (Is b) b (MachineT m (Is b) b) -> MachineT m (Is b) b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((b -> MachineT m (Is b) b)
-> Is b b
-> MachineT m (Is b) b
-> Step (Is b) b (MachineT m (Is b) b)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\b
v -> Step (Is b) b (MachineT m (Is b) b) -> MachineT m (Is b) b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (Is b) b (MachineT m (Is b) b) -> MachineT m (Is b) b)
-> Step (Is b) b (MachineT m (Is b) b) -> MachineT m (Is b) b
forall a b. (a -> b) -> a -> b
$ b -> MachineT m (Is b) b -> Step (Is b) b (MachineT m (Is b) b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield b
v (t -> MachineT m (Is b) b
loop (t
cnt t -> t -> t
forall a. Num a => a -> a -> a
- t
1))) Is b b
forall a. Is a a
Refl MachineT m (Is b) b
forall (k :: * -> *) b. Machine k b
stopped)
{-# INLINABLE taking #-}

-- | A 'Process' that passes through elements until a predicate ceases to hold, then stops
--
-- This can be constructed from a plan with
--
-- @
-- takingWhile :: (a -> Bool) -> Process a a
-- takingWhile p = repeatedly $ await >>= \v -> if p v then yield v else stop
-- @
--
-- Examples:
--
-- >>> run $ takingWhile (< 3) <~ source [1..5]
-- [1,2]
--
takingWhile :: (a -> Bool) -> Process a a
takingWhile :: (a -> Bool) -> Process a a
takingWhile a -> Bool
p =
    MachineT m (Is a) a
loop
  where
    loop :: MachineT m (Is a) a
loop = Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
         (Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a)
-> Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (Is a) a)
-> Is a a
-> MachineT m (Is a) a
-> Step (Is a) a (MachineT m (Is a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
a -> if a -> Bool
p a
a then Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (a -> MachineT m (Is a) a -> Step (Is a) a (MachineT m (Is a) a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
a MachineT m (Is a) a
loop) else MachineT m (Is a) a
forall (k :: * -> *) b. Machine k b
stopped)
           Is a a
forall a. Is a a
Refl
           MachineT m (Is a) a
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE takingWhile #-}

-- | A 'Process' that passes through elements unwrapped from 'Just' until a
-- 'Nothing' is found, then stops.
--
-- This can be constructed from a plan with
--
-- @
-- takingJusts :: Process (Maybe a) a
-- takingJusts = repeatedly $ await >>= maybe stop yield
-- @
--
-- Examples:
--
-- >>> run $ takingJusts <~ source [Just 1, Just 2, Nothing, Just 3, Just 4]
-- [1,2]
--
takingJusts :: Process (Maybe a) a
takingJusts :: MachineT m (Is (Maybe a)) a
takingJusts = MachineT m (Is (Maybe a)) a
forall o. MachineT m (Is (Maybe o)) o
loop
  where
    loop :: MachineT m (Is (Maybe o)) o
loop = Step (Is (Maybe o)) o (MachineT m (Is (Maybe o)) o)
-> MachineT m (Is (Maybe o)) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
         (Step (Is (Maybe o)) o (MachineT m (Is (Maybe o)) o)
 -> MachineT m (Is (Maybe o)) o)
-> Step (Is (Maybe o)) o (MachineT m (Is (Maybe o)) o)
-> MachineT m (Is (Maybe o)) o
forall a b. (a -> b) -> a -> b
$ (Maybe o -> MachineT m (Is (Maybe o)) o)
-> Is (Maybe o) (Maybe o)
-> MachineT m (Is (Maybe o)) o
-> Step (Is (Maybe o)) o (MachineT m (Is (Maybe o)) o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (MachineT m (Is (Maybe o)) o
-> (o -> MachineT m (Is (Maybe o)) o)
-> Maybe o
-> MachineT m (Is (Maybe o)) o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MachineT m (Is (Maybe o)) o
forall (k :: * -> *) b. Machine k b
stopped (\o
x -> Step (Is (Maybe o)) o (MachineT m (Is (Maybe o)) o)
-> MachineT m (Is (Maybe o)) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o
-> MachineT m (Is (Maybe o)) o
-> Step (Is (Maybe o)) o (MachineT m (Is (Maybe o)) o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
x MachineT m (Is (Maybe o)) o
loop)))
           Is (Maybe o) (Maybe o)
forall a. Is a a
Refl
           MachineT m (Is (Maybe o)) o
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE takingJusts #-}

-- | A 'Process' that drops elements while a predicate holds
--
-- This can be constructed from a plan with
--
-- @
-- droppingWhile :: (a -> Bool) -> Process a a
-- droppingWhile p = before echo loop where
--   loop = await >>= \v -> if p v then loop else yield v
-- @
--
-- Examples:
--
-- >>> run $ droppingWhile (< 3) <~ source [1..5]
-- [3,4,5]
--
droppingWhile :: (a -> Bool) -> Process a a
droppingWhile :: (a -> Bool) -> Process a a
droppingWhile a -> Bool
p =
    MachineT m (Is a) a
loop
  where
    loop :: MachineT m (Is a) a
loop = Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
         (Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a)
-> Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (Is a) a)
-> Is a a
-> MachineT m (Is a) a
-> Step (Is a) a (MachineT m (Is a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
a -> if a -> Bool
p a
a then MachineT m (Is a) a
loop else Step (Is a) a (MachineT m (Is a) a) -> MachineT m (Is a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (a -> MachineT m (Is a) a -> Step (Is a) a (MachineT m (Is a) a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
a MachineT m (Is a) a
forall a. Process a a
echo))
           Is a a
forall a. Is a a
Refl
           MachineT m (Is a) a
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE droppingWhile #-}

-- | Chunk up the input into `n` element lists.
--
-- Avoids returning empty lists and deals with the truncation of the final group.
--
-- An approximation of this can be constructed from a plan with
--
-- @
-- buffered :: Int -> Process a [a]
-- buffered = repeatedly . go [] where
--   go acc 0 = yield (reverse acc)
--   go acc n = do
--     i <- await <|> yield (reverse acc) *> stop
--     go (i:acc) $! n-1
-- @
--
-- Examples:
--
-- >>> run $ buffered 3 <~ source [1..6]
-- [[1,2,3],[4,5,6]]
--
-- >>> run $ buffered 3 <~ source [1..5]
-- [[1,2,3],[4,5]]
--
-- >>> run $ buffered 3 <~ source []
-- []
--
buffered :: Int -> Process a [a]
buffered :: Int -> Process a [a]
buffered Int
n =
    MachineT m (Is a) [a]
begin
  where
    -- The buffer is empty, if we don't get anything
    -- then we shouldn't yield at all.
    begin :: MachineT m (Is a) [a]
begin     = Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a]
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
              (Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a])
-> Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a]
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (Is a) [a])
-> Is a a
-> MachineT m (Is a) [a]
-> Step (Is a) [a] (MachineT m (Is a) [a])
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
v -> ([a] -> [a]) -> Int -> MachineT m (Is a) [a]
loop (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                      Is a a
forall a. Is a a
Refl
                      MachineT m (Is a) [a]
forall (k :: * -> *) b. Machine k b
stopped

    -- The buffer (a diff list) contains elements, and
    -- we're at the requisite number, yield the
    -- buffer and restart
    loop :: ([a] -> [a]) -> Int -> MachineT m (Is a) [a]
loop [a] -> [a]
dl Int
0 = Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a]
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
              (Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a])
-> Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a]
forall a b. (a -> b) -> a -> b
$ [a]
-> MachineT m (Is a) [a] -> Step (Is a) [a] (MachineT m (Is a) [a])
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield ([a] -> [a]
dl []) MachineT m (Is a) [a]
begin

    -- The buffer contains elements and we're not yet
    -- done, continue waiting, but if we don't receive
    -- anything, then yield what we have and stop.
    loop [a] -> [a]
dl Int
r = Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a]
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
              (Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a])
-> Step (Is a) [a] (MachineT m (Is a) [a]) -> MachineT m (Is a) [a]
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (Is a) [a])
-> Is a a
-> MachineT m (Is a) [a]
-> Step (Is a) [a] (MachineT m (Is a) [a])
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
v -> ([a] -> [a]) -> Int -> MachineT m (Is a) [a]
loop ([a] -> [a]
dl ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                      Is a a
forall a. Is a a
Refl
                      (([a] -> [a]) -> MachineT m (Is a) [a]
forall (m :: * -> *) a o (k :: * -> *).
Monad m =>
([a] -> o) -> MachineT m k o
finish [a] -> [a]
dl)

    -- All data has been retrieved, emit and stop.
    finish :: ([a] -> o) -> MachineT m k o
finish [a] -> o
dl = Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
              (Step k o (MachineT m k o) -> MachineT m k o)
-> Step k o (MachineT m k o) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield ([a] -> o
dl []) MachineT m k o
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE buffered #-}

-- | Build a new 'Machine' by adding a 'Process' to the output of an old 'Machine'
--
-- @
-- ('<~') :: 'Process' b c -> 'Process' a b -> 'Process' a c
-- ('<~') :: 'Process' c d -> 'Data.Machine.Tee.Tee' a b c -> 'Data.Machine.Tee.Tee' a b d
-- ('<~') :: 'Process' b c -> 'Machine' k b -> 'Machine' k c
-- @
(<~) :: Monad m => ProcessT m b c -> MachineT m k b -> MachineT m k c
ProcessT m b c
mp <~ :: ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT m k b
ma = m (Step k c (MachineT m k c)) -> MachineT m k c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k c (MachineT m k c)) -> MachineT m k c)
-> m (Step k c (MachineT m k c)) -> MachineT m k c
forall a b. (a -> b) -> a -> b
$ ProcessT m b c -> m (Step (Is b) c (ProcessT m b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT ProcessT m b c
mp m (Step (Is b) c (ProcessT m b c))
-> (Step (Is b) c (ProcessT m b c)
    -> m (Step k c (MachineT m k c)))
-> m (Step k c (MachineT m k c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Is b) c (ProcessT m b c)
v -> case Step (Is b) c (ProcessT m b c)
v of
  Step (Is b) c (ProcessT m b c)
Stop          -> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k c (MachineT m k c)
forall (k :: * -> *) o r. Step k o r
Stop
  Yield c
o ProcessT m b c
k     -> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k c (MachineT m k c) -> m (Step k c (MachineT m k c)))
-> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ c -> MachineT m k c -> Step k c (MachineT m k c)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield c
o (ProcessT m b c
k ProcessT m b c -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT m k b
ma)
  Await t -> ProcessT m b c
f Is b t
Refl ProcessT m b c
ff -> MachineT m k b -> m (Step k b (MachineT m k b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k b
ma m (Step k b (MachineT m k b))
-> (Step k b (MachineT m k b) -> m (Step k c (MachineT m k c)))
-> m (Step k c (MachineT m k c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k b (MachineT m k b)
u -> case Step k b (MachineT m k b)
u of
    Step k b (MachineT m k b)
Stop          -> MachineT m k c -> m (Step k c (MachineT m k c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k c -> m (Step k c (MachineT m k c)))
-> MachineT m k c -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ ProcessT m b c
ff ProcessT m b c -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT m k b
forall (k :: * -> *) b. Machine k b
stopped
    Yield b
o MachineT m k b
k     -> MachineT m k c -> m (Step k c (MachineT m k c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k c -> m (Step k c (MachineT m k c)))
-> MachineT m k c -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ t -> ProcessT m b c
f b
t
o ProcessT m b c -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT m k b
k
    Await t -> MachineT m k b
g k t
kg MachineT m k b
fg -> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k c (MachineT m k c) -> m (Step k c (MachineT m k c)))
-> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ (t -> MachineT m k c)
-> k t -> MachineT m k c -> Step k c (MachineT m k c)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
a -> Step (Is b) c (ProcessT m b c) -> ProcessT m b c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Is b) c (ProcessT m b c)
v ProcessT m b c -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ t -> MachineT m k b
g t
a) k t
kg (Step (Is b) c (ProcessT m b c) -> ProcessT m b c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Is b) c (ProcessT m b c)
v ProcessT m b c -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT m k b
fg)
{-# INLINABLE (<~) #-}

-- | Flipped ('<~').
(~>) :: Monad m => MachineT m k b -> ProcessT m b c -> MachineT m k c
MachineT m k b
ma ~> :: MachineT m k b -> ProcessT m b c -> MachineT m k c
~> ProcessT m b c
mp = ProcessT m b c
mp ProcessT m b c -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT m k b
ma
{-# INLINABLE (~>) #-}

-- | Feed a 'Process' some input.
--
-- Examples:
--
-- >>> run $ supply [1,2,3] echo <~ source [4..6]
-- [1,2,3,4,5,6]
--
supply :: forall f m a b . (Foldable f, Monad m) => f a -> ProcessT m a b -> ProcessT m a b
supply :: f a -> ProcessT m a b -> ProcessT m a b
supply = (a
 -> (ProcessT m a b -> ProcessT m a b)
 -> ProcessT m a b
 -> ProcessT m a b)
-> (ProcessT m a b -> ProcessT m a b)
-> f a
-> ProcessT m a b
-> ProcessT m a b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a
-> (ProcessT m a b -> ProcessT m a b)
-> ProcessT m a b
-> ProcessT m a b
go ProcessT m a b -> ProcessT m a b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    where
      go :: a ->
            (ProcessT m a b -> ProcessT m a b) ->
            ProcessT m a b ->
            ProcessT m a b
      go :: a
-> (ProcessT m a b -> ProcessT m a b)
-> ProcessT m a b
-> ProcessT m a b
go a
x ProcessT m a b -> ProcessT m a b
r ProcessT m a b
m = m (Step (Is a) b (ProcessT m a b)) -> ProcessT m a b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Is a) b (ProcessT m a b)) -> ProcessT m a b)
-> m (Step (Is a) b (ProcessT m a b)) -> ProcessT m a b
forall a b. (a -> b) -> a -> b
$ do
         Step (Is a) b (ProcessT m a b)
v <- 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
         case Step (Is a) b (ProcessT m a b)
v of
           Step (Is a) b (ProcessT m a b)
Stop -> Step (Is a) b (ProcessT m a b)
-> m (Step (Is a) b (ProcessT m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Is a) b (ProcessT m a b)
forall (k :: * -> *) o r. Step k o r
Stop
           Await t -> ProcessT m a b
f Is a t
Refl ProcessT m 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 (Step (Is a) b (ProcessT m a b)))
-> ProcessT m a b -> m (Step (Is a) b (ProcessT m a b))
forall a b. (a -> b) -> a -> b
$ ProcessT m a b -> ProcessT m a b
r (t -> ProcessT m a b
f a
t
x)
           Yield b
o ProcessT m a b
k -> Step (Is a) b (ProcessT m a b)
-> m (Step (Is a) b (ProcessT m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is a) b (ProcessT m a b)
 -> m (Step (Is a) b (ProcessT m a b)))
-> Step (Is a) b (ProcessT m a b)
-> m (Step (Is a) b (ProcessT m a b))
forall a b. (a -> b) -> a -> b
$ b -> ProcessT m a b -> Step (Is a) b (ProcessT m a b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield b
o (a
-> (ProcessT m a b -> ProcessT m a b)
-> ProcessT m a b
-> ProcessT m a b
go a
x ProcessT m a b -> ProcessT m a b
r ProcessT m a b
k)
{-# INLINABLE supply #-}

-- |
-- Convert a machine into a process, with a little bit of help.
--
-- @
-- choose :: 'Data.Machine.Tee.T' a b x -> (a, b) -> x
-- choose t = case t of
--   'Data.Machine.Tee.L' -> 'fst'
--   'Data.Machine.Tee.R' -> 'snd'
--
-- 'process' choose :: 'Data.Machine.Tee.Tee' a b c -> 'Data.Machine.Process.Process' (a, b) c
-- 'process' choose :: 'Data.Machine.Tee.Tee' a b c -> 'Data.Machine.Process.Process' (a, b) c
-- 'process' ('const' 'id') :: 'Data.Machine.Process.Process' a b -> 'Data.Machine.Process.Process' a b
-- @
process :: Monad m => (forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
process :: (forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
process forall a. k a -> i -> a
f (MachineT m (Step k o (MachineT m k o))
m) = m (Step (Is i) o (ProcessT m i o)) -> ProcessT m i o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT ((Step k o (MachineT m k o) -> Step (Is i) o (ProcessT m i o))
-> m (Step k o (MachineT m k o))
-> m (Step (Is i) o (ProcessT m i o))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Step k o (MachineT m k o) -> Step (Is i) o (ProcessT m i o)
f' m (Step k o (MachineT m k o))
m) where
  f' :: Step k o (MachineT m k o) -> Step (Is i) o (ProcessT m i o)
f' (Yield o
o MachineT m k o
k)     = o -> ProcessT m i o -> Step (Is i) o (ProcessT m i o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o ((forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
forall (m :: * -> *) (k :: * -> *) i o.
Monad m =>
(forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
process forall a. k a -> i -> a
f MachineT m k o
k)
  f' Step k o (MachineT m k o)
Stop            = Step (Is i) o (ProcessT m i o)
forall (k :: * -> *) o r. Step k o r
Stop
  f' (Await t -> MachineT m k o
g k t
kir MachineT m k o
h) = (i -> ProcessT m i o)
-> Is i i -> ProcessT m i o -> Step (Is i) o (ProcessT m i o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await ((forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
forall (m :: * -> *) (k :: * -> *) i o.
Monad m =>
(forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
process forall a. k a -> i -> a
f (MachineT m k o -> ProcessT m i o)
-> (i -> MachineT m k o) -> i -> ProcessT m i o
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> MachineT m k o
g (t -> MachineT m k o) -> (i -> t) -> i -> MachineT m k o
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. k t -> i -> t
forall a. k a -> i -> a
f k t
kir) Is i i
forall a. Is a a
Refl ((forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
forall (m :: * -> *) (k :: * -> *) i o.
Monad m =>
(forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
process forall a. k a -> i -> a
f MachineT m k o
h)

-- |
-- Construct a 'Process' from a left-scanning operation.
--
-- Like 'fold', but yielding intermediate values.
--
-- It may be useful to consider this alternative signature
--
-- @
-- 'scan' :: (a -> b -> a) -> a -> Process b a
-- @
--
-- For stateful 'scan' use 'auto' with "Data.Machine.Mealy" machine.
-- This can be constructed from a plan with
--
-- @
-- scan :: Category k => (a -> b -> a) -> a -> Machine (k b) a
-- scan func seed = construct $ go seed where
--   go cur = do
--     yield cur
--     next <- await
--     go $! func cur next
-- @
--
-- Examples:
--
-- >>> run $ scan (+) 0 <~ source [1..5]
-- [0,1,3,6,10,15]
--
-- >>> run $ scan (\a _ -> a + 1) 0 <~ source [1..5]
-- [0,1,2,3,4,5]
--
scan :: Category k => (a -> b -> a) -> a -> Machine (k b) a
scan :: (a -> b -> a) -> a -> Machine (k b) a
scan a -> b -> a
func a
seed =
  let step :: a -> MachineT m (k b) a
step a
t = a
t a -> MachineT m (k b) a -> MachineT m (k b) a
`seq` Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
             (Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a)
-> Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall a b. (a -> b) -> a -> b
$ a -> MachineT m (k b) a -> Step (k b) a (MachineT m (k b) a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
t
             (MachineT m (k b) a -> Step (k b) a (MachineT m (k b) a))
-> MachineT m (k b) a -> Step (k b) a (MachineT m (k b) a)
forall a b. (a -> b) -> a -> b
$ Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
             (Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a)
-> Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall a b. (a -> b) -> a -> b
$ (b -> MachineT m (k b) a)
-> k b b -> MachineT m (k b) a -> Step (k b) a (MachineT m (k b) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (a -> MachineT m (k b) a
step (a -> MachineT m (k b) a) -> (b -> a) -> b -> MachineT m (k b) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b -> a
func a
t)
                     k b b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                     MachineT m (k b) a
forall (k :: * -> *) b. Machine k b
stopped
  in  a -> MachineT m (k b) a
step a
seed
{-# INLINABLE scan #-}

-- |
-- 'scan1' is a variant of 'scan' that has no starting value argument
--
-- This can be constructed from a plan with
--
-- @
-- scan1 :: Category k => (a -> a -> a) -> Machine (k a) a
-- scan1 func = construct $ await >>= go where
--   go cur = do
--     yield cur
--     next <- await
--     go $! func cur next
-- @
--
-- Examples:
--
-- >>> run $ scan1 (+) <~ source [1..5]
-- [1,3,6,10,15]
--
scan1 :: Category k => (a -> a -> a) -> Machine (k a) a
scan1 :: (a -> a -> a) -> Machine (k a) a
scan1 a -> a -> a
func =
  let step :: a -> MachineT m (k a) a
step a
t = a
t a -> MachineT m (k a) a -> MachineT m (k a) a
`seq` Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
             (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a)
-> Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ a -> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
t
             (MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a))
-> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall a b. (a -> b) -> a -> b
$ Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
             (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a)
-> Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (k a) a)
-> k a a -> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (a -> MachineT m (k a) a
step (a -> MachineT m (k a) a) -> (a -> a) -> a -> MachineT m (k a) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a -> a
func a
t)
                     k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                     MachineT m (k a) a
forall (k :: * -> *) b. Machine k b
stopped
  in  Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a)
-> Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (k a) a)
-> k a a -> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await a -> MachineT m (k a) a
step k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id MachineT m (k a) a
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE scan1 #-}

-- |
-- Like 'scan' only uses supplied function to map and uses Monoid for
-- associative operation
--
-- Examples:
--
-- >>> run $ mapping getSum <~ scanMap Sum <~ source [1..5]
-- [0,1,3,6,10,15]
--
scanMap :: (Category k, Monoid b) => (a -> b) -> Machine (k a) b
scanMap :: (a -> b) -> Machine (k a) b
scanMap a -> b
f = (b -> a -> b) -> b -> Machine (k a) b
forall (k :: * -> * -> *) a b.
Category k =>
(a -> b -> a) -> a -> Machine (k b) a
scan (\b
b a
a -> b -> b -> b
forall a. Monoid a => a -> a -> a
mappend b
b (a -> b
f a
a)) b
forall a. Monoid a => a
mempty
{-# INLINABLE scanMap #-}

-- |
-- Construct a 'Process' from a left-folding operation.
--
-- Like 'scan', but only yielding the final value.
--
-- It may be useful to consider this alternative signature
--
-- @
-- 'fold' :: (a -> b -> a) -> a -> Process b a
-- @
--
-- This can be constructed from a plan with
--
-- @
-- fold :: Category k => (a -> b -> a) -> a -> Machine (k b) a
-- fold func seed = construct $ go seed where
--   go cur = do
--     next <- await <|> yield cur *> stop
--     go $! func cur next
-- @
--
-- Examples:
--
-- >>> run $ fold (+) 0 <~ source [1..5]
-- [15]
--
-- >>> run $ fold (\a _ -> a + 1) 0 <~ source [1..5]
-- [5]
--
fold :: Category k => (a -> b -> a) -> a -> Machine (k b) a
fold :: (a -> b -> a) -> a -> Machine (k b) a
fold a -> b -> a
func a
x =
  let step :: a -> MachineT m (k b) a
step a
t = a
t a -> MachineT m (k b) a -> MachineT m (k b) a
`seq` Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
             (Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a)
-> Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall a b. (a -> b) -> a -> b
$ (b -> MachineT m (k b) a)
-> k b b -> MachineT m (k b) a -> Step (k b) a (MachineT m (k b) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (a -> MachineT m (k b) a
step (a -> MachineT m (k b) a) -> (b -> a) -> b -> MachineT m (k b) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b -> a
func a
t)
                     k b b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                     (Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a)
-> Step (k b) a (MachineT m (k b) a) -> MachineT m (k b) a
forall a b. (a -> b) -> a -> b
$ a -> MachineT m (k b) a -> Step (k b) a (MachineT m (k b) a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
t MachineT m (k b) a
forall (k :: * -> *) b. Machine k b
stopped)
  in  a -> MachineT m (k b) a
step a
x
{-# INLINABLE fold #-}

-- |
-- 'fold1' is a variant of 'fold' that has no starting value argument
--
-- This can be constructed from a plan with
--
-- @
-- fold1 :: Category k => (a -> a -> a) -> Machine (k a) a
-- fold1 func = construct $ await >>= go where
--   go cur = do
--     next <- await <|> yield cur *> stop
--     go $! func cur next
-- @
--
-- Examples:
--
-- >>> run $ fold1 (+) <~ source [1..5]
-- [15]
--
fold1 :: Category k => (a -> a -> a) -> Machine (k a) a
fold1 :: (a -> a -> a) -> Machine (k a) a
fold1 a -> a -> a
func =
  let step :: a -> MachineT m (k a) a
step a
t = a
t a -> MachineT m (k a) a -> MachineT m (k a) a
`seq` Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
             (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a)
-> Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (k a) a)
-> k a a -> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (a -> MachineT m (k a) a
step (a -> MachineT m (k a) a) -> (a -> a) -> a -> MachineT m (k a) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a -> a
func a
t)
                     k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                     (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a)
-> Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ a -> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield a
t MachineT m (k a) a
forall (k :: * -> *) b. Machine k b
stopped)
  in  Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a)
-> Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (k a) a)
-> k a a -> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await a -> MachineT m (k a) a
step k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id MachineT m (k a) a
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE fold1 #-}

-- | Break each input into pieces that are fed downstream
-- individually.
--
-- This can be constructed from a plan with
--
-- @
-- asParts :: Foldable f => Process (f a) a
-- asParts = repeatedly $ await >>= traverse_ yield
-- @
--
-- Examples:
--
-- >>> run $ asParts <~ source [[1..3],[4..6]]
-- [1,2,3,4,5,6]
--
asParts :: Foldable f => Process (f a) a
asParts :: Process (f a) a
asParts =
  let step :: MachineT m (Is (f o)) o
step = Step (Is (f o)) o (MachineT m (Is (f o)) o)
-> MachineT m (Is (f o)) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased
           (Step (Is (f o)) o (MachineT m (Is (f o)) o)
 -> MachineT m (Is (f o)) o)
-> Step (Is (f o)) o (MachineT m (Is (f o)) o)
-> MachineT m (Is (f o)) o
forall a b. (a -> b) -> a -> b
$ (f o -> MachineT m (Is (f o)) o)
-> Is (f o) (f o)
-> MachineT m (Is (f o)) o
-> Step (Is (f o)) o (MachineT m (Is (f o)) o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await ((o -> MachineT m (Is (f o)) o -> MachineT m (Is (f o)) o)
-> MachineT m (Is (f o)) o -> f o -> MachineT m (Is (f o)) o
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\o
b MachineT m (Is (f o)) o
s -> Step (Is (f o)) o (MachineT m (Is (f o)) o)
-> MachineT m (Is (f o)) o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o
-> MachineT m (Is (f o)) o
-> Step (Is (f o)) o (MachineT m (Is (f o)) o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
b MachineT m (Is (f o)) o
s)) MachineT m (Is (f o)) o
step)
                   Is (f o) (f o)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                   MachineT m (Is (f o)) o
forall (k :: * -> *) b. Machine k b
stopped
  in  MachineT m (Is (f a)) a
forall o. MachineT m (Is (f o)) o
step
{-# INLINABLE asParts #-}

-- | Break each input into pieces that are fed downstream
-- individually.
--
-- Alias for @asParts@
--
flattened :: Foldable f => Process (f a) a
flattened :: Process (f a) a
flattened = MachineT m (Is (f a)) a
forall (f :: * -> *) a. Foldable f => Process (f a) a
asParts
{-# INLINABLE flattened #-}

-- | @sinkPart_ toParts sink@ creates a process that uses the
-- @toParts@ function to break input into a tuple of @(passAlong,
-- sinkPart)@ for which the second projection is given to the supplied
-- @sink@ 'ProcessT' (that produces no output) while the first
-- projection is passed down the pipeline.
sinkPart_ :: Monad m => (a -> (b,c)) -> ProcessT m c Void -> ProcessT m a b
sinkPart_ :: (a -> (b, c)) -> ProcessT m c Void -> ProcessT m a b
sinkPart_ a -> (b, c)
p = ProcessT m c Void -> ProcessT m a b
go
  where go :: ProcessT m c Void -> ProcessT m a b
go ProcessT m c Void
m = m (Step (Is a) b (ProcessT m a b)) -> ProcessT m a b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Is a) b (ProcessT m a b)) -> ProcessT m a b)
-> m (Step (Is a) b (ProcessT m a b)) -> ProcessT m a b
forall a b. (a -> b) -> a -> b
$ ProcessT m c Void -> m (Step (Is c) Void (ProcessT m c Void))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT ProcessT m c Void
m m (Step (Is c) Void (ProcessT m c Void))
-> (Step (Is c) Void (ProcessT m c Void)
    -> m (Step (Is a) b (ProcessT m a b)))
-> m (Step (Is a) b (ProcessT m a b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Is c) Void (ProcessT m c Void)
v -> case Step (Is c) Void (ProcessT m c Void)
v of
          Step (Is c) Void (ProcessT m c Void)
Stop -> Step (Is a) b (ProcessT m a b)
-> m (Step (Is a) b (ProcessT m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Is a) b (ProcessT m a b)
forall (k :: * -> *) o r. Step k o r
Stop
          Yield Void
o ProcessT m c Void
_ -> Void -> m (Step (Is a) b (ProcessT m a b))
forall a. Void -> a
absurd Void
o
          Await t -> ProcessT m c Void
f Is c t
Refl ProcessT m c Void
ff -> Step (Is a) b (ProcessT m a b)
-> m (Step (Is a) b (ProcessT m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Is a) b (ProcessT m a b)
 -> m (Step (Is a) b (ProcessT m a b)))
-> Step (Is a) b (ProcessT m a b)
-> m (Step (Is 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
x -> let (b
keep,c
sink) = a -> (b, c)
p a
x
                         in 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)
-> (ProcessT m a b -> Step (Is a) b (ProcessT m a b))
-> ProcessT m a b
-> ProcessT m a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> ProcessT m a b -> Step (Is a) b (ProcessT m a b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield b
keep (ProcessT m a b -> ProcessT m a b)
-> ProcessT m a b -> ProcessT m a b
forall a b. (a -> b) -> a -> b
$ ProcessT m c Void -> ProcessT m a b
go (t -> ProcessT m c Void
f c
t
sink))
                  Is a a
forall a. Is a a
Refl
                  (ProcessT m c Void -> ProcessT m a b
go ProcessT m c Void
ff)

-- | Apply a monadic function to each element of a 'ProcessT'.
--
-- This can be constructed from a plan with
--
-- @
-- autoM :: Monad m => (a -> m b) -> ProcessT m a b
-- autoM :: (Category k, Monad m) => (a -> m b) -> MachineT m (k a) b
-- autoM f = repeatedly $ await >>= lift . f >>= yield
-- @
--
-- Examples:
--
-- >>> runT $ autoM Left <~ source [3, 4]
-- Left 3
--
-- >>> runT $ autoM Right <~ source [3, 4]
-- Right [3,4]
--
autoM :: (Category k, Monad m) => (a -> m b) -> MachineT m (k a) b
autoM :: (a -> m b) -> MachineT m (k a) b
autoM a -> m b
f =
    MachineT m (k a) b
loop
  where
    loop :: MachineT m (k a) b
loop = Step (k a) b (MachineT m (k a) b) -> MachineT m (k a) b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((a -> MachineT m (k a) b)
-> k a a -> MachineT m (k a) b -> Step (k a) b (MachineT m (k a) b)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
t -> m (Step (k a) b (MachineT m (k a) b)) -> MachineT m (k a) b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT ((b -> MachineT m (k a) b -> Step (k a) b (MachineT m (k a) b))
-> MachineT m (k a) b -> b -> Step (k a) b (MachineT m (k a) b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> MachineT m (k a) b -> Step (k a) b (MachineT m (k a) b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield MachineT m (k a) b
loop (b -> Step (k a) b (MachineT m (k a) b))
-> m b -> m (Step (k a) b (MachineT m (k a) b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` a -> m b
f a
t)) k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id MachineT m (k a) b
forall (k :: * -> *) b. Machine k b
stopped)
{-# INLINABLE autoM #-}

-- |
-- Skip all but the final element of the input
--
-- This can be constructed from a plan with
--
-- @
-- 'final' :: 'Process' a a
-- final :: Category k => Machine (k a) a
-- final = construct $ await >>= go where
--   go prev = do
--     next <- await <|> yield prev *> stop
--     go next
-- @
--
-- Examples:
--
-- >>> runT $ final <~ source [1..10]
-- [10]
-- >>> runT $ final <~ source []
-- []
--
final :: Category k => Machine (k a) a
final :: Machine (k a) a
final =
  let step :: t -> MachineT m (cat t) t
step t
x = Step (cat t) t (MachineT m (cat t) t) -> MachineT m (cat t) t
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((t -> MachineT m (cat t) t)
-> cat t t
-> MachineT m (cat t) t
-> Step (cat t) t (MachineT m (cat t) t)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await t -> MachineT m (cat t) t
step cat t t
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (t -> MachineT m (cat t) t
forall (m :: * -> *) o (k :: * -> *).
Monad m =>
o -> MachineT m k o
emit t
x))
      emit :: o -> MachineT m k o
emit o
x = Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
x MachineT m k o
forall (k :: * -> *) b. Machine k b
stopped)
  in Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a)
-> Step (k a) a (MachineT m (k a) a) -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ (a -> MachineT m (k a) a)
-> k a a -> MachineT m (k a) a -> Step (k a) a (MachineT m (k a) a)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await a -> MachineT m (k a) a
forall (m :: * -> *) (cat :: * -> * -> *) t.
(Monad m, Category cat) =>
t -> MachineT m (cat t) t
step k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id MachineT m (k a) a
forall (k :: * -> *) b. Machine k b
stopped
{-# INLINABLE final #-}

-- |
-- Skip all but the final element of the input.
-- If the input is empty, the default value is emitted
--
-- This can be constructed from a plan with
--
-- @
-- 'finalOr' :: a -> 'Process' a a
-- finalOr :: Category k => a -> Machine (k a) a
-- finalOr = construct . go where
--   go prev = do
--     next <- await <|> yield prev *> stop
--     go next
-- @
--
-- Examples:
--
-- >>> runT $ finalOr (-1) <~ source [1..10]
-- [10]
-- >>> runT $ finalOr (-1) <~ source []
-- [-1]
--
finalOr :: Category k => a -> Machine (k a) a
finalOr :: a -> Machine (k a) a
finalOr a
y =
  let step :: t -> MachineT m (cat t) t
step t
x = Step (cat t) t (MachineT m (cat t) t) -> MachineT m (cat t) t
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((t -> MachineT m (cat t) t)
-> cat t t
-> MachineT m (cat t) t
-> Step (cat t) t (MachineT m (cat t) t)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await t -> MachineT m (cat t) t
step cat t t
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (t -> MachineT m (cat t) t
forall (m :: * -> *) o (k :: * -> *).
Monad m =>
o -> MachineT m k o
emit t
x))
      emit :: o -> MachineT m k o
emit o
x = Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
x MachineT m k o
forall (k :: * -> *) b. Machine k b
stopped)
  in a -> MachineT m (k a) a
forall (m :: * -> *) (cat :: * -> * -> *) t.
(Monad m, Category cat) =>
t -> MachineT m (cat t) t
step a
y
{-# INLINABLE finalOr #-}

-- |
-- Intersperse an element between the elements of the input
--
-- @
-- 'intersperse' :: a -> 'Process' a a
-- @
intersperse :: Category k => a -> Machine (k a) a
intersperse :: a -> Machine (k a) a
intersperse a
sep = PlanT (k a) a m Any -> MachineT m (k a) a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (PlanT (k a) a m Any -> MachineT m (k a) a)
-> PlanT (k a) a m Any -> MachineT m (k a) a
forall a b. (a -> b) -> a -> b
$ PlanT (k a) a m a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await PlanT (k a) a m a
-> (a -> PlanT (k a) a m Any) -> PlanT (k a) a m Any
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> PlanT (k a) a m Any
go where
  go :: a -> PlanT (k a) a m Any
go a
cur = do
    a -> Plan (k a) a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
cur
    a
next <- PlanT (k a) a m a
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await
    a -> Plan (k a) a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
sep
    a -> PlanT (k a) a m Any
go a
next

-- |
-- Return the maximum value from the input
largest :: (Category k, Ord a) => Machine (k a) a
largest :: Machine (k a) a
largest = (a -> a -> a) -> Machine (k a) a
forall (k :: * -> * -> *) a.
Category k =>
(a -> a -> a) -> Machine (k a) a
fold1 a -> a -> a
forall a. Ord a => a -> a -> a
max
{-# INLINABLE largest #-}

-- |
-- Return the minimum value from the input
smallest :: (Category k, Ord a) => Machine (k a) a
smallest :: Machine (k a) a
smallest = (a -> a -> a) -> Machine (k a) a
forall (k :: * -> * -> *) a.
Category k =>
(a -> a -> a) -> Machine (k a) a
fold1 a -> a -> a
forall a. Ord a => a -> a -> a
min
{-# INLINABLE smallest #-}

-- |
-- Convert a stream of actions to a stream of values
--
-- This can be constructed from a plan with
--
-- @
-- sequencing :: Monad m => (a -> m b) -> ProcessT m a b
-- sequencing :: (Category k, Monad m) => MachineT m (k (m a)) a
-- sequencing = repeatedly $ do
--   ma <- await
--   a  <- lift ma
--   yield a
-- @
--
-- Examples:
--
-- >>> runT $ sequencing <~ source [Just 3, Nothing]
-- Nothing
--
-- >>> runT $ sequencing <~ source [Just 3, Just 4]
-- Just [3,4]
--
sequencing :: (Category k, Monad m) => MachineT m (k (m a)) a
sequencing :: MachineT m (k (m a)) a
sequencing = (m a -> m a) -> MachineT m (k (m a)) a
forall (k :: * -> * -> *) (m :: * -> *) a b.
(Category k, Monad m) =>
(a -> m b) -> MachineT m (k a) b
autoM m a -> m a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINABLE sequencing #-}

-- |
-- Apply a function to all values coming from the input
--
-- This can be constructed from a plan with
--
-- @
-- mapping :: Category k => (a -> b) -> Machine (k a) b
-- mapping f = repeatedly $ await >>= yield . f
-- @
--
-- Examples:
--
-- >>> runT $ mapping (*2) <~ source [1..3]
-- [2,4,6]
--
mapping :: Category k => (a -> b) -> Machine (k a) b
mapping :: (a -> b) -> Machine (k a) b
mapping a -> b
f =
    MachineT m (k a) b
loop
  where
    loop :: MachineT m (k a) b
loop = Step (k a) b (MachineT m (k a) b) -> MachineT m (k a) b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((a -> MachineT m (k a) b)
-> k a a -> MachineT m (k a) b -> Step (k a) b (MachineT m (k a) b)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\a
t -> Step (k a) b (MachineT m (k a) b) -> MachineT m (k a) b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (b -> MachineT m (k a) b -> Step (k a) b (MachineT m (k a) b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> b
f a
t) MachineT m (k a) b
loop)) k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id MachineT m (k a) b
forall (k :: * -> *) b. Machine k b
stopped)
{-# INLINABLE mapping #-}

-- |
-- Apply an effectful to all values coming from the input.
--
-- Alias to 'autoM'.
traversing :: (Category k, Monad m) => (a -> m b) -> MachineT m (k a) b
traversing :: (a -> m b) -> MachineT m (k a) b
traversing = (a -> m b) -> MachineT m (k a) b
forall (k :: * -> * -> *) (m :: * -> *) a b.
(Category k, Monad m) =>
(a -> m b) -> MachineT m (k a) b
autoM

-- |
-- Parse 'Read'able values, only emitting the value if the parse succceeds.
-- This 'Machine' stops at first parsing error
reading :: (Category k, Read a) => Machine (k String) a
reading :: Machine (k String) a
reading = PlanT (k String) a m () -> MachineT m (k String) a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT (k String) a m () -> MachineT m (k String) a)
-> PlanT (k String) a m () -> MachineT m (k String) a
forall a b. (a -> b) -> a -> b
$ do
  String
s <- PlanT (k String) a m String
forall (k :: * -> * -> *) i o. Category k => Plan (k i) o i
await
  case ReadS a
forall a. Read a => ReadS a
reads String
s of
    [(a
a, String
"")] -> a -> Plan (k String) a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
a
    [(a, String)]
_         -> PlanT (k String) a m ()
forall (k :: * -> *) o a. Plan k o a
stop

-- |
-- Convert 'Show'able values to 'String's
showing :: (Category k, Show a) => Machine (k a) String
showing :: Machine (k a) String
showing = (a -> String) -> Machine (k a) String
forall (k :: * -> * -> *) a b.
Category k =>
(a -> b) -> Machine (k a) b
mapping a -> String
forall a. Show a => a -> String
show
{-# INLINABLE showing #-}

-- |
-- 'strippingPrefix' @mp mb@ Drops the given prefix from @mp@. It stops if @mb@
-- did not start with the prefix given, or continues streaming after the
-- prefix, if @mb@ did.
strippingPrefix :: (Eq b, Monad m)
                => MachineT m (k a) b
                -> MachineT m (k a) b
                -> MachineT m (k a) b
strippingPrefix :: MachineT m (k a) b -> MachineT m (k a) b -> MachineT m (k a) b
strippingPrefix MachineT m (k a) b
mp MachineT m (k a) b
mb = m (Step (k a) b (MachineT m (k a) b)) -> MachineT m (k a) b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (k a) b (MachineT m (k a) b)) -> MachineT m (k a) b)
-> m (Step (k a) b (MachineT m (k a) b)) -> MachineT m (k a) b
forall a b. (a -> b) -> a -> b
$ MachineT m (k a) b -> m (Step (k a) b (MachineT m (k a) b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m (k a) b
mp m (Step (k a) b (MachineT m (k a) b))
-> (Step (k a) b (MachineT m (k a) b)
    -> m (Step (k a) b (MachineT m (k a) b)))
-> m (Step (k a) b (MachineT m (k a) b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (k a) b (MachineT m (k a) b)
v -> case Step (k a) b (MachineT m (k a) b)
v of
  Step (k a) b (MachineT m (k a) b)
Stop          -> MachineT m (k a) b -> m (Step (k a) b (MachineT m (k a) b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m (k a) b
mb
  Yield b
b MachineT m (k a) b
k     -> b
-> MachineT m (k a) b
-> MachineT m (k a) b
-> m (Step (k a) b (MachineT m (k a) b))
forall (m :: * -> *) o (k :: * -> * -> *) a.
(Eq o, Monad m) =>
o
-> MachineT m (k a) o
-> MachineT m (k a) o
-> m (Step (k a) o (MachineT m (k a) o))
verify b
b MachineT m (k a) b
k MachineT m (k a) b
mb
  Await t -> MachineT m (k a) b
f k a t
ki MachineT m (k a) b
ff ->
    Step (k a) b (MachineT m (k a) b)
-> m (Step (k a) b (MachineT m (k a) b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (k a) b (MachineT m (k a) b)
 -> m (Step (k a) b (MachineT m (k a) b)))
-> Step (k a) b (MachineT m (k a) b)
-> m (Step (k a) b (MachineT m (k a) b))
forall a b. (a -> b) -> a -> b
$ (t -> MachineT m (k a) b)
-> k a t -> MachineT m (k a) b -> Step (k a) b (MachineT m (k a) b)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
a -> MachineT m (k a) b -> MachineT m (k a) b -> MachineT m (k a) b
forall b (m :: * -> *) (k :: * -> * -> *) a.
(Eq b, Monad m) =>
MachineT m (k a) b -> MachineT m (k a) b -> MachineT m (k a) b
strippingPrefix (t -> MachineT m (k a) b
f t
a) MachineT m (k a) b
mb) k a t
ki (MachineT m (k a) b -> MachineT m (k a) b -> MachineT m (k a) b
forall b (m :: * -> *) (k :: * -> * -> *) a.
(Eq b, Monad m) =>
MachineT m (k a) b -> MachineT m (k a) b -> MachineT m (k a) b
strippingPrefix MachineT m (k a) b
ff MachineT m (k a) b
mb)
  where
    verify :: o
-> MachineT m (k a) o
-> MachineT m (k a) o
-> m (Step (k a) o (MachineT m (k a) o))
verify o
b MachineT m (k a) o
nxt MachineT m (k a) o
cur = MachineT m (k a) o -> m (Step (k a) o (MachineT m (k a) o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m (k a) o
cur m (Step (k a) o (MachineT m (k a) o))
-> (Step (k a) o (MachineT m (k a) o)
    -> m (Step (k a) o (MachineT m (k a) o)))
-> m (Step (k a) o (MachineT m (k a) o))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (k a) o (MachineT m (k a) o)
u -> case Step (k a) o (MachineT m (k a) o)
u of
      Step (k a) o (MachineT m (k a) o)
Stop -> Step (k a) o (MachineT m (k a) o)
-> m (Step (k a) o (MachineT m (k a) o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (k a) o (MachineT m (k a) o)
forall (k :: * -> *) o r. Step k o r
Stop
      Yield o
b' MachineT m (k a) o
nxt'
        | o
b o -> o -> Bool
forall a. Eq a => a -> a -> Bool
== o
b'   -> MachineT m (k a) o -> m (Step (k a) o (MachineT m (k a) o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m (k a) o -> m (Step (k a) o (MachineT m (k a) o)))
-> MachineT m (k a) o -> m (Step (k a) o (MachineT m (k a) o))
forall a b. (a -> b) -> a -> b
$ MachineT m (k a) o -> MachineT m (k a) o -> MachineT m (k a) o
forall b (m :: * -> *) (k :: * -> * -> *) a.
(Eq b, Monad m) =>
MachineT m (k a) b -> MachineT m (k a) b -> MachineT m (k a) b
strippingPrefix MachineT m (k a) o
nxt MachineT m (k a) o
nxt'
        | Bool
otherwise -> Step (k a) o (MachineT m (k a) o)
-> m (Step (k a) o (MachineT m (k a) o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (k a) o (MachineT m (k a) o)
forall (k :: * -> *) o r. Step k o r
Stop
      Await t -> MachineT m (k a) o
f k a t
ki MachineT m (k a) o
ff ->
        Step (k a) o (MachineT m (k a) o)
-> m (Step (k a) o (MachineT m (k a) o))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (k a) o (MachineT m (k a) o)
 -> m (Step (k a) o (MachineT m (k a) o)))
-> Step (k a) o (MachineT m (k a) o)
-> m (Step (k a) o (MachineT m (k a) o))
forall a b. (a -> b) -> a -> b
$ (t -> MachineT m (k a) o)
-> k a t -> MachineT m (k a) o -> Step (k a) o (MachineT m (k a) o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (m (Step (k a) o (MachineT m (k a) o)) -> MachineT m (k a) o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (k a) o (MachineT m (k a) o)) -> MachineT m (k a) o)
-> (t -> m (Step (k a) o (MachineT m (k a) o)))
-> t
-> MachineT m (k a) o
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. o
-> MachineT m (k a) o
-> MachineT m (k a) o
-> m (Step (k a) o (MachineT m (k a) o))
verify o
b MachineT m (k a) o
nxt (MachineT m (k a) o -> m (Step (k a) o (MachineT m (k a) o)))
-> (t -> MachineT m (k a) o)
-> t
-> m (Step (k a) o (MachineT m (k a) o))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> MachineT m (k a) o
f)
                    k a t
ki (m (Step (k a) o (MachineT m (k a) o)) -> MachineT m (k a) o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (k a) o (MachineT m (k a) o)) -> MachineT m (k a) o)
-> m (Step (k a) o (MachineT m (k a) o)) -> MachineT m (k a) o
forall a b. (a -> b) -> a -> b
$ o
-> MachineT m (k a) o
-> MachineT m (k a) o
-> m (Step (k a) o (MachineT m (k a) o))
verify o
b MachineT m (k a) o
nxt MachineT m (k a) o
ff)