machines 0.1.2 → 0.2.1

raw patch · 13 files changed

+187/−149 lines, 13 filesdep +pointedPVP ok

version bump matches the API change (PVP)

Dependencies added: pointed

API changes (from Hackage documentation)

Files

• .gitignore +1/−0
• CHANGELOG.markdown +8/−0
• README.markdown +3/−0
• machines.cabal +2/−1
• src/Data/Machine/Mealy.hs +5/−1
• src/Data/Machine/Moore.hs +8/−0
• src/Data/Machine/Plan.hs +37/−28
• src/Data/Machine/Process.hs +32/−24
• src/Data/Machine/Source.hs +4/−4
• src/Data/Machine/Tee.hs +8/−9
• src/Data/Machine/Type.hs +68/−71
• src/Data/Machine/Unread.hs +2/−2
• src/Data/Machine/Wye.hs +9/−9

@@ -2,3 +2,4 @@ TAGS tags docs+wiki

@@ -1,3 +1,11 @@+0.2.1+-----+* Fixed the `Mealy` Monad++0.2+---+* Removed the input type parameter from (almost) all of the types.+ 0.1 --- * Initial release

@@ -3,6 +3,8 @@  [![Build Status](https://secure.travis-ci.org/ekmett/machines.png?branch=master)](http://travis-ci.org/ekmett/machines) +*Ceci n'est pas une pipe*+ Machines are demand driven input sources like pipes or conduits, but can support multiple inputs.  You design a `Machine` by writing a `Plan`. You then `construct` the machine.@@ -19,6 +21,7 @@ There is a lot of flexibility when building a machine in choosing between empowering the machine to run its own monadic effects or delegating that responsibility to a custom driver. +A port of this design to scala is available from runarorama/machines  Contact Information -------------------

@@ -1,6 +1,6 @@ name:          machines category:      Control, Enumerator-version:       0.1.2+version:       0.2.1 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -33,6 +33,7 @@     comonad      == 3.0.*,     containers   >= 0.3   && < 0.6,     free         >= 3.1.1 && < 3.3,+    pointed      == 3.0.*,     profunctors  == 3.0.*,     semigroups   >= 0.8.3 && < 0.9,     transformers == 0.3.*,

@@ -23,6 +23,7 @@ import Data.Machine.Type import Data.Machine.Process import Data.Profunctor+import Data.Pointed import Data.Semigroup import Data.Sequence as Seq import Prelude hiding ((.),id)@@ -42,6 +43,9 @@   m <* _ = m   _ *> n = n +instance Pointed (Mealy a) where+  point b = r where r = Mealy (const (b, r))+ -- | A 'Mealy' machine modeled with explicit state. unfoldMealy :: (s -> a -> (b, s)) -> s -> Mealy a b unfoldMealy f = go where@@ -52,7 +56,7 @@ instance Monad (Mealy a) where   return b = r where r = Mealy (const (b, r))   m >>= f = Mealy $ \a -> case runMealy m a of-    (b, m') -> (fst (runMealy (f b) a), snd (runMealy (m' >>= f) a))+    (b, m') -> (fst (runMealy (f b) a), m' >>= f)   _ >> n = n  instance Profunctor Mealy where

@@ -19,10 +19,12 @@ import Control.Applicative import Control.Comonad import Control.Monad+import Data.Copointed import Data.Machine.Plan import Data.Machine.Type import Data.Machine.Process import Data.Monoid+import Data.Pointed import Data.Profunctor  -- | 'Moore' machines@@ -58,12 +60,18 @@   m <* _ = m   _ *> n = n +instance Pointed (Moore a) where+  point a = r where r = Moore a (const r)+ -- | slow diagonalization instance Monad (Moore a) where   return a = r where r = Moore a (const r)   Moore a k >>= f = case f a of     Moore b _ -> Moore b (k >=> f)   _ >> m = m++instance Copointed (Moore a) where+  copoint (Moore b _) = b  instance Comonad (Moore a) where   extract (Moore b _) = b

