StateVar-1.2.2/src/0000755000000000000000000000000013463557734012243 5ustar0000000000000000StateVar-1.2.2/src/Data/0000755000000000000000000000000014077304223013075 5ustar0000000000000000StateVar-1.2.2/src/Data/StateVar.hs0000644000000000000000000002165714077304223015175 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} #if USE_DEFAULT_SIGNATURES {-# LANGUAGE DefaultSignatures #-} #endif {-# LANGUAGE TypeFamilies #-} -- Foreign.ForeignPtr is unsafe before GHC-7.10 #if __GLASGOW_HASKELL__ >= 704 && MIN_VERSION_base(4,8,0) {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -------------------------------------------------------------------------------- -- | -- Module : Data.StateVar -- Copyright : (c) Edward Kmett 2014-2019, Sven Panne 2009-2021 -- License : BSD3 -- -- Maintainer : Sven Panne -- 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.ForeignPtr import Foreign.Ptr import Foreign.Storable #if MIN_VERSION_base(4,12,0) import Data.Functor.Contravariant #endif -------------------------------------------------------------------- -- * 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 #if MIN_VERSION_base(4,12,0) instance Contravariant SettableStateVar where contramap f (SettableStateVar k) = SettableStateVar (k . f) {-# INLINE contramap #-} #endif -- | 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 ($=) #-} instance Storable a => HasSetter (ForeignPtr a) a where p $= a = liftIO $ withForeignPtr p ($= a) {-# INLINE ($=) #-} -------------------------------------------------------------------- -- * HasUpdate -------------------------------------------------------------------- infixr 2 $~, $~! -- | This is the class of all updatable state variables. class HasSetter t b => 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) => 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) => 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 MIN_VERSION_base(4,6,0) 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 instance Storable a => HasUpdate (ForeignPtr a) a a where p $~ f = liftIO $ withForeignPtr p ($~ f) p $~! f = liftIO $ withForeignPtr p ($~! f) -------------------------------------------------------------------- -- * 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 #-} instance Storable a => HasGetter (ForeignPtr a) a where get p = liftIO $ withForeignPtr p get {-# INLINE get #-} StateVar-1.2.2/README.md0000644000000000000000000000074513463557734012741 0ustar0000000000000000[![Hackage](https://img.shields.io/hackage/v/StateVar.svg)](https://hackage.haskell.org/package/StateVar) [![Stackage LTS](https://www.stackage.org/package/StateVar/badge/lts)](https://www.stackage.org/lts/package/StateVar) [![Stackage nightly](https://www.stackage.org/package/StateVar/badge/nightly)](https://www.stackage.org/nightly/package/StateVar) [![Build Status](https://img.shields.io/travis/haskell-opengl/StateVar/master.svg)](https://travis-ci.org/haskell-opengl/StateVar) StateVar-1.2.2/CHANGELOG.md0000644000000000000000000000240214077303632013247 0ustar00000000000000001.2.2 ----- * Relaxed upper version bound for `transformers`. 1.2.1 ----- * Explicitly mark `Data.StateVar` as Safe (or Trustworthy for GHC before 7.10). 1.2 --- * Added instances for `ForeignPtr`. 1.1.1.1 ------- * Relaxed upper version bound for `stm`. 1.1.1.0 ------- * Track recent move of `Contravariant` to `base`. 1.1.0.4 ------- * Corrected HasUpdate's superclass constraint. 1.1.0.3 ------- * Removed a couple of redundant typeclass constraints. 1.1.0.2 ------- * Relaxed upper version bound for `transformers`. 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. StateVar-1.2.2/LICENSE0000644000000000000000000000277014077304167012457 0ustar0000000000000000Copyright (c) 2014-2015, Edward Kmett Copyright (c) 2009-2021, 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. StateVar-1.2.2/Setup.hs0000644000000000000000000000005613463557734013111 0ustar0000000000000000import Distribution.Simple main = defaultMain StateVar-1.2.2/StateVar.cabal0000644000000000000000000000321114077303712014151 0ustar0000000000000000name: StateVar version: 1.2.2 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-2021 Sven Panne license: BSD3 license-file: LICENSE author: Sven Panne and Edward Kmett maintainer: Sven Panne category: Data build-type: Simple tested-with: GHC == 7.0.4 GHC == 7.2.2 GHC == 7.4.2 GHC == 7.6.3 GHC == 7.8.4 GHC == 7.10.3 GHC == 8.0.2 GHC == 8.2.2 GHC == 8.4.3 GHC == 8.6.5 GHC == 8.8.4 GHC == 8.10.3 GHC == 8.10.4 GHC == 9.0.1 cabal-version: >= 1.10 extra-source-files: README.md CHANGELOG.md library exposed-modules: Data.StateVar build-depends: base >= 4 && < 5, stm >= 2.3.0.1 && < 2.6, transformers >= 0.3 && < 0.7 default-language: Haskell2010 other-extensions: CPP DeriveDataTypeable MultiParamTypeClasses FunctionalDependencies FlexibleInstances TypeFamilies hs-source-dirs: src ghc-options: -Wall if impl(ghc > 8) ghc-options: -Wcompat if impl(ghc>=7.4) -- other-extensions: DefaultSignatures cpp-options: -DUSE_DEFAULT_SIGNATURES=1 if impl(ghc >= 9.0) -- these flags may abort compilation with GHC-8.10 -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295 ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode source-repository head type: git location: https://github.com/haskell-opengl/StateVar.git