Functional programmers enter a diner…

Posted on October 20, 2025

In this post I’ll try and flesh out a thought experiment I had while working with a few state-carrying MVar’s.

What’s on the menu?

If you have an application that carries quite some state that needs to be accessed by multiple threads concurrently, you have a choice in how to expose this state to those threads. One option is to put each state component in its own MVar. Interfacing with these MVar’s is straightforward, but exposes your application to deadlocks, if for example, multiple threads want to acquire resources that the other one has.

One way to avoid this, is to ensure that resources are always (preemptively) acquired in a fixed order for any computation. The thought experiment is then, is it possible to write an interface for which this is possible for any subset of static locks in an application? Against Betteridge’s law, I think the following is quite nifty, if verbose.

This can be seen as a continuance to, at this point, my series of blog posts on polyvariadic functions, as the interface I’d ideally want would just work for any number of locks.
-- So an interface akin to the following:
withLocks locks $ \b a -> ...
withLocks locks $ \c b a -> ...

I’ll be working with a running example. Say there’s some state that’s split up into three locks. And because I’m allowing myself the restriction of working with a static set of locks, I’ll also add some singletons that’ll be useful later.
I’ll also need quite a few helpers in converting these lock singletons to and from values that can actually be sorted. See this as just boilerplate, and try not to look too much at it.
data AllLocks
  = ALock_
  | BLock_
  | CLock_
  deriving (Eq, Ord)

data LockRequest l where
  ALockRequest :: LockRequest ALock
  BLockRequest :: LockRequest BLock
  CLockRequest :: LockRequest CLock

lockToValue :: Some LockRequest -> AllLocks
lockToValue s = case s of
  Some ALockRequest -> ALock_
  Some BLockRequest -> BLock_
  Some CLockRequest -> CLock_

valueToLock :: AllLocks -> Some LockRequest
valueToLock s = case s of
  ALock_ -> Some ALockRequest
  BLock_ -> Some BLockRequest
  CLock_ -> Some CLockRequest

data ContentsOf l where
  LockOfA :: Int -> ContentsOf ALock
  LockOfB :: String -> ContentsOf BLock
  LockOfC :: () -> ContentsOf CLock

data Locks = Locks
  { aLock :: MVar Int
  , bLock :: MVar String
  , cLock :: MVar ()
  }

-- Each one represents its respective lock in the state.
data ALock = ALock
data BLock = BLock
data CLock = CLock

Chef’s choice

The hardest part about the above interface is that the polyvariadic function we’re building is a continuation. We need to acquire all locks in the right order, and provide the underlying resources to the supplied function. Peeling this into concrete steps, gives the following.
  1. Identify all locks that are wanted by the underlying function
  2. Sort these locks according to a fixed ordering
  3. Acquire the locks
  4. Provide the lock contents to the underlying function

These four steps can’t be done incrementally on each lock. The second step is the only real valuable functionality this interface is providing, and can only be done once the set of requested locks is fully known. One way to do this is to first accumulate all lock requests, and only then give the concrete continuation.

But what do we actually accumulate? A first attempt might be the following where we build up the continuation like a list. For each lock we add, we ensure that the continuation grows with the contents of that lock accordingly. The base case should look pretty standard as the identity function. When we cons a lock request, we’d also want supply how we provide the contents of the lock.
data LockProvider c where
  LockProviderCons
    :: ...
    -> LockProvider (c -> r)
    -> LockProvider ((ContentsOf l -> c) -> r)
  LockProviderNil
    :: LockProvider (r -> r)

The above captures the signature we want to generate, but doesn’t yet give us the tools to generate it. We still need ContentsOf, or more importantly, a way to provide it.

A few ideas come to mind. If we were to take the idea of a lock naively, we could look at the type signature of functions like readMVar or takeMVar, giving IO (ContentsOf l) for some lock l. That doesn’t ensure we always unlock the MVar though. For that withMVar would be more apt, which would correspond to the type signature of forall r. (ContentsOf l -> IO r) -> IO r, which is isomorphic to ContT r IO (ContentsOf l).

Note that both takeMVar/readMVar and withMVar are valid. Key observation here is that if we choose to follow the type signature of either of these functions, we’re pigeonholing our LockProvider mini-DSL to a specific behavior. For that reason, and because I’ll actually use both interpretations, I’ll choose to keep the type generic.
data LockProvider f c where
  LockProviderCons
    :: forall l c r
     . LockRequest l
    -> (f (ContentsOf l))
    -> LockProvider (c -> r)
    -> LockProvider ((ContentsOf l -> c) -> r)
  LockProviderNil
    :: LockProvider (r -> r)

Next is how to convert this datatype into an appropriate continuation. Because we both gather and sort, we’ll need to keep the order of the lock requests at least fixed somehow to be able to create a function that satisfies the built-up signature.

Continuationing polyvariadicity

There’s a peculiar disconnect here, we gather and provide the lock requests and contents respectively in a certain ordering, and we have to acquire those exact locks in a different one. To not make my life anymore harder than it needs to be, I’ll enforce the second ordering using evaluation in IO using IORef’s. Being able to manipulate the evaluation order is what the type variable f is intended for.
-- It's not exactly IO, interacting with the locks safely occurs
-- within continuations. So we need `ContT IO`.
newtype Acquire l = Acquire { acquire :: forall r. ContT r IO l }
  deriving Functor