@@ -33,6 +33,7 @@ import Control.Monad.State.Class import Control.Monad.Reader.Class import Control.Monad.Error.Class+import Control.Monad.Writer.Class import Data.Functor.Identity import Prelude hiding ((.),id) @@ -43,37 +44,37 @@ -- | You can 'construct' a 'Plan' (or 'PlanT'), turning it into a -- 'Data.Machine.Type.Machine' (or 'Data.Machine.Type.MachineT'). ---newtype PlanT k i o m a = PlanT+newtype PlanT k o m a = PlanT   { runPlanT :: forall r.       (a -> m r) ->                                     -- Done a-      (o -> m r -> m r) ->                              -- Yield o (Plan k i o a)-      (forall z. (z -> m r) -> k i z -> m r -> m r) ->  -- forall z. Await (z -> Plan i o a) (k i z) (Plan k i o a)+      (o -> m r -> m r) ->                              -- Yield o (Plan k o a)+      (forall z. (z -> m r) -> k z -> m r -> m r) ->  -- forall z. Await (z -> Plan o a) (k z) (Plan k o a)       m r ->                                            -- Fail       m r   } --- | A @'Plan' k i o a@ is a specification for a pure 'Machine', that reads inputs selected by @k@+-- | A @'Plan' k o a@ is a specification for a pure 'Machine', that reads inputs selected by @k@ -- with types based on @i@, writes values of type @o@, and has intermediate results of type @a@. ----- A @'PlanT' k i o a@ can be used as a @'PlanT' k i o m a@ for any @'Monad' m@.+-- A @'PlanT' k o a@ can be used as a @'PlanT' k o m a@ for any @'Monad' m@. -- -- It is perhaps easier to think of 'Plan' in its un-cps'ed form, which would -- look like: -- -- @--- data 'Plan' k i o a+-- data 'Plan' k o a --   = Done a---   | Yield o (Plan k i o a)---   | forall z. Await (z -> Plan k i o a) (k i z) (Plan k i o a)+--   | Yield o (Plan k o a)+--   | forall z. Await (z -> Plan k o a) (k z) (Plan k o a) --   | Fail -- @-type Plan k i o a = forall m. PlanT k i o m a+type Plan k o a = forall m. PlanT k o m a  -- | Deconstruct a 'Plan' without reference to a 'Monad'.-runPlan :: PlanT k i o Identity a+runPlan :: PlanT k o Identity a         -> (a -> r)         -> (o -> r -> r)-        -> (forall z. (z -> r) -> k i z -> r -> r)+        -> (forall z. (z -> r) -> k z -> r -> r)         -> r         -> r runPlan m kp ke kr kf = runIdentity $ runPlanT m@@ -82,66 +83,74 @@   (\f k (Identity r) -> Identity (kr (runIdentity . f) k r))   (Identity kf) -instance Functor (PlanT k i o m) where+instance Functor (PlanT k o m) where   fmap f (PlanT m) = PlanT $ \k -> m (k . f) -instance Applicative (PlanT k i o m) where+instance Applicative (PlanT k o m) where   pure a = PlanT (\kp _ _ _ -> kp a)   (<*>) = ap -instance Alternative (PlanT k i o m) where+instance Alternative (PlanT k o m) where   empty = PlanT $ \_ _ _ kf -> kf   PlanT m <|> PlanT n = PlanT $ \kp ke kr kf -> m kp ke (\ks kir _ -> kr ks kir (n kp ke kr kf)) (n kp ke kr kf) -instance Monad (PlanT k i o m) where+instance Monad (PlanT k o m) where   return a = PlanT (\kp _ _ _ -> kp a)   PlanT m >>= f = PlanT (\kp ke kr kf -> m (\a -> runPlanT (f a) kp ke kr kf) ke kr kf)   fail _ = PlanT (\_ _ _ kf -> kf) -instance MonadPlus (PlanT k i o m) where+instance MonadPlus (PlanT k o m) where   mzero = empty   mplus = (<|>) -instance MonadTrans (PlanT k i o) where+instance MonadTrans (PlanT k o) where   lift m = PlanT (\kp _ _ _ -> m >>= kp) -instance MonadIO m => MonadIO (PlanT k i o m) where+instance MonadIO m => MonadIO (PlanT k o m) where   liftIO m = PlanT (\kp _ _ _ -> liftIO m >>= kp) -instance MonadState s m => MonadState s (PlanT k i o m) where+instance MonadState s m => MonadState s (PlanT k o m) where   get = lift get   put = lift . put   state f = PlanT $ \kp _ _ _ -> state f >>= kp -instance MonadReader e m => MonadReader e (PlanT k i o m) where+instance MonadReader e m => MonadReader e (PlanT k o m) where   ask = lift ask   reader = lift . reader   local f m = PlanT $ \kp ke kr kf -> local f (runPlanT m kp ke kr kf) -instance MonadError e m => MonadError e (PlanT k i o m) where+instance MonadWriter w m  => MonadWriter w (PlanT k o m) where+  writer = lift . writer+  tell   = lift . tell++  listen m = PlanT $ \kp ke kr kf -> runPlanT m ((kp =<<) . listen . return) ke kr kf++  pass m = PlanT $ \kp ke kr kf -> runPlanT m ((kp =<<) . pass . return) ke kr kf++instance MonadError e m => MonadError e (PlanT k o m) where   throwError = lift . throwError   catchError m k = PlanT $ \kp ke kr kf -> runPlanT m kp ke kr kf `catchError` \e -> runPlanT (k e) kp ke kr kf  -- | Output a result.-yield :: o -> Plan k i o ()+yield :: o -> Plan k o () yield o = PlanT (\kp ke _ _ -> ke o (kp ()))  -- | Wait for input. -- -- @'await' = 'awaits' 'id'@-await :: Category k => Plan k i o i+await :: Category k => Plan (k i) o i await = PlanT (\kp _ kr kf -> kr kp id kf)  -- | Wait for a particular input. -- -- @--- awaits 'L'  :: 'Plan' 'T' (a, b) o a--- awaits 'R'  :: 'Plan' 'T' (a, b) o b--- awaits 'id' :: 'Plan' 'Data.Machine.Is.Is' i o i+-- awaits 'L'  :: 'Plan' ('T' a b) o a+-- awaits 'R'  :: 'Plan' ('T' a b) o b+-- awaits 'id' :: 'Plan' ('Data.Machine.Is.Is' i) o i -- @-awaits :: k i j -> Plan k i o j+awaits :: k i -> Plan k o i awaits h = PlanT $ \kp _ kr -> kr kp h  -- | @'stop' = 'empty'@-stop :: Plan k i o a+stop :: Plan k o a stop = empty

