Timeouts

Transactions

Inverting functions

When a program requests some information from an external source (say, from a web server) we usually want it to give up after some amount of time instead hanging indefinitely awaiting a response that may never arrive.

timeouts.hs

This code uses \case and numeric underscores.

{-# LANGUAGE LambdaCase, NumericUnderscores #-}

The asum function in Data.Foldable chooses the first feasible action among a list of possibilities.

import Data.Foldable (asum)

We will be forking threads that communicate using mutable references (TVar).

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (atomically, retry)
import Control.Concurrent.STM.TVar

We initialize two variables:

main =
  do

result is initialized to Nothing. When our imaginary task (doing nothing for two seconds) completes, it assigns the value Just "Task A: ..." to the result variable.

    result <- atomically (newTVar Nothing)
    forkIO $
      do
        threadDelay 2_000_000
        atomically (writeTVar result (Just
            "Task A: Completed in two seconds"))

timeout is initialized to False. We fork another thread which waits for one second and then changes it to True.

The race is now on; what we care about now is which of these two variables changes first.

    timeout <- atomically (newTVar False)
    forkIO $
      do
        threadDelay 1_000_000
        atomically (writeTVar timeout True)

This is where asum comes in. We want to either:

    message <- atomically $
      asum

Read a Just value from result; or

        [ readTVar result >>=
            \case
              Nothing -> retry
              Just x  -> return x

Read a True value from timeout.

        , readTVar timeout >>=
            \case
              False -> retry
              True  -> return "Task A: Gave up after one second"
        ]

The program pauses here until either of these two actions is able to run.

Printing the resulting string will tell us which of the two possibilities actually ran.

Since Task A takes two seconds and the timeout is one second, the timeout will happen first.

    putStrLn message

Now we’ll try the same thing again, but with Task B completing in only half a second (500,000 microseconds, written as 500_000 with the comma replaced by an underscore).

    result <- atomically (newTVar Nothing)
    forkIO $
      do
        threadDelay (500_000)
        atomically (writeTVar result (Just
            "Task B: Completed in half a second"))

The timeout is one second again.

    timeout <- atomically (newTVar False)
    forkIO $
      do
        threadDelay 1_000_000
        atomically (writeTVar timeout True)

So this time, the reading of the completed task’s result will be the action that becomes runnable first.

    message <- atomically $
      asum
        [ readTVar result >>=
            \case
              Nothing -> retry
              Just x  -> return x
        , readTVar timeout >>=
            \case
              False -> retry
              True  -> return "Task B: Gave up after one second"
        ]
    putStrLn message

The output shows us that the slower Task A times out, whereas the faster Task B succeeds.

$ runhaskell timeouts.hs
Task A: Gave up after one second
Task B: Completed in half a second

Next: Inverting functions