objective 0.1 → 0.2

raw patch · 4 files changed

+47/−25 lines, 4 filesdep +free

Dependencies added: free

Files

objective.cabal +2/−2
src/Control/Monad/Objective/Class.hs +25/−14
src/Control/Monad/Objective/IO.hs +1/−3
src/Control/Object.hs +19/−6

objective.cabal view

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                objective
-version:             0.1
+version:             0.2
 synopsis:            Extensible objects
 description:         Stateful effect transducer
 homepage:            https://github.com/fumieval/objective
@@ -20,6 +20,6 @@   exposed-modules:     Control.Object, Control.Monad.Objective.Class, Control.Monad.Objective.IO, Control.Monad.Objective
   -- other-modules:       
   other-extensions:    MultiParamTypeClasses, KindSignatures, TypeFamilies
-  build-depends:       base >=4.5 && <5, trivia, comonad, transformers >= 0.3 && <0.5
+  build-depends:       base >=4.5 && <5, trivia, comonad, transformers >= 0.3 && <0.5, free >= 4.0 && <5
   hs-source-dirs:      src
   default-language:    Haskell2010

src/Control/Monad/Objective/Class.hs view

@@ -25,6 +25,7 @@ import qualified Control.Monad.Trans.RWS.Strict as StrictRWS
 import Data.Monoid
 import Control.Monad
+import Control.Monad.Free
 
 infix 3 .-
 infix 3 .&
@@ -37,8 +38,13 @@   -- | Send a message to the pointed one.
   (.-) :: Address e m -> e a -> m a
   -- | Add an object to the environment.
-  invoke :: Object e (Residence m) -> m (Address e m)
+  new :: Object e (Residence m) -> m (Address e m)
 
