Skip to content
Browse files

Merge pull request #10 from aslatter/master

Add instances for Applicative and Functor
  • Loading branch information...
2 parents 4dc5ac3 + 2b88b35 commit 60c8c8356ccb4d080a77b49cd0e1d99c254c2243 @jepst committed Mar 13, 2012
Showing with 24 additions and 0 deletions.
  1. +9 −0 Remote/Process.hs
  2. +15 −0 Remote/Task.hs
View
9 Remote/Process.hs
@@ -67,6 +67,7 @@ module Remote.Process (
import qualified Prelude as Prelude
import Prelude hiding (catch, id, init, last, lookup, pi)
+import Control.Applicative (Applicative(..))
import Control.Concurrent (forkIO,ThreadId,threadDelay)
import Control.Concurrent.MVar (MVar,newMVar, newEmptyMVar,takeMVar,putMVar,modifyMVar,modifyMVar_,readMVar)
import Control.Exception (ErrorCall(..),throwTo,bracket,try,Exception,throw,evaluate,finally,SomeException,catch)
@@ -282,6 +283,14 @@ instance Monad ProcessM where
instance Functor ProcessM where
fmap f v = ProcessM $ (\p -> (runProcessM v) p >>= (\x -> return $ fmap f x))
+instance Applicative ProcessM where
+ mf <*> mx =
+ ProcessM $ \p0 ->
+ runProcessM mf p0 >>= \(p1, f) ->
+ runProcessM mx p1 >>= \(p2, x) ->
+ return (p2, f x)
+ pure = return
+
instance MonadIO ProcessM where
liftIO arg = ProcessM $ \pr -> (arg >>= (\x -> return (pr,x)))
View
15 Remote/Task.hs
@@ -39,6 +39,7 @@ import System.Directory (renameFile)
import Data.Binary (Binary,get,put,putWord8,getWord8)
import Control.Exception (SomeException,Exception,throw)
import Data.Typeable (Typeable)
+import Control.Applicative (Applicative(..))
import Control.Monad (liftM,when)
import Control.Monad.Trans (liftIO)
import Control.Concurrent.MVar (MVar,modifyMVar,modifyMVar_,newMVar,newEmptyMVar,takeMVar,putMVar,readMVar,withMVar)
@@ -851,6 +852,20 @@ instance Monad TaskM where
return (ts'',a')
return x = TaskM $ \ts -> return $ (ts,x)
+instance Functor TaskM where
+ f `fmap` m =
+ TaskM $ \ts ->
+ runTaskM m ts >>= \(ts', x) ->
+ return (ts', f x)
+
+instance Applicative TaskM where
+ mf <*> mx =
+ TaskM $ \ts ->
+ runTaskM mf ts >>= \(ts', f) ->
+ runTaskM mx ts' >>= \(ts'', x) ->
+ return (ts'', f x)
+ pure = return
+
lookupForwardedRedeemer :: PromiseId -> TaskM (Maybe ProcessId)
lookupForwardedRedeemer q =
TaskM $ \ts ->

0 comments on commit 60c8c83

Please sign in to comment.
Something went wrong with that request. Please try again.