Add instances for Applicative and Functor #10

Merged
merged 1 commit into from Mar 14, 2012
View
@@ -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
@@ -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 ->