+-- | Old synonym for 'new'.
+invoke :: MonadObjective m => Object e (Residence m) -> m (Address e m)
+invoke = new
+{-# DEPRECATED invoke "Use new instead of misleading invoke" #-} 
+
 (.&) :: (MonadObjective m, Stateful s e) => Address e m -> Strict.StateT s m a -> m a
 c .& m = do
   s <- c .- get_
@@ -46,82 +52,87 @@   c .- put_ s'
   return a
 
+-- | like 'sequential', but it allows ad-hoc use of 'Free'.
+(.|-) :: MonadObjective m => Address e m -> Free e a -> m a
+_ .|- Pure a = return a
+c .|- Free f = c .- f >>= (c .|-)
+
 instance MonadObjective m => MonadObjective (ReaderT r m) where
   data Address e (ReaderT r m) = WrapReaderT (Address e m)
   type Residence (ReaderT r m) = Residence m
   WrapReaderT c .- e = lift (c .- e)
-  invoke = liftM WrapReaderT . lift . invoke
+  new = liftM WrapReaderT . lift . new
 
 instance (Monoid w, MonadObjective m) => MonadObjective (LazyRWS.RWST r w s m) where
   data Address e (LazyRWS.RWST r w s m) = WrapLazyRWST (Address e m)
   type Residence (LazyRWS.RWST r w s m) = Residence m
   WrapLazyRWST c .- e = lift (c .- e)
-  invoke = liftM WrapLazyRWST . lift . invoke
+  new = liftM WrapLazyRWST . lift . new
 
 instance (Monoid w, MonadObjective m) => MonadObjective (StrictRWS.RWST r w s m) where
   data Address e (StrictRWS.RWST r w s m) = WrapStrictRWST (Address e m)
   type Residence (StrictRWS.RWST r w s m) = Residence m
   WrapStrictRWST c .- e = lift (c .- e)
-  invoke = liftM WrapStrictRWST . lift . invoke
+  new = liftM WrapStrictRWST . lift . new
 
 instance MonadObjective m => MonadObjective (ContT r m) where
   data Address e (ContT r m) = WrapContT (Address e m)
   type Residence (ContT r m) = Residence m
   WrapContT c .- e = lift (c .- e)
-  invoke = liftM WrapContT . lift . invoke
+  new = liftM WrapContT . lift . new
 
 #if MIN_VERSION_transformers(0,4,0)
 instance MonadObjective m => MonadObjective (ExceptT er m) where
   data Address e (ExceptT er m) = WrapExceptT (Address e m)
   type Residence (ExceptT er m) = Residence m
   WrapExceptT c .- e = lift (c .- e)
-  invoke = liftM WrapExceptT . lift . invoke
+  new = liftM WrapExceptT . lift . new
 #else
 instance (Error er, MonadObjective m) => MonadObjective (ErrorT er m) where
   data Address e (ErrorT er m) = WrapErrorT (Address e m)
   type Residence (ErrorT er m) = Residence m
   WrapErrorT c .- e = lift (c .- e)
-  invoke = liftM WrapErrorT . lift . invoke
+  new = liftM WrapErrorT . lift . new
 #endif
 
 instance MonadObjective m => MonadObjective (IdentityT m) where
   data Address e (IdentityT m) = WrapIdentityT (Address e m)
   type Residence (IdentityT m) = Residence m
   WrapIdentityT c .- e = lift (c .- e)
-  invoke = liftM WrapIdentityT . lift . invoke
+  new = liftM WrapIdentityT . lift . new
 
 instance MonadObjective m => MonadObjective (ListT m) where
   data Address e (ListT m) = WrapListT (Address e m)
   type Residence (ListT m) = Residence m
   WrapListT c .- e = lift (c .- e)
-  invoke = liftM WrapListT . lift . invoke
+  new = liftM WrapListT . lift . new
 
 instance MonadObjective m => MonadObjective (MaybeT m) where
   data Address e (MaybeT m) = WrapMaybeT (Address e m)
   type Residence (MaybeT m) = Residence m
   WrapMaybeT c .- e = lift (c .- e)
-  invoke = liftM WrapMaybeT . lift . invoke
+  new = liftM WrapMaybeT . lift . new
 
 instance MonadObjective m => MonadObjective (Lazy.StateT s m) where
   data Address e (Lazy.StateT s m) = WrapLazyStateT (Address e m)
   type Residence (Lazy.StateT s m) = Residence m
   WrapLazyStateT c .- e = lift (c .- e)
-  invoke = liftM WrapLazyStateT . lift . invoke
+  new = liftM WrapLazyStateT . lift . new
 
 instance MonadObjective m => MonadObjective (Strict.StateT s m) where
   data Address e (Strict.StateT s m) = WrapStrictStateT (Address e m)
   type Residence (Strict.StateT s m) = Residence m
   WrapStrictStateT c .- e = lift (c .- e)
-  invoke = liftM WrapStrictStateT . lift . invoke
+  new = liftM WrapStrictStateT . lift . new
 
 instance (Monoid w, MonadObjective m) => MonadObjective (Lazy.WriterT w m) where
   data Address e (Lazy.WriterT w m) = WrapLazyWriterT (Address e m)
   type Residence (Lazy.WriterT w m) = Residence m
   WrapLazyWriterT c .- e = lift (c .- e)
-  invoke = liftM WrapLazyWriterT . lift . invoke
+  new = liftM WrapLazyWriterT . lift . new
 
 instance (Monoid w, MonadObjective m) => MonadObjective (Strict.WriterT w m) where
   data Address e (Strict.WriterT w m) = WrapStrictWriterT (Address e m)
   type Residence (Strict.WriterT w m) = Residence m
   WrapStrictWriterT c .- e = lift (c .- e)
-  invoke = liftM WrapStrictWriterT . lift . invoke
+  new = liftM WrapStrictWriterT . lift . new

src/Control/Monad/Objective/IO.hs view

@@ -28,6 +28,4 @@       (a, c') <- runObject c e
       putMVar m c'
       return a
-  invoke v = do
-      m <- newMVar v
-      return (Address m)+  new v = Address `fmap` newMVar v

src/Control/Object.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
 {-# LANGUAGE DeriveFunctor, DeriveDataTypeable #-}
 {-# LANGUAGE FunctionalDependencies #-}
 module Control.Object where
@@ -9,10 +9,13 @@ import Control.Monad
 import Data.Typeable
 import Control.Applicative
+import Data.Maybe
+import Control.Monad.Free
+import Control.Monad.Trans.Maybe
 
--- | The type 'Object e m' represents objects which can handle messages 'e', perform actions in the environment 'm'.
--- It can be thought of as a function between effects.
--- Thus, it can be composed just like functions using '(.>>.)' (not often needed); the identity element is `echo`.
+-- | The type 'Object e m' represents objects which can handle messages @e@, perform actions in the environment @m@.
+-- It can be thought of as an automaton that converts effects.
+-- 'Object's can be composed just like functions using '.>>.'; the identity element is 'echo'.
 newtype Object e m = Object { runObject :: forall x. e x -> m (x, Object e m) } deriving Typeable
 
 -- | Lift a natural transformation into an object.
@@ -63,8 +66,18 @@   put_ s = Put s ()
 
 -- | A mutable variable.
-variable :: Applicative f => s -> Object (AccessT s Zero) f
+variable :: Applicative f => s -> Object (Access s) f
 variable s = Object $ \x -> case x of
   Get cont -> pure (cont s, variable s)
   Put s' cont -> pure (cont, variable s')
-  LiftAccessT e -> pure (extract e, variable s)+  LiftAccessT e -> pure (extract e, variable s)
+
+type Access s = AccessT s Zero
+
+-- | Convert a /method sequence/ into a sequential /method execution/.
+sequential :: Monad m => Object e m -> Object (Free e) m
+sequential obj = Object $ \x -> case x of
+  Pure a -> return (a, sequential obj)
+  Free f -> do
+    (a, obj') <- runObject obj f
+    runObject (sequential obj') a