1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
{-# LANGUAGE DeriveDataTypeable #-}
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)
|
