git.iko.soy/typeable/wai
on master help sign in
Defining an exception: BreakForever.
de0f05aKazu Yamamoto
warp/Network/Wai/Handler/Warp/Thread.hs+10−3
compare with master
unifiedsplit
@@ -1,12 +1,19 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+
1module Network.Wai.Handler.Warp.Thread (
3module Network.Wai.Handler.Warp.Thread (
2 forkIOwithBreakableForever
4 forkIOwithBreakableForever
3 , breakForever
5 , breakForever
4 ) where
6 ) where
5
7
6import Control.Concurrent (forkIO)
8import Control.Concurrent (forkIO)
9+import Control.Exception (handle, throw, mask_, Exception)
7import Control.Monad (void, forever)
10import Control.Monad (void, forever)
8−import Control.Exception (handle, throw, mask_, SomeException, AsyncException(ThreadKilled))
9import Data.IORef
11import Data.IORef
12+import Data.Typeable
13+
14+data BreakForever = BreakForever deriving (Show, Typeable)
15+
16+instance Exception BreakForever
10
17
11forkIOwithBreakableForever :: a -> (IORef a -> IO ()) -> IO (IORef a)
18forkIOwithBreakableForever :: a -> (IORef a -> IO ()) -> IO (IORef a)
12forkIOwithBreakableForever ini action = do
19forkIOwithBreakableForever ini action = do
@@ -14,8 +21,8 @@ forkIOwithBreakableForever ini action = do
14 void . forkIO . handle stopPropagation . forever . mask_ $ action ref
21 void . forkIO . handle stopPropagation . forever . mask_ $ action ref
15 return ref
22 return ref
16
23
17−stopPropagation :: SomeException -> IO ()
24+stopPropagation :: BreakForever -> IO ()
18stopPropagation _ = return ()
25stopPropagation _ = return ()
19
26
20breakForever :: IORef a -> IO a
27breakForever :: IORef a -> IO a
21−breakForever ref = atomicModifyIORef ref $ \x -> (throw ThreadKilled, x)
28+breakForever ref = atomicModifyIORef ref $ \x -> (throw BreakForever, x)