STM variables in ReaderT, hoisting from STM to IO

Show and Tell
#1

(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 TVars, TMVars 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 TVars 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).

4 Likes
#2

Don’t know if you are aware but I think this is the ReaderT desing pattern. Maybe with some extra hoist

1 Like
#3

Thanks for the pointer! I heard about it, but never read that post.

Indeed, very related. I think the “novelty” lies in looking at the TVars (etc.) in the ReaderT context as a whole, and hoist atomically to run a ReaderT Env STM in the environment with get/put-like actions-with-a-getter, instead of using more traditional calls to asks myGetter to retrieve variables from the environment.

2 Likes
#4

This pattern is new to me. My ReaderT STM code is similar to your thread2 example, and use of hoist is a definite improvement.

Thank you for sharing!

2 Likes
#5

Actually the ReaderT pattern is based on that. The Idea goes like this

-- your main types. An Evironment with mutable variables and your App type which is ReaderT over IO
data Env = Env { sFoo :: TVar Int, mutables_references ...}
data App = App { runApp :: ReaderT Env IO a} deriving (Monads...)

class HasMutableRef w env | env -> w where
  writeRefL :: Lens' env (TVar w)

instance HasMutableRef Int Env where
  writeRefL = lens sFoo (...)

You should look at RIO prelude, which is an opinionated prelude sustitute with more less the same ideas you’ve come with (including lenses to mutable references). I say so because it seems you are reinventing the wheel a little bit :smile:

That being said, the hoist thing seems like a good addition to the pattern

1 Like