@@ -20,7 +20,8 @@   , Automaton(..)   , process   -- ** Common Processes-  , after+  , (<~), (~>)+  , echo   , supply   , prepended   , filtered@@ -40,18 +41,21 @@ import Data.Machine.Type import Prelude hiding ((.),id) +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+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+type ProcessT m a b = MachineT m (Is a) b  -- | An 'Automaton' is can be automatically lifted into a 'Process' class Automaton k where@@ -63,13 +67,17 @@     yield (f i)  instance Automaton Is where-  auto Refl = repeatedly $ do-    i <- await-    yield i+  auto Refl = echo +-- | The trivial 'Process' that simply repeats each input it receives.+echo :: Process a a+echo = repeatedly $ do+  i <- await+  yield i+ -- | 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 = before id . traverse_ yield+prepended = before echo . traverse_ yield  -- | A 'Process' that only passes through inputs that match a predicate. filtered :: (a -> Bool) -> Process a a@@ -79,7 +87,7 @@  -- | A 'Process' that drops the first @n@, then repeats the rest. dropping :: Int -> Process a a-dropping n = before id $ replicateM_ n await+dropping n = before echo $ replicateM_ n await  -- | A 'Process' that passes through the first @n@ elements from its input then stops taking :: Int -> Process a a@@ -91,7 +99,7 @@  -- | A 'Process' that drops elements while a predicate holds droppingWhile :: (a -> Bool) -> Process a a-droppingWhile p = before id loop where+droppingWhile p = before echo loop where   loop = await >>= \v -> if p v then loop else yield v  -- | Chunk up the input into `n` element lists.@@ -105,23 +113,27 @@     i <- await <|> yield (reverse acc) *> stop     go (i:acc) $! n-1 + -- | Build a new 'Machine' by adding a 'Process' to the output of an old 'Machine' -- -- @--- after :: 'Process' a b   -> 'Process' b c -> 'Process' a c--- after :: 'Data.Machine.Tee.Tee' a b c     -> 'Process' c d -> 'Data.Machine.Tee.Tee' a b d--- after :: 'Machine' k a b -> 'Process' b c -> 'Machine' k a c+-- ('<~') :: '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 -- @-after :: Monad m => MachineT m k a b -> ProcessT m b c -> MachineT m k a c-after ma mp = MachineT $ runMachineT mp >>= \v -> case v of+(<~) :: Monad m => ProcessT m b c -> MachineT m k b -> MachineT m k c+mp <~ ma = MachineT $ runMachineT mp >>= \v -> case v of   Stop          -> return Stop-  Yield o k     -> return $ Yield o (after ma k)+  Yield o k     -> return $ Yield o (k <~ ma)   Await f Refl ff -> runMachineT ma >>= \u -> case u of-    Stop          -> runMachineT $ after stopped ff-    Yield o k     -> runMachineT . after k $ f o-    Await g kg fg -> let mv = MachineT (return v) in-      return $ Await (\a -> after (g a) mv) kg (after fg mv)+    Stop          -> runMachineT $ ff <~ stopped+    Yield o k     -> runMachineT $ f o <~ k+    Await g kg fg -> return $ Await (\a -> MachineT (return v) <~ g a) kg (MachineT (return v) <~ fg) +-- | Flipped ('<~').+(~>) :: Monad m => MachineT m k b -> ProcessT m b c -> MachineT m k c+ma ~> mp = mp <~ ma+ -- | Feed a 'Process' some input. supply :: Monad m => [a] -> ProcessT m a b -> ProcessT m a b supply []         m = m@@ -133,17 +145,13 @@ -- | -- Convert a machine into a process, with a little bit of help. ----- @'process' 'id' = 'id'@--- -- @ -- 'process' 'Data.Machine.Tee.L' :: 'Data.Machine.Process.Process' a c -> 'Data.Machine.Tee.Tee' a b c -- 'process' 'Data.Machine.Tee.R' :: 'Data.Machine.Process.Process' b c -> 'Data.Machine.Tee.Tee' a b c -- 'process' 'id' :: 'Data.Machine.Process.Process' a b -> 'Data.Machine.Process.Process' a b -- @-process :: Monad m => (forall a. k i a -> i' -> a) -> MachineT m k i o -> ProcessT m i' o+process :: Monad m => (forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o process f (MachineT m) = MachineT (liftM f' m) where   f' (Yield o k)     = Yield o (process f k)   f' Stop            = Stop   f' (Await g kir h) = Await (process f . g . f kir) Refl (process f h)--

