packages feed

stateref (empty) → 0.2.1.1

raw patch · 13 files changed

+774/−0 lines, 13 filesdep +basedep +mtldep +stmsetup-changed

Dependencies added: base, mtl, stm

Files

+ LICENSE view
@@ -0,0 +1,28 @@+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.
+ Setup.lhs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain+
+ src/Data/Accessor.hs view
@@ -0,0 +1,28 @@+{-+ -      ``Data/Accessor''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        MultiParamTypeClasses,+        FlexibleInstances+  #-}++module Data.Accessor where++import Data.StateRef.Classes++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++instance Monad m => WriteRef (Setter m a) m a where+        writeRef (Setter f) = f++instance Monad m => ReadRef (Accessor m a) m a where+        readRef (Accessor (Getter x, _)) = x+instance Monad m => WriteRef (Accessor m a) m a where+        writeRef (Accessor (_, Setter f)) = f+
+ src/Data/MRef.hs view
@@ -0,0 +1,31 @@+{-+ -      ``Data/MRef''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}++module Data.MRef +        ( module Data.MRef+        , module Data.MRef.Classes+        , module Data.MRef.Instances+        ) where++import Data.MRef.Classes+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++-- |See 'putMRef'.+putDefaultMRef :: (DefaultMRef sr m a, PutMRef sr m a) => sr -> a -> m ()+putDefaultMRef = putMRef
+ src/Data/MRef/Classes.hs view
@@ -0,0 +1,40 @@+{-+ -      ``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
@@ -0,0 +1,41 @@+{-+ -      ``Data/MRef/Instances''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        CPP,+        MultiParamTypeClasses,+        FlexibleInstances+  #-}++-- |This module exports no new symbols of its own.  It defines +--  basic class instances for creating, reading, and writing 'MVar's, and+--  re-exports 'MVar'.+module Data.MRef.Instances+        ( MVar+        , MonadIO(..)++#ifdef useSTM+        , module Data.MRef.Instances.STM+#endif+        ) where++#ifdef useSTM+import Data.MRef.Instances.STM+#endif++import Data.MRef.Classes++import Control.Concurrent.MVar+import Control.Monad.Trans++-- preferred instances+-- MVar in IO monad+instance DefaultMRef (MVar a) IO a+instance MonadIO m => NewMRef (MVar a) m a where+        newMRef = liftIO . newMVar+        newEmptyMRef = liftIO newEmptyMVar+instance MonadIO m => TakeMRef (MVar a) m a where+	takeMRef = liftIO . takeMVar+instance MonadIO m => PutMRef (MVar a) m a where+	putMRef r = liftIO . putMVar r
+ src/Data/MRef/Instances/STM.hs view
@@ -0,0 +1,87 @@+{-+ -      ``Data/MRef/Instances/STM''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        CPP,+        MultiParamTypeClasses,+        FlexibleInstances+  #-}++-- |This module exports no new symbols of its own.  It defines +--  basic class instances for creating, reading, and writing 'TVar's and+--  (if available) 'TMVar's, and re-exports the types for which it defines +--  instances as well as the 'atomically' function, which is indispensible+--  when playing with this stuff in ghci.+module Data.MRef.Instances.STM+        ( STM+#ifdef useTMVar+        , TMVar+#endif+        , TVar+        +        , atomically+        ) where++import Data.MRef.Classes+import Data.StateRef (readRef, writeRef, newRef)+import Data.StateRef.Instances.STM ()++import Control.Concurrent.STM++#ifdef useTMVar+--TMVar in STM monad+instance DefaultMRef (TMVar a) STM a+instance NewMRef (TMVar a) STM a where+        newMRef = newTMVar+        newEmptyMRef = newEmptyTMVar++instance TakeMRef (TMVar a) STM a where+	takeMRef = takeTMVar+instance PutMRef (TMVar a) STM a where+	putMRef = putTMVar++-- TMVar in IO monad+instance NewMRef (TMVar a) IO a where+        newMRef = newTMVarIO+        newEmptyMRef = newEmptyTMVarIO+        +instance TakeMRef (TMVar a) IO a where+        takeMRef = atomically . takeMRef+instance PutMRef (TMVar a) IO a where+        putMRef ref = atomically . putMRef 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+#endif+instance NewMRef (TVar (Maybe a)) STM a where+        newMRef = newRef . Just+        newEmptyMRef = newRef 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+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++-- TVars containing "Maybe" values in IO monad+instance NewMRef (TVar (Maybe a)) IO a where+        newMRef = newRef . Just+        newEmptyMRef = newRef Nothing+instance TakeMRef (TVar (Maybe a)) IO a where+        takeMRef = atomically . takeMRef+instance PutMRef (TVar (Maybe a)) IO a where+        putMRef ref = atomically . putMRef ref
+ src/Data/StateRef.hs view
@@ -0,0 +1,106 @@+{-+ -      ``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+-- which don't depend on the specific monad or reference type in use.+-- +-- 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++import Data.StateRef.Classes+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++-- |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++-- |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 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+++-- |Essentially the same concept as 'Control.Monad.State.gets',+-- 'Control.Monad.State.asks', et al. Typically useful to read a field of+-- a referenced ADT by passing a record selector as the second argument.+readsRef :: (ReadRef sr m a,+             Monad m) =>+            sr -> (a -> b) -> m b+readsRef r f = do+        x <- readRef 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 n = do+        c <- newRef n+        return $ do+		x <- readDefaultRef c+		writeDefaultRef 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 var f = do+        startVal <- readRef var+        prevRef <- newRef startVal+        +        return $ do+                newVal <- readRef var+                prevVal <- readDefaultRef prevRef+                +                writeRef prevRef newVal+                +                return (f newVal prevVal)
+ src/Data/StateRef/Classes.hs view
@@ -0,0 +1,76 @@+{-+ -      ``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
@@ -0,0 +1,155 @@+{-+ -      ``Data/StateRef/Instances''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        CPP,+        MultiParamTypeClasses,+        FlexibleInstances+  #-}++-- |This module exports no new symbols of its own.  It defines several +--  basic class instances for creating, reading, and writing standard+--  reference types, and re-exports the types for which it defines instances.+--  +--  TODO: add millions of SPECIALIZE INSTANCE pragmas, for IO monad at+--  a minimum.+module Data.StateRef.Instances+        ( IORef+        , MVar+        , MonadIO(..)+        +        , STRef+        , ST+        , RealWorld+        +        , ForeignPtr+        +#ifdef useSTM+        , module Data.StateRef.Instances.STM+#endif+        +        , module Data.StateRef.Instances.Undecidable+        +        ) where++#ifdef useSTM+import Data.StateRef.Instances.STM+#endif++import Data.StateRef.Classes+import Data.StateRef.Instances.Undecidable++import Data.IORef+import Control.Concurrent.MVar++import Control.Monad.Trans+import Control.Monad.ST+import Data.STRef++import qualified Control.Monad.ST.Lazy+import qualified Data.STRef.Lazy++import Foreign.Storable+import Foreign.ForeignPtr++-- 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)+instance MonadIO m => ReadRef (IO a) m a where+        readRef = liftIO++instance Monad m => NewRef (ST s a) m a where+        newRef ro = return (return ro)+instance ReadRef (ST s a) (ST s) a where+        readRef = id+instance MonadIO m => ReadRef (ST RealWorld a) m a where+        readRef = liftIO . stToIO++-- IORef in IO-compatible monads+instance DefaultStateRef (IORef a) IO a+instance MonadIO m => NewRef (IORef a) m a where+        newRef = liftIO . newIORef+instance MonadIO m => ReadRef (IORef a) m a where+        readRef = liftIO . readIORef+instance MonadIO m => WriteRef (IORef a) m a where+        writeRef r = liftIO . writeIORef r+instance MonadIO m => ModifyRef (IORef a) m a where+        atomicModifyRef r = liftIO . atomicModifyIORef r+        modifyRef r = liftIO . modifyIORef r++-- (STRef s) in (ST s) monad+instance DefaultStateRef (STRef s a) (ST s) a+instance NewRef (STRef s a) (ST s) a where+        newRef = newSTRef+instance ReadRef (STRef s a) (ST s) a where+        readRef = readSTRef+instance WriteRef (STRef s a) (ST s) a where+        writeRef = writeSTRef+instance ModifyRef (STRef s a) (ST s) a where++-- (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+instance ReadRef (STRef RealWorld a) IO a where+        readRef = stToIO . readRef+instance WriteRef (STRef RealWorld a) IO a where+        writeRef r = stToIO . writeRef r+instance ModifyRef (STRef RealWorld a) IO a where+        modifyRef r = stToIO . modifyRef r++-- (STRef s) in lazy (ST s) monad+instance DefaultStateRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a+instance NewRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where+        newRef = Data.STRef.Lazy.newSTRef+instance ReadRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where+        readRef = Data.STRef.Lazy.readSTRef+instance WriteRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where+        writeRef = Data.STRef.Lazy.writeSTRef+instance ModifyRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where++-- 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)++-- 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+instance (Storable a, MonadIO m) => ReadRef (ForeignPtr a) m a where+        readRef 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++-- this is an instance I would like to make, but it opens+-- a big can of worms... it requires incoherent instances, for one.+-- perhaps I ought to give up the abstractness of 'sr' in the class+-- definition; i don't know if that gets me anywhere though... +--+-- note that as long as only these instances exist, there is no+-- actual overlap.  maybe it's not such a bad idea.  on the other+-- hand, a corresponding instance for Reader would be nice too, and+-- that would be a duplicate instance (because only the context would+-- differ).+--+-- instance (MonadState s1 m,+--           StateRef s2 m a)+--                 => StateRef (s1 -> s2) m a+--         where+--                 readRef f       = do+--                         s1 <- get+--                         readRef (f s1)+--                 writeRef f val  = do+--                         s1 <- get+--                         writeRef (f s1) val+--                 modifyRef f g = do+--                         s1 <- get+--                         modifyRef (f s1) g
+ src/Data/StateRef/Instances/STM.hs view
@@ -0,0 +1,81 @@+{-+ -      ``Data/StateRef/Instances/STM''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        CPP,+        MultiParamTypeClasses,+        FlexibleInstances,+        IncoherentInstances+  #-}++-- |This module exports no new symbols of its own.  It defines +--  basic class instances for creating, reading, and writing 'TVar's and+--  (if available) 'TMVar's, and re-exports the types for which it defines +--  instances as well as the 'atomically' function, which is indispensible+--  when playing with this stuff in ghci.+--+--  Note that this module declares incoherent instances.  The universe should+--  refrain from imploding on itself as long as you don't define+--  \"instance MonadIO STM\".  However, hugs doesn't seem to support +--  overlapping instances, so I may have to give up on the dream of MonadIO +--  everywhere, or introduce some major conditional compilation stuff. (or+--  abandon hugs support)++module Data.StateRef.Instances.STM+        ( STM+        , TVar+#ifdef useTMVar+        , TMVar+#endif+        +        , atomically+        ) where++import Data.StateRef.Classes++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+instance MonadIO m => ReadRef (STM a) m a where+        readRef = liftIO . atomically++-- TVar in STM monad+instance DefaultStateRef (TVar a) STM a+instance NewRef (TVar a) STM a where+        newRef = newTVar+instance ReadRef (TVar a) STM a where+        readRef = readTVar+instance WriteRef (TVar a) STM a where+        writeRef = writeTVar+instance ModifyRef (TVar a) STM a++-- TVar in IO-compatible monads+instance MonadIO m => NewRef (TVar a) m a where+        newRef = liftIO . newTVarIO+instance MonadIO m => ReadRef (TVar a) m a where+        readRef = liftIO . atomically . readRef+instance MonadIO m => WriteRef (TVar a) m a where+        writeRef ref = liftIO . atomically . writeRef ref+instance MonadIO m => ModifyRef (TVar a) m a where+        modifyRef ref = liftIO . atomically . modifyRef ref++#ifdef useTMVar+-- TMVar in STM monad+instance NewRef (TMVar a) STM (Maybe a) where+	newRef Nothing = newEmptyTMVar+	newRef (Just x) = newTMVar x+instance ReadRef (TMVar a) STM (Maybe a) where+	readRef 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)+instance MonadIO m => ReadRef (TMVar a) m (Maybe a) where+	readRef = liftIO . atomically . readRef+#endif
+ src/Data/StateRef/Instances/Undecidable.hs view
@@ -0,0 +1,24 @@+{-+ -      ``Data/StateRef/Instances/Undecidable''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        MultiParamTypeClasses,+        FlexibleInstances,+        UndecidableInstances+  #-}++module Data.StateRef.Instances.Undecidable where++import Data.StateRef.Classes++-- |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+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+
+ stateref.cabal view
@@ -0,0 +1,72 @@+name:                   stateref+version:                0.2.1.1+stability:              provisional+license:                BSD3+license-file:           LICENSE++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++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.++tested-with:            GHC++Flag useSTM+  Description:          Include instances for STM types+  Default:              True++Flag useTMVar+  Description:          Include instances for TMVar (TMVar 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+                        were either an explicit backtrack command in cabal+                        or if 'buildable:false' would trigger a backtrack.+                        +                        Or if I could say "default: not(impl(hugs))" for this+                        flag.+                        +                        Note that this is irrelevant at the moment because+                        I broke Hugs+STM support by adding MonadIO m => ...+                        instances.  If anyone really wants me to fix it,+                        speak up - but those instances are pretty darn+                        convenient.+                        +  Default:              True++Library+  hs-source-dirs:       src+  extensions:           CPP+  +  exposed-modules:      Data.Accessor+                        Data.StateRef+                        Data.StateRef.Classes+                        Data.StateRef.Instances+                        Data.MRef+                        Data.MRef.Classes+                        Data.MRef.Instances+  other-modules:        Data.StateRef.Instances.Undecidable+  +  if flag(useSTM)+    other-modules:      Data.StateRef.Instances.STM+                        Data.MRef.Instances.STM+    cpp-options:        -DuseSTM+    +    if flag(useTMVar)+      cpp-options:      -DuseTMVar+      +      if impl(hugs)+        buildable:      False+  +  build-depends:        base, mtl+  if flag(useSTM)+    build-depends:      stm