-- | Perform an IO action, and place its result in a 'TMVar'.  See
-- also "Control.Concurrent.MVarIO" for an 'MVar' version.
module Control.Concurrent.STM.TMVarIO (run, runOrTakeTMVar) where

import Data.Functor
import Control.Concurrent
import Control.Concurrent.STM

-- | @'run' action@ returns a 'TMVar' immediately. The result of
-- @action@ will be placed in said 'TMVar'. If the 'TMVar' is full
-- when @action@ completes, the return value is lost (the action does
-- not wait for an empty 'TMVar').
run :: IO a -> IO (TMVar a)
run action = newEmptyTMVarIO >>= \tm ->
             forkIO (run' action tm) >>
             return tm

-- | This version of '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.
-- The function was made to support
-- 'System.Posix.IO.Select.STM.selectOrTakeTMVar', the reason this
-- library exists, and may not be useful outside of that context.
runOrTakeTMVar :: IO a -> TMVar b -> IO (Either a b)
runOrTakeTMVar action tm1 = run action >>= \tm2 ->
                            atomically ((Left <$> takeTMVar tm2) `orElse` (Right <$> takeTMVar tm1))

run' :: IO a -> TMVar a -> IO ()
run' action tm = action >>= \ret ->
                 atomically (tryPutTMVar tm ret) >>
                 return ()