objective 0.2 → 0.3

raw patch · 2 files changed

+15/−6 lines, 2 files

Files

• objective.cabal +1/−1
• src/Control/Object.hs +14/−5

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                objective
-version:             0.2
+version:             0.3
 synopsis:            Extensible objects
 description:         Stateful effect transducer
 homepage:            https://github.com/fumieval/objective

@@ -1,6 +1,6 @@ {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
 {-# LANGUAGE DeriveFunctor, DeriveDataTypeable #-}
-{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FunctionalDependencies, UndecidableInstances #-}
 module Control.Object where
 
 import Control.Comonad.Zero
@@ -45,13 +45,18 @@ {-# INLINE oneshot #-}
 
 -- | Build a stateful object.
-stateful :: (Functor e, Monad m) => (forall a. e (StateT s m a) -> StateT s m a) -> s -> Object (AccessT s e) m
-stateful m = go where
+stateful :: Monad m => (forall a. e a -> StateT s m a) -> s -> Object e m
+stateful h = go where
+  go s = Object $ liftM (\(a, s) -> (a, go s)) . flip runStateT s . h
+
+-- | Build a stateful object, sharing out the state.
+sharing :: Monad m => (forall a. e a -> StateT s m a) -> s -> Object (AccessT s e) m
+sharing m = go where
   go s = Object $ \k -> liftM (fmap go) $ case k of
-    LiftAccessT e -> runStateT (m (fmap return e)) s
+    LiftAccessT e -> runStateT (m e) s
     Get cont -> return (cont s, s)
     Put s' cont -> return (cont, s')
-{-# INLINE stateful #-}
+{-# INLINE sharing #-}
 
 -- | Like 'MonadState', but doesn't require 'Monad' as a prerequisite.
 class Stateful s f | f -> s where
@@ -64,6 +69,10 @@ instance Stateful s (AccessT s f) where
   get_ = Get id
   put_ s = Put s ()
+
+instance (Functor f, Stateful s f) => Stateful s (Free f) where
+  get_ = liftF get_
+  put_ = liftF . put_
 
 -- | A mutable variable.
 variable :: Applicative f => s -> Object (Access s) f