getA :: Locks -> Acquire (ContentsOf ALock)
getA locks = Acquire $ ContT $ \action' -> do
  withMVar (aLock locks) $
    \contents -> action' (LockOfA contents)

Using what is practically a minimal DSL for specifying how to acquire locks, I can now play around with this and reorder the acquisitions.
Because the DSL is functor-ish, and I’m reusing it in multiple places, I’ll create a few minimal helpers.
type f ∘ g = Compose f g
infixr 8 ∘

data Defer l
  = Defer {unDefer :: Acquire l}
  | Evaluated l

-- Turn the lock acquisition requests into stateful slots we can use
-- to acquire at a later point in time.
prepareLockProvider ::
  LockProvider Acquire continuation ->
  IO (LockProvider (IORef ∘ Defer) continuation)
prepareLockProvider lp = do
  case lp of
    LockProviderCons lockRequest action continuation -> do
      ref <- Compose <$> newIORef (Defer action)
      rest <- prepareLockProvider continuation
      pure $ LockProviderCons lockRequest ref rest
    LockProviderNil -> pure LockProviderNil

The next task is to convert the lock requests along with their deferred acquisitions into something we can sort. The lock requests are already sortable, so tupling them up should be enough. I’ll need an existential wrapper though to elide the exact contents of each lock, which we don’t care about yet at this point.
Some exists, so I could have made this an alias to Some ∘ Pair f g, but this was already quite the mess.
data BiSome f g = forall l. BiSome
  { getBiSome :: (f l, g l)
  }

-- Pretty straightforward, recursively iterate over the DSL and
-- accumulate every lock request and deferred acquisition into a list.
gatherLocks ::
  LockProvider (IORef ∘ Defer) continuation ->
  IO [BiSome LockRequest (IORef ∘ Defer ∘ ContentsOf)]
gatherLocks lp = case lp of
  LockProviderCons lockRequest action continuation -> do
    let action' = action
    rest <- gatherLocks continuation
    pure $ BiSome (lockRequest, coerce action') : rest
  LockProviderNil -> pure []

Once everything’s in a proper list, we can sort using the LockRequest in the existential wrapper. And finally, we can acquire every locked resource and subsequently execute the continuation.
-- With the accumulated requests, first sort on the request using the
-- fixed 'Ord' instance and execute once everything has been acquired.
requestLocksSorted
  :: forall r
   . [BiSome LockRequest (IORef ∘ Defer ∘ ContentsOf)]
  -> IO r
  -> IO r
requestLocksSorted ls action = do
  let eval
        :: [BiSome LockRequest (IORef ∘ Defer ∘ ContentsOf)] -> IO r
      eval [] = action
      eval ((BiSome (_, Compose ioRef)) : rest) = do
        ref' <- getCompose <$> readIORef ioRef
        case ref' of
          Defer (Acquire l) -> do
            runContT l $ \l' -> do
              writeIORef ioRef (Compose (Evaluated l'))
              eval rest
          Evaluated _ ->
            eval rest
      lockValue (BiSome (lr, _ioRef)) = lockToValue (Some lr)
  eval (sortOn lockValue ls)

-- The action we execute once everything has been acquired consists of
-- reading every lock's contents and passing it to the continuation.
giveLockContents
  :: LockProvider (IORef ∘ Defer) continuation -> IO continuation
giveLockContents lp = case lp of
  LockProviderCons _ ioRef continuation -> do
    ref <- readIORef (getCompose ioRef)
    case ref of
      Evaluated l -> do
        continue <- giveLockContents continuation
        pure $ \f -> continue (f l)
      _ -> error "not evaluated yet"
  LockProviderNil -> pure id

The final interface is pretty neat.
provideAllLocks
  :: LockProvider Acquire continuation
  -> (continuation -> IO r)
  -> IO r
provideAllLocks lp action = do
  lp' <- prepareLockProvider lp
  gathered <- gatherLocks lp'
  let actWithLocks = giveLockContents lp' >>= action
  requestLocksSorted gathered actWithLocks

There’s quite a few options in how to build the exact LockProvider value. To stay in the polyvariadic theme, the appendix contains how to have every lock’s contents be inferred from type class resolution. The final example can look something like this.
provideLocks
  :: (ProvidesLock continuation)
  => Locks
  -> (continuation -> IO r)
  -> IO r
provideLocks state = provideAllLocks (provideLock state)

example'
  :: Locks
  -> (ContentsOf BLock -> IO Int)
  -> IO Int
example' locks action = do
  provideLocks locks $ \with -> with action

example''
  :: Locks
  -> (ContentsOf BLock -> ContentsOf ALock -> IO Int)
  -> IO Int
example'' locks action = do
  provideLocks locks $ \with -> with action

withLocks
  :: (ProvidesLock (f -> IO b), Result f ~ IO b)
  => Locks
  -> f
  -> IO b
withLocks locks action =
  provideLocks locks $ \with ->
    with action

example''' :: Locks -> IO ()
example''' locks = do
  withLocks @(ContentsOf BLock -> ContentsOf ALock -> IO ()) locks $
    \b a -> print "contents"