woker.hs

{-# LANGUAGE ExistentialQuantification #-}

-- base
import Control.Exception
import Control.Concurrent.MVar
import Control.Monad

import Data.IORef

import System.IO.Unsafe

-- async
import Control.Concurrent.Async

-- stm
import Control.Concurrent.STM.TQueue
import Control.Monad.STM

data Task = forall a. Task (IO a) (MVar (Either SomeException a))

initMagic :: IO ()
initMagic = undefined

finalMagic :: IO ()
finalMagic = undefined

magicString :: IO (IORef String)
magicString = undefined

magicRef :: IORef String
magicRef =

    let refRet = unsafePerformIO $ mask_ $ do
            ret  <- newEmptyMVar
            atomically $ writeTQueue toMagic (Task magicString ret)
            return ret

    in unsafePerformIO $ mask $ \unmask -> do
        eval <- unmask $ takeMVar refRet
        either throw return eval

toMagic :: TQueue Task
toMagic = unsafePerformIO newTQueueIO

main :: IO ()
main = do
    magicWoker <- async $ do
        Task _ ret <- atomically $ peekTQueue toMagic
        bracket_
            (initMagic `catch` (\e -> putMVar ret (Left e) >> throw e))
            finalMagic
            (forever $ do
                Task cmd ret <- atomically $ readTQueue toMagic
                try cmd >>= putMVar ret)
    undefined