module Network.Wai.Handler.Warp.Thread (
forkIOwithBreakableForever
, breakForever
) where
import Control.Concurrent (forkIO)
import Control.Exception (handle, throw, mask_, Exception)
import Control.Monad (void, forever)
import Data.IORef
import Data.Typeable
data BreakForever = BreakForever deriving (Show, Typeable)
instance Exception BreakForever
forkIOwithBreakableForever :: a -> (IORef a -> IO ()) -> IO (IORef a)
forkIOwithBreakableForever ini action = do
ref <- newIORef ini
void . forkIO . handle stopPropagation . forever . mask_ $ action ref
return ref
stopPropagation :: BreakForever -> IO ()
stopPropagation _ = return ()
breakForever :: IORef a -> IO a
breakForever ref = atomicModifyIORef ref $ \x -> (throw BreakForever, x)