Use strict-mutable-base (#235)

.github/workflows/haskell-ci.yml

@@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.19.20240514
+# version: 0.19.20240708
 #
-# REGENDATA ("0.19.20240514",["github","--config=cabal.haskell-ci","cabal.project"])
+# REGENDATA ("0.19.20240708",["github","--config=cabal.haskell-ci","cabal.project"])
 #
 name: Haskell-CI
 on:
@@ -74,10 +74,10 @@ jobs:
           apt-get update
           apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
           mkdir -p "$HOME/.ghcup/bin"
-          curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
+          curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"
           chmod a+x "$HOME/.ghcup/bin/ghcup"
           "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
-          "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+          "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
         env:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
@@ -95,7 +95,7 @@ jobs:
           echo "HC=$HC" >> "$GITHUB_ENV"
           echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
           echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
-          echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+          echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
           echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
           echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

effectful-core/CHANGELOG.md

@@ -21,6 +21,8 @@
     replaced with `ThrowErrorWith`.
   - `stateEnv` and `modifyEnv` now take pure modification functions. If you rely
     on their old forms, switch to a combination of `getEnv` and `putEnv`.
+  - `runStateMVar`, `evalStateMVar` and `execStateMVar` now take a strict
+    `MVar'` from the `strict-mutable-base` package.
 
 # effectful-core-2.3.1.0 (2024-06-07)
 * Drop support for GHC 8.8.

effectful-core/effectful-core.cabal

@@ -67,6 +67,7 @@ library
                     , exceptions          >= 0.10.4
                     , monad-control       >= 1.0.3
                     , primitive           >= 0.7.3.0
+                    , strict-mutable-base >= 1.1.0.0
                     , transformers-base   >= 0.4.6
                     , unliftio-core       >= 0.2.0.1
 

effectful-core/src/Effectful/Internal/Env.hs

@@ -40,6 +40,7 @@ module Effectful.Internal.Env
 
 import Control.Monad
 import Control.Monad.Primitive
+import Data.IORef.Strict
 import Data.Primitive.PrimArray
 import Data.Primitive.SmallArray
 import GHC.Stack (HasCallStack)

effectful-core/src/Effectful/Internal/Unlift.hs

@@ -17,6 +17,7 @@ module Effectful.Internal.Unlift
   ) where
 
 import Control.Concurrent
+import Control.Concurrent.MVar.Strict
 import Control.Monad
 import Data.IntMap.Strict qualified as IM
 import GHC.Conc.Sync (ThreadId(..))
@@ -295,7 +296,7 @@ consThreadData w (ThreadEntry i td) =
 ----------------------------------------
 
 deleteThreadData :: Int -> EntryId -> MVar' (ThreadEntries es) -> IO ()
-deleteThreadData wkTid i v = modifyMVar_' v $ \te -> do
+deleteThreadData wkTid i v = modifyMVar'_ v $ \te -> do
   pure ThreadEntries
     { teCapacity = case teCapacity te of
         -- If the template copy of the environment hasn't been consumed

effectful-core/src/Effectful/Internal/Utils.hs

@@ -14,20 +14,6 @@ module Effectful.Internal.Utils
   , toAny
   , fromAny
 
-    -- * Strict 'IORef'
-  , IORef'
-  , newIORef'
-  , readIORef'
-  , writeIORef'
-
-    -- * Strict 'MVar'
-  , MVar'
-  , toMVar'
-  , newMVar'
-  , readMVar'
-  , modifyMVar'
-  , modifyMVar_'
-
     -- * Unique
   , Unique
   , newUnique
@@ -36,9 +22,7 @@ module Effectful.Internal.Utils
   , thawCallStack
   ) where
 
-import Control.Concurrent.MVar
 import Control.Exception
-import Data.IORef
 import Data.Primitive.ByteArray
 import GHC.Conc.Sync (ThreadId(..))
 import GHC.Exts (Any, RealWorld)
