module Control.Concurrent.STM.RunOrElse(runOrElse, runOrElse', runOrTakeTMVar) where

import Control.Applicative
import Control.Concurrent.STM
import Control.Concurrent.STM.TMVarIO

-- | @'runOrElse' action stm@ runs the IO action @action@ and attempts
-- the STM operation @stm@, returning the return value which is
-- available first. If @action@ returns first, then @stm@ is not
-- run. If @stm@ returns first, @action@ may or may not complete, but
-- its return value is discarded.
--
-- 'runOrTakeTMVar' is a special case
-- of this function, where @stm@ is simply 'takeTMVar' applied to the
-- given 'TMVar'.
runOrElse :: IO a -> STM b -> IO (Either a b)
runOrElse action stm = run action >>= \tm ->
                       atomically ((Left <$> takeTMVar tm) `orElse` (Right <$> stm))

-- | A version of 'runOrElse' that prefers the STM operation to the IO
-- action.
runOrElse' :: STM a -> IO b -> IO (Either a b)
runOrElse' stm action = run action >>= \tm ->
                        atomically ((Left <$> stm) `orElse` (Right <$> takeTMVar tm))

-- | This version of 'Control.Concurrent.STM.TMVarIO.run' takes an
-- additional 'TMVar', and returns its content /or/ the result of the
-- IO action, depending on which is available first. Note that the
-- action is /not/ interrupted if the 'TMVar' is the winner, so you
-- may want to make sure it doesn't stick around forever.
--
-- @'runOrTakeTMVar' action tm = 'runOrElse' action ('takeTMVar' tm)@.
--
-- The function was originally made to support
-- 'System.Posix.IO.Select.STM.selectOrTakeTMVar', the reason this
-- library exists.
runOrTakeTMVar :: IO a -> TMVar b -> IO (Either a b)
runOrTakeTMVar action tm = runOrElse action (takeTMVar tm)