module Acme.Missiles.STM (
withMissilesDo,
launchMissilesSTM,
) where
import Acme.Missiles (launchMissiles)
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.STM (STM, atomically, retry,
TVar, newTVarIO, readTVar, writeTVar)
import Control.Exception (bracket)
import Control.Monad (forever)
import System.IO.Unsafe (unsafePerformIO)
withMissilesDo :: IO a -> IO a
withMissilesDo action =
bracket (forkIO doLaunching)
killThread
(\_ -> action)
where
doLaunching = forever $ do
atomically $ do
n <- readTVar missileCommand
if n > 0
then writeTVar missileCommand (n 1)
else retry
launchMissiles
launchMissilesSTM :: STM ()
launchMissilesSTM = do
n <- readTVar missileCommand
writeTVar missileCommand $! n + 1
missileCommand :: TVar Integer
missileCommand = unsafePerformIO (newTVarIO 0)