@@ -128,49 +112,6 @@ fromAny = unsafeCoerce
 
 ----------------------------------------
 
--- | A strict variant of 'IORef'.
-newtype IORef' a = IORef' (IORef a)
-  deriving Eq
-
-newIORef' :: a -> IO (IORef' a)
-newIORef' a = a `seq` (IORef' <$> newIORef a)
-
-readIORef' :: IORef' a -> IO a
-readIORef' (IORef' var) = readIORef var
-
-writeIORef' :: IORef' a -> a -> IO ()
-writeIORef' (IORef' var) a = a `seq` writeIORef var a
-
-----------------------------------------
-
--- | A strict variant of 'MVar'.
-newtype MVar' a = MVar' (MVar a)
-  deriving Eq
-
-toMVar' :: MVar a -> IO (MVar' a)
-toMVar' var = do
-  let var' = MVar' var
-  modifyMVar_' var' pure
-  pure var'
-
-newMVar' :: a -> IO (MVar' a)
-newMVar' a = a `seq` (MVar' <$> newMVar a)
-
-readMVar' :: MVar' a -> IO a
-readMVar' (MVar' var) = readMVar var
-
-modifyMVar' :: MVar' a -> (a -> IO (a, r)) -> IO r
-modifyMVar' (MVar' var) action = modifyMVar var $ \a0 -> do
-  (a, r) <- action a0
-  a `seq` pure (a, r)
-
-modifyMVar_' :: MVar' a -> (a -> IO a) -> IO ()
-modifyMVar_' (MVar' var) action = modifyMVar_ var $ \a0 -> do
-  a <- action a0
-  a `seq` pure a
-
-----------------------------------------
-
 -- | A unique with no possibility for CAS contention.
 --
 -- Credits for this go to Edward Kmett.

effectful-core/src/Effectful/State/Static/Shared.hs

@@ -45,13 +45,12 @@ module Effectful.State.Static.Shared
   , modifyM
   ) where
 
-import Control.Concurrent.MVar
+import Control.Concurrent.MVar.Strict
 import Data.Kind
 
 import Effectful
 import Effectful.Dispatch.Static
 import Effectful.Dispatch.Static.Primitive
-import Effectful.Internal.Utils
 
 -- | Provide access to a strict (WHNF), shared, mutable value of type @s@.
 data State (s :: Type) :: Effect
@@ -82,28 +81,24 @@ execState s m = do
   _ <- evalStaticRep (State v) m
   unsafeEff_ $ readMVar' v
 
--- | Run the 'State' effect with the given initial state 'MVar' and return the
+-- | Run the 'State' effect with the given initial state 'MVar'' and return the
 -- final value along with the final state.
-runStateMVar :: MVar s -> Eff (State s : es) a -> Eff es (a, s)
+runStateMVar :: MVar' s -> Eff (State s : es) a -> Eff es (a, s)
 runStateMVar v m = do
