packages feed

lifted-stm (empty) → 0.1

raw patch · 13 files changed

+710/−0 lines, 13 filesdep +arraydep +basedep +monad-finallysetup-changed

Dependencies added: array, base, monad-finally, stm, transformers, transformers-abort, transformers-base, transformers-compat

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2018 Mikhail Vorozhtsov+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+- 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.+- Neither the names of the copyright owners nor the names of the+  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
@@ -0,0 +1,13 @@+Lifted-STM+==========++[![Travis](https://img.shields.io/travis/mvv/lifted-stm/master.svg)](https://travis-ci.org/mvv/lifted-stm) [![Hackage](https://img.shields.io/hackage/v/lifted-stm.svg)](http://hackage.haskell.org/package/lifted-stm)++This package provides STM operations lifted through monad transformer stacks.++Installation+------------+The usual:++	$ cabal install+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lifted-stm.cabal view
@@ -0,0 +1,52 @@+Name: lifted-stm+Version: 0.1+Category: Concurrency+Stability: experimental+Synopsis: STM operations lifted through monad transformer stacks+Description:+  This package provides STM operations lifted through monad transformer+  stacks.++Homepage: https://github.com/mvv/lifted-stm+Bug-Reports: https://github.com/mvv/lifted-stm/issues++Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+Maintainer: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+Copyright: 2018 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+License: BSD3+License-File: LICENSE++Extra-Source-Files:+  README.md++Tested-With: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1++Cabal-Version: >= 1.10.0+Build-Type: Simple++Source-Repository head+  Type: git+  Location: https://github.com/mvv/lifted-stm.git++Library+  Default-Language: Haskell2010+  Build-Depends: base >= 4 && < 5+               , array >= 0.3+               , stm >= 2.4.5+               , transformers >= 0.2+               , transformers-compat >= 0.6.1+               , transformers-base >= 0.4.5.2+               , transformers-abort >= 0.6+               , monad-finally >= 0.1.2+  Hs-Source-Dirs: src+  GHC-Options: -Wall+  Exposed-Modules:+    Control.Monad.STM.Lifted+    Control.Concurrent.STM.TVar.Lifted+    Control.Concurrent.STM.TMVar.Lifted+    Control.Concurrent.STM.TSem.Lifted+    Control.Concurrent.STM.TChan.Lifted+    Control.Concurrent.STM.TQueue.Lifted+    Control.Concurrent.STM.TBQueue.Lifted+    Control.Concurrent.STM.TArray.Lifted+    Control.Concurrent.STM.Lifted
+ src/Control/Concurrent/STM/Lifted.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE UnicodeSyntax #-}++-- | Software Transactional Memory operations lifted through monad+-- transformer stacks.+module Control.Concurrent.STM.Lifted+  ( module Control.Monad.STM.Lifted+  , module Control.Concurrent.STM.TVar.Lifted+  , module Control.Concurrent.STM.TMVar.Lifted+  , module Control.Concurrent.STM.TSem.Lifted+  , module Control.Concurrent.STM.TChan.Lifted+  , module Control.Concurrent.STM.TQueue.Lifted+  , module Control.Concurrent.STM.TBQueue.Lifted+  , module Control.Concurrent.STM.TArray.Lifted+  ) where++import Control.Monad.STM.Lifted+import Control.Concurrent.STM.TVar.Lifted+import Control.Concurrent.STM.TMVar.Lifted+import Control.Concurrent.STM.TSem.Lifted+import Control.Concurrent.STM.TChan.Lifted+import Control.Concurrent.STM.TQueue.Lifted+import Control.Concurrent.STM.TBQueue.Lifted+import Control.Concurrent.STM.TArray.Lifted
+ src/Control/Concurrent/STM/TArray/Lifted.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-orphans #-}+#endif++-- | Lifted 'TArray' operations.+module Control.Concurrent.STM.TArray.Lifted+  ( TArray+  ) where++import Data.Array.Base (MArray(..))+import Control.Monad.Base (MonadBase(..))+import Control.Monad.STM (STM)+import Control.Concurrent.STM.TArray (TArray)++instance {-# OVERLAPPABLE #-} MonadBase STM μ ⇒ MArray TArray e μ where+  getBounds = liftBase . getBounds+  {-# INLINE getBounds #-}+  newArray = (liftBase .) . newArray+  {-# INLINE newArray #-}+  newArray_ = liftBase . newArray_+  {-# INLINE newArray_ #-}+  unsafeRead = (liftBase .) . unsafeRead+  {-# INLINE unsafeRead #-}+  unsafeWrite = ((liftBase .) .) . unsafeWrite+  {-# INLINE unsafeWrite #-}+  getNumElements = liftBase . getNumElements+  {-# INLINE getNumElements #-}
+ src/Control/Concurrent/STM/TBQueue/Lifted.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Lifted 'TBQueue' operations.+module Control.Concurrent.STM.TBQueue.Lifted+  ( TBQueue+  , newTBQueue+  , newTBQueueIO+  , readTBQueue+  , tryReadTBQueue+  , peekTBQueue+  , tryPeekTBQueue+  , flushTBQueue+  , writeTBQueue+  , unGetTBQueue+  , isEmptyTBQueue+  , isFullTBQueue+  ) where++import Control.Monad.Base (MonadBase(..))+import Control.Monad.STM (STM)+import Control.Concurrent.STM.TBQueue (TBQueue)+import qualified Control.Concurrent.STM.TBQueue as STM++-- | A lifted version of 'STM.newTBQueue'.+newTBQueue ∷ MonadBase STM μ ⇒ Int → μ (TBQueue α)+newTBQueue = liftBase . STM.newTBQueue+{-# INLINE newTBQueue #-}++-- | A lifted version of 'STM.newTBQueueIO'.+newTBQueueIO ∷ MonadBase IO μ ⇒ Int → μ (TBQueue α)+newTBQueueIO = liftBase . STM.newTBQueueIO+{-# INLINE newTBQueueIO #-}++-- | A lifted version of 'STM.readTBQueue'.+readTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → μ α+readTBQueue = liftBase . STM.readTBQueue+{-# INLINE readTBQueue #-}++-- | A lifted version of 'STM.tryReadTBQueue'.+tryReadTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → μ (Maybe α)+tryReadTBQueue = liftBase . STM.tryReadTBQueue+{-# INLINE tryReadTBQueue #-}++-- | A lifted version of 'STM.peekTBQueue'.+peekTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → μ α+peekTBQueue = liftBase . STM.peekTBQueue+{-# INLINE peekTBQueue #-}++-- | A lifted version of 'STM.tryPeekTBQueue'.+tryPeekTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → μ (Maybe α)+tryPeekTBQueue = liftBase . STM.tryPeekTBQueue+{-# INLINE tryPeekTBQueue #-}++-- | A lifted version of 'STM.flushTBQueue'.+flushTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → μ [α]+flushTBQueue = liftBase . STM.flushTBQueue+{-# INLINE flushTBQueue #-}++-- | A lifted version of 'STM.writeTBQueue'.+writeTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → α → μ ()+writeTBQueue = (liftBase .) . STM.writeTBQueue+{-# INLINE writeTBQueue #-}++-- | A lifted version of 'STM.unGetTBQueue'.+unGetTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → α → μ ()+unGetTBQueue = (liftBase .) . STM.unGetTBQueue+{-# INLINE unGetTBQueue #-}++-- | A lifted version of 'STM.isEmptyTBQueue'.+isEmptyTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → μ Bool+isEmptyTBQueue = liftBase . STM.isEmptyTBQueue+{-# INLINE isEmptyTBQueue #-}++-- | A lifted version of 'STM.isFullTBQueue'.+isFullTBQueue ∷ MonadBase STM μ ⇒ TBQueue α → μ Bool+isFullTBQueue = liftBase . STM.isFullTBQueue+{-# INLINE isFullTBQueue #-}
+ src/Control/Concurrent/STM/TChan/Lifted.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Lifted 'TChan' operations.+module Control.Concurrent.STM.TChan.Lifted+  ( TChan+  , newTChan+  , newTChanIO+  , newBroadcastTChan+  , newBroadcastTChanIO+  , dupTChan+  , cloneTChan+  , readTChan+  , tryReadTChan+  , peekTChan+  , tryPeekTChan+  , writeTChan+  , unGetTChan+  , isEmptyTChan+  ) where++import Control.Monad.Base (MonadBase(..))+import Control.Monad.STM (STM)+import Control.Concurrent.STM.TChan (TChan)+import qualified Control.Concurrent.STM.TChan as STM++-- | A lifted version of 'STM.newTChan'.+newTChan ∷ MonadBase STM μ ⇒ μ (TChan α)+newTChan = liftBase STM.newTChan+{-# INLINE newTChan #-}++-- | A lifted version of 'STM.newTChanIO'.+newTChanIO ∷ MonadBase IO μ ⇒ μ (TChan α)+newTChanIO = liftBase STM.newTChanIO+{-# INLINE newTChanIO #-}++-- | A lifted version of 'STM.newBroadcastTChan'.+newBroadcastTChan ∷ MonadBase STM μ ⇒ μ (TChan α)+newBroadcastTChan = liftBase STM.newBroadcastTChan+{-# INLINE newBroadcastTChan #-}++-- | A lifted version of 'STM.newBroadcastTChanIO'.+newBroadcastTChanIO ∷ MonadBase IO μ ⇒ μ (TChan α)+newBroadcastTChanIO = liftBase STM.newBroadcastTChanIO+{-# INLINE newBroadcastTChanIO #-}++-- | A lifted version of 'STM.dupTChan'.+dupTChan ∷ MonadBase STM μ ⇒ TChan α → μ (TChan α)+dupTChan = liftBase . STM.dupTChan+{-# INLINE dupTChan #-}++-- | A lifted version of 'STM.cloneTChan'.+cloneTChan ∷ MonadBase STM μ ⇒ TChan α → μ (TChan α)+cloneTChan = liftBase . STM.cloneTChan+{-# INLINE cloneTChan #-}++-- | A lifted version of 'STM.readTChan'.+readTChan ∷ MonadBase STM μ ⇒ TChan α → μ α+readTChan = liftBase . STM.readTChan+{-# INLINE readTChan #-}++-- | A lifted version of 'STM.tryReadTChan'.+tryReadTChan ∷ MonadBase STM μ ⇒ TChan α → μ (Maybe α)+tryReadTChan = liftBase . STM.tryReadTChan+{-# INLINE tryReadTChan #-}++-- | A lifted version of 'STM.peekTChan'.+peekTChan ∷ MonadBase STM μ ⇒ TChan α → μ α+peekTChan = liftBase . STM.peekTChan+{-# INLINE peekTChan #-}++-- | A lifted version of 'STM.tryPeekTChan'.+tryPeekTChan ∷ MonadBase STM μ ⇒ TChan α → μ (Maybe α)+tryPeekTChan = liftBase . STM.tryPeekTChan+{-# INLINE tryPeekTChan #-}++-- | A lifted version of 'STM.writeTChan'.+writeTChan ∷ MonadBase STM μ ⇒ TChan α → α → μ ()+writeTChan = (liftBase .) . STM.writeTChan+{-# INLINE writeTChan #-}++-- | A lifted version of 'STM.unGetTChan'.+unGetTChan ∷ MonadBase STM μ ⇒ TChan α → α → μ ()+unGetTChan = (liftBase .) . STM.unGetTChan+{-# INLINE unGetTChan #-}++-- | A lifted version of 'STM.isEmptyTChan'.+isEmptyTChan ∷ MonadBase STM μ ⇒ TChan α → μ Bool+isEmptyTChan = liftBase . STM.isEmptyTChan+{-# INLINE isEmptyTChan #-}
+ src/Control/Concurrent/STM/TMVar/Lifted.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Lifted 'STM.TMVar' operations.+module Control.Concurrent.STM.TMVar.Lifted+  ( TMVar+  , newTMVar+  , newEmptyTMVar+  , newTMVarIO+  , newEmptyTMVarIO+  , takeTMVar+  , tryTakeTMVar+  , putTMVar+  , tryPutTMVar+  , readTMVar+  , tryReadTMVar+  , swapTMVar+  , isEmptyTMVar+  , mkWeakTMVar+  ) where++import Control.Monad.Base (MonadBase(..))+import Control.Monad.STM (STM)+import Control.Concurrent.STM.TMVar (TMVar)+import qualified Control.Concurrent.STM.TMVar as STM+import System.Mem.Weak (Weak)++-- | A lifted version of 'STM.newTMVar'.+newTMVar ∷ MonadBase STM μ ⇒ α → μ (TMVar α)+newTMVar = liftBase . STM.newTMVar+{-# INLINE newTMVar #-}++-- | A lifted version of 'STM.newEmptyTMVar'.+newEmptyTMVar ∷ MonadBase STM μ ⇒ μ (TMVar α)+newEmptyTMVar = liftBase STM.newEmptyTMVar+{-# INLINE newEmptyTMVar #-}++-- | A lifted version of 'STM.newTMVarIO'.+newTMVarIO ∷ MonadBase IO μ ⇒ α → μ (TMVar α)+newTMVarIO = liftBase . STM.newTMVarIO+{-# INLINE newTMVarIO #-}++-- | A lifted version of 'STM.newEmptyTMVarIO'.+newEmptyTMVarIO ∷ MonadBase IO μ ⇒ μ (TMVar α)+newEmptyTMVarIO = liftBase STM.newEmptyTMVarIO+{-# INLINE newEmptyTMVarIO #-}++-- | A lifted version of 'STM.takeTMVar'.+takeTMVar ∷ MonadBase STM μ ⇒ TMVar α → μ α+takeTMVar = liftBase . STM.takeTMVar+{-# INLINE takeTMVar #-}++-- | A lifted version of 'STM.tryTakeTMVar'.+tryTakeTMVar ∷ MonadBase STM μ ⇒ TMVar α → μ (Maybe α)+tryTakeTMVar = liftBase . STM.tryTakeTMVar+{-# INLINE tryTakeTMVar #-}++-- | A lifted version of 'STM.putTMVar'.+putTMVar ∷ MonadBase STM μ ⇒ TMVar α → α → μ ()+putTMVar = (liftBase .) . STM.putTMVar+{-# INLINE putTMVar #-}++-- | A lifted version of 'STM.tryPutTMVar'.+tryPutTMVar ∷ MonadBase STM μ ⇒ TMVar α → α → μ Bool+tryPutTMVar = (liftBase .) . STM.tryPutTMVar+{-# INLINE tryPutTMVar #-}++-- | A lifted version of 'STM.readTMVar'.+readTMVar ∷ MonadBase STM μ ⇒ TMVar α → μ α+readTMVar = liftBase . STM.readTMVar+{-# INLINE readTMVar #-}++-- | A lifted version of 'STM.tryReadTMVar'.+tryReadTMVar ∷ MonadBase STM μ ⇒ TMVar α → μ (Maybe α)+tryReadTMVar = liftBase . STM.tryReadTMVar+{-# INLINE tryReadTMVar #-}++-- | A lifted version of 'STM.swapTMVar'.+swapTMVar ∷ MonadBase STM μ ⇒ TMVar α → α → μ α+swapTMVar = (liftBase .) . STM.swapTMVar+{-# INLINE swapTMVar #-}++-- | A lifted version of 'STM.isEmptyTMVar'.+isEmptyTMVar ∷ MonadBase STM μ ⇒ TMVar α → μ Bool+isEmptyTMVar = liftBase . STM.isEmptyTMVar+{-# INLINE isEmptyTMVar #-}++-- | A lifted version of 'STM.mkWeakTMVar'.+mkWeakTMVar ∷ MonadBase IO μ ⇒ TMVar α → IO () → μ (Weak (TMVar α))+mkWeakTMVar = (liftBase .) . STM.mkWeakTMVar+{-# INLINE mkWeakTMVar #-}
+ src/Control/Concurrent/STM/TQueue/Lifted.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Lifted 'TQueue' operations.+module Control.Concurrent.STM.TQueue.Lifted+  ( TQueue+  , newTQueue+  , newTQueueIO+  , readTQueue+  , tryReadTQueue+  , peekTQueue+  , tryPeekTQueue+  , flushTQueue+  , writeTQueue+  , unGetTQueue+  , isEmptyTQueue+  ) where++import Control.Monad.Base (MonadBase(..))+import Control.Monad.STM (STM)+import Control.Concurrent.STM.TQueue (TQueue)+import qualified Control.Concurrent.STM.TQueue as STM++-- | A lifted version of 'STM.newTQueue'.+newTQueue ∷ MonadBase STM μ ⇒ μ (TQueue α)+newTQueue = liftBase STM.newTQueue+{-# INLINE newTQueue #-}++-- | A lifted version of 'STM.newTQueueIO'.+newTQueueIO ∷ MonadBase IO μ ⇒ μ (TQueue α)+newTQueueIO = liftBase STM.newTQueueIO+{-# INLINE newTQueueIO #-}++-- | A lifted version of 'STM.readTQueue'.+readTQueue ∷ MonadBase STM μ ⇒ TQueue α → μ α+readTQueue = liftBase . STM.readTQueue+{-# INLINE readTQueue #-}++-- | A lifted version of 'STM.tryReadTQueue'.+tryReadTQueue ∷ MonadBase STM μ ⇒ TQueue α → μ (Maybe α)+tryReadTQueue = liftBase . STM.tryReadTQueue+{-# INLINE tryReadTQueue #-}++-- | A lifted version of 'STM.peekTQueue'.+peekTQueue ∷ MonadBase STM μ ⇒ TQueue α → μ α+peekTQueue = liftBase . STM.peekTQueue+{-# INLINE peekTQueue #-}++-- | A lifted version of 'STM.tryPeekTQueue'.+tryPeekTQueue ∷ MonadBase STM μ ⇒ TQueue α → μ (Maybe α)+tryPeekTQueue = liftBase . STM.tryPeekTQueue+{-# INLINE tryPeekTQueue #-}++-- | A lifted version of 'STM.flushTQueue'.+flushTQueue ∷ MonadBase STM μ ⇒ TQueue α → μ [α]+flushTQueue = liftBase . STM.flushTQueue+{-# INLINE flushTQueue #-}++-- | A lifted version of 'STM.writeTQueue'.+writeTQueue ∷ MonadBase STM μ ⇒ TQueue α → α → μ ()+writeTQueue = (liftBase .) . STM.writeTQueue+{-# INLINE writeTQueue #-}++-- | A lifted version of 'STM.unGetTQueue'.+unGetTQueue ∷ MonadBase STM μ ⇒ TQueue α → α → μ ()+unGetTQueue = (liftBase .) . STM.unGetTQueue+{-# INLINE unGetTQueue #-}++-- | A lifted version of 'STM.isEmptyTQueue'.+isEmptyTQueue ∷ MonadBase STM μ ⇒ TQueue α → μ Bool+isEmptyTQueue = liftBase . STM.isEmptyTQueue+{-# INLINE isEmptyTQueue #-}
+ src/Control/Concurrent/STM/TSem/Lifted.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Lifted 'STM.TSem' operations.+module Control.Concurrent.STM.TSem.Lifted+  ( TSem+  , newTSem+  , waitTSem+  , signalTSem+  , signalTSemN+  ) where++import Control.Monad.Base (MonadBase(..))+import Control.Monad.STM (STM)+import Control.Concurrent.STM.TSem (TSem)+import qualified Control.Concurrent.STM.TSem as STM++-- | A lifted version of 'STM.newTSem'.+newTSem ∷ MonadBase STM μ ⇒ Int → μ TSem+newTSem = liftBase . STM.newTSem+{-# INLINE newTSem #-}++-- | A lifted version of 'STM.waitTSem'.+waitTSem ∷ MonadBase STM μ ⇒ TSem → μ ()+waitTSem = liftBase . STM.waitTSem+{-# INLINE waitTSem #-}++-- | A lifted version of 'STM.signalTSem'.+signalTSem ∷ MonadBase STM μ ⇒ TSem → μ ()+signalTSem = liftBase . STM.signalTSem+{-# INLINE signalTSem #-}++-- | A lifted version of 'STM.signalTSemN'.+signalTSemN ∷ MonadBase STM μ ⇒ Word → TSem → μ ()+signalTSemN = (liftBase .) . STM.signalTSemN+{-# INLINE signalTSemN #-}
+ src/Control/Concurrent/STM/TVar/Lifted.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Lifted 'STM.TVar' operations.+module Control.Concurrent.STM.TVar.Lifted+  ( TVar+  , newTVar+  , newTVarIO+  , readTVar+  , readTVarIO+  , writeTVar+  , modifyTVar+  , modifyTVar'+  , swapTVar+  , registerDelay+  , mkWeakTVar+  ) where++import Control.Monad.Base (MonadBase(..))+import Control.Monad.STM (STM)+import Control.Concurrent.STM.TVar (TVar)+import qualified Control.Concurrent.STM.TVar as STM+import System.Mem.Weak (Weak)++-- | A lifted version of 'STM.newTVar'.+newTVar ∷ MonadBase STM μ ⇒ α → μ (TVar α)+newTVar = liftBase . STM.newTVar+{-# INLINE newTVar #-}++-- | A lifted version of 'STM.newTVarIO'.+newTVarIO ∷ MonadBase IO μ ⇒ α → μ (TVar α)+newTVarIO = liftBase . STM.newTVarIO+{-# INLINE newTVarIO #-}++-- | A lifted version of 'STM.readTVar'.+readTVar ∷ MonadBase STM μ ⇒ TVar α → μ α+readTVar = liftBase . STM.readTVar+{-# INLINE readTVar #-}++-- | A lifted version of 'STM.readTVarIO'.+readTVarIO ∷ MonadBase IO μ ⇒ TVar α → μ α+readTVarIO = liftBase . STM.readTVarIO+{-# INLINE readTVarIO #-}++-- | A lifted version of 'STM.writeTVar'.+writeTVar ∷ MonadBase STM μ ⇒ TVar α → α → μ ()+writeTVar = (liftBase .) . STM.writeTVar+{-# INLINE writeTVar #-}++-- | A lifted version of 'STM.modifyTVar'.+modifyTVar ∷ MonadBase STM μ ⇒ TVar α → (α → α) → μ ()+modifyTVar = (liftBase .) . STM.modifyTVar+{-# INLINE modifyTVar #-}++-- | A lifted version of 'STM.modifyTVar''.+modifyTVar' ∷ MonadBase STM μ ⇒ TVar α → (α → α) → μ ()+modifyTVar' = (liftBase .) . STM.modifyTVar'+{-# INLINE modifyTVar' #-}++-- | A lifted version of 'STM.swapTVar'.+swapTVar ∷ MonadBase STM μ ⇒ TVar α → α → μ α+swapTVar = (liftBase .) . STM.swapTVar+{-# INLINE swapTVar #-}++-- | A lifted version of 'STM.registerDelay'.+registerDelay ∷ MonadBase IO μ ⇒ Int → μ (TVar Bool)+registerDelay = liftBase . STM.registerDelay+{-# INLINE registerDelay #-}++-- | A lifted version of 'STM.mkWeakTVar'.+mkWeakTVar ∷ MonadBase IO μ ⇒ TVar α → IO () → μ (Weak (TVar α))+mkWeakTVar = (liftBase .) . STM.mkWeakTVar+{-# INLINE mkWeakTVar #-}
+ src/Control/Monad/STM/Lifted.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Lifted 'STM' operations.+module Control.Monad.STM.Lifted+  ( STM+  , MonadSTM(..)+  , atomically+  , retry+  , alwaysSucceeds+  , always+  , check+  , throwSTM+  , catchSTM+  ) where++import Data.Monoid (Monoid)+import Control.Monad.Base+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Accum+import qualified Control.Monad.Trans.State.Lazy as L+import qualified Control.Monad.Trans.State.Strict as S+import qualified Control.Monad.Trans.Writer.Lazy as L+import qualified Control.Monad.Trans.Writer.Strict as S+import qualified Control.Monad.Trans.RWS.Lazy as L+import qualified Control.Monad.Trans.RWS.Strict as S+import Control.Monad.Trans.Finish+import Control.Monad.Exception+import Control.Monad.STM (STM)+import qualified Control.Monad.STM as STM++-- | Class of monads that have 'STM' as their base and support composing+-- alternative (vs retries) actions.+class (MonadBase STM μ, MonadCatch μ) ⇒ MonadSTM μ where+  -- | Equivalent to the first action, unless it retries. It which case the second+  -- action is performed in its place.+  orElse ∷ μ α → μ α → μ α++instance MonadSTM STM where+  orElse = STM.orElse+  {-# INLINE orElse #-}++instance MonadSTM μ ⇒ MonadSTM (IdentityT μ) where+  orElse m₁ m₂ = IdentityT $ orElse (runIdentityT m₁) (runIdentityT m₂)+  {-# INLINE orElse #-}++instance MonadSTM μ ⇒ MonadSTM (MaybeT μ) where+  orElse m₁ m₂ = MaybeT $ orElse (runMaybeT m₁) (runMaybeT m₂)+  {-# INLINE orElse #-}++instance MonadSTM μ ⇒ MonadSTM (ReaderT w μ) where+  orElse m₁ m₂ = ReaderT $ \r → orElse (runReaderT m₁ r) (runReaderT m₂ r)+  {-# INLINE orElse #-}++instance (Monoid w, MonadSTM μ) ⇒ MonadSTM (AccumT w μ) where+  orElse m₁ m₂ = AccumT $ \w → orElse (runAccumT m₁ w) (runAccumT m₂ w)+  {-# INLINE orElse #-}++instance MonadSTM μ ⇒ MonadSTM (L.StateT s μ) where+  orElse m₁ m₂ = L.StateT $ \s → orElse (L.runStateT m₁ s) (L.runStateT m₂ s)+  {-# INLINE orElse #-}++instance MonadSTM μ ⇒ MonadSTM (S.StateT s μ) where+  orElse m₁ m₂ = S.StateT $ \s → orElse (S.runStateT m₁ s) (S.runStateT m₂ s)+  {-# INLINE orElse #-}++instance (Monoid w, MonadSTM μ) ⇒ MonadSTM (L.WriterT w μ) where+  orElse m₁ m₂ = L.WriterT $ orElse (L.runWriterT m₁) (L.runWriterT m₂)+  {-# INLINE orElse #-}++instance (Monoid w, MonadSTM μ) ⇒ MonadSTM (S.WriterT w μ) where+  orElse m₁ m₂ = S.WriterT $ orElse (S.runWriterT m₁) (S.runWriterT m₂)+  {-# INLINE orElse #-}++instance (Monoid w, MonadSTM μ) ⇒ MonadSTM (L.RWST r w s μ) where+  orElse m₁ m₂ = L.RWST $ \r s → orElse (L.runRWST m₁ r s) (L.runRWST m₂ r s)+  {-# INLINE orElse #-}++instance (Monoid w, MonadSTM μ) ⇒ MonadSTM (S.RWST r w s μ) where+  orElse m₁ m₂ = S.RWST $ \r s → orElse (S.runRWST m₁ r s) (S.runRWST m₂ r s)+  {-# INLINE orElse #-}++instance MonadSTM μ ⇒ MonadSTM (FinishT r μ) where+  orElse m₁ m₂ = FinishT $ orElse (runFinishT m₁) (runFinishT m₂)+  {-# INLINE orElse #-}++-- | A lifted version of 'STM.atomically'.+atomically ∷ MonadBase IO μ ⇒ STM α → μ α+atomically = liftBase . STM.atomically+{-# INLINE atomically #-}++-- | A lifted version of 'STM.retry'.+retry ∷ MonadBase STM μ ⇒ μ α+retry = liftBase STM.retry+{-# INLINE retry #-}++-- | A lifted version of 'STM.alwaysSucceeds'.+alwaysSucceeds ∷ MonadBase STM μ ⇒ STM α → μ ()+alwaysSucceeds = liftBase . STM.alwaysSucceeds+{-# INLINE alwaysSucceeds #-}++-- | A lifted version of 'STM.always'.+always ∷ MonadBase STM μ ⇒ STM Bool → μ ()+always = liftBase . STM.always+{-# INLINE always #-}++-- | A lifted version of 'STM.check'.+check ∷ MonadBase STM μ ⇒ Bool → μ ()+check = liftBase . STM.check+{-# INLINE check #-}++-- | A lifted version of 'STM.throwSTM'.+throwSTM ∷ (Exception e, MonadBase STM μ) ⇒ e → μ α+throwSTM = liftBase . STM.throwSTM+{-# INLINE throwSTM #-}++-- | A specialized version of 'catch'.+catchSTM ∷ (Exception e, MonadSTM μ) ⇒ μ α → (e → μ α) → μ α+catchSTM = catch+{-# INLINE catchSTM #-}