packages feed

io-classes 1.0.0.1 → 1.1.0.0

raw patch · 5 files changed

+215/−199 lines, 5 files

Files

CHANGELOG.md view
@@ -1,5 +1,16 @@ # Revsion history of io-classes +## 1.1.0.0++### Breaking changes++* `Control.Monad.Class.MonadMVar` is now deprecated in favour of+  `Control.Concurrent.Class.MonadMVar`.++### Non breaking changes++* Fixed building haddocks with `ghc-8.10`.+ ## 1.0.0.1  ### Non breaking changes
io-classes.cabal view
@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                io-classes-version:             1.0.0.1+version:             1.1.0.0 synopsis:            Type classes for concurrency with STM, ST and timing description:   IO Monad class hierarchy compatible with@@ -46,7 +46,8 @@    -- At this experiment/prototype stage everything is exposed.   -- This has to be tidied up once the design becomes clear.-  exposed-modules:     Control.Concurrent.Class.MonadSTM+  exposed-modules:     Control.Concurrent.Class.MonadMVar+                       Control.Concurrent.Class.MonadSTM                        Control.Concurrent.Class.MonadSTM.TArray                        Control.Concurrent.Class.MonadSTM.TBQueue                        Control.Concurrent.Class.MonadSTM.TChan
+ src/Control/Concurrent/Class/MonadMVar.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE DefaultSignatures      #-}+{-# LANGUAGE QuantifiedConstraints  #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators          #-}++module Control.Concurrent.Class.MonadMVar (MonadMVar (..)) where++import qualified Control.Concurrent.MVar as IO+import           Control.Monad.Class.MonadThrow++import           Control.Monad.Reader (ReaderT (..))+import           Control.Monad.Trans (lift)++import           Data.Kind (Type)+++class Monad m => MonadMVar m where+  {-# MINIMAL newEmptyMVar,+              takeMVar, tryTakeMVar,+              putMVar,  tryPutMVar,+              readMVar, tryReadMVar,+              isEmptyMVar #-}++  type MVar m :: Type -> Type++  -- | See 'IO.newEmptyMVar'.+  newEmptyMVar      :: m (MVar m a)+  -- | See 'IO.takeMVar'.+  takeMVar          :: MVar m a -> m a+  -- | See 'IO.putMVar'.+  putMVar           :: MVar m a -> a -> m ()+  -- | See 'IO.tryTakeMVar'.+  tryTakeMVar       :: MVar m a -> m (Maybe a)+  -- | See 'IO.tryPutMVar'.+  tryPutMVar        :: MVar m a -> a -> m Bool+  -- | See 'IO.isEmptyMVar'.+  isEmptyMVar       :: MVar m a -> m Bool++  -- methods with a default implementation+  -- | See 'IO.newMVar'.+  newMVar           :: a -> m (MVar m a)+  -- | See 'IO.readMVar'.+  readMVar          :: MVar m a -> m a+  -- | See 'IO.tryReadMVar'.+  tryReadMVar       :: MVar m a -> m (Maybe a)+  -- | See 'IO.swapMVar'.+  swapMVar          :: MVar m a -> a -> m a+  -- | See 'IO.withMVar'.+  withMVar          :: MVar m a -> (a -> m b) -> m b+  -- | See 'IO.withMVarMasked'.+  withMVarMasked    :: MVar m a -> (a -> m b) -> m b+  -- | See 'IO.modifyMVar_'.+  modifyMVar_       :: MVar m a -> (a -> m a) -> m ()+  -- | See 'IO.modifyMVar'.+  modifyMVar        :: MVar m a -> (a -> m (a, b)) -> m b+  -- | See 'IO.modifyMVarMasked_'.+  modifyMVarMasked_ :: MVar m a -> (a -> m a) -> m ()+  -- | See 'IO.modifyMVarMasked'.+  modifyMVarMasked  :: MVar m a -> (a -> m (a,b)) -> m b++  default newMVar :: a -> m (MVar m a)+  newMVar a = do+    v <- newEmptyMVar+    putMVar v a+    return v+  {-# INLINE newMVar #-}++  default swapMVar :: MonadMask m => MVar m a -> a -> m a+  swapMVar mvar new =+    mask_ $ do+      old <- takeMVar mvar+      putMVar mvar new+      return old+  {-# INLINE swapMVar #-}++  default withMVar :: MonadMask m => MVar m a -> (a -> m b) -> m b+  withMVar m io =+    mask $ \restore -> do+      a <- takeMVar m+      b <- restore (io a) `onException` putMVar m a+      putMVar m a+      return b+  {-# INLINE withMVar #-}++  default withMVarMasked :: MonadMask m => MVar m a -> (a -> m b) -> m b+  withMVarMasked m io =+    mask_ $ do+      a <- takeMVar m+      b <- io a `onException` putMVar m a+      putMVar m a+      return b+  {-# INLINE withMVarMasked #-}++  default modifyMVar_ :: MonadMask m => MVar m a -> (a -> m a) -> m ()+  modifyMVar_ m io =+    mask $ \restore -> do+      a  <- takeMVar m+      a' <- restore (io a) `onException` putMVar m a+      putMVar m a'+  {-# INLINE modifyMVar_ #-}++  default modifyMVar :: (MonadMask m, MonadEvaluate m)+                     => MVar m a -> (a -> m (a,b)) -> m b+  modifyMVar m io =+    mask $ \restore -> do+      a      <- takeMVar m+      (a',b) <- restore (io a >>= evaluate) `onException` putMVar m a+      putMVar m a'+      return b+  {-# INLINE modifyMVar #-}++  default modifyMVarMasked_ :: MonadMask m => MVar m a -> (a -> m a) -> m ()+  modifyMVarMasked_ m io =+    mask_ $ do+      a  <- takeMVar m+      a' <- io a `onException` putMVar m a+      putMVar m a'+  {-# INLINE modifyMVarMasked_ #-}++  default modifyMVarMasked :: (MonadMask m, MonadEvaluate m)+                           => MVar m a -> (a -> m (a,b)) -> m b+  modifyMVarMasked m io =+    mask_ $ do+      a      <- takeMVar m+      (a',b) <- (io a >>= evaluate) `onException` putMVar m a+      putMVar m a'+      return b+  {-# INLINE modifyMVarMasked #-}+++instance MonadMVar IO where+    type MVar IO      = IO.MVar+    newEmptyMVar      = IO.newEmptyMVar+    newMVar           = IO.newMVar+    takeMVar          = IO.takeMVar+    putMVar           = IO.putMVar+    readMVar          = IO.readMVar+    swapMVar          = IO.swapMVar+    tryTakeMVar       = IO.tryTakeMVar+    tryPutMVar        = IO.tryPutMVar+    tryReadMVar       = IO.tryReadMVar+    isEmptyMVar       = IO.isEmptyMVar+    withMVar          = IO.withMVar+    withMVarMasked    = IO.withMVarMasked+    modifyMVar_       = IO.modifyMVar_+    modifyMVar        = IO.modifyMVar+    modifyMVarMasked_ = IO.modifyMVarMasked_+    modifyMVarMasked  = IO.modifyMVarMasked+++--+-- ReaderT instance+--++newtype WrappedMVar r (m :: Type -> Type) a = WrappedMVar { unwrapMVar :: MVar m a }++instance ( MonadMask m+         , MonadMVar m+         ) => MonadMVar (ReaderT r m) where+    type MVar (ReaderT r m) = WrappedMVar r m+    newEmptyMVar = WrappedMVar <$> lift newEmptyMVar+    newMVar      = fmap WrappedMVar . lift . newMVar+    takeMVar     = lift .   takeMVar    . unwrapMVar+    putMVar      = lift .: (putMVar     . unwrapMVar)+    readMVar     = lift .   readMVar    . unwrapMVar+    tryReadMVar  = lift .   tryReadMVar . unwrapMVar+    swapMVar     = lift .: (swapMVar    . unwrapMVar)+    tryTakeMVar  = lift .   tryTakeMVar . unwrapMVar+    tryPutMVar   = lift .: (tryPutMVar  . unwrapMVar)+    isEmptyMVar  = lift .   isEmptyMVar . unwrapMVar+    withMVar (WrappedMVar v) f = ReaderT $ \r ->+      withMVar v (\a -> runReaderT (f a) r)+    withMVarMasked (WrappedMVar v) f = ReaderT $ \r ->+      withMVarMasked v (\a -> runReaderT (f a) r)+    modifyMVar_ (WrappedMVar v) f = ReaderT $ \r ->+      modifyMVar_ v (\a -> runReaderT (f a) r)+    modifyMVar (WrappedMVar v) f = ReaderT $ \r ->+      modifyMVar v (\a -> runReaderT (f a) r)+    modifyMVarMasked_ (WrappedMVar v) f = ReaderT $ \r ->+      modifyMVarMasked_ v (\a -> runReaderT (f a) r)+    modifyMVarMasked (WrappedMVar v) f = ReaderT $ \r ->+      modifyMVarMasked v (\a -> runReaderT (f a) r)+++++--+-- Utilities+--++(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)+(f .: g) x y = f (g x y)
src/Control/Monad/Class/MonadMVar.hs view
@@ -1,192 +1,3 @@-{-# LANGUAGE DefaultSignatures      #-}-{-# LANGUAGE QuantifiedConstraints  #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE TypeOperators          #-}--module Control.Monad.Class.MonadMVar (MonadMVar (..)) where--import qualified Control.Concurrent.MVar as IO-import           Control.Monad.Class.MonadThrow--import           Control.Monad.Reader (ReaderT (..))-import           Control.Monad.Trans (lift)--import           Data.Kind (Type)---class Monad m => MonadMVar m where-  {-# MINIMAL newEmptyMVar,-              takeMVar, tryTakeMVar,-              putMVar,  tryPutMVar,-              readMVar, tryReadMVar,-              isEmptyMVar #-}--  type MVar m :: Type -> Type--  -- | See 'IO.newEmptyMVar'.-  newEmptyMVar      :: m (MVar m a)-  -- | See 'IO.takeMVar'.-  takeMVar          :: MVar m a -> m a-  -- | See 'IO.putMVar'.-  putMVar           :: MVar m a -> a -> m ()-  -- | See 'IO.tryTakeMVar'.-  tryTakeMVar       :: MVar m a -> m (Maybe a)-  -- | See 'IO.tryPutMVar'.-  tryPutMVar        :: MVar m a -> a -> m Bool-  -- | See 'IO.isEmptyMVar'.-  isEmptyMVar       :: MVar m a -> m Bool--  -- methods with a default implementation-  -- | See 'IO.newMVar'.-  newMVar           :: a -> m (MVar m a)-  -- | See 'IO.readMVar'.-  readMVar          :: MVar m a -> m a-  -- | See 'IO.tryReadMVar'.-  tryReadMVar       :: MVar m a -> m (Maybe a)-  -- | See 'IO.swapMVar'.-  swapMVar          :: MVar m a -> a -> m a-  -- | See 'IO.withMVar'.-  withMVar          :: MVar m a -> (a -> m b) -> m b-  -- | See 'IO.withMVarMasked'.-  withMVarMasked    :: MVar m a -> (a -> m b) -> m b-  -- | See 'IO.modifyMVar_'.-  modifyMVar_       :: MVar m a -> (a -> m a) -> m ()-  -- | See 'IO.modifyMVar'.-  modifyMVar        :: MVar m a -> (a -> m (a, b)) -> m b-  -- | See 'IO.modifyMVarMasked_'.-  modifyMVarMasked_ :: MVar m a -> (a -> m a) -> m ()-  -- | See 'IO.modifyMVarMasked'.-  modifyMVarMasked  :: MVar m a -> (a -> m (a,b)) -> m b--  default newMVar :: a -> m (MVar m a)-  newMVar a = do-    v <- newEmptyMVar-    putMVar v a-    return v-  {-# INLINE newMVar #-}--  default swapMVar :: MonadMask m => MVar m a -> a -> m a-  swapMVar mvar new =-    mask_ $ do-      old <- takeMVar mvar-      putMVar mvar new-      return old-  {-# INLINE swapMVar #-}--  default withMVar :: MonadMask m => MVar m a -> (a -> m b) -> m b-  withMVar m io =-    mask $ \restore -> do-      a <- takeMVar m-      b <- restore (io a) `onException` putMVar m a-      putMVar m a-      return b-  {-# INLINE withMVar #-}--  default withMVarMasked :: MonadMask m => MVar m a -> (a -> m b) -> m b-  withMVarMasked m io =-    mask_ $ do-      a <- takeMVar m-      b <- io a `onException` putMVar m a-      putMVar m a-      return b-  {-# INLINE withMVarMasked #-}--  default modifyMVar_ :: MonadMask m => MVar m a -> (a -> m a) -> m ()-  modifyMVar_ m io =-    mask $ \restore -> do-      a  <- takeMVar m-      a' <- restore (io a) `onException` putMVar m a-      putMVar m a'-  {-# INLINE modifyMVar_ #-}--  default modifyMVar :: (MonadMask m, MonadEvaluate m)-                     => MVar m a -> (a -> m (a,b)) -> m b-  modifyMVar m io =-    mask $ \restore -> do-      a      <- takeMVar m-      (a',b) <- restore (io a >>= evaluate) `onException` putMVar m a-      putMVar m a'-      return b-  {-# INLINE modifyMVar #-}--  default modifyMVarMasked_ :: MonadMask m => MVar m a -> (a -> m a) -> m ()-  modifyMVarMasked_ m io =-    mask_ $ do-      a  <- takeMVar m-      a' <- io a `onException` putMVar m a-      putMVar m a'-  {-# INLINE modifyMVarMasked_ #-}--  default modifyMVarMasked :: (MonadMask m, MonadEvaluate m)-                           => MVar m a -> (a -> m (a,b)) -> m b-  modifyMVarMasked m io =-    mask_ $ do-      a      <- takeMVar m-      (a',b) <- (io a >>= evaluate) `onException` putMVar m a-      putMVar m a'-      return b-  {-# INLINE modifyMVarMasked #-}---instance MonadMVar IO where-    type MVar IO      = IO.MVar-    newEmptyMVar      = IO.newEmptyMVar-    newMVar           = IO.newMVar-    takeMVar          = IO.takeMVar-    putMVar           = IO.putMVar-    readMVar          = IO.readMVar-    swapMVar          = IO.swapMVar-    tryTakeMVar       = IO.tryTakeMVar-    tryPutMVar        = IO.tryPutMVar-    tryReadMVar       = IO.tryReadMVar-    isEmptyMVar       = IO.isEmptyMVar-    withMVar          = IO.withMVar-    withMVarMasked    = IO.withMVarMasked-    modifyMVar_       = IO.modifyMVar_-    modifyMVar        = IO.modifyMVar-    modifyMVarMasked_ = IO.modifyMVarMasked_-    modifyMVarMasked  = IO.modifyMVarMasked-------- ReaderT instance-----newtype WrappedMVar r (m :: Type -> Type) a = WrappedMVar { unwrapMVar :: MVar m a }--instance ( MonadMask m-         , MonadMVar m-         ) => MonadMVar (ReaderT r m) where-    type MVar (ReaderT r m) = WrappedMVar r m-    newEmptyMVar = WrappedMVar <$> lift newEmptyMVar-    newMVar      = fmap WrappedMVar . lift . newMVar-    takeMVar     = lift .   takeMVar    . unwrapMVar-    putMVar      = lift .: (putMVar     . unwrapMVar)-    readMVar     = lift .   readMVar    . unwrapMVar-    tryReadMVar  = lift .   tryReadMVar . unwrapMVar-    swapMVar     = lift .: (swapMVar    . unwrapMVar)-    tryTakeMVar  = lift .   tryTakeMVar . unwrapMVar-    tryPutMVar   = lift .: (tryPutMVar  . unwrapMVar)-    isEmptyMVar  = lift .   isEmptyMVar . unwrapMVar-    withMVar (WrappedMVar v) f = ReaderT $ \r ->-      withMVar v (\a -> runReaderT (f a) r)-    withMVarMasked (WrappedMVar v) f = ReaderT $ \r ->-      withMVarMasked v (\a -> runReaderT (f a) r)-    modifyMVar_ (WrappedMVar v) f = ReaderT $ \r ->-      modifyMVar_ v (\a -> runReaderT (f a) r)-    modifyMVar (WrappedMVar v) f = ReaderT $ \r ->-      modifyMVar v (\a -> runReaderT (f a) r)-    modifyMVarMasked_ (WrappedMVar v) f = ReaderT $ \r ->-      modifyMVarMasked_ v (\a -> runReaderT (f a) r)-    modifyMVarMasked (WrappedMVar v) f = ReaderT $ \r ->-      modifyMVarMasked v (\a -> runReaderT (f a) r)---------- Utilities---+module Control.Monad.Class.MonadMVar {-# DEPRECATED "Use Control.Concurrent.Class.MonadMVar" #-} (module X) where -(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)-(f .: g) x y = f (g x y)+import Control.Concurrent.Class.MonadMVar as X
src/Control/Monad/Class/MonadSTM/Internal.hs view
@@ -99,12 +99,6 @@   , labelTChanDefault   ) where --- $default-implementations------ The default implementations are based on a `TVar` defined in the class.  They--- are tailored towards `IOSim` rather than instances which would like to derive--- from `IO` or monad transformers.- import           Prelude hiding (read)  import qualified Control.Concurrent.STM.TArray as STM@@ -134,6 +128,13 @@ import           Data.Typeable (Typeable) import           GHC.Stack import           Numeric.Natural (Natural)+++-- $default-implementations+--+-- The default implementations are based on a `TVar` defined in the class.  They+-- are tailored towards `IOSim` rather than instances which would like to derive+-- from `IO` or monad transformers.   -- | The STM primitives parametrised by a monad `m`.