Polling.hs

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception.Safe
import Data.Time.Units

pollT :: TimeUnit t => t -> IO a -> IO (STM (Maybe a), Async b)
pollT delay act = do
  tv <- newTVarIO Nothing
  as <-
    async . forever $ do
      r <- tryAny act
      case r of
        Left e -> print e
        Right r' -> atomically (writeTVar tv (Just r'))
      (threadDelay . fromIntegral . toMicroseconds) delay
  pure (readTVar tv, as)

pollTDef :: TimeUnit t => t -> a -> IO a -> IO (STM a, Async b)
pollTDef delay def act = do
  (r, as) <- pollT delay act
  pure (fromMaybe def <$> r, as)

alwaysFromMaybe :: STM (Maybe a) -> STM a
alwaysFromMaybe = (maybe retry pure =<<)