Poll asyncs until any fails or all return and only one succeeds

OneOfMany.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables #-}

oneOfMany :: forall a. [Async (Maybe a)] -> IO (Either SomeException (Maybe a))
oneOfMany asyncs = loop
  where

    loop :: IO (Either SomeException (Maybe a))
    loop = do
      statuses <- for asyncs poll
      let exceptions = [exception | Just (Left exception) <- statuses]
      case exceptions of

        -- At least one task failed: cancel all tasks and fail.
        exception : _ -> do
          for_ asyncs cancel
          pure (Left exception)

        -- No tasks have yet failed.
        [] -> let

          -- Collect results of all tasks.
          allResults :: Maybe [Maybe a]
          allResults = for statuses \ status -> do
            Right result <- status
            pure result

          in case allResults of

            -- If at least one task hasn't completed, continue polling.
            Nothing -> loop

            -- All tasks have completed.
            Just results -> case catMaybes results of

              -- If exactly one task returned a result, return.
              [value] -> pure (Right (Just value))

              -- If no task returned a result, done.
              [] -> pure (Right Nothing)

              -- If multiple tasks returned, error.
              _ -> throwIO (InternalError "at most one task should return")