coroutine-object 0.1.0 → 0.2

raw patch · 7 files changed

+42/−42 lines, 7 filesdep +eitherdep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: either

Dependency ranges changed: lens

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• coroutine-object.cabal +5/−3
• src/Control/Monad/Trans/Crtn.hs +9/−23
• src/Control/Monad/Trans/Crtn/Driver.hs +12/−7
• src/Control/Monad/Trans/Crtn/EventHandler.hs +3/−2
• src/Control/Monad/Trans/Crtn/Object.hs +10/−5
• src/Control/Monad/Trans/Crtn/World.hs +2/−1

@@ -1,4 +1,4 @@-Copyright (c) 2012 Ian-Woo Kim+Copyright (c) 2012-2013 Ian-Woo Kim  All rights reserved. 

@@ -1,5 +1,5 @@ Name:		coroutine-object-Version:	0.1.0+Version:	0.2 Synopsis:       Object-oriented programming realization using coroutine  Description: 	Object-oriented programming realization using coroutine  License: 	BSD3@@ -15,14 +15,16 @@   ghc-prof-options: -caf-all -auto-all   Build-Depends:   base >4 && <5,                     mtl>2, -                   lens >= 2.4,+                   lens >= 2.5,                    containers >= 0.4,                    transformers == 0.3.*,                     transformers-free == 1.0.*,                     bytestring >= 0.9,                    safecopy >= 0.6,                    uuid == 1.2.*,-                   cereal == 0.3.*+                   cereal == 0.3.*, +                   either >= 3 +                   -- errors >= 1.3   Other-Modules:      exposed-modules:                    Control.Monad.Trans.Crtn

@@ -17,7 +17,7 @@  module Control.Monad.Trans.Crtn where  -import Control.Monad.Error+-- import Control.Monad.Error import Control.Monad.Reader  import Control.Monad.State  import Control.Monad.Trans.Free@@ -98,17 +98,11 @@ type CliT req ans = CrtnT req ans    -- | type for coroutine status after execution-data CrtnErr r = NoError -               | ServerFinished r -               | Other String ---- | -deriving instance (Show r) => Show (CrtnErr r) +data CrtnErr = ServerFinished  +             | Other String   -- | -instance Error (CrtnErr r) where -  noMsg = NoError -  strMsg str = Other str +deriving instance Show CrtnErr   ----------------------------- -- communication combinator @@ -118,24 +112,16 @@ (<==|) :: Monad m =>            SrvT req ans m r'    -- ^ server coroutine        -> CliT req ans m r  -- ^ client coroutine-       -> ErrorT (CrtnErr r') m (SrvT req ans m r', r)+       -> m (Either CrtnErr (SrvT req ans m r', r))  s <==| c = do -    y <- lift (runFreeT c)+    y <- runFreeT c      case y of-      Pure r -> return (s,r)+      Pure r -> return (Right (s,r))       Free (Rqst rq af) -> do -        x <- lift (runFreeT (runReaderT s rq))+        x <- runFreeT (runReaderT s rq)          case x of -          Pure r' -> throwError (ServerFinished r')+          Pure _r' -> return (Left ServerFinished)            Free (Rqst ans rf) -> (ReaderT rf) <==| (af ans)--{---- | synonym of connectE-(<==>) :: Monad m => SrvT req ans m r' -> CliT req ans m r-          -> ErrorT (CrtnErr r') m (SrvT req ans m r', r)-(<==>) = connectE- -}         -  ---------------------- -- some utility 

@@ -7,8 +7,9 @@  module Control.Monad.Trans.Crtn.Driver where  -import Control.Monad.Error+-- import Control.Monad.Error import Control.Monad.Reader+import Control.Monad.Trans.Either  import Data.Foldable --  import Control.Monad.Trans.Crtn @@ -63,12 +64,16 @@                     , World e (SObjBT (DrvOp e) m) ()                     , [EvOrAct e]) singleDispatch (Right ev) (logobj,worldobj,evacc) = do-    Right (logobj',worldobj',events) <- -      runErrorT $ do (worldobj1,_)  <- worldobj  <==| giveEvent ev-                     (worldobj2,logobj1) <- worldobj1 <==| flushLog logobj-                     (worldobj3,events) <- worldobj2 <==| flushQueue -                     return (logobj1,worldobj3,events)-    return (logobj',worldobj',evacc++events) +    -- Right (logobj',worldobj',events) <- +    r <- +      runEitherT $ do (worldobj1,_)  <- EitherT (worldobj  <==| giveEvent ev)+                      (worldobj2,logobj1) <- EitherT (worldobj1 <==| flushLog logobj)+                      (worldobj3,events) <- EitherT (worldobj2 <==| flushQueue)+                      return (logobj1,worldobj3,events)+    case r of +      Left _ -> -- resuming original (this must be refined. resume point must be defined ) +                return (logobj,worldobj,evacc)+      Right (logobj',worldobj',events) -> return (logobj',worldobj',evacc++events)  singleDispatch (Left act) (logobj,worldobj,evacc) = do      Arg Dispatch ev <- request (Res Dispatch (Just act))     return (logobj,worldobj,evacc++[Right ev]) 

@@ -16,7 +16,8 @@    import Control.Concurrent.MVar  import Control.Monad.State -import Control.Monad.Error+-- import Control.Monad.Error+import Control.Monad.Trans.Either -- from this package  -- import Control.Monad.Trans.Crtn import Control.Monad.Trans.Crtn.Event @@ -37,5 +38,5 @@           Right Nothing -> return ()            Right (Just (ActionOrder act)) ->              act (eventHandler evar) >>= eventHandler evar -  where eaction = runStateT (runErrorT $ fire ev) +  where eaction = runStateT (runEitherT $ fire ev)                    

@@ -1,4 +1,4 @@-{-# LANGUAGE GADTs, RankNTypes #-}+{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -18,7 +18,8 @@  -- from other packages import Control.Monad.State -import Control.Monad.Error +-- import Control.Monad.Error +import Control.Monad.Trans.Either  -- from this package import Control.Monad.Trans.Crtn @@ -50,13 +51,17 @@   -- | convenient error state monad for object  -type EStT s m = ErrorT (CrtnErr ()) (StateT s m)  +type EStT s m = EitherT CrtnErr (StateT s m)    -- |  -query :: (Monad m) => CObjT s m r -> EStT (SObjT s m ()) m r  +query :: forall m s r. (Monad m) => CObjT s m r -> EStT (SObjT s m ()) m r   query cli = do    qserv <- lift get -  (qserv',r) <- mapErrorT lift (qserv <==| cli )+  let result :: m (Either CrtnErr (SrvT (Arg s) (Res s) m (), r))+      result = qserv <==| cli+      r2 :: StateT (SObjT s m ()) m (Either CrtnErr (SrvT (Arg s) (Res s) m (), r))+      r2 = lift result+  (qserv',r) <- EitherT r2    lift (put qserv')   return r   

@@ -16,7 +16,8 @@  module Control.Monad.Trans.Crtn.World where  -import Control.Monad.Error +-- import Control.Monad.Error +-- import Control.Monad.Trans.Either  --  import Control.Monad.Trans.Crtn import Control.Monad.Trans.Crtn.Event