-  v' <- unsafeEff_ $ toMVar' v
-  a <- evalStaticRep (State v') m
-  (a, ) <$> unsafeEff_ (readMVar v)
+  a <- evalStaticRep (State v) m
+  (a, ) <$> unsafeEff_ (readMVar' v)
 
--- | Run the 'State' effect with the given initial state 'MVar' and return the
+-- | Run the 'State' effect with the given initial state 'MVar'' and return the
 -- final value, discarding the final state.
-evalStateMVar :: MVar s -> Eff (State s : es) a -> Eff es a
-evalStateMVar v m = do
-  v' <- unsafeEff_ $ toMVar' v
-  evalStaticRep (State v') m
+evalStateMVar :: MVar' s -> Eff (State s : es) a -> Eff es a
+evalStateMVar v = evalStaticRep (State v)
 
--- | Run the 'State' effect with the given initial state 'MVar' and return the
+-- | Run the 'State' effect with the given initial state 'MVar'' and return the
 -- final state, discarding the final value.
-execStateMVar :: MVar s -> Eff (State s : es) a -> Eff es s
+execStateMVar :: MVar' s -> Eff (State s : es) a -> Eff es s
 execStateMVar v m = do
-  v' <- unsafeEff_ $ toMVar' v
-  _ <- evalStaticRep (State v') m
-  unsafeEff_ $ readMVar v
+  _ <- evalStaticRep (State v) m
+  unsafeEff_ $ readMVar' v
 
 -- | Fetch the current value of the state.
 get :: State s :> es => Eff es s
@@ -121,7 +116,7 @@ gets f = f <$> get
 put :: State s :> es => s -> Eff es ()
 put s = unsafeEff $ \es -> do
   State v <- getEnv es
-  modifyMVar_' v $ \_ -> pure s
+  modifyMVar'_ v $ \_ -> pure s
 
 -- | Apply the function to the current state and return a value.
 --

effectful-core/src/Effectful/Writer/Static/Shared.hs

@@ -27,13 +27,13 @@ module Effectful.Writer.Static.Shared
   , listens
   ) where
 
+import Control.Concurrent.MVar.Strict
 import Control.Exception (onException, uninterruptibleMask)
 import Data.Kind
 
 import Effectful
 import Effectful.Dispatch.Static
 import Effectful.Dispatch.Static.Primitive
-import Effectful.Internal.Utils
 
 -- | Provide access to a strict (WHNF), shared, write only value of type @w@.
 data Writer (w :: Type) :: Effect
@@ -61,7 +61,7 @@ execWriter m = do
 tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
 tell w1 = unsafeEff $ \es -> do
   Writer v <- getEnv es
-  modifyMVar_' v $ \w0 -> let w = w0 <> w1 in pure w
+  modifyMVar'_ v $ \w0 -> let w = w0 <> w1 in pure w
 
 -- | Execute an action and append its output to the overall output of the
 -- 'Writer'.
@@ -97,7 +97,7 @@ listen m = unsafeEff $ \es -> do
     merge es v0 v1 = do
       putEnv es $ Writer v0
       w1 <- readMVar' v1
-      modifyMVar_' v0 $ \w0 -> let w = w0 <> w1 in pure w
+      modifyMVar'_ v0 $ \w0 -> let w = w0 <> w1 in pure w
       pure w1
 
 -- | Execute an action and append its output to the overall output of the

effectful/CHANGELOG.md

@@ -8,7 +8,8 @@
   `Effectful.Labeled.Writer`.
 * Add `throwErrorWith` and `throwError_` to `Effectful.Error.Static` and
   `Effectful.Error.Dynamic`.
-* Add `Effectful.Prim.IORef`.
+* Add `Effectful.Concurrent.Chan.Strict`.
+* Add `Effectful.Prim.IORef` and `Effectful.Prim.IORef.Strict`.
 * Fix a bug in `stateM` and `modifyM` of thread local `State` effect that
   might've caused dropped state updates
   ([#237](https://github.com/haskell-effectful/effectful/issues/237)).
@@ -22,6 +23,12 @@
     replaced with `ThrowErrorWith`.
   - `stateEnv` and `modifyEnv` now take pure modification functions. If you rely
     on their old forms, switch to a combination of `getEnv` and `putEnv`.
+  - `runStateMVar`, `evalStateMVar` and `execStateMVar` now take a strict
+    `MVar'` from the `strict-mutable-base` package.
+  - `Effectful.Concurrent.MVar.Strict` is now a lifted version of
+    `Control.Concurrent.MVar.Strict` from `strict-mutable-base`. The original
+    module was renamed to `Effectful.Concurrent.MVar.Strict.Compat` and
+    deprecated.
 
 # effectful-2.3.1.0 (2024-06-07)
 * Drop support for GHC 8.8.

effectful/effectful.cabal

@@ -72,7 +72,7 @@ library
                     , directory           >= 1.3.2
                     , effectful-core      >= 2.4.0.0   && < 2.4.1.0
                     , process             >= 1.6.9
-
+                    , strict-mutable-base >= 1.1.0.0
                     , time                >= 1.9.2
                     , stm                 >= 2.5.0.0
                     , unliftio            >= 0.2.20
@@ -82,8 +82,10 @@ library
     exposed-modules: Effectful.Concurrent
                      Effectful.Concurrent.Async
                      Effectful.Concurrent.Chan
+                     Effectful.Concurrent.Chan.Strict
                      Effectful.Concurrent.MVar
                      Effectful.Concurrent.MVar.Strict
+                     Effectful.Concurrent.MVar.Strict.Compat
                      Effectful.Concurrent.STM
                      Effectful.Concurrent.QSem
                      Effectful.Concurrent.QSemN
@@ -97,6 +99,7 @@ library
                      Effectful.FileSystem.IO.ByteString.Lazy
                      Effectful.FileSystem.IO.File
                      Effectful.Prim.IORef
+                     Effectful.Prim.IORef.Strict
                      Effectful.Process
                      Effectful.Temporary
                      Effectful.Timeout
@@ -141,6 +144,7 @@ test-suite test
                     , exceptions
                     , lifted-base
                     , primitive
+                    , strict-mutable-base
                     , tasty
                     , tasty-hunit
                     , unliftio

effectful/src/Effectful/Concurrent/Chan/Strict.hs

@@ -0,0 +1,50 @@
+-- | Lifted "Control.Concurrent.Chan.Strict".
+--
+-- @since 2.4.0.0
+module Effectful.Concurrent.Chan.Strict
+  ( -- * Effect
+    Concurrent
+
+    -- ** Handlers
+  , runConcurrent
+
+    -- * Chan
+  , Chan'
+  , newChan'
+  , writeChan'
+  , readChan'
+  , dupChan'
+  , getChan'Contents
+  , writeList2Chan'
+  ) where
+
+import Control.Concurrent.Chan.Strict (Chan')
+import Control.Concurrent.Chan.Strict qualified as C
+
+import Effectful
+import Effectful.Concurrent.Effect
+import Effectful.Dispatch.Static
+
+-- | Lifted 'C.newChan''.
+newChan' :: Concurrent :> es => Eff es (Chan' a)
+newChan' = unsafeEff_ C.newChan'
+
+-- | Lifted 'C.writeChan''.
+writeChan' :: Concurrent :> es => Chan' a -> a -> Eff es ()
+writeChan' c = unsafeEff_ . C.writeChan' c
+
+-- | Lifted 'C.readChan''.
+readChan' :: Concurrent :> es => Chan' a -> Eff es a
+readChan' = unsafeEff_ . C.readChan'
+
+-- | Lifted 'C.dupChan''.
+dupChan' :: Concurrent :> es => Chan' a -> Eff es (Chan' a)
+dupChan' = unsafeEff_ . C.dupChan'
+
+-- | Lifted 'C.getChan'Contents'.
+getChan'Contents :: Concurrent :> es => Chan' a -> Eff es [a]
+getChan'Contents = unsafeEff_ . C.getChan'Contents
+
+-- | Lifted 'C.writeList2Chan''.
+writeList2Chan' :: Concurrent :> es => Chan' a -> [a] -> Eff es ()
+writeList2Chan' c = unsafeEff_ . C.writeList2Chan' c

effectful/src/Effectful/Concurrent/MVar.hs

@@ -114,6 +114,9 @@ modifyMVarMasked var f = reallyUnsafeUnliftIO $ \unlift -> do
 {-# INLINE modifyMVarMasked #-}
 
 -- | Lifted 'M.mkWeakMVar'.
+--
+-- /Note:/ the finalizer will run a cloned environment, so any changes it makes
+-- to thread local data will not be visible outside of it.
 mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
 mkWeakMVar var f = unsafeEff $ \es -> do
   -- The finalizer can run at any point and in any thread.