io-classes 1.7.0.0 → 1.8.0.0
raw patch · 25 files changed
+468/−286 lines, 25 filesdep ~asyncdep ~basedep ~stm
Dependency ranges changed: async, base, stm, time
Files
- CHANGELOG.md +21/−0
- README.md +30/−15
- io-classes.cabal +47/−85
- mtl/Control/Monad/Class/MonadSTM/Trans.hs +109/−12
- mtl/Control/Monad/Class/MonadThrow/Trans.hs +31/−2
- si-timers/src/Control/Monad/Class/MonadTime/SI.hs +3/−6
- si-timers/src/Control/Monad/Class/MonadTimer/SI.hs +2/−8
- src/Control/Concurrent/Class/MonadMVar.hs +25/−3
- src/Control/Concurrent/Class/MonadSTM/TMVar.hs +2/−0
- src/Control/Concurrent/Class/MonadSTM/TVar.hs +2/−0
- src/Control/Monad/Class/MonadAsync.hs +0/−5
- src/Control/Monad/Class/MonadFork.hs +36/−22
- src/Control/Monad/Class/MonadST.hs +0/−3
- src/Control/Monad/Class/MonadSTM.hs +6/−10
- src/Control/Monad/Class/MonadSTM/Internal.hs +90/−43
- src/Control/Monad/Class/MonadThrow.hs +21/−18
- src/Control/Monad/Class/MonadTime.hs +0/−2
- src/Control/Monad/Class/MonadTimer.hs +2/−5
- strict-mvar/src/Control/Concurrent/Class/MonadMVar/Strict.hs +5/−5
- strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TArray.hs +2/−7
- strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TBQueue.hs +2/−7
- strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TChan.hs +0/−6
- strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs +15/−7
- strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TQueue.hs +2/−8
- strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TVar.hs +15/−7
CHANGELOG.md view
@@ -1,5 +1,26 @@ # Revsion history of io-classes +### 1.8.0.0++### Breaking changes++* Provided `MonadTraceMVar`+* Renamed `InspectMonad` to `InspectMonadSTM`+* Added `threadLabel` to `MonadThread`+* Added `MonadLabelledMVar` class.+* Added `labelMVar` to `Control.Concurrent.Class.MonadMVar.Strict`+* Added `debugTraceTVar`, `debugTraceTMVar`, `debugTraceTVarIO`, `debugTraceTMVarIO` for `Show`-based tracing.+* `MonadEvaluate` is not a supper-class of `MonadThrow` anymore.+* Moved all `MonadMaskingState` methods to `MonadMask`. `MonadMaskingState` is+ available but deprecated, it will be removed in one of the future releases.+* `io-classes:mtl` instances support the extended `MonadMask` instance.++### Non-breaking changes++* Added monad transformer instances for `MonadInspectSTM` & `MonadTraceSTM`+ type classes.+* Support ghc-9.12+ ### 1.7.0.0 ### Breaking changes
README.md view
@@ -1,4 +1,4 @@-# IO Monad Class Hierarchy: `io-classes`+# IO Monad Class Hierarchy: `io-classes` package This package provides a monad class hierarchy which is an interface for both the [`io-sim`] and [`IO`] monads. It was developed with the following@@ -21,7 +21,7 @@ microseconds represented as `Int` as in `base`) - cancellable timeouts. -* [`io-classes:io-classes-mtl`](https://input-output-hk.github.io/io-sim/io-classes/io-classes-mtl/index.html):+* [`io-classes:mtl`](https://input-output-hk.github.io/io-sim/io-classes/mtl/index.html): MTL instances. [`io-classes:strict-stm`](https://input-output-hk.github.io/io-sim/io-classes/strict-stm/index.html)@@ -63,6 +63,8 @@ monotonic time as well as exposes 32-bit safe timer API (on 32-bit systems time in microseconds represented as an `Int` can only hold timeouts of ~35 minutes). +[`si-timers`] sublibrary provides cancellable timers API, see [`registerDelayCancellable`].+ `Control.Monad.Class.MonadTimer.NonStandard.MonadTimeout` provides a low-level timeout abstraction. On systems that support a native timer manager, it's used to implement its API, which is very efficient even for low-latency timeouts.@@ -77,25 +79,38 @@ ## Software Transactional Memory API -We provide two interfaces to `stm` API: lazy, included in `io-classes`; and+We provide two interfaces to `stm` API: lazy, included in [`io-classes`][lazy-stm]; and strict one provided by [`io-classes:strict-stm`](https://input-output-hk.github.io/io-sim/io-classes/strict-stm/index.html). ## Threads API We draw a line between `base` API and `async` API. The former is provided by-[MonadFork](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadFork.html#t:MonadFork)-the latter by-[MonadAsync](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadAsync.html#t:MonadAsync).-Both are shallow abstractions around APIs exposed by the `base` and `async`-packages.+[MonadFork] the latter by+[MonadAsync] Both are shallow abstractions around APIs exposed by the `base`+and `async` packages. +## `MVar` API +We also provide lazy and strict `MVar`s:++* [lazy `MVar`][MonadMVar] API+* [strict `MVar`][strict-mvar] API is provided in the [io-classes:strict-mvar] sublibrary.++ ## Some other APIs * [MonadEventlog][MonadEventlog]: provides an API to the [Debug.Trace] event log interface. * [MonadST][MonadST]: provides a way to lift `ST`-computations. * [MonadSay][MonadSay]: dummy debugging interface ++## Monad Transformers++We provide support for monad transformers, see [io-classes:mtl] sublibrary.+Although at this stage it might have its limitations and so there might be some+rough edges. PRs are welcomed, [contributing].++ ## Differences from `base`, `async`, or `exceptions` packages ### Major differences@@ -142,13 +157,6 @@ * `MonadInspectSTM` which allows inspecting values of `STM` mutable variables when they are committed. ([`io-sim`], not provided by `GHC`). --## Monad Transformers--We provide support for monad transformers (although at this stage it might have-its limitations and so there might be some rough edges. PRs are welcomed,-[contributing]).- [SI]: https://www.wikiwand.com/en/International_System_of_Units [`DiffTime`]: https://hackage.haskell.org/package/time-1.10/docs/Data-Time-Clock.html#t:DiffTime [`IO`]: https://hackage.haskell.org/package/base-4.14.0.0/docs/GHC-IO.html#t:IO@@ -156,8 +164,10 @@ [`base`]: https://hackage.haskell.org/package/base [`exceptions`]: https://hackage.haskell.org/package/exceptions [`io-sim`]: https://hackage.haskell.org/package/io-sim+[io-classes:strict-mvar]: https://input-output-hk.github.io/io-sim/io-classes/strict-mvar/index.html [io-classes:mtl]: https://input-output-hk.github.io/io-sim/io-classes/mtl/index.html [`stm`]: https://hackage.haskell.org/package/stm+[lazy-stm]: https://input-output-hk.github.io/io-sim/io-classes/Control-Concurrent-Class-MonadSTM.html [`threadDelay`]: https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadTimer.html#v:threadDelay [`time`]: https://hackage.haskell.org/package/time [contributing]: https://www.github.com/input-output-hk/io-sim/tree/master/CONTRIBUTING.md@@ -167,6 +177,11 @@ [MonadEventlog]: https://input-output-hk.github.io/io-sim/io-classes/Control-Monad-Class-MonadEventlog.html#t:MonadEventlog [Debug.Trace]: https://hackage.haskell.org/package/base/docs/Debug-Trace.html+[MonadAsync]: https://input-output-hk.github.io/io-sim/io-classes/Control-Monad-Class-MonadAsync.html#t:MonadAsync+[MonadFork]: https://input-output-hk.github.io/io-sim/io-classes/Control-Monad-Class-MonadFork.html#t:MonadFork+[MonadMVar]: https://input-output-hk.github.io/io-sim/io-classes/Control-Concurrent-Class-MonadMVar.html#t:MonadMVar+[`registerDelayCancellable`]: http://input-output-hk.github.io/io-sim/io-classes/si-timers/Control-Monad-Class-MonadTimer-SI.html#v:registerDelayCancellable+[strict-mvar]: https://input-output-hk.github.io/io-sim/io-classes/strict-mvar/Control-Concurrent-Class-MonadMVar-Strict.html [MonadST]: https://input-output-hk.github.io/io-sim/io-classes/Control-Monad-Class-MonadST.html#t:MonadST [MonadSay]: https://input-output-hk.github.io/io-sim/io-classes/Control-Monad-Class-MonadSay.html#t:MonadSay [io-classes-haddocks]: https://input-output-hk.github.io/io-sim
io-classes.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: io-classes-version: 1.7.0.0+version: 1.8.0.0 synopsis: Type classes for concurrency with STM, ST and timing description: IO Monad class hierarchy compatible with:@@ -14,16 +14,31 @@ packages. + = Sublibraries+ @io-classes@ provides non-standard extensions distributed in public+ sublibraries++ * @io-classes:io-classes@ - the main library compatible with the above+ packages+ * @io-classes:strict-stm@ - strict @STM@ API+ * @io-classes:strict-mvar@ - strict @MVar@ API+ * @io-classes:si-timers@ - SI-unit based time / timers API, cancellable timers+ * @io-classes:mtl@ - MTL instances, some of which are experiemental++ = Documentation+ Haddocks of all public sublibraries are published+ [here](https://input-output-hk.github.io/io-sim).+ license: Apache-2.0 license-files: LICENSE NOTICE-copyright: 2019-2024 Input Output Global Inc (IOG)-author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas Winant+copyright: 2019-2025 Input Output Global Inc (IOG)+author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Neil Davies, Thomas Winant maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple extra-doc-files: CHANGELOG.md README.md strict-stm/README.md strict-mvar/README.md bug-reports: https://github.com/input-output-hk/io-sim/issues-tested-with: GHC == { 8.10, 9.2, 9.4, 9.6, 9.8, 9.10 }+tested-with: GHC == { 9.6, 9.8, 9.10, 9.12 } source-repository head type: git@@ -72,38 +87,15 @@ Control.Monad.Class.MonadTime Control.Monad.Class.MonadTimer Control.Monad.Class.MonadTest- default-language: Haskell2010- default-extensions: ImportQualifiedPost- other-extensions: CPP- DataKinds- DefaultSignatures- DeriveFunctor- DeriveGeneric- DerivingStrategies- ExistentialQuantification- ExplicitNamespaces- FlexibleContexts- FlexibleInstances- FunctionalDependencies- GADTs- GeneralisedNewtypeDeriving- MultiParamTypeClasses- NamedFieldPuns- QuantifiedConstraints- RankNTypes- ScopedTypeVariables- StandaloneDeriving- TypeFamilies- TypeFamilyDependencies- TypeOperators- UndecidableInstances- build-depends: base >=4.9 && <4.21,+ default-language: GHC2021+ default-extensions: LambdaCase+ build-depends: base >=4.9 && <4.22, array,- async >=2.1,+ async >=2.1 && <2.3, bytestring, mtl >=2.2 && <2.4, primitive >= 0.7 && <0.11,- stm >=2.5 && <2.5.2 || >=2.5.3 && <2.6,+ stm >=2.5 && <2.5.2 || ^>=2.5.3, time >=1.9.1 && <1.13 if impl(ghc >= 9.10) build-depends: ghc-internal@@ -112,6 +104,7 @@ ghc-options: -fno-ignore-asserts library strict-stm+ import: warnings visibility: public hs-source-dirs: strict-stm @@ -123,40 +116,26 @@ Control.Concurrent.Class.MonadSTM.Strict.TQueue Control.Concurrent.Class.MonadSTM.Strict.TVar reexported-modules: Control.Concurrent.Class.MonadSTM.TSem as Control.Concurrent.Class.MonadSTM.Strict.TSem- default-language: Haskell2010- default-extensions: ImportQualifiedPost- build-depends: base >= 4.9 && <4.21,+ default-language: GHC2021+ default-extensions: LambdaCase+ build-depends: base, array,- stm >= 2.5 && <2.6, io-classes:io-classes,- ghc-options: -Wall- -Wno-unticked-promoted-constructors- -Wcompat- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wpartial-fields- -Widentities if flag(asserts) ghc-options: -fno-ignore-asserts library strict-mvar+ import: warnings visibility: public hs-source-dirs: strict-mvar/src exposed-modules: Control.Concurrent.Class.MonadMVar.Strict- default-language: Haskell2010- default-extensions: ImportQualifiedPost- build-depends: base >= 4.9 && <4.21,+ default-language: GHC2021+ default-extensions: LambdaCase+ build-depends: base, io-classes:io-classes,- ghc-options: -Wall- -Wno-unticked-promoted-constructors- -Wcompat- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wpartial-fields- -Widentities library si-timers import: warnings@@ -165,22 +144,14 @@ exposed-modules: Control.Monad.Class.MonadTime.SI Control.Monad.Class.MonadTimer.SI other-modules: Control.Monad.Class.MonadTimer.NonStandard- default-language: Haskell2010- default-extensions: ImportQualifiedPost- other-extensions: BangPatterns,- CPP,- ConstraintKinds,- DefaultSignatures,- DeriveGeneric,- NumericUnderscores,- ScopedTypeVariables,- TypeFamilies- build-depends: base >=4.9 && <4.21,+ default-language: GHC2021+ default-extensions: LambdaCase+ build-depends: base, deepseq, mtl, nothunks, stm,- time >=1.9.1 && <1.13,+ time, io-classes:io-classes if flag(asserts)@@ -199,24 +170,24 @@ , Control.Monad.Class.MonadTime.SI.Trans , Control.Monad.Class.MonadTimer.Trans , Control.Monad.Class.MonadTimer.SI.Trans- build-depends: base >=4.9 && <4.21,+ build-depends: base, array, mtl, io-classes:{io-classes,si-timers} hs-source-dirs: mtl- default-language: Haskell2010- default-extensions: ImportQualifiedPost+ default-language: GHC2021+ default-extensions: LambdaCase library testlib import: warnings visibility: public hs-source-dirs: test exposed-modules: Test.Control.Concurrent.Class.MonadMVar.Strict.WHNF- default-language: Haskell2010- default-extensions: ImportQualifiedPost- build-depends: base >=4.9 && <4.21,+ default-language: GHC2021+ default-extensions: LambdaCase+ build-depends: base, nothunks, QuickCheck, io-classes:strict-mvar@@ -224,27 +195,18 @@ ghc-options: -fno-ignore-asserts test-suite test-strict-mvar+ import: warnings type: exitcode-stdio-1.0 hs-source-dirs: strict-mvar/test main-is: Main.hs-- default-language: Haskell2010- default-extensions: ImportQualifiedPost+ default-language: GHC2021+ default-extensions: LambdaCase build-depends: base, QuickCheck, tasty, tasty-quickcheck, io-classes:testlib - ghc-options: -Wall- -Wno-unticked-promoted-constructors- -Wcompat- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wpartial-fields- -Widentities- -fno-ignore-asserts- -- Since `io-sim` depends on `si-times` (`io-sim` depends on `Time`) some tests of -- are in `io-sim:test`: this is a good enough reason to pull `io-sim:test` -- into a seprate package.@@ -254,8 +216,8 @@ hs-source-dirs: si-timers/test main-is: Main.hs other-modules: Test.MonadTimer- default-language: Haskell2010- default-extensions: ImportQualifiedPost+ default-language: GHC2021+ default-extensions: LambdaCase build-depends: base, QuickCheck,
mtl/Control/Monad/Class/MonadSTM/Trans.hs view
@@ -1,16 +1,10 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} -- undecidable instances needed for 'ContTSTM' instances of -- 'MonadThrow' and 'MonadCatch' type classes.-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Control.Monad.Class.MonadSTM.Trans (ContTSTM (..)) where@@ -31,6 +25,7 @@ import Data.Array.Base (MArray (..)) import Data.Function (on) import Data.Kind (Type)+import Data.Proxy (Proxy (..)) -- | A newtype wrapper for an 'STM' monad for 'ContT'@@ -51,9 +46,7 @@ getNumElements = ContTSTM . getNumElements unsafeRead arr = ContTSTM . unsafeRead arr unsafeWrite arr i = ContTSTM . unsafeWrite arr i-#if __GLASGOW_HASKELL__ >= 910 newArray idxs = ContTSTM . newArray idxs-#endif -- note: this (and the following) instance requires 'UndecidableInstances'@@ -161,6 +154,19 @@ isEmptyTChan = ContTSTM . isEmptyTChan +instance MonadInspectSTM m => MonadInspectSTM (ContT r m) where+ type InspectMonadSTM (ContT r m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance MonadTraceSTM m => MonadTraceSTM (ContT r m) where+ traceTVar _ = ContTSTM .: traceTVar (Proxy @m)+ traceTMVar _ = ContTSTM .: traceTMVar (Proxy @m)+ traceTQueue _ = ContTSTM .: traceTQueue (Proxy @m)+ traceTBQueue _ = ContTSTM .: traceTBQueue (Proxy @m)+ traceTSem _ = ContTSTM .: traceTSem (Proxy @m)++ -- | The underlying stm monad is also transformed. -- instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.WriterT w m) where@@ -239,6 +245,19 @@ isEmptyTChan = lift . isEmptyTChan +instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Lazy.WriterT w m) where+ type InspectMonadSTM (Lazy.WriterT w m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.WriterT w m) where+ traceTVar _ = lift .: traceTVar (Proxy @m)+ traceTMVar _ = lift .: traceTMVar (Proxy @m)+ traceTQueue _ = lift .: traceTQueue (Proxy @m)+ traceTBQueue _ = lift .: traceTBQueue (Proxy @m)+ traceTSem _ = lift .: traceTSem (Proxy @m)++ -- | The underlying stm monad is also transformed. -- instance (Monoid w, MonadSTM m) => MonadSTM (Strict.WriterT w m) where@@ -317,6 +336,19 @@ isEmptyTChan = lift . isEmptyTChan +instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Strict.WriterT w m) where+ type InspectMonadSTM (Strict.WriterT w m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.WriterT w m) where+ traceTVar _ = lift .: traceTVar (Proxy @m)+ traceTMVar _ = lift .: traceTMVar (Proxy @m)+ traceTQueue _ = lift .: traceTQueue (Proxy @m)+ traceTBQueue _ = lift .: traceTBQueue (Proxy @m)+ traceTSem _ = lift .: traceTSem (Proxy @m)++ -- | The underlying stm monad is also transformed. -- instance MonadSTM m => MonadSTM (Lazy.StateT s m) where@@ -395,6 +427,19 @@ isEmptyTChan = lift . isEmptyTChan +instance MonadInspectSTM m => MonadInspectSTM (Lazy.StateT s m) where+ type InspectMonadSTM (Lazy.StateT s m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance MonadTraceSTM m => MonadTraceSTM (Lazy.StateT s m) where+ traceTVar _ = lift .: traceTVar (Proxy @m)+ traceTMVar _ = lift .: traceTMVar (Proxy @m)+ traceTQueue _ = lift .: traceTQueue (Proxy @m)+ traceTBQueue _ = lift .: traceTBQueue (Proxy @m)+ traceTSem _ = lift .: traceTSem (Proxy @m)++ -- | The underlying stm monad is also transformed. -- instance MonadSTM m => MonadSTM (Strict.StateT s m) where@@ -473,6 +518,19 @@ isEmptyTChan = lift . isEmptyTChan +instance MonadInspectSTM m => MonadInspectSTM (Strict.StateT s m) where+ type InspectMonadSTM (Strict.StateT s m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance MonadTraceSTM m => MonadTraceSTM (Strict.StateT s m) where+ traceTVar _ = lift .: traceTVar (Proxy @m)+ traceTMVar _ = lift .: traceTMVar (Proxy @m)+ traceTQueue _ = lift .: traceTQueue (Proxy @m)+ traceTBQueue _ = lift .: traceTBQueue (Proxy @m)+ traceTSem _ = lift .: traceTSem (Proxy @m)++ -- | The underlying stm monad is also transformed. -- instance MonadSTM m => MonadSTM (ExceptT e m) where@@ -551,6 +609,19 @@ isEmptyTChan = lift . isEmptyTChan +instance MonadInspectSTM m => MonadInspectSTM (ExceptT e m) where+ type InspectMonadSTM (ExceptT e m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance MonadTraceSTM m => MonadTraceSTM (ExceptT e m) where+ traceTVar _ = lift .: traceTVar (Proxy @m)+ traceTMVar _ = lift .: traceTMVar (Proxy @m)+ traceTQueue _ = lift .: traceTQueue (Proxy @m)+ traceTBQueue _ = lift .: traceTBQueue (Proxy @m)+ traceTSem _ = lift .: traceTSem (Proxy @m)++ -- | The underlying stm monad is also transformed. -- instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.RWST r w s m) where@@ -629,6 +700,19 @@ isEmptyTChan = lift . isEmptyTChan +instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Lazy.RWST r w s m) where+ type InspectMonadSTM (Lazy.RWST r w s m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.RWST r w s m) where+ traceTVar _ = lift .: traceTVar (Proxy @m)+ traceTMVar _ = lift .: traceTMVar (Proxy @m)+ traceTQueue _ = lift .: traceTQueue (Proxy @m)+ traceTBQueue _ = lift .: traceTBQueue (Proxy @m)+ traceTSem _ = lift .: traceTSem (Proxy @m)++ -- | The underlying stm monad is also transformed. -- instance (Monoid w, MonadSTM m) => MonadSTM (Strict.RWST r w s m) where@@ -705,6 +789,19 @@ writeTChan = lift .: writeTChan unGetTChan = lift .: unGetTChan isEmptyTChan = lift . isEmptyTChan+++instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Strict.RWST r w s m) where+ type InspectMonadSTM (Strict.RWST r w s m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy @m)+ inspectTMVar _ = inspectTMVar (Proxy @m)++instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.RWST r w s m) where+ traceTVar _ = lift .: traceTVar (Proxy @m)+ traceTMVar _ = lift .: traceTMVar (Proxy @m)+ traceTQueue _ = lift .: traceTQueue (Proxy @m)+ traceTBQueue _ = lift .: traceTBQueue (Proxy @m)+ traceTSem _ = lift .: traceTSem (Proxy @m) (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
mtl/Control/Monad/Class/MonadThrow/Trans.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-orphans #-} module Control.Monad.Class.MonadThrow.Trans () where @@ -60,6 +59,11 @@ -> ExceptT e m a -> ExceptT e m a q u (ExceptT b) = ExceptT (u b) + getMaskingState = lift getMaskingState+ interruptible = ExceptT . interruptible . runExceptT+ allowInterrupt = lift allowInterrupt++ -- -- Lazy.WriterT instances --@@ -104,6 +108,11 @@ -> Lazy.WriterT w m a -> Lazy.WriterT w m a q u (Lazy.WriterT b) = Lazy.WriterT (u b) + getMaskingState = lift getMaskingState+ interruptible = Lazy.WriterT . interruptible . Lazy.runWriterT+ allowInterrupt = lift allowInterrupt++ -- -- Strict.WriterT instances --@@ -147,7 +156,11 @@ -> Strict.WriterT w m a -> Strict.WriterT w m a q u (Strict.WriterT b) = Strict.WriterT (u b) + getMaskingState = lift getMaskingState+ interruptible = Strict.WriterT . interruptible . Strict.runWriterT+ allowInterrupt = lift allowInterrupt + -- -- Lazy.RWST Instances --@@ -193,7 +206,11 @@ -> Lazy.RWST r w s m a -> Lazy.RWST r w s m a q u (Lazy.RWST b) = Lazy.RWST $ \r s -> u (b r s) + getMaskingState = lift getMaskingState+ interruptible f = Lazy.RWST $ \r s -> interruptible (Lazy.runRWST f r s)+ allowInterrupt = lift allowInterrupt + -- -- Strict.RWST Instances --@@ -239,7 +256,11 @@ -> Strict.RWST r w s m a -> Strict.RWST r w s m a q u (Strict.RWST b) = Strict.RWST $ \r s -> u (b r s) + getMaskingState = lift getMaskingState+ interruptible f = Strict.RWST $ \r s -> interruptible (Strict.runRWST f r s)+ allowInterrupt = lift allowInterrupt + -- -- Lazy.StateT instances --@@ -283,7 +304,11 @@ -> Lazy.StateT s m a -> Lazy.StateT s m a q u (Lazy.StateT b) = Lazy.StateT $ \s -> u (b s) + getMaskingState = lift getMaskingState+ interruptible f = Lazy.StateT $ \s -> interruptible (Lazy.runStateT f s)+ allowInterrupt = lift allowInterrupt + -- -- Strict.StateT instances --@@ -327,3 +352,7 @@ -> Strict.StateT s m a -> Strict.StateT s m a q u (Strict.StateT b) = Strict.StateT $ \s -> u (b s) ++ getMaskingState = lift getMaskingState+ interruptible f = Strict.StateT $ \s -> interruptible (Strict.runStateT f s)+ allowInterrupt = lift allowInterrupt
si-timers/src/Control/Monad/Class/MonadTime/SI.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-} module Control.Monad.Class.MonadTime.SI ( MonadTime (..)
si-timers/src/Control/Monad/Class/MonadTimer/SI.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE ScopedTypeVariables #-}- module Control.Monad.Class.MonadTimer.SI ( -- * Type classes MonadDelay (..)@@ -124,7 +118,7 @@ -- | A timeout function. --- -- TODO: 'IO' instance is not safe on 32-bit systems.+ -- __TODO__: /'IO' instance is not safe on 32-bit systems./ timeout :: DiffTime -> m a -> m (Maybe a) @@ -244,7 +238,7 @@ -- small enough it will use the `MonadTimer`'s `registerDelay` (e.g. for `IO` -- monad it will use the `GHC`'s `GHC.Conc.registerDelay`). ----- TODO: 'timeout' not safe on 32-bit systems.+-- __TODO__: /'timeout' is not safe on 32-bit systems./ instance MonadTimer IO where registerDelay d | d <= maxDelay =
src/Control/Concurrent/Class/MonadMVar.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE TypeFamilyDependencies #-} module Control.Concurrent.Class.MonadMVar ( MonadMVar (..)+ -- * non-standard extensions , MonadInspectMVar (..)+ , MonadTraceMVar (..)+ , MonadLabelledMVar (..) ) where import Control.Concurrent.MVar qualified as IO@@ -14,6 +15,7 @@ import Control.Monad.Reader (ReaderT (..)) import Control.Monad.Trans (lift) +import Control.Concurrent.Class.MonadSTM (TraceValue) import Data.Kind (Type) @@ -153,7 +155,6 @@ modifyMVarMasked_ = IO.modifyMVarMasked_ modifyMVarMasked = IO.modifyMVarMasked - -- -- ReaderT instance --@@ -204,6 +205,27 @@ type InspectMVarMonad IO = IO inspectMVar _ = tryReadMVar +class MonadTraceMVar m where+ traceMVarIO :: proxy+ -> MVar m a+ -> (Maybe (Maybe a) -> Maybe a -> InspectMVarMonad m TraceValue)+ -> m ()++instance MonadTraceMVar IO where+ traceMVarIO = \_ _ _ -> pure ()++-- | Labelled `MVar`s+--+-- The `IO` instances is no-op, the `IOSim` instance enhances simulation trace.+-- This is very useful when analysing low lever concurrency issues (e.g.+-- deadlocks, livelocks etc).+class MonadMVar m+ => MonadLabelledMVar m where+ -- | Name an `MVar`+ labelMVar :: MVar m a -> String -> m ()++instance MonadLabelledMVar IO where+ labelMVar = \_ _ -> pure () -- -- Utilities --
src/Control/Concurrent/Class/MonadSTM/TMVar.hs view
@@ -24,6 +24,8 @@ -- * MonadTraceSTM , traceTMVar , traceTMVarIO+ , debugTraceTMVar+ , debugTraceTMVarIO ) where import Control.Monad.Class.MonadSTM.Internal
src/Control/Concurrent/Class/MonadSTM/TVar.hs view
@@ -21,6 +21,8 @@ -- * MonadTraceSTM , traceTVar , traceTVarIO+ , debugTraceTVar+ , debugTraceTVarIO ) where import Control.Monad.Class.MonadSTM.Internal
src/Control/Monad/Class/MonadAsync.hs view
@@ -1,12 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE QuantifiedConstraints #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilyDependencies #-} -- MonadAsync's ReaderT instance is undecidable. {-# LANGUAGE UndecidableInstances #-}
src/Control/Monad/Class/MonadFork.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-} -- | A generalisation of -- <https://hackage.haskell.org/package/base/docs/Control-Concurrent.html Control.Concurrent>@@ -18,7 +16,7 @@ SomeException) import Control.Monad.Reader (ReaderT (..), lift) import Data.Kind (Type)-import GHC.Conc.Sync qualified as IO (labelThread)+import GHC.Conc.Sync qualified as IO class (Monad m, Eq (ThreadId m),@@ -30,6 +28,11 @@ myThreadId :: m (ThreadId m) labelThread :: ThreadId m -> String -> m () + -- | Requires ghc-9.6.1 or newer.+ --+ -- @since 1.8.0.0+ threadLabel :: ThreadId m -> m (Maybe String)+ -- | Apply the label to the current thread labelThisThread :: MonadThread m => String -> m () labelThisThread label = myThreadId >>= \tid -> labelThread tid label@@ -37,36 +40,45 @@ class MonadThread m => MonadFork m where - forkIO :: m () -> m (ThreadId m)- forkOn :: Int -> m () -> m (ThreadId m)- forkIOWithUnmask :: ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)- forkFinally :: m a -> (Either SomeException a -> m ()) -> m (ThreadId m)- throwTo :: Exception e => ThreadId m -> e -> m ()+ forkIO :: m () -> m (ThreadId m)+ forkOn :: Int -> m () -> m (ThreadId m)+ forkIOWithUnmask :: ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)+ forkFinally :: m a -> (Either SomeException a -> m ()) -> m (ThreadId m)+ throwTo :: Exception e => ThreadId m -> e -> m () - killThread :: ThreadId m -> m ()- killThread tid = throwTo tid ThreadKilled+ killThread :: ThreadId m -> m ()+ killThread tid = throwTo tid ThreadKilled - yield :: m ()+ yield :: m () + getNumCapabilities :: m Int + instance MonadThread IO where type ThreadId IO = IO.ThreadId myThreadId = IO.myThreadId labelThread = IO.labelThread+#if MIN_VERSION_base(4,18,0)+ threadLabel = IO.threadLabel+#else+ threadLabel = \_ -> pure Nothing+#endif instance MonadFork IO where- forkIO = IO.forkIO- forkOn = IO.forkOn- forkIOWithUnmask = IO.forkIOWithUnmask- forkFinally = IO.forkFinally- throwTo = IO.throwTo- killThread = IO.killThread- yield = IO.yield+ forkIO = IO.forkIO+ forkOn = IO.forkOn+ forkIOWithUnmask = IO.forkIOWithUnmask+ forkFinally = IO.forkFinally+ throwTo = IO.throwTo+ killThread = IO.killThread+ yield = IO.yield+ getNumCapabilities = IO.getNumCapabilities instance MonadThread m => MonadThread (ReaderT r m) where type ThreadId (ReaderT r m) = ThreadId m myThreadId = lift myThreadId labelThread t l = lift (labelThread t l)+ threadLabel = lift . threadLabel instance MonadFork m => MonadFork (ReaderT e m) where forkIO (ReaderT f) = ReaderT $ \e -> forkIO (f e)@@ -75,7 +87,9 @@ let restore' :: ReaderT e m a -> ReaderT e m a restore' (ReaderT f) = ReaderT $ restore . f in runReaderT (k restore') e- forkFinally f k = ReaderT $ \e -> forkFinally (runReaderT f e)- $ \err -> runReaderT (k err) e+ forkFinally f k = ReaderT $ \e -> forkFinally (runReaderT f e)+ $ \err -> runReaderT (k err) e throwTo e t = lift (throwTo e t) yield = lift yield++ getNumCapabilities = lift getNumCapabilities
src/Control/Monad/Class/MonadST.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-} module Control.Monad.Class.MonadST (MonadST (..)) where import Control.Monad.Reader
src/Control/Monad/Class/MonadSTM.hs view
@@ -1,15 +1,11 @@--- | This module corresponds to "Control.Monad.STM" in "stm" package----{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-} -- undecidable instances needed for 'WrappedSTM' instances of 'MonadThrow' and -- 'MonadCatch' type classes.-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableInstances #-}++-- | This module corresponds to "Control.Monad.STM" in "stm" package+-- module Control.Monad.Class.MonadSTM ( MonadSTM (STM, atomically, retry, orElse, check) , throwSTM
src/Control/Monad/Class/MonadSTM/Internal.hs view
@@ -1,23 +1,12 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-} -- needed for `ReaderT` instance-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableInstances #-} -- Internal module. It's only exposed as it provides various default types for -- defining new instances, otherwise prefer to use@@ -99,6 +88,11 @@ , isEmptyTChanDefault , cloneTChanDefault , labelTChanDefault+ -- * Trace tvar and tmvar+ , debugTraceTVar+ , debugTraceTVarIO+ , debugTraceTMVar+ , debugTraceTMVarIO ) where import Prelude hiding (read)@@ -367,21 +361,21 @@ -- to access a 'TVar' in the underlying 'ST' monad. -- class ( MonadSTM m- , Monad (InspectMonad m)+ , Monad (InspectMonadSTM m) ) => MonadInspectSTM m where- type InspectMonad m :: Type -> Type+ type InspectMonadSTM m :: Type -> Type -- | Return the value of a `TVar` as an `InspectMonad` computation. -- -- `inspectTVar` is useful if the value of a `TVar` observed by `traceTVar` -- contains other `TVar`s.- inspectTVar :: proxy m -> TVar m a -> InspectMonad m a+ inspectTVar :: proxy m -> TVar m a -> InspectMonadSTM m a -- | Return the value of a `TMVar` as an `InspectMonad` computation.- inspectTMVar :: proxy m -> TMVar m a -> InspectMonad m (Maybe a)+ inspectTMVar :: proxy m -> TMVar m a -> InspectMonadSTM m (Maybe a) -- TODO: inspectTQueue, inspectTBQueue instance MonadInspectSTM IO where- type InspectMonad IO = IO+ type InspectMonadSTM IO = IO inspectTVar _ = readTVarIO -- issue #3198: tryReadTMVarIO inspectTMVar _ = atomically . tryReadTMVar@@ -449,7 +443,7 @@ -- traceTVar :: proxy m -> TVar m a- -> (Maybe a -> a -> InspectMonad m TraceValue)+ -> (Maybe a -> a -> InspectMonadSTM m TraceValue) -- ^ callback which receives initial value or 'Nothing' (if it -- is a newly created 'TVar'), and the committed value. -> STM m ()@@ -457,85 +451,128 @@ traceTMVar :: proxy m -> TMVar m a- -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)+ -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonadSTM m TraceValue) -> STM m () traceTQueue :: proxy m -> TQueue m a- -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)+ -> (Maybe [a] -> [a] -> InspectMonadSTM m TraceValue) -> STM m () traceTBQueue :: proxy m -> TBQueue m a- -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)+ -> (Maybe [a] -> [a] -> InspectMonadSTM m TraceValue) -> STM m () traceTSem :: proxy m -> TSem m- -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)+ -> (Maybe Integer -> Integer -> InspectMonadSTM m TraceValue) -> STM m () default traceTMVar :: TMVar m a ~ TMVarDefault m a => proxy m -> TMVar m a- -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)+ -> (Maybe (Maybe a) -> Maybe a -> InspectMonadSTM m TraceValue) -> STM m () traceTMVar = traceTMVarDefault default traceTSem :: TSem m ~ TSemDefault m => proxy m -> TSem m- -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)+ -> (Maybe Integer -> Integer -> InspectMonadSTM m TraceValue) -> STM m () traceTSem = traceTSemDefault traceTVarIO :: TVar m a- -> (Maybe a -> a -> InspectMonad m TraceValue)+ -> (Maybe a -> a -> InspectMonadSTM m TraceValue) -> m () traceTMVarIO :: TMVar m a- -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)+ -> (Maybe (Maybe a) -> Maybe a -> InspectMonadSTM m TraceValue) -> m () traceTQueueIO :: TQueue m a- -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)+ -> (Maybe [a] -> [a] -> InspectMonadSTM m TraceValue) -> m () traceTBQueueIO :: TBQueue m a- -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)+ -> (Maybe [a] -> [a] -> InspectMonadSTM m TraceValue) -> m () traceTSemIO :: TSem m- -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)+ -> (Maybe Integer -> Integer -> InspectMonadSTM m TraceValue) -> m () default traceTVarIO :: TVar m a- -> (Maybe a -> a -> InspectMonad m TraceValue)+ -> (Maybe a -> a -> InspectMonadSTM m TraceValue) -> m () traceTVarIO = \v f -> atomically (traceTVar Proxy v f) default traceTMVarIO :: TMVar m a- -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)+ -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonadSTM m TraceValue) -> m () traceTMVarIO = \v f -> atomically (traceTMVar Proxy v f) default traceTQueueIO :: TQueue m a- -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)+ -> (Maybe [a] -> [a] -> InspectMonadSTM m TraceValue) -> m () traceTQueueIO = \v f -> atomically (traceTQueue Proxy v f) default traceTBQueueIO :: TBQueue m a- -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)+ -> (Maybe [a] -> [a] -> InspectMonadSTM m TraceValue) -> m () traceTBQueueIO = \v f -> atomically (traceTBQueue Proxy v f) default traceTSemIO :: TSem m- -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)+ -> (Maybe Integer -> Integer -> InspectMonadSTM m TraceValue) -> m () traceTSemIO = \v f -> atomically (traceTSem Proxy v f) +debugTraceTVar :: (MonadTraceSTM m, Show a)+ => proxy m+ -> TVar m a+ -> STM m ()+debugTraceTVar p tvar =+ traceTVar p tvar (\pv v -> pure $ TraceString $ case (pv, v) of+ (Nothing, _) -> error "Unreachable"+ (Just st', st'') -> "Modified: " <> show st' <> " -> " <> show st''+ ) +debugTraceTVarIO :: (MonadTraceSTM m, Show a)+ => TVar m a+ -> m ()+debugTraceTVarIO tvar =+ traceTVarIO tvar (\pv v -> pure $ TraceString $ case (pv, v) of+ (Nothing, _) -> error "Unreachable"+ (Just st', st'') -> "Modified: " <> show st' <> " -> " <> show st''+ )++debugTraceTMVar :: (MonadTraceSTM m, Show a)+ => proxy m+ -> TMVar m a+ -> STM m ()+debugTraceTMVar p tmvar =+ traceTMVar p tmvar (\pv v -> pure $ TraceString $ case (pv, v) of+ (Nothing, _) -> error "Unreachable"+ (Just Nothing, Just st') -> "Put: " <> show st'+ (Just Nothing, Nothing) -> "Remains empty"+ (Just Just{}, Nothing) -> "Take"+ (Just (Just st'), Just st'') -> "Modified: " <> show st' <> " -> " <> show st''+ )++debugTraceTMVarIO :: (Show a, MonadTraceSTM m)+ => TMVar m a+ -> m ()+debugTraceTMVarIO tmvar =+ traceTMVarIO tmvar (\pv v -> pure $ TraceString $ case (pv, v) of+ (Nothing, _) -> error "Unreachable"+ (Just Nothing, Just st') -> "Put: " <> show st'+ (Just Nothing, Nothing) -> "Remains empty"+ (Just Just{}, Nothing) -> "Take"+ (Just (Just st'), Just st'') -> "Modified: " <> show st' <> " -> " <> show st''+ )+ -- -- Instance for IO uses the existing STM library implementations --@@ -689,7 +726,7 @@ :: MonadTraceSTM m => proxy m -> TMVarDefault m a- -> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)+ -> (Maybe (Maybe a) -> Maybe a -> InspectMonadSTM m TraceValue) -> STM m () traceTMVarDefault p (TMVar t) f = traceTVar p t f @@ -982,7 +1019,6 @@ -- | Default implementation of 'TArray'. -- data TArrayDefault m i e = TArray (Array i (TVar m e))- deriving Typeable deriving instance (Eq (TVar m e), Ix i) => Eq (TArrayDefault m i e) @@ -1029,7 +1065,7 @@ traceTSemDefault :: MonadTraceSTM m => proxy m -> TSemDefault m- -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)+ -> (Maybe Integer -> Integer -> InspectMonadSTM m TraceValue) -> STM m () traceTSemDefault proxy (TSem t) k = traceTVar proxy t k @@ -1247,6 +1283,17 @@ unGetTChan = lift .: unGetTChan isEmptyTChan = lift . isEmptyTChan +instance MonadInspectSTM m => MonadInspectSTM (ReaderT r m) where+ type InspectMonadSTM (ReaderT r m) = InspectMonadSTM m+ inspectTVar _ = inspectTVar (Proxy :: Proxy m)+ inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)++instance MonadTraceSTM m => MonadTraceSTM (ReaderT r m) where+ traceTVar _ = lift .: traceTVar Proxy+ traceTMVar _ = lift .: traceTMVar Proxy+ traceTQueue _ = lift .: traceTQueue Proxy+ traceTBQueue _ = lift .: traceTBQueue Proxy+ traceTSem _ = lift .: traceTSem Proxy (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) (f .: g) x y = f (g x y)
src/Control/Monad/Class/MonadThrow.hs view
@@ -1,12 +1,6 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeFamilies #-} -- | A generalisation of -- <https://hackage.haskell.org/package/base/docs/Control-Exception.html Control.Exception>@@ -16,7 +10,7 @@ ( MonadThrow (..) , MonadCatch (..) , MonadMask (..)- , MonadMaskingState (..)+ , MonadMaskingState , MonadEvaluate (..) , MaskingState (..) , Exception (..)@@ -193,27 +187,30 @@ -- class MonadCatch m => MonadMask m where - {-# MINIMAL mask, uninterruptibleMask #-}+ {-# MINIMAL mask,+ uninterruptibleMask,+ getMaskingState,+ interruptible #-}+ mask, uninterruptibleMask :: ((forall a. m a -> m a) -> m b) -> m b mask_, uninterruptibleMask_ :: m a -> m a mask_ action = mask $ \_ -> action uninterruptibleMask_ action = uninterruptibleMask $ \_ -> action --class MonadMask m => MonadMaskingState m where- {-# MINIMAL getMaskingState, interruptible #-} getMaskingState :: m MaskingState interruptible :: m a -> m a- allowInterrupt :: m () + allowInterrupt :: m () allowInterrupt = interruptible (return ()) +class MonadMask m => MonadMaskingState m+{-# DEPRECATED MonadMaskingState "Use MonadMask instead" #-} -- | Monads which can 'evaluate'. ---class MonadThrow m => MonadEvaluate m where+class MonadEvaluate m where evaluate :: a -> m a --@@ -254,11 +251,12 @@ uninterruptibleMask = IO.uninterruptibleMask uninterruptibleMask_ = IO.uninterruptibleMask_ -instance MonadMaskingState IO where getMaskingState = IO.getMaskingState interruptible = IO.interruptible allowInterrupt = IO.allowInterrupt +instance MonadMaskingState IO+ instance MonadEvaluate IO where evaluate = IO.evaluate @@ -321,5 +319,10 @@ where q :: (m a -> m a) -> ReaderT e m a -> ReaderT e m a q u (ReaderT b) = ReaderT (u . b) -instance MonadEvaluate m => MonadEvaluate (ReaderT r m) where+ getMaskingState = lift getMaskingState+ interruptible a =+ ReaderT $ \e -> interruptible (runReaderT a e)+ allowInterrupt = lift allowInterrupt++instance (Monad m, MonadEvaluate m) => MonadEvaluate (ReaderT r m) where evaluate = lift . evaluate
src/Control/Monad/Class/MonadTime.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}- -- | <https://hackage.haskell.org/package/time time> and -- <https://hackage.haskell.org/package/base base> time API compatible with both -- 'IO' and <https://hackage.haskell.org/package/io-sim IOSim>.
src/Control/Monad/Class/MonadTimer.hs view
@@ -1,8 +1,5 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeFamilies #-} -- | Provides classes to handle delays and timeouts which generalised -- <https://hackage.haskell.org/package/base base> API to both 'IO' and
strict-mvar/src/Control/Concurrent/Class/MonadMVar/Strict.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}- -- | This module corresponds to "Control.Concurrent.MVar" in the @base@ package. module Control.Concurrent.Class.MonadMVar.Strict ( -- * StrictMVar@@ -26,11 +22,12 @@ , modifyMVarMasked_ , modifyMVarMasked , tryReadMVar+ , labelMVar -- * Re-exports , MonadMVar ) where -import Control.Concurrent.Class.MonadMVar (MonadMVar)+import Control.Concurrent.Class.MonadMVar (MonadLabelledMVar, MonadMVar) import Control.Concurrent.Class.MonadMVar qualified as Lazy --@@ -61,6 +58,9 @@ -- is in WHNF. This should be used with caution. fromLazyMVar :: Lazy.MVar m a -> StrictMVar m a fromLazyMVar = StrictMVar++labelMVar :: MonadLabelledMVar m => StrictMVar m a -> String -> m ()+labelMVar (StrictMVar m) = Lazy.labelMVar m newEmptyMVar :: MonadMVar m => m (StrictMVar m a) newEmptyMVar = fromLazyMVar <$> Lazy.newEmptyMVar
strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TArray.hs view
@@ -1,10 +1,5 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE UndecidableInstances #-} -- | This module corresponds to `Control.Concurrent.STM.TArray` in "stm" package --
strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TBQueue.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeOperators #-}- -- | This module corresponds to `Control.Concurrent.STM.TBQueue` in "stm" package -- module Control.Concurrent.Class.MonadSTM.Strict.TBQueue@@ -59,13 +54,13 @@ traceTBQueue :: MonadTraceSTM m => proxy m -> StrictTBQueue m a- -> ((Maybe [a]) -> [a] -> InspectMonad m TraceValue)+ -> ((Maybe [a]) -> [a] -> InspectMonadSTM m TraceValue) -> STM m () traceTBQueue p (StrictTBQueue queue) = Lazy.traceTBQueue p queue traceTBQueueIO :: MonadTraceSTM m => StrictTBQueue m a- -> ((Maybe [a]) -> [a] -> InspectMonad m TraceValue)+ -> ((Maybe [a]) -> [a] -> InspectMonadSTM m TraceValue) -> m () traceTBQueueIO (StrictTBQueue queue) = Lazy.traceTBQueueIO queue
strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TChan.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TypeOperators #-}- -- | This module corresponds to `Control.Concurrent.STM.TChan` in "stm" package -- module Control.Concurrent.Class.MonadSTM.Strict.TChan
strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeOperators #-}- -- | This module corresponds to `Control.Concurrent.STM.TMVar` in "stm" package -- module Control.Concurrent.Class.MonadSTM.Strict.TMVar@@ -31,6 +26,8 @@ -- * MonadTraceSTM , traceTMVar , traceTMVarIO+ , debugTraceTMVar+ , debugTraceTMVarIO ) where @@ -55,15 +52,26 @@ traceTMVar :: MonadTraceSTM m => proxy m -> StrictTMVar m a- -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)+ -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonadSTM m TraceValue) -> STM m () traceTMVar p (StrictTMVar var) = Lazy.traceTMVar p var +debugTraceTMVar :: (MonadTraceSTM m, Show a)+ => proxy m+ -> StrictTMVar m a+ -> STM m ()+debugTraceTMVar p (StrictTMVar var) = Lazy.debugTraceTMVar p var+ traceTMVarIO :: MonadTraceSTM m => StrictTMVar m a- -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)+ -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonadSTM m TraceValue) -> m () traceTMVarIO (StrictTMVar var) = Lazy.traceTMVarIO var++debugTraceTMVarIO :: (MonadTraceSTM m, Show a)+ => StrictTMVar m a+ -> m ()+debugTraceTMVarIO (StrictTMVar var) = Lazy.debugTraceTMVarIO var castStrictTMVar :: LazyTMVar m ~ LazyTMVar n => StrictTMVar m a -> StrictTMVar n a
strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TQueue.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TypeOperators #-}- -- | This module corresponds to `Control.Concurrent.STM.TQueue` in "stm" package -- module Control.Concurrent.Class.MonadSTM.Strict.TQueue@@ -56,13 +50,13 @@ traceTQueue :: MonadTraceSTM m => proxy m -> StrictTQueue m a- -> ((Maybe [a]) -> [a] -> InspectMonad m TraceValue)+ -> ((Maybe [a]) -> [a] -> InspectMonadSTM m TraceValue) -> STM m () traceTQueue p (StrictTQueue queue) = Lazy.traceTQueue p queue traceTQueueIO :: MonadTraceSTM m => StrictTQueue m a- -> ((Maybe [a]) -> [a] -> InspectMonad m TraceValue)+ -> ((Maybe [a]) -> [a] -> InspectMonadSTM m TraceValue) -> m () traceTQueueIO (StrictTQueue queue) = Lazy.traceTQueueIO queue
strict-stm/Control/Concurrent/Class/MonadSTM/Strict/TVar.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}- -- | This module corresponds to `Control.Concurrent.STM.TVar` in "stm" package -- module Control.Concurrent.Class.MonadSTM.Strict.TVar@@ -27,6 +22,8 @@ -- * MonadTraceSTM , traceTVar , traceTVarIO+ , debugTraceTVar+ , debugTraceTVarIO ) where import Control.Concurrent.Class.MonadSTM.TVar qualified as Lazy@@ -47,15 +44,26 @@ traceTVar :: MonadTraceSTM m => proxy m -> StrictTVar m a- -> (Maybe a -> a -> InspectMonad m TraceValue)+ -> (Maybe a -> a -> InspectMonadSTM m TraceValue) -> STM m () traceTVar p StrictTVar {tvar} = Lazy.traceTVar p tvar +debugTraceTVar :: (MonadTraceSTM m, Show a)+ => proxy m+ -> StrictTVar m a+ -> STM m ()+debugTraceTVar p StrictTVar {tvar} = Lazy.debugTraceTVar p tvar+ traceTVarIO :: MonadTraceSTM m => StrictTVar m a- -> (Maybe a -> a -> InspectMonad m TraceValue)+ -> (Maybe a -> a -> InspectMonadSTM m TraceValue) -> m () traceTVarIO StrictTVar {tvar} = Lazy.traceTVarIO tvar++debugTraceTVarIO :: (MonadTraceSTM m, Show a)+ => StrictTVar m a+ -> m ()+debugTraceTVarIO StrictTVar {tvar} = Lazy.debugTraceTVarIO tvar -- | Cast the monad if both use the same representation of `TVar`s. --