module PrioritySync.Internal.Dispatch
(dispatch,TaskHandle,reprioritize,getResult,tryGetResult)
where
import PrioritySync.Internal.Prioritized
import PrioritySync.Internal.Receipt
import PrioritySync.Internal.RoomGroup
import PrioritySync.Internal.Room
import PrioritySync.Internal.ClaimContext
import Control.Concurrent
import Control.Concurrent.STM
data TaskHandle p a = TaskHandle {
task_reprioritize :: (p -> p) -> STM (),
task_result :: TVar (Maybe a) }
dispatch :: (RoomGroup c,ClaimContext c,Prioritized (ClaimHandle c)) =>
c -> IO a -> IO (TaskHandle (Priority (ClaimHandle c)) a)
dispatch c actionM =
do result <- newTVarIO Nothing
receive_task_handle <- newTVarIO Nothing
_ <- forkIO $ (atomically . writeTVar result . Just) =<< claim Acquire (Receipt c (writeTVar receive_task_handle . Just) (const $ return ())) actionM
task_handle <- atomically $ maybe retry return =<< readTVar receive_task_handle
return $ TaskHandle (reprioritize task_handle) result
instance Prioritized (TaskHandle p a) where
type Priority (TaskHandle p a) = p
reprioritize = task_reprioritize
getResult :: TaskHandle p a -> STM a
getResult task = maybe retry return =<< readTVar (task_result task)
tryGetResult :: TaskHandle p a -> STM (Maybe a)
tryGetResult = readTVar . task_result