Dimachine

[none]

ChannelT.cabal

@@ -52,7 +52,7 @@ library
                        Control.Monad.Channel.Selector.Tee,
                        Control.Monad.Channel.Selector.Machine,
                        Control.Monad.Channel.Selector.Comachine,
-                       -- Control.Monad.Channel.Selector.Dimachine,
+                       Control.Monad.Channel.Selector.Dimachine,
                        -- Control.Monad.Channel.Selector.Multi
                        Data.KUnit
 

Control/Monad/Channel/Selector/Dimachine.hs

@@ -1,6 +1,39 @@
 {-# LANGUAGE GADTs, KindSignatures, RankNTypes, MultiParamTypeClasses, FunctionalDependencies, LiberalTypeSynonyms, FlexibleContexts #-}
-module Control.Monad.Channel.Selector.Dimachine () where
+module Control.Monad.Channel.Selector.Dimachine (DimachineChannel,
+                                                 DimachineChannelT,
+                                                 awaitOn,
+                                                 await,
+                                                 yieldOn,
+                                                 yield,
+                                                 runDimachine,
+                                                 DimachineSelector(..)) where
+import Prelude hiding (id)
 import Control.Monad.Channel
 import Control.Monad.Channel.Selector.Empty
 import Control.Monad.Trans.Free (FreeT(..), FreeF(..))
 import Control.Applicative
+import Control.Category (Category(id))
+import Data.KUnit
+
+data DimachineSelector :: * -> (* -> *) -> * -> * -> * where
+  AwaitOnDimachine :: kI i -> DimachineSelector kI kO i ()
+  YieldOnDimachine :: kO o -> DimachineSelector kI kO () o
+
+type DimachineChannel kI kO a = Channel (DimachineSelector kI kO) a
+
+type DimachineChannelT kI kO m a = ChannelT (DimachineSelector kI kO) m a
+
+awaitOn :: DimachineChannel kI kO i
+awaitOn = (`syncOn` ()) . AwaitOnDimachine
+
+await :: (Category c) => DimachineChannel (c i) kO i
+await = awaitOn id
+
+yield :: (Category c) => o -> DimachineChannel kI (c o) ()
+yield = yieldOn id
+
+runDimachine :: (Monad m) => DimachineChannelT KUnit kO m a -> m a
+runDimachine (FreeT a) = a >>= \x -> case x of
+  Pure v -> return v
+  Free (SyncChannel (AwaitOnDimachine _) _ iK) -> runDimachine $ iK ()
+  Free (SyncChannel (YieldOnDimachine _) _ iU) -> runDimachine $ iU ()