StateVar 1.1.0.0 → 1.1.0.1
raw patch · 6 files changed
+377/−361 lines, 6 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +23/−5
- LICENSE +29/−29
- README.md +1/−1
- Setup.hs +2/−2
- StateVar.cabal +46/−46
- src/Data/StateVar.hs +276/−278
CHANGELOG.md view
@@ -1,5 +1,23 @@-1.1-----* Melded the API of `foreign-var` 0.1 with the API of `StateVar` 1.0.1.1-* Introduced `HasUpdate`, which permits a wider array of uses of these combinators, including usecases that must update atomically.-* Switched to multi-parameter typeclasses. This permits `Ptr a` to be directly employed as an instance of `HasGetter`, `HasUpdate`, and `HasSetter`.+1.1.0.1 +------- +* Documentation changes only. + +1.1.0.0 +------- +* Melded the API of `foreign-var` 0.1 with the API of `StateVar` 1.0.1.1 +* Introduced `HasUpdate`, which permits a wider array of uses of these combinators, including usecases that must update atomically. +* Switched to multi-parameter typeclasses. This permits `Ptr a` to be directly employed as an instance of `HasGetter`, `HasUpdate`, and `HasSetter`. + +1.0.1.1 +------- +* Infrastructure changes only. + +1.0.1.0 +------- +* Exposed `GettableStateVar`, `SettableStateVar` and `StateVar` constructors to make writing own instances possible. +* Added `Functor`, `Applicative` and `Monad` instances for `GettableStateVar`. +* Various infrastructure improvements. + +1.0.0.0 +------- +* Initial release.
LICENSE view
@@ -1,29 +1,29 @@-Copyright (c) 2014-2015, Edward Kmett-Copyright (c) 2009-2014, Sven Panne-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 its contributors may be- used to endorse or promote products derived from this software without- specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER 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.+Copyright (c) 2014-2015, Edward Kmett +Copyright (c) 2009-2014, Sven Panne +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 its contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER 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.
README.md view
@@ -1,1 +1,1 @@-[](https://hackage.haskell.org/package/StateVar) [](https://travis-ci.org/haskell-opengl/StateVar)+[](https://hackage.haskell.org/package/StateVar) [](https://travis-ci.org/haskell-opengl/StateVar)
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
StateVar.cabal view
@@ -1,46 +1,46 @@-name: StateVar-version: 1.1.0.0-synopsis: State variables-description:- This package contains state variables, which are references in the IO monad,- like IORefs or parts of the OpenGL state.-homepage: https://github.com/haskell-opengl/StateVar-bug-reports: https://github.com/haskell-opengl/StateVar/issues-copyright: Copyright (C) 2014-2015 Edward A. Kmett, 2009-2014 Sven Panne-license: BSD3-license-file: LICENSE-author: Sven Panne and Edward Kmett-maintainer: Sven Panne <svenpanne@gmail.com>-category: Data-build-type: Simple-cabal-version: >=1.10-extra-source-files: README.md CHANGELOG.md--library- exposed-modules:- Data.StateVar-- build-depends:- base >= 4 && < 5,- stm >= 2.0 && < 2.5,- transformers >= 0.2 && < 0.5-- default-language: Haskell2010- other-extensions:- CPP- DeriveDataTypeable- MultiParamTypeClasses- FunctionalDependencies- FlexibleInstances- TypeFamilies-- hs-source-dirs: src- ghc-options: -Wall-- if impl(ghc>=7.4)- -- other-extensions: DefaultSignatures- cpp-options: -DUSE_DEFAULT_SIGNATURES=1--source-repository head- type: git- location: https://github.com/haskell-opengl/StateVar.git+name: StateVar +version: 1.1.0.1 +synopsis: State variables +description: + This package contains state variables, which are references in the IO monad, + like IORefs or parts of the OpenGL state. +homepage: https://github.com/haskell-opengl/StateVar +bug-reports: https://github.com/haskell-opengl/StateVar/issues +copyright: Copyright (C) 2014-2015 Edward A. Kmett, 2009-2015 Sven Panne +license: BSD3 +license-file: LICENSE +author: Sven Panne and Edward Kmett +maintainer: Sven Panne <svenpanne@gmail.com> +category: Data +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md CHANGELOG.md + +library + exposed-modules: + Data.StateVar + + build-depends: + base >= 4 && < 5, + stm >= 2.0 && < 2.5, + transformers >= 0.2 && < 0.5 + + default-language: Haskell2010 + other-extensions: + CPP + DeriveDataTypeable + MultiParamTypeClasses + FunctionalDependencies + FlexibleInstances + TypeFamilies + + hs-source-dirs: src + ghc-options: -Wall + + if impl(ghc>=7.4) + -- other-extensions: DefaultSignatures + cpp-options: -DUSE_DEFAULT_SIGNATURES=1 + +source-repository head + type: git + location: https://github.com/haskell-opengl/StateVar.git
src/Data/StateVar.hs view
@@ -1,278 +1,276 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}-#if USE_DEFAULT_SIGNATURES-{-# LANGUAGE DefaultSignatures #-}-#endif-{-# LANGUAGE TypeFamilies #-}------------------------------------------------------------------------------------ |--- Module : Data.StateVar--- Copyright : (c) Edward Kmett 2014-2015, Sven Panne 2009-2014--- License : BSD3--- --- Maintainer : Sven Panne <svenpanne@gmail.com>--- Stability : stable--- Portability : portable------ State variables are references in the IO monad, like 'IORef's or parts of--- the OpenGL state. Note that state variables are not neccessarily writable or--- readable, they may come in read-only or write-only flavours, too. As a very--- simple example for a state variable, consider an explicitly allocated memory--- buffer. This buffer could easily be converted into a 'StateVar':------ @--- makeStateVarFromPtr :: Storable a => Ptr a -> StateVar a--- makeStateVarFromPtr p = makeStateVar (peek p) (poke p)--- @------ The example below puts 11 into a state variable (i.e. into the buffer),--- increments the contents of the state variable by 22, and finally prints the--- resulting content:------ @--- do p <- malloc :: IO (Ptr Int)--- let v = makeStateVarFromPtr p--- v $= 11--- v $~ (+ 22)--- x <- get v--- print x--- @------ However, 'Ptr' can be used directly through the same API:------ @--- do p <- malloc :: IO (Ptr Int)--- p $= 11--- p $~ (+ 22)--- x <- get p--- print x--- @------ 'IORef's are state variables, too, so an example with them looks extremely--- similiar:------ @--- do v <- newIORef (0 :: Int)--- v $= 11--- v $~ (+ 22)--- x <- get v--- print x--- @-----------------------------------------------------------------------------------module Data.StateVar- (- -- * Readable State Variables- HasGetter(get)- , GettableStateVar, makeGettableStateVar- -- * Writable State Variables- , HasSetter(($=)), ($=!)- , SettableStateVar(SettableStateVar), makeSettableStateVar- -- * Updatable State Variables- , HasUpdate(($~), ($~!))- , StateVar(StateVar), makeStateVar- , mapStateVar- ) where--import Control.Concurrent.STM-import Control.Monad.IO.Class-import Data.IORef-import Data.Typeable-import Foreign.Ptr-import Foreign.Storable------------------------------------------------------------------------- * StateVar------------------------------------------------------------------------- | A concrete implementation of a readable and writable state variable,--- carrying one IO action to read the value and another IO action to write the--- new value.------ This data type represents a piece of mutable, imperative state--- with possible side-effects. These tend to encapsulate all sorts--- tricky behavior in external libraries, and may well throw--- exceptions.------ Inhabitants __should__ satsify the following properties.------ In the absence of concurrent mutation from other threads or a--- thrown exception:------ @--- do x <- 'get' v; v '$=' y; v '$=' x--- @------ should restore the previous state.------ Ideally, in the absence of thrown exceptions:------ @--- v '$=' a >> 'get' v--- @------ should return @a@, regardless of @a@. In practice some 'StateVar's only--- permit a very limited range of value assignments, and do not report failure.-data StateVar a = StateVar (IO a) (a -> IO ()) deriving Typeable---- | Construct a 'StateVar' from two IO actions, one for reading and one for---- writing.-makeStateVar- :: IO a -- ^ getter- -> (a -> IO ()) -- ^ setter- -> StateVar a-makeStateVar = StateVar---- | Change the type of a 'StateVar'-mapStateVar :: (b -> a) -> (a -> b) -> StateVar a -> StateVar b-mapStateVar ba ab (StateVar ga sa) = StateVar (fmap ab ga) (sa . ba)-{-# INLINE mapStateVar #-}---- | A concrete implementation of a write-only state variable, carrying an IO--- action to write the new value.-newtype SettableStateVar a = SettableStateVar (a -> IO ())- deriving Typeable---- | Construct a 'SettableStateVar' from an IO action for writing.-makeSettableStateVar- :: (a -> IO ()) -- ^ setter- -> SettableStateVar a-makeSettableStateVar = SettableStateVar-{-# INLINE makeSettableStateVar #-}---- | A concrete implementation of a read-only state variable is simply an IO--- action to read the value.-type GettableStateVar = IO---- | Construct a 'GettableStateVar' from an IO action.-makeGettableStateVar- :: IO a -- ^ getter- -> GettableStateVar a-makeGettableStateVar = id-{-# INLINE makeGettableStateVar #-}------------------------------------------------------------------------- * HasSetter-----------------------------------------------------------------------infixr 2 $=, $=!---- | This is the class of all writable state variables.-class HasSetter t a | t -> a where- -- | Write a new value into a state variable.- ($=) :: MonadIO m => t -> a -> m ()---- | This is a variant of '$=' which is strict in the value to be set.-($=!) :: (HasSetter t a, MonadIO m) => t -> a -> m ()-p $=! a = (p $=) $! a-{-# INLINE ($=!) #-}--instance HasSetter (SettableStateVar a) a where- SettableStateVar f $= a = liftIO (f a)- {-# INLINE ($=) #-}--instance HasSetter (StateVar a) a where- StateVar _ s $= a = liftIO $ s a- {-# INLINE ($=) #-}--instance Storable a => HasSetter (Ptr a) a where- p $= a = liftIO $ poke p a- {-# INLINE ($=) #-}--instance HasSetter (IORef a) a where- p $= a = liftIO $ writeIORef p a- {-# INLINE ($=) #-}--instance HasSetter (TVar a) a where- p $= a = liftIO $ atomically $ writeTVar p a- {-# INLINE ($=) #-}------------------------------------------------------------------------- * HasUpdate-----------------------------------------------------------------------infixr 2 $~, $~!--class HasSetter t a => HasUpdate t a b | t -> a b where- -- | Transform the contents of a state variable with a given funtion.- ($~) :: MonadIO m => t -> (a -> b) -> m ()-#if USE_DEFAULT_SIGNATURES- default ($~) :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m ()- ($~) = defaultUpdate-#endif- -- | This is a variant of '$~' which is strict in the transformed value.- ($~!) :: MonadIO m => t -> (a -> b) -> m ()-#if USE_DEFAULT_SIGNATURES- default ($~!) :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m ()- ($~!) = defaultUpdateStrict-#endif--defaultUpdate :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m ()-defaultUpdate r f = liftIO $ do- a <- get r- r $= f a--defaultUpdateStrict :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m ()-defaultUpdateStrict r f = liftIO $ do- a <- get r- r $=! f a--instance HasUpdate (StateVar a) a a where- ($~) = defaultUpdate- ($~!) = defaultUpdateStrict--instance Storable a => HasUpdate (Ptr a) a a where- ($~) = defaultUpdate- ($~!) = defaultUpdateStrict--instance HasUpdate (IORef a) a a where- r $~ f = liftIO $ atomicModifyIORef r $ \a -> (f a,())-#if __GLASGOW_HASKELL__ >= 706- r $~! f = liftIO $ atomicModifyIORef' r $ \a -> (f a,())-#else- r $~! f = liftIO $ do- s <- atomicModifyIORef r $ \a -> let s = f a in (s, s)- s `seq` return ()-#endif--instance HasUpdate (TVar a) a a where- r $~ f = liftIO $ atomically $ do- a <- readTVar r- writeTVar r (f a)- r $~! f = liftIO $ atomically $ do- a <- readTVar r- writeTVar r $! f a------------------------------------------------------------------------- * HasGetter-----------------------------------------------------------------------class HasGetter t a | t -> a where- get :: MonadIO m => t -> m a--instance HasGetter (StateVar a) a where- get (StateVar g _) = liftIO g- {-# INLINE get #-}--instance HasGetter (TVar a) a where- get = liftIO . atomically . readTVar- {-# INLINE get #-}--instance HasGetter (IO a) a where- get = liftIO- {-# INLINE get #-}--instance HasGetter (STM a) a where- get = liftIO . atomically- {-# INLINE get #-}--instance Storable a => HasGetter (Ptr a) a where- get = liftIO . peek- {-# INLINE get #-}--instance HasGetter (IORef a) a where- get = liftIO . readIORef- {-# INLINE get #-}+{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} +#if USE_DEFAULT_SIGNATURES +{-# LANGUAGE DefaultSignatures #-} +#endif +{-# LANGUAGE TypeFamilies #-} +-------------------------------------------------------------------------------- +-- | +-- Module : Data.StateVar +-- Copyright : (c) Edward Kmett 2014-2015, Sven Panne 2009-2014 +-- License : BSD3 +-- +-- Maintainer : Sven Panne <svenpanne@gmail.com> +-- Stability : stable +-- Portability : portable +-- +-- State variables are references in the IO monad, like 'IORef's or parts of +-- the OpenGL state. Note that state variables are not neccessarily writable or +-- readable, they may come in read-only or write-only flavours, too. As a very +-- simple example for a state variable, consider an explicitly allocated memory +-- buffer. This buffer could easily be converted into a 'StateVar': +-- +-- @ +-- makeStateVarFromPtr :: Storable a => Ptr a -> StateVar a +-- makeStateVarFromPtr p = makeStateVar (peek p) (poke p) +-- @ +-- +-- The example below puts 11 into a state variable (i.e. into the buffer), +-- increments the contents of the state variable by 22, and finally prints the +-- resulting content: +-- +-- @ +-- do p <- malloc :: IO (Ptr Int) +-- let v = makeStateVarFromPtr p +-- v $= 11 +-- v $~ (+ 22) +-- x <- get v +-- print x +-- @ +-- +-- However, 'Ptr' can be used directly through the same API: +-- +-- @ +-- do p <- malloc :: IO (Ptr Int) +-- p $= 11 +-- p $~ (+ 22) +-- x <- get p +-- print x +-- @ +-- +-- 'IORef's are state variables, too, so an example with them looks extremely +-- similiar: +-- +-- @ +-- do v <- newIORef (0 :: Int) +-- v $= 11 +-- v $~ (+ 22) +-- x <- get v +-- print x +-- @ +-------------------------------------------------------------------------------- + +module Data.StateVar + ( + -- * Readable State Variables + HasGetter(get) + , GettableStateVar, makeGettableStateVar + -- * Writable State Variables + , HasSetter(($=)), ($=!) + , SettableStateVar(SettableStateVar), makeSettableStateVar + -- * Updatable State Variables + , HasUpdate(($~), ($~!)) + , StateVar(StateVar), makeStateVar + , mapStateVar + ) where + +import Control.Concurrent.STM +import Control.Monad.IO.Class +import Data.IORef +import Data.Typeable +import Foreign.Ptr +import Foreign.Storable + +-------------------------------------------------------------------- +-- * StateVar +-------------------------------------------------------------------- + +-- | A concrete implementation of a readable and writable state variable, +-- carrying one IO action to read the value and another IO action to write the +-- new value. This data type represents a piece of mutable, imperative state +-- with possible side-effects. These tend to encapsulate all sorts tricky +-- behavior in external libraries, and may well throw exceptions. Inhabitants +-- __should__ satsify the following properties: +-- +-- * In the absence of concurrent mutation from other threads or a thrown +-- exception: +-- +-- @ +-- do x <- 'get' v; v '$=' y; v '$=' x +-- @ +-- +-- should restore the previous state. +-- +-- * Ideally, in the absence of thrown exceptions: +-- +-- @ +-- v '$=' a >> 'get' v +-- @ +-- +-- should return @a@, regardless of @a@. In practice some 'StateVar's only +-- permit a very limited range of value assignments, and do not report failure. +data StateVar a = StateVar (IO a) (a -> IO ()) deriving Typeable + +-- | Construct a 'StateVar' from two IO actions, one for reading and one for +--- writing. +makeStateVar + :: IO a -- ^ getter + -> (a -> IO ()) -- ^ setter + -> StateVar a +makeStateVar = StateVar + +-- | Change the type of a 'StateVar' +mapStateVar :: (b -> a) -> (a -> b) -> StateVar a -> StateVar b +mapStateVar ba ab (StateVar ga sa) = StateVar (fmap ab ga) (sa . ba) +{-# INLINE mapStateVar #-} + +-- | A concrete implementation of a write-only state variable, carrying an IO +-- action to write the new value. +newtype SettableStateVar a = SettableStateVar (a -> IO ()) + deriving Typeable + +-- | Construct a 'SettableStateVar' from an IO action for writing. +makeSettableStateVar + :: (a -> IO ()) -- ^ setter + -> SettableStateVar a +makeSettableStateVar = SettableStateVar +{-# INLINE makeSettableStateVar #-} + +-- | A concrete implementation of a read-only state variable is simply an IO +-- action to read the value. +type GettableStateVar = IO + +-- | Construct a 'GettableStateVar' from an IO action. +makeGettableStateVar + :: IO a -- ^ getter + -> GettableStateVar a +makeGettableStateVar = id +{-# INLINE makeGettableStateVar #-} + +-------------------------------------------------------------------- +-- * HasSetter +-------------------------------------------------------------------- + +infixr 2 $=, $=! + +-- | This is the class of all writable state variables. +class HasSetter t a | t -> a where + -- | Write a new value into a state variable. + ($=) :: MonadIO m => t -> a -> m () + +-- | This is a variant of '$=' which is strict in the value to be set. +($=!) :: (HasSetter t a, MonadIO m) => t -> a -> m () +p $=! a = (p $=) $! a +{-# INLINE ($=!) #-} + +instance HasSetter (SettableStateVar a) a where + SettableStateVar f $= a = liftIO (f a) + {-# INLINE ($=) #-} + +instance HasSetter (StateVar a) a where + StateVar _ s $= a = liftIO $ s a + {-# INLINE ($=) #-} + +instance Storable a => HasSetter (Ptr a) a where + p $= a = liftIO $ poke p a + {-# INLINE ($=) #-} + +instance HasSetter (IORef a) a where + p $= a = liftIO $ writeIORef p a + {-# INLINE ($=) #-} + +instance HasSetter (TVar a) a where + p $= a = liftIO $ atomically $ writeTVar p a + {-# INLINE ($=) #-} + +-------------------------------------------------------------------- +-- * HasUpdate +-------------------------------------------------------------------- + +infixr 2 $~, $~! + +-- | This is the class of all updatable state variables. +class HasSetter t a => HasUpdate t a b | t -> a b where + -- | Transform the contents of a state variable with a given funtion. + ($~) :: MonadIO m => t -> (a -> b) -> m () +#if USE_DEFAULT_SIGNATURES + default ($~) :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m () + ($~) = defaultUpdate +#endif + -- | This is a variant of '$~' which is strict in the transformed value. + ($~!) :: MonadIO m => t -> (a -> b) -> m () +#if USE_DEFAULT_SIGNATURES + default ($~!) :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m () + ($~!) = defaultUpdateStrict +#endif + +defaultUpdate :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m () +defaultUpdate r f = liftIO $ do + a <- get r + r $= f a + +defaultUpdateStrict :: (MonadIO m, a ~ b, HasGetter t a, HasSetter t a) => t -> (a -> b) -> m () +defaultUpdateStrict r f = liftIO $ do + a <- get r + r $=! f a + +instance HasUpdate (StateVar a) a a where + ($~) = defaultUpdate + ($~!) = defaultUpdateStrict + +instance Storable a => HasUpdate (Ptr a) a a where + ($~) = defaultUpdate + ($~!) = defaultUpdateStrict + +instance HasUpdate (IORef a) a a where + r $~ f = liftIO $ atomicModifyIORef r $ \a -> (f a,()) +#if __GLASGOW_HASKELL__ >= 706 + r $~! f = liftIO $ atomicModifyIORef' r $ \a -> (f a,()) +#else + r $~! f = liftIO $ do + s <- atomicModifyIORef r $ \a -> let s = f a in (s, s) + s `seq` return () +#endif + +instance HasUpdate (TVar a) a a where + r $~ f = liftIO $ atomically $ do + a <- readTVar r + writeTVar r (f a) + r $~! f = liftIO $ atomically $ do + a <- readTVar r + writeTVar r $! f a + +-------------------------------------------------------------------- +-- * HasGetter +-------------------------------------------------------------------- + +-- | This is the class of all readable state variables. +class HasGetter t a | t -> a where + get :: MonadIO m => t -> m a + +instance HasGetter (StateVar a) a where + get (StateVar g _) = liftIO g + {-# INLINE get #-} + +instance HasGetter (TVar a) a where + get = liftIO . atomically . readTVar + {-# INLINE get #-} + +instance HasGetter (IO a) a where + get = liftIO + {-# INLINE get #-} + +instance HasGetter (STM a) a where + get = liftIO . atomically + {-# INLINE get #-} + +instance Storable a => HasGetter (Ptr a) a where + get = liftIO . peek + {-# INLINE get #-} + +instance HasGetter (IORef a) a where + get = liftIO . readIORef + {-# INLINE get #-}