@@ -33,10 +33,10 @@ -------------------------------------------------------------------------------  -- | A 'Source' never reads from its inputs.-type Source b = forall k a. Machine k a b+type Source b = forall k. Machine k b  -- | A 'SourceT' never reads from its inputs, but may have monadic side-effects.-type SourceT m b = forall k a. MachineT m k a b+type SourceT m b = forall k. MachineT m k b  -- | Repeat the same value, over and over. repeated :: o -> Source o@@ -56,7 +56,7 @@ -- Alternately you can view this as capping the 'Source' end of a 'Process', -- yielding a new 'Source'. ----- @'cap' = 'pipe'@+-- @'cap' l r = l '<~' r@ -- cap :: Process a b -> Source a -> Source b-cap l r = after r l+cap l r = l <~ r

@@ -20,7 +20,6 @@   , capL, capR   ) where -import Control.Category import Data.Machine.Is import Data.Machine.Process import Data.Machine.Type@@ -32,15 +31,15 @@ -------------------------------------------------------------------------------  -- | The input descriptor for a 'Tee' or 'TeeT'-data T i c where-  L :: T (a, b) a-  R :: T (a, b) b+data T a b c where+  L :: T a b a+  R :: T a b b  -- | A 'Machine' that can read from two input stream in a deterministic manner.-type Tee a b c = Machine T (a, b) c+type Tee a b c = Machine (T a b) c  -- | A 'Machine' that can read from two input stream in a deterministic manner with monadic side-effects.-type TeeT m a b c = MachineT m T (a, b) c+type TeeT m a b c = MachineT m (T a b) c  -- | Compose a pair of pipes onto the front of a Tee. tee :: Monad m => ProcessT m a a' -> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c@@ -60,11 +59,11 @@  -- | Precompose a pipe onto the left input of a tee. addL :: Monad m => ProcessT m a b -> TeeT m b c d -> TeeT m a c d-addL p = tee p id+addL p = tee p echo  -- | Precompose a pipe onto the right input of a tee. addR :: Monad m => ProcessT m b c -> TeeT m a c d -> TeeT m a b d-addR = tee id+addR = tee echo  -- | Tie off one input of a tee by connecting it to a known source. capL :: Monad m => SourceT m a -> TeeT m a b c -> ProcessT m b c@@ -75,6 +74,6 @@ capR s t = fit cappedT $ addR s t  -- | Natural transformation used by 'capL' and 'capR'.-cappedT :: T (a, a) b -> Is a b+cappedT :: T a a b -> Is a b cappedT R = Refl cappedT L = Refl

