StateVar-transformer (empty) → 1.0.0.0

raw patch · 4 files changed

+241/−0 lines, 4 filesdep +basedep +mtldep +transformerssetup-changed

Dependencies added: base, mtl, transformers

Files

• LICENSE +28/−0
• Setup.hs +2/−0
• StateVar-transformer.cabal +25/−0
• src/Data/StateVar/Trans.hs +186/−0

@@ -0,0 +1,28 @@+Copyright (c) 2009, 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,25 @@+name: StateVar-transformer+version: 1.0.0.0+license: BSD3+license-file: LICENSE+maintainer: HATTORI,HIROKI <seagull.kamome@gmail.com>+homepage: http://github.com/seagull-kamome/StateVar-transformer+bug-reports: http://github.com/seagull-kamome/StateVar-transformer/issues+category: Data+cabal-version: >=1.8+synopsis: State variables+description: StateVar with monad transformer+build-type: Simple++source-repository head+    type: git+    location: git@github.com:seagull-kamome/StateVar-transformer.git++library+    exposed-modules: Data.StateVar.Trans+    hs-Source-Dirs: src+    ghc-options: -Wall+    build-depends: base >= 3 && < 5,+                   transformers,+                   mtl+

@@ -0,0 +1,186 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.StateVar+-- Copyright   :  (c) Sven Panne 2009+--                (c) HATTORI,HIROKI 2014+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  HATTORI, HIROKI <seagull.kamome@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- Data.StateVarがIO専用なのが気にくわないので変換できるようにしただけ+-- +--------------------------------------------------------------------------------++module Data.StateVar.Trans (+   -- * Readable State Variables+   HasGetter(..),+   GettableStateVar, makeGettableStateVar,+   -- * Writable State Variables+   HasSetter(..),+   SettableStateVar, makeSettableStateVar,+   -- * General State Variables+   StateVar, makeStateVar, makePtrVar,+   -- * Utility Functions+   ($~), ($=!), ($~!),+   (&),+   (^=), (^~), (^=!), (^~!), (^.),+   (@=)+) where++import Data.IORef (IORef, readIORef, writeIORef)+import GHC.Conc (STM, TVar, readTVar, writeTVar)+import Data.STRef (STRef, readSTRef, writeSTRef)+import Foreign.Ptr (Ptr)+import Foreign.Storable+import Control.Monad.ST.Safe (ST)+import Control.Monad.Trans (MonadTrans(..))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader.Class (MonadReader(..))++--------------------------------------------------------------------------------++infixr 2 $=++--------------------------------------------------------------------------------++-- | The class of all readable state variables.+class HasGetter g m | g -> m where+   -- | Read the value of a state variable.+   get :: g a -> m a++instance HasGetter IORef IO where+  get = readIORef+  {-# INLINE get #-}+instance HasGetter TVar STM where+  get = readTVar+  {-# INLINE get #-}+instance HasGetter (STRef s) (ST s) where+  get = readSTRef+  {-# INLINE get #-}++-- | A concrete implementation of a read-only state variable, carrying an IO+-- action to read the value.+newtype GettableStateVar m a = GettableStateVar (m a)++instance HasGetter (GettableStateVar m) m where+   get (GettableStateVar g) = g+   {-# INLINE get #-}++-- | Construct a 'GettableStateVar' from an IO action.+makeGettableStateVar :: m a -> GettableStateVar m a+makeGettableStateVar = GettableStateVar+{-# INLINE makeGettableStateVar #-}++--------------------------------------------------------------------------------++-- | The class of all writable state variables.+class HasSetter s m where+   -- | Write a new value into a state variable.+   ($=) :: s a -> a -> m ()++instance HasSetter IORef IO where+  ($=) = writeIORef+  {-# INLINE ($=) #-}+instance HasSetter TVar STM where+  ($=) = writeTVar+  {-# INLINE ($=) #-}+instance HasSetter (STRef s) (ST s) where+  ($=) = writeSTRef+  {-# INLINE ($=) #-}++-- | A concrete implementation of a write-only state variable, carrying an IO+-- action to write the new value.+newtype SettableStateVar m a = SettableStateVar (a -> m ())++instance HasSetter (SettableStateVar m) m where+  ($=) (SettableStateVar s) a = s a+  {-# INLINE ($=) #-}++-- | Construct a 'SettableStateVar' from an IO action.+makeSettableStateVar :: (a -> m ()) -> SettableStateVar m a+makeSettableStateVar = SettableStateVar+{-# INLINE makeSettableStateVar #-}++--------------------------------------------------------------------------------++-- | 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.+data StateVar m a =+  StateVar (GettableStateVar m a) (SettableStateVar m a)++instance HasGetter (StateVar m) m where+  get (StateVar g _) = get g+  {-# INLINE get #-}+instance HasSetter (StateVar m) m where+  ($=) (StateVar _ s) a = s $= a+  {-# INLINE ($=) #-}++-- | Construct a 'StateVar' from two IO actions, one for reading and one for+-- writing.+makeStateVar :: m a -> (a -> m ()) -> StateVar m a+makeStateVar g s = StateVar (makeGettableStateVar g) (makeSettableStateVar s)+{-# INLINE makeStateVar #-}++makePtrVar :: (MonadIO m, Storable a) => Ptr a -> StateVar m a+makePtrVar p = makeStateVar (liftIO $ peek p) (liftIO . poke p)+{-# INLINE makePtrVar #-}++--------------------------------------------------------------------------------++-- | A modificator convenience function, transforming the contents of a state+-- variable with a given funtion.++($~) :: (Monad m, HasGetter v m, HasSetter v m) => v a -> (a -> a) -> m ()+v $~ f = get v >>= ($=) v . f+{-# INLINE ($~) #-}++-- | A variant of '$=' which is strict in the value to be set.+($=!) :: (Monad m, HasSetter s m) => s a -> a -> m ()+v $=! x = x `seq` v $= x+{-# INLINE ($=!) #-}++-- | A variant of '$~' which is strict in the transformed value.+($~!) :: (Monad m, HasGetter v m, HasSetter v m) => v a -> (a -> a) -> m ()+v $~! f = get v >>= ($=!) v . f+{-# INLINE ($~!) #-}++--------------------------------------------------------------------------------++(&) :: s -> (s -> t) -> t+s & t = t s+{-# INLINE (&) #-}++infixl 8 ^=, ^~, ^=!, ^~!, ^.++(^=) :: HasSetter g m => (s -> g a) -> a -> s -> m ()+(fv ^= v) s = fv s $= v+{-# INLINE (^=) #-}++(^~) :: (Monad m, HasGetter g m, HasSetter g m) => (s -> g a) -> (a -> a) -> s -> m ()+(fv ^~ f) s = v $~ f where v = fv s+{-# INLINE (^~) #-}++(^=!) :: (Monad m, HasSetter g m) => (s -> g a) -> a -> s -> m ()+(fv ^=! x) s = v $=! x where v = fv s+{-# INLINE (^=!) #-}++(^~!) :: (Monad m, HasGetter g m, HasSetter g m) => (s -> g a) -> (a ->a) -> s -> m ()+(fv ^~! f) s = v $~! f where v = fv s+{-# INLINE (^~!) #-}++(^.) :: (Monad m, HasGetter g m, HasGetter h m) => (s -> g a) -> (a -> h b) -> s -> GettableStateVar m b+(fg ^. fh) s = makeGettableStateVar $ get (fg s) >>= get . fh+{-# INLINE (^.) #-}++--------------------------------------------------------------------------------++(@=) :: (Monad m, MonadTrans n, MonadReader s (n m), HasSetter g m) => (s -> g a) -> a -> n m ()+fv @= v = ask >>= lift . (fv ^= v)+{-# INLINE (@=) #-}+++