(This may be a well-known pattern, but I don’t think I’ve seen it before, so here goes)
I was working on some code recently, where some data must be shared (and mutated) by several threads. Hence, using STM. The data model is not a single TVar
, but multiple TVar
s, TMVar
s etc. I decided to create a data
record, bundling all these variables.
Initially, I passed such value around wherever needed, then using readTVar
etc. in atomically
blocks. Something like the following:
data S = S { sFoo :: TVar Int, sBar :: TVar Int }
thread :: S -> IO ()
thread s = do
i <- atomically $ do
f <- readTVar (sFoo s)
writeTVar' (sBar s) (f + 1)
pure f
putStrLn ("foo was " ++ show i)
main :: IO ()
main = do
s <- S <$> newTVarIO <*> newTVarIO
forkIO (thread s)
forkIO (thread s)
...
(In the above, imagine thread
needs to call some other actions which also need some of the S
structure)
This works, but the ergonomics aren’t great. So, I realized, I could use ReaderT S IO
to make my S
available. However, this still required to pull out the various TVar
s in the outer scope (outside atomically
), then mutate them inside atomically
:
thread2 :: ReaderT S IO ()
thread2 = do
vf <- asks sFoo
vb <- asks sBar
i <- atomically $ do
f <- readTVar vf
writeTVar' vb (f + 1)
pure f
lift (putStrLn ("foo was " ++ show i))
-- Then
-- forkIO (runReaderT thread2 s)
Not great either. However, there’s a trick up our sleeves: there’s a monad morphism from ReaderT S STM
to ReaderT S IO
, and we can write combinators which, given a S -> TVar a
(or something Lens’y, of course) allows to read or write the TVar
:
get :: (r -> TVar a) -> ReaderT r STM a
get g = asks g >>= \t -> lift (readTVar t)
set :: (r -> TVar a) -> a -> ReaderT r STM ()
set g v = asks g >>= \t -> lift (writeTVar' t v)
Now we can write
thread3 :: ReaderT S IO ()
thread3 = do
i <- hoist atomically $ do
f <- get sFoo
set sBar (f + 1)
pure f
lift (putStrLn ("foo was " ++ show i))
or, with a more explicit type signature
thread4 :: ReaderT S IO ()
thread4 = do
i <- hoist atomically transaction
lift (putStrLn ("foo was " ++ show i))
transaction :: ReaderT S STM Int
transaction = do
f <- get sFoo
set sBar (f + 1)
pure f
One could imagine having a library exposing all actions from the stm
package, now taking a r -> T a
instead of a T a
directly (or a Lens’y Getting (TVar a) r (TVar a)
), lifting the original action into ReaderT r m
(or MonadReader r m => ...
, of course).