-- | -- Module: Acme.Missiles -- License: Public domain -- Portability: non-portable -- -- The 'launchMissiles' action, as mentioned in: -- -- * /Beautiful concurrency/, by Simon Peyton Jones, to appear in -- \"Beautiful code\", ed Greg Wilson, O'Reilly 2007. -- <http://research.microsoft.com/en-us/um/people/simonpj/papers/stm/index.htm#beautiful> module Acme.Missiles ( launchMissiles, -- * Launching missiles in the 'STM' monad withMissilesDo, launchMissilesSTM, ) where import Control.Concurrent import Control.Concurrent.STM import Control.Exception (bracket) import Control.Monad (forever) import System.IO.Unsafe (unsafePerformIO) -- | Cause serious international side effects. launchMissiles :: IO () launchMissiles = putStrLn "Nuclear launch detected." -- | Perform initialization needed to launch missiles in the 'STM' monad. withMissilesDo :: IO a -> IO a withMissilesDo action = bracket (forkIO doLaunching) killThread (\_ -> action) where doLaunching = forever $ do atomically $ takeTMVar missileCommand launchMissiles -- | Launch missiles within an 'STM' computation. Even if the memory -- transaction is retried, only one salvo of missiles will be launched. -- -- Example: -- -- >import Acme.Missiles -- >import Control.Concurrent -- >import Control.Concurrent.STM -- > -- >main :: IO () -- >main = withMissilesDo $ do -- > xv <- atomically $ newTVar (2 :: Int) -- > yv <- atomically $ newTVar (1 :: Int) -- > atomically $ do -- > x <- readTVar xv -- > y <- readTVar yv -- > if x > y -- > then launchMissilesSTM -- > else return () -- > threadDelay 100000 launchMissilesSTM :: STM () launchMissilesSTM = putTMVar missileCommand () missileCommand :: TMVar () {-# NOINLINE missileCommand #-} missileCommand = unsafePerformIO newEmptyTMVarIO