Browse files

`Dimachine`

[none]
  • Loading branch information...
1 parent 1b2d152 commit a974790092b06821deffefdeff8576ba4783fd5c @pthariensflame committed Feb 26, 2013
Showing with 35 additions and 2 deletions.
  1. +1 −1 ChannelT.cabal
  2. +34 −1 Control/Monad/Channel/Selector/Dimachine.hs
View
2 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
View
35 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 ()

0 comments on commit a974790

Please sign in to comment.