{-# 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)