-- | 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) 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

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