stateref 0.2.1.1 → 0.3
raw patch · 14 files changed
+381/−407 lines, 14 filesdep ~base
Dependency ranges changed: base
Files
- LICENSE +0/−28
- src/Data/Accessor.hs +5/−9
- src/Data/MRef.hs +9/−24
- src/Data/MRef/Classes.hs +0/−40
- src/Data/MRef/Instances.hs +12/−14
- src/Data/MRef/Instances/STM.hs +57/−41
- src/Data/MRef/Types.hs +42/−0
- src/Data/StateRef.hs +38/−69
- src/Data/StateRef/Classes.hs +0/−76
- src/Data/StateRef/Instances.hs +93/−58
- src/Data/StateRef/Instances/STM.hs +43/−30
- src/Data/StateRef/Instances/Undecidable.hs +6/−8
- src/Data/StateRef/Types.hs +57/−0
- stateref.cabal +19/−10
− LICENSE
@@ -1,28 +0,0 @@-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:--1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.--2. Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.--3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-POSSIBILITY OF SUCH DAMAGE.
src/Data/Accessor.hs view
@@ -1,7 +1,3 @@-{-- - ``Data/Accessor''- - (c) 2008 Cook, J. MR SSD, Inc.- -} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances@@ -9,20 +5,20 @@ module Data.Accessor where -import Data.StateRef.Classes+import Data.StateRef.Types newtype Getter m a = Getter (m a) newtype Setter m a = Setter (a -> m ()) newtype Accessor m a = Accessor (Getter m a, Setter m a) instance Monad m => ReadRef (Getter m a) m a where- readRef (Getter x) = x+ readReference (Getter x) = x instance Monad m => WriteRef (Setter m a) m a where- writeRef (Setter f) = f+ writeReference (Setter f) = f instance Monad m => ReadRef (Accessor m a) m a where- readRef (Accessor (Getter x, _)) = x+ readReference (Accessor (Getter x, _)) = x instance Monad m => WriteRef (Accessor m a) m a where- writeRef (Accessor (_, Setter f)) = f+ writeReference (Accessor (_, Setter f)) = f
src/Data/MRef.hs view
@@ -1,31 +1,16 @@-{-- - ``Data/MRef''- - (c) 2008 Cook, J. MR SSD, Inc.- -}- module Data.MRef - ( module Data.MRef- , module Data.MRef.Classes- , module Data.MRef.Instances- ) where+ ( module Data.MRef+ , module Data.MRef.Types+ , module Data.MRef.Instances+ ) where -import Data.MRef.Classes+import Data.MRef.Types import Data.MRef.Instances --- |Create a m-reference and constrain its type to be the default reference--- type for the monad in which it is being created. See 'newMRef'.-newDefaultMRef :: (DefaultMRef sr m a, NewMRef sr m a) => a -> m sr-newDefaultMRef = newMRef---- |Create an empty m-reference and constrain its type to be the default--- reference type for the monad in which it is being created. See 'newMRef'.-newDefaultEmptyMRef :: (DefaultMRef sr m a, NewMRef sr m a) => m sr-newDefaultEmptyMRef = newEmptyMRef- -- |See 'takeMRef'.-takeDefaultMRef :: (DefaultMRef sr m a, TakeMRef sr m a) => sr -> m a-takeDefaultMRef = takeMRef+takeMRef :: MRef m a -> m a+takeMRef = takeMRef -- |See 'putMRef'.-putDefaultMRef :: (DefaultMRef sr m a, PutMRef sr m a) => sr -> a -> m ()-putDefaultMRef = putMRef+putMRef :: MRef m a -> a -> m ()+putMRef = putMRef
− src/Data/MRef/Classes.hs
@@ -1,40 +0,0 @@-{-- - ``Data/MRef/Classes''- - (c) 2008 Cook, J. MR SSD, Inc.- -}-{-# LANGUAGE- MultiParamTypeClasses,- FunctionalDependencies- #-}---- |This module defines the \"MRef\" abstraction, which is a set of--- type-classes for things that behave like 'Control.Concurrent.MVar.MVar's.--- See the documentation there for more info. ------ This interface may be subject to future expansion. Presently, rather --- than providing something like 'Control.Concurrent.MVar.tryTakeMVar',--- instances for \"'Data.StateRef.Classes.ReadRef' sr m ('Maybe' a)\" are--- provided, giving 'Data.StateRef.Classes.readRef' the same type --- tryTakeMRef would have if it existed. There is currently nothing like--- 'Control.Concurrent.MVar.tryPutMVar', though. Perhaps there should be.--- Or, perhaps this is the sort of thing the weird (to me) signature of--- 'Data.IORef.atomicModifyIORef' is for, and an argument for a similar--- signature for 'Data.StateRef.Classes.modifyStateRef' or the addition of--- a new atomicModifyStateRef function.------ I would like to resolve these questions in version 0.3 of this package.-module Data.MRef.Classes where--class Monad m => NewMRef sr m a | sr -> a where- -- |See 'Control.Concurrent.MVar.newMVar'- newMRef :: a -> m sr- -- |See 'Control.Concurrent.MVar.newEmptyMVar'- newEmptyMRef :: m sr-class Monad m => TakeMRef sr m a | sr -> a where- -- |See 'Control.Concurrent.MVar.takeMVar'- takeMRef :: sr -> m a-class Monad m => PutMRef sr m a | sr -> a where- -- |See 'Control.Concurrent.MVar.putMVar'- putMRef :: sr -> a -> m ()--class Monad m => DefaultMRef sr m a | sr -> a, m a -> sr
src/Data/MRef/Instances.hs view
@@ -1,7 +1,3 @@-{-- - ``Data/MRef/Instances''- - (c) 2008 Cook, J. MR SSD, Inc.- -} {-# LANGUAGE CPP, MultiParamTypeClasses,@@ -12,30 +8,32 @@ -- basic class instances for creating, reading, and writing 'MVar's, and -- re-exports 'MVar'. module Data.MRef.Instances- ( MVar- , MonadIO(..)+ ( MVar+ , MonadIO(..) #ifdef useSTM- , module Data.MRef.Instances.STM+ , module Data.MRef.Instances.STM #endif- ) where+ ) where #ifdef useSTM import Data.MRef.Instances.STM #endif -import Data.MRef.Classes+import Data.MRef.Types import Control.Concurrent.MVar import Control.Monad.Trans -- preferred instances -- MVar in IO monad-instance DefaultMRef (MVar a) IO a+instance HasMRef IO where+ newMRef x = fmap MRef (newMVar x)+ newEmptyMRef = fmap MRef newEmptyMVar instance MonadIO m => NewMRef (MVar a) m a where- newMRef = liftIO . newMVar- newEmptyMRef = liftIO newEmptyMVar+ newMReference = liftIO . newMVar+ newEmptyMReference = liftIO newEmptyMVar instance MonadIO m => TakeMRef (MVar a) m a where- takeMRef = liftIO . takeMVar+ takeMReference = liftIO . takeMVar instance MonadIO m => PutMRef (MVar a) m a where- putMRef r = liftIO . putMVar r+ putMReference r = liftIO . putMVar r
src/Data/MRef/Instances/STM.hs view
@@ -1,7 +1,3 @@-{-- - ``Data/MRef/Instances/STM''- - (c) 2008 Cook, J. MR SSD, Inc.- -} {-# LANGUAGE CPP, MultiParamTypeClasses,@@ -14,74 +10,94 @@ -- instances as well as the 'atomically' function, which is indispensible -- when playing with this stuff in ghci. module Data.MRef.Instances.STM- ( STM+ ( STM #ifdef useTMVar- , TMVar+ , TMVar #endif- , TVar- - , atomically- ) where+ , TVar+ + , atomically+ ) where -import Data.MRef.Classes-import Data.StateRef (readRef, writeRef, newRef)+import Data.MRef.Types+import Data.StateRef (readReference, writeReference, newReference) import Data.StateRef.Instances.STM () import Control.Concurrent.STM +-- MRef STM in IO monad+instance NewMRef (MRef STM a) IO a where #ifdef useTMVar+ newMReference = fmap MRef . newTMVarIO+ newEmptyMReference = fmap MRef newEmptyTMVarIO+#else+ newMReference = fmap MRef . newTVarIO . Just+ newEmptyMReference = fmap MRef (newTVarIO Nothing)+#endif+ +instance TakeMRef (MRef STM a) IO a where+ takeMReference (MRef ref) = atomically (takeMReference ref)+instance PutMRef (MRef STM a) IO a where+ putMReference (MRef ref) = atomically . putMReference ref+++#ifdef useTMVar --TMVar in STM monad-instance DefaultMRef (TMVar a) STM a+instance HasMRef STM where+ newMRef x = fmap MRef (newTMVar x)+ newEmptyMRef = fmap MRef newEmptyTMVar instance NewMRef (TMVar a) STM a where- newMRef = newTMVar- newEmptyMRef = newEmptyTMVar+ newMReference = newTMVar+ newEmptyMReference = newEmptyTMVar instance TakeMRef (TMVar a) STM a where- takeMRef = takeTMVar+ takeMReference = takeTMVar instance PutMRef (TMVar a) STM a where- putMRef = putTMVar+ putMReference = putTMVar -- TMVar in IO monad instance NewMRef (TMVar a) IO a where- newMRef = newTMVarIO- newEmptyMRef = newEmptyTMVarIO- + newMReference = newTMVarIO+ newEmptyMReference = newEmptyTMVarIO+ instance TakeMRef (TMVar a) IO a where- takeMRef = atomically . takeMRef+ takeMReference = atomically . takeMReference instance PutMRef (TMVar a) IO a where- putMRef ref = atomically . putMRef ref+ putMReference ref = atomically . putMReference ref #endif -- incidental instances, which may occasionally be handy in a pinch -- TVars containing "Maybe" values in STM monad. -- Also use as default if TMVar isn't available. #ifndef useTMVar-instance DefaultMRef (TVar (Maybe a)) STM a+instance HasMRef STM where+ newMRef x = fmap MRef (newTVar (Just x))+ newEmptyMRef = fmap MRef (newTVar Nothing) #endif instance NewMRef (TVar (Maybe a)) STM a where- newMRef = newRef . Just- newEmptyMRef = newRef Nothing+ newMReference = newReference . Just+ newEmptyMReference = newReference Nothing instance TakeMRef (TVar (Maybe a)) STM a where- takeMRef ref = do- x <- readRef ref- case x of- Nothing -> retry- Just x -> do- writeRef ref Nothing- return x+ takeMReference ref = do+ x <- readReference ref+ case x of+ Nothing -> retry+ Just x -> do+ writeReference ref Nothing+ return x instance PutMRef (TVar (Maybe a)) STM a where- putMRef ref val = do- x <- readRef ref- case x of- Nothing -> writeRef ref (Just val)- Just x -> retry+ putMReference ref val = do+ x <- readReference ref+ case x of+ Nothing -> writeReference ref (Just val)+ Just x -> retry -- TVars containing "Maybe" values in IO monad instance NewMRef (TVar (Maybe a)) IO a where- newMRef = newRef . Just- newEmptyMRef = newRef Nothing+ newMReference = newReference . Just+ newEmptyMReference = newReference Nothing instance TakeMRef (TVar (Maybe a)) IO a where- takeMRef = atomically . takeMRef+ takeMReference = atomically . takeMReference instance PutMRef (TVar (Maybe a)) IO a where- putMRef ref = atomically . putMRef ref+ putMReference ref = atomically . putMReference ref
+ src/Data/MRef/Types.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE+ MultiParamTypeClasses,+ FunctionalDependencies,+ GADTs+ #-}++-- |This module defines the \"MRef\" abstraction, which is a set of+-- type-classes for things that behave like 'Control.Concurrent.MVar.MVar's.+-- See the documentation there for more info. +--+-- This interface may be subject to future expansion. Presently, rather +-- than providing something like 'Control.Concurrent.MVar.tryTakeMVar',+-- instances for \"'Data.StateRef.Types.ReadRef' sr m ('Maybe' a)\" are+-- provided, giving 'Data.StateRef.Types.readReference' the same type +-- tryTakeMRef would have if it existed. There is currently nothing like+-- 'Control.Concurrent.MVar.tryPutMVar', though. Perhaps there should be.+-- Or, perhaps this is the sort of thing the weird (to me) signature of+-- 'Data.IORef.atomicModifyIORef' is for, and an argument for a similar+-- signature for 'Data.StateRef.Types.modifyStateRef' or the addition of+-- a new atomicModifyStateRef function.+--+-- I would like to resolve these questions in version 0.3 of this package.+module Data.MRef.Types where++data MRef m a where+ MRef :: (TakeMRef sr m a, PutMRef sr m a) => !sr -> MRef m a++class HasMRef m where+ newMRef :: a -> m (MRef m a)+ newEmptyMRef :: m (MRef m a)++class Monad m => NewMRef sr m a | sr -> a where+ -- |See 'Control.Concurrent.MVar.newMVar'+ newMReference :: a -> m sr+ -- |See 'Control.Concurrent.MVar.newEmptyMVar'+ newEmptyMReference :: m sr+class Monad m => TakeMRef sr m a | sr -> a where+ -- |See 'Control.Concurrent.MVar.takeMVar'+ takeMReference :: sr -> m a+class Monad m => PutMRef sr m a | sr -> a where+ -- |See 'Control.Concurrent.MVar.putMVar'+ putMReference :: sr -> a -> m ()
src/Data/StateRef.hs view
@@ -1,8 +1,3 @@-{-- - ``StateRef.hs''- - (c) 2008 Cook, J. MR SSD, Inc.- -}- -- |This module provides classes and instances for mutable state -- references. Various implementation exist in common usage, but -- no way (until now ;-) to define functions using state references@@ -11,41 +6,32 @@ -- These modules use several language extensions, including multi-parameter -- type classes and functional dependencies. module Data.StateRef- ( module Data.StateRef- , module Data.StateRef.Classes- , module Data.StateRef.Instances- , module Data.Accessor- ) where+ ( module Data.StateRef+ , module Data.StateRef.Types+ , module Data.StateRef.Instances+ , module Data.Accessor+ ) where -import Data.StateRef.Classes+import Data.StateRef.Types import Data.StateRef.Instances import Data.Accessor --- |Create a reference and constrain its type to be the default reference type--- for the monad in which it is being created. See 'newRef'.-newDefaultRef :: (DefaultStateRef sr m a, NewRef sr m a) => a -> m sr-newDefaultRef = newRef---- |Read a reference and constrain its type to be the default reference type--- for the monad in which it is being read. See 'readRef'.-readDefaultRef :: (DefaultStateRef sr m a, ReadRef sr m a) => sr -> m a-readDefaultRef = readRef+-- |Read a 'Ref'. See 'readReference'.+readRef :: Ref m a -> m a+readRef = readReference --- |Write a reference and constrain its type to be the default reference type--- for the monad in which it is being written. See 'writeRef'-writeDefaultRef :: (DefaultStateRef sr m a, WriteRef sr m a) => sr -> a -> m ()-writeDefaultRef = writeRef+-- |Write a 'Ref'. See 'writeReference'+writeRef :: Ref m a -> a -> m ()+writeRef = writeReference --- |Modify a reference and constrain its type to be the default reference type--- for the monad in which it is being modified. See 'modifyRef'.-atomicModifyDefaultRef :: (DefaultStateRef sr m a, ModifyRef sr m a) => sr -> (a -> (a,b)) -> m b-atomicModifyDefaultRef = atomicModifyRef+-- |Modify a 'Ref'. See 'modifyReference'.+atomicModifyRef :: Ref m a -> (a -> (a,b)) -> m b+atomicModifyRef = atomicModifyReference --- |Modify a reference and constrain its type to be the default reference type--- for the monad in which it is being modified. See 'modifyRef'.-modifyDefaultRef :: (DefaultStateRef sr m a, ModifyRef sr m a) => sr -> (a -> a) -> m ()-modifyDefaultRef = modifyRef+-- |Modify a 'Ref'. See 'modifyReference'.+modifyRef :: Ref m a -> (a -> a) -> m ()+modifyRef = modifyReference -- |Essentially the same concept as 'Control.Monad.State.gets',@@ -55,52 +41,35 @@ Monad m) => sr -> (a -> b) -> m b readsRef r f = do- x <- readRef r- return (f x)+ x <- readReference r+ return (f x) -- |Construct a counter - a monadic value which, each time it is -- evaluated, returns the 'succ' of the previous value returned.-newCounter :: (DefaultStateRef sr m1 a,- ModifyRef sr m1 a,- NewRef sr m a,- Enum a) =>- a -> m (m1 a)+newCounter :: (HasRef m, Monad m, Enum a) => a -> m (m a) newCounter n = do- c <- newRef n- return $ do- x <- readDefaultRef c- writeDefaultRef c (succ x)- return x+ c <- newRef n+ return $ do+ x <- readRef c+ writeRef c (succ x)+ return x -- |Create a \"lapse reader\" (suggestions for better terminology are more -- than welcome), a sort of a time-lapse of the variable. The first -- motivating instance for this operation was a clock in a simple simulation -- application. Given a 'TVar' 'Double' called \"clock\", a useful -- value \"dT\" is yielded by the expression: 'mkLapseReader' clock (-)--- --- note that there's a unification ghc missed here:--- the fundep sr -> a on NewRef and DefaultStateRef should cause a and a1 --- to be unified, because of the 2 constraints:--- NewRef sr1 m a--- DefaultStateRef sr1 m1 a1--- this isn't a \"bug\" because the type is still valid, but it seems like--- something ghc \"ought\" to do, since a and a1 are doomed to unification--- anyway.-mkLapseReader :: (ReadRef sr m a,- ReadRef sr m1 a,- NewRef sr1 m a,- DefaultStateRef sr1 m1 a1,- ReadRef sr1 m1 a1,- WriteRef sr1 m1 a) =>- sr -> (a -> a1 -> b) -> m (m1 b)+mkLapseReader+ :: (ReadRef sr m a, HasRef m, Monad m) =>+ sr -> (a -> a -> b) -> m (m b) mkLapseReader var f = do- startVal <- readRef var- prevRef <- newRef startVal+ startVal <- readReference var+ prevRef <- newRef startVal+ + return $ do+ newVal <- readReference var+ prevVal <- readRef prevRef - return $ do- newVal <- readRef var- prevVal <- readDefaultRef prevRef- - writeRef prevRef newVal- - return (f newVal prevVal)+ writeReference prevRef newVal+ + return (f newVal prevVal)
− src/Data/StateRef/Classes.hs
@@ -1,76 +0,0 @@-{-- - ``Data/StateRef/Classes''- - (c) 2008 Cook, J. MR SSD, Inc.- -}-{-# LANGUAGE - MultiParamTypeClasses,- FunctionalDependencies- #-}--module Data.StateRef.Classes where--class Monad m => NewRef sr m a | sr -> a where- -- |Construct a new mutable reference containing the provided value.- newRef :: a -> m sr--class Monad m => WriteRef sr m a | sr -> a where- -- |Replace the existing value of the given reference with the provided value.- writeRef :: sr -> a -> m ()--class Monad m => ReadRef sr m a | sr -> a where- -- |Get the current value referenced by the given state reference.- readRef :: sr -> m a---- consider whether there needs to be something along the lines of--- 'atomicModifyIORef' and/or 'modifyMVar' (specifically, what is the--- motivation for the signature of atomicModifyIORef? and is there a--- downside to providing a signature like that to modifyRef?)--class (Monad m, ReadRef sr m a, WriteRef sr m a) => ModifyRef sr m a | sr -> a where- -- |Atomically modify the contents of a reference. This is- -- implemented in a separate class (rather than a function with- -- context (ReadRef sr m a, WriteRef sr m a)) because in most- -- cases the default implementation cannot act atomically.- atomicModifyRef :: sr -> (a -> (a,b)) -> m b- atomicModifyRef ref f = do- x <- readRef ref- let (x', b) = f x- writeRef ref x'- return b- - -- |Same thing, but don't thread out the extra return. Could perhaps- -- be implemented slightly more efficiently than 'atomicModifyRef' in many cases.- -- Note that implementations are expected to be atomic, if at all possible,- -- but not strictly required to be.- modifyRef :: sr -> (a -> a) -> m ()- modifyRef ref f = do- x <- readRef ref- let x' = f x- writeRef ref x'- return ()---- |The 'DefaultStateRef' and 'Data.MRef.Classes.DefaultMRef' are used to --- internally constrain types that do not escape an expression, so that the --- compiler may choose an instance for the reference type (which it otherwise--- would not, and maybe not even tell you until you tried to use your--- function). For an example, see the source for 'Data.StateRef.newCounter'.--- See also 'Data.MRef.Classes.DefaultMRef'.--- --- The sole purpose for these classes' existence is as a carrier for an--- altered set of functional dependencies, which constrain the reference--- type to be uniquely determined by the monad and the contained type.-class Monad m => DefaultStateRef sr m a | sr -> a, m a -> sr------- in the absence of type families, it'd be nice to be able to say --- something like:------ type StateRef m a = --- ( DefaultStateRef sr m a--- , ReadRef sr m a--- , WriteRef sr m a--- ) => sr------ this would ease the transition to type families later, assuming--- they catch on.---
src/Data/StateRef/Instances.hs view
@@ -1,7 +1,3 @@-{-- - ``Data/StateRef/Instances''- - (c) 2008 Cook, J. MR SSD, Inc.- -} {-# LANGUAGE CPP, MultiParamTypeClasses,@@ -15,29 +11,29 @@ -- TODO: add millions of SPECIALIZE INSTANCE pragmas, for IO monad at -- a minimum. module Data.StateRef.Instances- ( IORef- , MVar- , MonadIO(..)- - , STRef- , ST- , RealWorld- - , ForeignPtr- + ( IORef+ , MVar+ , MonadIO(..)+ + , STRef+ , ST+ , RealWorld+ + , ForeignPtr+ #ifdef useSTM- , module Data.StateRef.Instances.STM+ , module Data.StateRef.Instances.STM #endif- - , module Data.StateRef.Instances.Undecidable- - ) where+ + , module Data.StateRef.Instances.Undecidable+ + ) where #ifdef useSTM import Data.StateRef.Instances.STM #endif -import Data.StateRef.Classes+import Data.StateRef.Types import Data.StateRef.Instances.Undecidable import Data.IORef@@ -53,81 +49,120 @@ import Foreign.Storable import Foreign.ForeignPtr +-- @Ref m@ in @m@:+instance HasRef m => NewRef (Ref m a) m a where+ newReference = newRef+instance ReadRef (Ref m a) m a where+ readReference (Ref sr) = readReference sr+instance WriteRef (Ref m a) m a where+ writeReference (Ref sr) = writeReference sr+instance ModifyRef (Ref m a) m a where+ atomicModifyReference (Ref sr) = atomicModifyReference sr+ modifyReference (Ref sr) = modifyReference sr+ -- m a in semi-arbitrary monad m -- (cannot have instance Monad m => ReadRef (m a) m a, because this activates -- functional dependencies that would overconstrain totally unrelated instances -- because of the possibility of the future addition of, e.g., instance Monad TMVar) instance Monad m => NewRef (IO a) m a where- newRef ro = return (return ro)+ newReference ro = return (return ro) instance MonadIO m => ReadRef (IO a) m a where- readRef = liftIO+ readReference = liftIO instance Monad m => NewRef (ST s a) m a where- newRef ro = return (return ro)+ newReference ro = return (return ro) instance ReadRef (ST s a) (ST s) a where- readRef = id+ readReference = id instance MonadIO m => ReadRef (ST RealWorld a) m a where- readRef = liftIO . stToIO+ readReference = liftIO . stToIO -- IORef in IO-compatible monads-instance DefaultStateRef (IORef a) IO a+instance HasRef IO where+ newRef x = do+ sr <- newIORef x+ return (Ref sr) instance MonadIO m => NewRef (IORef a) m a where- newRef = liftIO . newIORef+ newReference = liftIO . newIORef instance MonadIO m => ReadRef (IORef a) m a where- readRef = liftIO . readIORef+ readReference = liftIO . readIORef instance MonadIO m => WriteRef (IORef a) m a where- writeRef r = liftIO . writeIORef r+ writeReference r = liftIO . writeIORef r instance MonadIO m => ModifyRef (IORef a) m a where- atomicModifyRef r = liftIO . atomicModifyIORef r- modifyRef r = liftIO . modifyIORef r+ atomicModifyReference r = liftIO . atomicModifyIORef r+ modifyReference r = liftIO . modifyIORef r +-- @Ref IO@ in IO-compatible monads+-- (maybe...)+-- instance MonadIO m => NewRef (Ref IO a) m a where+-- newReference (Ref sr) = liftIO (newIORef sr)+-- instance MonadIO m => ReadRef (Ref IO a) m a where+-- readReference (Ref sr) = liftIO (readIORef sr)+-- instance MonadIO m => WriteRef (Ref IO a) m a where+-- writeReference (Ref sr) = liftIO . writeIORef sr+-- instance MonadIO m => ModifyRef (Ref IO a) m a where+-- atomicModifyReference (Ref sr) = liftIO . atomicModifyIORef sr+-- modifyReference (Ref sr) = liftIO . modifyIORef sr+ -- (STRef s) in (ST s) monad-instance DefaultStateRef (STRef s a) (ST s) a+instance HasRef (ST s) where+ newRef x = do+ sr <- newSTRef x+ return (Ref sr) instance NewRef (STRef s a) (ST s) a where- newRef = newSTRef+ newReference = newSTRef instance ReadRef (STRef s a) (ST s) a where- readRef = readSTRef+ readReference = readSTRef instance WriteRef (STRef s a) (ST s) a where- writeRef = writeSTRef+ writeReference = writeSTRef instance ModifyRef (STRef s a) (ST s) a where+ atomicModifyReference = defaultAtomicModifyReference+ modifyReference = defaultModifyReference -- (STRef RealWorld) in IO monad (not MonadIO instances, because the m -- would overlap with (ST s) even though there's no instance MonadIO (ST a)) instance NewRef (STRef RealWorld a) IO a where- newRef = stToIO . newRef+ newReference = stToIO . newReference instance ReadRef (STRef RealWorld a) IO a where- readRef = stToIO . readRef+ readReference = stToIO . readReference instance WriteRef (STRef RealWorld a) IO a where- writeRef r = stToIO . writeRef r+ writeReference r = stToIO . writeReference r instance ModifyRef (STRef RealWorld a) IO a where- modifyRef r = stToIO . modifyRef r+ modifyReference r = stToIO . modifyReference r+ atomicModifyReference r = stToIO . atomicModifyReference r -- (STRef s) in lazy (ST s) monad-instance DefaultStateRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a+instance HasRef (Control.Monad.ST.Lazy.ST s) where+ newRef x = do+ sr <- Data.STRef.Lazy.newSTRef x+ return (Ref sr) instance NewRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where- newRef = Data.STRef.Lazy.newSTRef+ newReference = Data.STRef.Lazy.newSTRef instance ReadRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where- readRef = Data.STRef.Lazy.readSTRef+ readReference = Data.STRef.Lazy.readSTRef instance WriteRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where- writeRef = Data.STRef.Lazy.writeSTRef+ writeReference = Data.STRef.Lazy.writeSTRef instance ModifyRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where+ atomicModifyReference = defaultAtomicModifyReference+ modifyReference = defaultModifyReference -- MVar in IO-compatible monads (constructable but not usable as a "normal" state ref) instance MonadIO m => NewRef (MVar a) m (Maybe a) where- newRef Nothing = liftIO newEmptyMVar- newRef (Just x) = liftIO (newMVar x)+ newReference Nothing = liftIO newEmptyMVar+ newReference (Just x) = liftIO (newMVar x) -- ForeignPtrs, Ptrs, etc., in IO-compatible monads instance (Storable a, MonadIO m) => NewRef (ForeignPtr a) m a where- newRef val = liftIO $ do- ptr <- mallocForeignPtr- withForeignPtr ptr (\ptr -> poke ptr val)- return ptr+ newReference val = liftIO $ do+ ptr <- mallocForeignPtr+ withForeignPtr ptr (\ptr -> poke ptr val)+ return ptr instance (Storable a, MonadIO m) => ReadRef (ForeignPtr a) m a where- readRef ptr = liftIO (withForeignPtr ptr peek)+ readReference ptr = liftIO (withForeignPtr ptr peek) instance (Storable a, MonadIO m) => WriteRef (ForeignPtr a) m a where- writeRef ptr val = liftIO (withForeignPtr ptr (\ptr -> poke ptr val))-instance (Storable a, MonadIO m) => ModifyRef (ForeignPtr a) m a+ writeReference ptr val = liftIO (withForeignPtr ptr (\ptr -> poke ptr val))+instance (Storable a, MonadIO m) => ModifyRef (ForeignPtr a) m a where+ atomicModifyReference = defaultAtomicModifyReference+ modifyReference = defaultModifyReference -- this is an instance I would like to make, but it opens -- a big can of worms... it requires incoherent instances, for one.@@ -144,12 +179,12 @@ -- StateRef s2 m a) -- => StateRef (s1 -> s2) m a -- where--- readRef f = do+-- readReference f = do -- s1 <- get--- readRef (f s1)--- writeRef f val = do+-- readReference (f s1)+-- writeReference f val = do -- s1 <- get--- writeRef (f s1) val--- modifyRef f g = do+-- writeReference (f s1) val+-- modifyReference f g = do -- s1 <- get--- modifyRef (f s1) g+-- modifyReference (f s1) g
src/Data/StateRef/Instances/STM.hs view
@@ -1,7 +1,3 @@-{-- - ``Data/StateRef/Instances/STM''- - (c) 2008 Cook, J. MR SSD, Inc.- -} {-# LANGUAGE CPP, MultiParamTypeClasses,@@ -23,59 +19,76 @@ -- abandon hugs support) module Data.StateRef.Instances.STM- ( STM- , TVar+ ( STM+ , TVar #ifdef useTMVar- , TMVar+ , TMVar #endif- - , atomically- ) where--import Data.StateRef.Classes+ + , atomically+ ) where +import Data.StateRef.Types import Control.Monad.Trans- import Control.Concurrent.STM -- (STM a) in STM and IO-compatible monads instance ReadRef (STM a) STM a where- readRef = id+ readReference = id instance MonadIO m => ReadRef (STM a) m a where- readRef = liftIO . atomically+ readReference = liftIO . atomically -- TVar in STM monad-instance DefaultStateRef (TVar a) STM a+instance HasRef STM where+ newRef x = do+ sr <- newTVar x+ return (Ref sr) instance NewRef (TVar a) STM a where- newRef = newTVar+ newReference = newTVar instance ReadRef (TVar a) STM a where- readRef = readTVar+ readReference = readTVar instance WriteRef (TVar a) STM a where- writeRef = writeTVar-instance ModifyRef (TVar a) STM a+ writeReference = writeTVar+instance ModifyRef (TVar a) STM a where+ atomicModifyReference = defaultAtomicModifyReference+ modifyReference = defaultModifyReference -- TVar in IO-compatible monads instance MonadIO m => NewRef (TVar a) m a where- newRef = liftIO . newTVarIO+ newReference = liftIO . newTVarIO instance MonadIO m => ReadRef (TVar a) m a where- readRef = liftIO . atomically . readRef+ readReference = liftIO . atomically . readReference instance MonadIO m => WriteRef (TVar a) m a where- writeRef ref = liftIO . atomically . writeRef ref+ writeReference ref = liftIO . atomically . writeReference ref instance MonadIO m => ModifyRef (TVar a) m a where- modifyRef ref = liftIO . atomically . modifyRef ref+ modifyReference ref = liftIO . atomically . modifyReference ref+ atomicModifyReference ref = liftIO . atomically . atomicModifyReference ref +-- @Ref STM@ in IO-compatible monads+instance MonadIO m => NewRef (Ref STM a) m a where+ newReference x = do+ sr <- liftIO (newTVarIO x)+ return (Ref sr)+instance MonadIO m => ReadRef (Ref STM a) m a where+ readReference (Ref sr) = liftIO (atomically (readReference sr))+instance MonadIO m => WriteRef (Ref STM a) m a where+ writeReference (Ref sr) = liftIO . atomically . writeReference sr+instance MonadIO m => ModifyRef (Ref STM a) m a where+ modifyReference (Ref sr) = liftIO . atomically . modifyReference sr+ atomicModifyReference (Ref sr) = liftIO . atomically . atomicModifyReference sr+ #ifdef useTMVar -- TMVar in STM monad instance NewRef (TMVar a) STM (Maybe a) where- newRef Nothing = newEmptyTMVar- newRef (Just x) = newTMVar x+ newReference Nothing = newEmptyTMVar+ newReference (Just x) = newTMVar x instance ReadRef (TMVar a) STM (Maybe a) where- readRef tmv = fmap Just (readTMVar tmv) `orElse` return Nothing+ readReference tmv = fmap Just (readTMVar tmv) `orElse` return Nothing -- TMVar in IO-compatible monad instance MonadIO m => NewRef (TMVar a) m (Maybe a) where- newRef Nothing = liftIO newEmptyTMVarIO- newRef (Just x) = liftIO (newTMVarIO x)+ newReference Nothing = liftIO newEmptyTMVarIO+ newReference (Just x) = liftIO (newTMVarIO x) instance MonadIO m => ReadRef (TMVar a) m (Maybe a) where- readRef = liftIO . atomically . readRef+ readReference = liftIO . atomically . readReference #endif
src/Data/StateRef/Instances/Undecidable.hs view
@@ -1,7 +1,3 @@-{-- - ``Data/StateRef/Instances/Undecidable''- - (c) 2008 Cook, J. MR SSD, Inc.- -} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,@@ -10,15 +6,17 @@ module Data.StateRef.Instances.Undecidable where -import Data.StateRef.Classes+import Data.StateRef.Types -- |Wrap a state reference that supports reading and writing, and add a -- potentially thread-unsafe 'ModifyRef' instance. newtype UnsafeModifyRef sr = UnsafeModifyRef sr instance ReadRef sr m a => ReadRef (UnsafeModifyRef sr) m a where- readRef (UnsafeModifyRef sr) = readRef sr+ readReference (UnsafeModifyRef sr) = readReference sr instance WriteRef sr m a => WriteRef (UnsafeModifyRef sr) m a where- writeRef (UnsafeModifyRef sr) = writeRef sr-instance (ReadRef sr m a, WriteRef sr m a) => ModifyRef (UnsafeModifyRef sr) m a+ writeReference (UnsafeModifyRef sr) = writeReference sr+instance (Monad m, ReadRef sr m a, WriteRef sr m a) => ModifyRef (UnsafeModifyRef sr) m a where+ atomicModifyReference = defaultAtomicModifyReference+ modifyReference = defaultModifyReference
+ src/Data/StateRef/Types.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE + MultiParamTypeClasses,+ FunctionalDependencies,+ GADTs+ #-}++module Data.StateRef.Types where++-- |A simple reference type, hiding the complexity of all these type classes,+-- since most of the time the only thing you care about is that you want a reference.+-- The full complexity is still there, though, so FFI types or other reference-like+-- things can still be made into 'Ref's.+data Ref m a where+ Ref :: ModifyRef sr m a => !sr -> Ref m a++class WriteRef sr m a | sr -> a where+ -- |Replace the existing value of the given reference with the provided value.+ writeReference :: sr -> a -> m ()++class ReadRef sr m a | sr -> a where+ -- |Get the current value referenced by the given state reference.+ readReference :: sr -> m a++class (ReadRef sr m a, WriteRef sr m a) => ModifyRef sr m a | sr -> a where+ -- |Atomically modify the contents of a reference. This is+ -- implemented in a separate class (rather than a function with+ -- context (ReadRef sr m a, WriteRef sr m a)) because in most+ -- cases the default implementation cannot act atomically.+ atomicModifyReference :: sr -> (a -> (a,b)) -> m b+ + -- |Same thing, but don't thread out the extra return. Could perhaps+ -- be implemented slightly more efficiently than 'atomicModifyReference' in many cases.+ -- Note that implementations are expected to be atomic, if at all possible,+ -- but not strictly required to be.+ modifyReference :: sr -> (a -> a) -> m ()++-- |Default implementation of atomicModifyReference in terms of readReference and writeReference+defaultAtomicModifyReference ref f = do+ x <- readReference ref+ let (x', b) = f x+ writeReference ref x'+ return b++-- |Default implementation of modifyReference in terms of readReference and writeReference+defaultModifyReference ref f = do+ x <- readReference ref+ let x' = f x+ writeReference ref x'+ return ()++class NewRef sr m a | sr -> a where+ -- |Construct a new reference to the provided value.+ newReference :: a -> m sr++class HasRef m where+ -- |Construct a new mutable reference (of an unspecified implementation type) containing the provided value.+ newRef :: a -> m (Ref m a)
stateref.cabal view
@@ -1,21 +1,30 @@ name: stateref-version: 0.2.1.1+version: 0.3 stability: provisional-license: BSD3-license-file: LICENSE+license: PublicDomain cabal-version: >= 1.2 build-type: Simple author: James Cook <mokus@deepbondi.net> maintainer: James Cook <mokus@deepbondi.net>-homepage: http://darcs.deepbondi.net/stateref+homepage: http://code.haskell.org/~mokus/stateref/ category: Data synopsis: Abstraction for things that work like IORef. description: A collection of type-classes generalizing the read\/write\/modify operations for stateful variables- provided by things like IORef, TVar, &c.+ provided by things like IORef, TVar, &c. + + Note that The interface has changed a bit from the+ 0.2.* version. \"*Ref\" functions are now called + \"*Reference\" and new \"*Ref\" function exist with + simpler signatures.+ + The new 'Ref' existential type provides a convenient+ monad-indexed reference type, and the HasRef class+ indicates monads for which there is a default+ reference type for every referent. tested-with: GHC @@ -24,8 +33,8 @@ Default: True Flag useTMVar- Description: Include instances for TMVar (TMVar not available- in hugs' stm implementation). I have been unable to+ Description: Include instances for TMVar (TMVar is not available+ in hugs' STM implementation). I have been unable to make this flag's value depend on whether or not you're running hugs, so if you are, you'll just have to change it manually. It'd sure be nice if there@@ -49,10 +58,10 @@ exposed-modules: Data.Accessor Data.StateRef- Data.StateRef.Classes+ Data.StateRef.Types Data.StateRef.Instances Data.MRef- Data.MRef.Classes+ Data.MRef.Types Data.MRef.Instances other-modules: Data.StateRef.Instances.Undecidable @@ -67,6 +76,6 @@ if impl(hugs) buildable: False - build-depends: base, mtl+ build-depends: base >= 3 && <5, mtl if flag(useSTM) build-depends: stm