@@ -35,6 +35,9 @@   , pass    , stopped++  -- * Applicative Machines+  , Appliance(..)   ) where  import Control.Applicative@@ -42,10 +45,9 @@ import Control.Monad (liftM) import Data.Foldable import Data.Functor.Identity-import Data.Machine.Is import Data.Machine.Plan import Data.Monoid-import Data.Profunctor+import Data.Pointed import Prelude hiding ((.),id)  -------------------------------------------------------------------------------@@ -54,92 +56,105 @@  -- | This is the base functor for a 'Machine' or 'MachineT'. ----- Note: Machines are usually constructed from 'Plan', so this does not need to be CPS'd.-data Step k i o r+-- Note: A 'Machine' is usually constructed from 'Plan', so it does not need to be CPS'd.+data Step k o r   = Stop   | Yield o r-  | forall t. Await (t -> r) (k i t) r+  | forall t. Await (t -> r) (k t) r -instance Functor (Step k i o) where+instance Functor (Step k o) where   fmap _ Stop = Stop   fmap f (Yield o k) = Yield o (f k)   fmap f (Await g kg fg) = Await (f . g) kg (f fg)  -- | A 'MachineT' reads from a number of inputs and may yield results before stopping -- with monadic side-effects.-newtype MachineT m k i o = MachineT { runMachineT :: m (Step k i o (MachineT m k i o)) }+newtype MachineT m k o = MachineT { runMachineT :: m (Step k o (MachineT m k o)) }  -- | A 'Machine' reads from a number of inputs and may yield results before stopping. -- -- A 'Machine' can be used as a @'MachineT' m@ for any @'Monad' m@.-type Machine k i o = forall m. Monad m => MachineT m k i o+type Machine k o = forall m. Monad m => MachineT m k o  -- | @'runMachine' = 'runIdentity' . 'runMachineT'@-runMachine :: MachineT Identity k i o -> Step k i o (MachineT Identity k i o)+runMachine :: MachineT Identity k o -> Step k o (MachineT Identity k o) runMachine = runIdentity . runMachineT --- | Pack a Step of a Machine into a Machine.-encased :: Monad m => Step k i o (MachineT m k i o) -> MachineT m k i o+-- | Pack a 'Step' of a 'Machine' into a 'Machine'.+encased :: Monad m => Step k o (MachineT m k o) -> MachineT m k o encased = MachineT . return -instance Monad m => Functor (MachineT m k i) where+instance Monad m => Functor (MachineT m k) where   fmap f (MachineT m) = MachineT (liftM f' m) where     f' (Yield o xs)    = Yield (f o) (f <$> xs)     f' (Await k kir e) = Await (fmap f . k) kir (f <$> e)     f' Stop            = Stop +instance Monad m => Pointed (MachineT m k) where+  point = repeatedly . yield++-- | An input type that supports merging requests from multiple machines.+class Appliance k where+  applied :: Monad m => MachineT m k (a -> b) -> MachineT m k a -> MachineT m k b++instance (Monad m, Appliance k) => Applicative (MachineT m k) where+  pure = point+  (<*>) = applied+ {--apMachines :: Maybe (Seq i) -> Seq a -> MachineT m k i (a -> b) -> MachineT m k i a -> MachineT m k i b-apMachines is as m n = MachineT $ runMachineT m >>= \u -> case u of-  Stop -> return Stop-  Yield f m' -> case viewl as of-    a :< as' -> return $ Yield (f a) (apMachines is as' m' n)-    EmptyL   -> paMachines is (Seq.singleton f) m' n-  Await k Refl kf -> case is of-    Nothing ->+-- TODO -paMachines :: Maybe (Seq i) -> Seq (a -> b) -> MachineT m k i (a -> b) -> MachineT m k i a -> MachineT m k i b-paMachines is fs m n = MachineT $ runMachineT n >>= \v -> case v of-  Stop -> return Stop-  Yield a n' -> case viewl fs of-    f :< fs' -> return $ Yield (f a) (paMachines is fs' m n')-    EmptyL   -> apMachines is (Seq.singleton a) m n'+instance Appliance (Is i) where+  applied = appliedTo (Just mempty) (Just mempty) id (flip id) where -instance (k ~ Is, Monad m) => Applicative (MachineT m k i) where-  pure = repeatedly . yield-  m <*>  n = runMachineT m >>= \u -> case u of-    Stop       -> return stopped-    Yield f xs ->-    Await f Refl ff ->+-- applied+appliedTo+  :: Maybe (Seq i)+  -> Maybe (i -> MachineT m (Is i) b, MachineT m (Is i) b)+  -> Either (Seq a) (Seq b)+  -> (a -> b -> c)+  -> (b -> a -> c)+  -> MachineT m (Is i) a+  -> MachineT m (Is i) b+  -> MachineT m (Is i) c+appliedTo mis blocking ss f g m n = MachineT $ runMachineT m >>= \v -> case v of+  Stop -> return Stop+  Yield a k -> case ss of+    Left as ->+    Right bs -> case viewl bs of+      b :< bs' -> return $ Yield (f a b) (appliedTo mis bs' f g m n)+      EmptyL   -> runMachine $ appliedTo mis blocking (singleton a) g f n m+  Await ak Refl e -> case mis of+    Nothing -> runMachine $ appliedTo Nothing blocking bs f g e n+    Just is -> case viewl is of+      i :< is' -> runMachine $ appliedTo (Just is') blocking bs f g (ak i) m+      EmptyL -> case blocking of+        Just (bk, be) ->+        Nothing -> runMachine $ appliedTo mis (Just (ak, e))+        | blocking  -> return $ Await (\i -> appliedTo (Just (singleton i)) False f g (ak i) n) Refl $+        | otherwise -> -} -instance (Monad m, Profunctor k) => Profunctor (MachineT m k) where-  rmap = fmap-  lmap f (MachineT m) = MachineT (liftM f' m) where-    f' (Yield o xs)    = Yield o (lmap f xs)-    f' (Await k kir e) = Await (lmap f . k) (lmap f kir) (lmap f e)-    f' Stop            = Stop- -- | Stop feeding input into model, taking only the effects.-runT_ :: Monad m => MachineT m k a b -> m ()-runT_ (MachineT m) = m >>= \v -> case v of+runT_ :: Monad m => MachineT m k b -> m ()+runT_ m = runMachineT m >>= \v -> case v of   Stop        -> return ()   Yield _ k   -> runT_ k   Await _ _ e -> runT_ e  -- | Stop feeding input into model and extract an answer-runT :: Monad m => MachineT m k a b -> m [b]+runT :: Monad m => MachineT m k b -> m [b] runT (MachineT m) = m >>= \v -> case v of   Stop        -> return []   Yield o k   -> liftM (o:) (runT k)   Await _ _ e -> runT e  -- | Run a pure machine and extract an answer.-run :: MachineT Identity k a b -> [b]+run :: MachineT Identity k b -> [b] run = runIdentity . runT  -- | This permits toList to be used on a Machine.-instance (m ~ Identity) => Foldable (MachineT m k i) where+instance (m ~ Identity) => Foldable (MachineT m k) where   foldMap f (MachineT (Identity m)) = go m where     go Stop = mempty     go (Yield o k) = f o `mappend` foldMap f k@@ -149,18 +164,14 @@ -- Connect different kinds of machines. -- -- @'fit' 'id' = 'id'@------ @--- 'fit' 'id' :: 'Data.Machine.Process.Process' a b -> 'Data.Machine.Process.Process' a b--- @-fit :: Monad m => (forall a. k i a -> k' i' a) -> MachineT m k i o -> MachineT m k' i' o+fit :: Monad m => (forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o fit f (MachineT m) = MachineT (liftM f' m) where   f' (Yield o k)     = Yield o (fit f k)   f' Stop            = Stop   f' (Await g kir h) = Await (fit f . g) (f kir) (fit f h)  -- | Compile a machine to a model.-construct :: Monad m => PlanT k i o m a -> MachineT m k i o+construct :: Monad m => PlanT k o m a -> MachineT m k o construct m = MachineT $ runPlanT m   (const (return Stop))   (\o k -> return (Yield o (MachineT k)))@@ -170,7 +181,7 @@ -- | Generates a model that runs a machine until it stops, then start it up again. -- -- @'repeatedly' m = 'construct' ('Control.Monad.forever' m)@-repeatedly :: Monad m => PlanT k i o m a -> MachineT m k i o+repeatedly :: Monad m => PlanT k o m a -> MachineT m k o repeatedly m = r where   r = MachineT $ runPlanT m     (const (runMachineT r))@@ -179,7 +190,7 @@     (return Stop)  -- | Evaluate a machine until it stops, and then yield answers according to the supplied model.-before :: Monad m => MachineT m k i o -> PlanT k i o m a -> MachineT m k i o+before :: Monad m => MachineT m k o -> PlanT k o m a -> MachineT m k o before (MachineT n) m = MachineT $ runPlanT m   (const n)   (\o k -> return (Yield o (MachineT k)))@@ -196,27 +207,13 @@ -- 'pass' 'Data.Machine.Wye.Y'  :: 'Data.Machine.Wye.Wye' a b b -- 'pass' 'Data.Machine.Wye.Z'  :: 'Data.Machine.Wye.Wye' a b (Either a b) -- @-pass :: k i o -> Machine k i o-pass input = repeatedly $ do-  a <- awaits input+pass :: k o -> Machine k o+pass k = repeatedly $ do+  a <- awaits k   yield a --- | Eventually this will probably revert to @instance 'Monad' m => 'Category' ('MachineT' m 'Is')@-instance (k ~ Is, Monad m) => Category (MachineT m k) where-  id = repeatedly $ do-    i <- await-    yield i--  m . n = MachineT $ runMachineT m >>= \v -> case v of-    Stop          -> return Stop-    Yield a as    -> return $ Yield a (as . n)-    Await f Refl k -> runMachineT n >>= \u -> case u of-      Stop          -> runMachineT $ k . stopped-      Yield b bs    -> runMachineT $ f b . bs-      Await g Refl fg -> return $ Await (\a -> encased v . g a) Refl (encased v . fg)- -- | This is a stopped 'Machine'-stopped :: Machine k a b+stopped :: Machine k b stopped = encased Stop  -------------------------------------------------------------------------------@@ -229,6 +226,6 @@ -- (or 'Data.Machine.Tee.Tee', etc) that produces a single answer. -- -- \"Is that your final answer?\"-sink :: Monad m => (forall o. PlanT k i o m a) -> MachineT m k i a+sink :: Monad m => (forall o. PlanT k o m a) -> MachineT m k a sink m = runPlanT m (\a -> Yield a Stop) id (Await id) Stop -}

@@ -25,14 +25,14 @@   Read   :: Unread a a  -- | Peek at the next value in the input stream without consuming it-peek :: Plan Unread a b a+peek :: Plan (Unread a) b a peek = do   a <- awaits Read   awaits (Unread a)   return a  -- | Push back into the input stream-unread :: a -> Plan Unread a b ()+unread :: a -> Plan (Unread a) b () unread a = awaits (Unread a)  -- TODO: make this a class?

@@ -33,16 +33,16 @@ -------------------------------------------------------------------------------  -- | The input descriptor for a 'Wye' or 'WyeT'-data Y i c where-  X :: Y (a, b) a            -- block waiting on the left input-  Y :: Y (a, b) b            -- block waiting on the right input-  Z :: Y (a, b) (Either a b) -- block waiting on either input+data Y a b c where+  X :: Y a b a            -- block waiting on the left input+  Y :: Y a b b            -- block waiting on the right input+  Z :: Y a b (Either a b) -- block waiting on either input  -- | A 'Machine' that can read from two input stream in a non-deterministic manner.-type Wye a b c = Machine Y (a, b) c+type Wye a b c = Machine (Y a b) c  -- | A 'Machine' that can read from two input stream in a non-deterministic manner with monadic side-effects.-type WyeT m a b c = MachineT m Y (a, b) c+type WyeT m a b c = MachineT m (Y a b) c  -- | Compose a pair of pipes onto the front of a 'Wye'. @@ -82,11 +82,11 @@  -- | Precompose a pipe onto the left input of a wye. addX :: Monad m => ProcessT m a b -> WyeT m b c d -> WyeT m a c d-addX p = wye p id+addX p = wye p echo  -- | Precompose a pipe onto the right input of a tee. addY :: Monad m => ProcessT m b c -> WyeT m a c d -> WyeT m a b d-addY = wye id+addY = wye echo  -- | Tie off one input of a tee by connecting it to a known source. capX :: Monad m => SourceT m a -> WyeT m a b c -> ProcessT m b c@@ -97,7 +97,7 @@ capY s t = process (capped Left) (addY s t)  -- | Natural transformation used by 'capX' and 'capY'-capped :: (a -> Either a a) -> Y (a, a) b -> a -> b+capped :: (a -> Either a a) -> Y a a b -> a -> b capped _ X = id capped _ Y = id capped f Z = f