happstack-server 6.6.3 → 6.6.4

raw patch · 2 files changed

+19/−8 lines, 2 files

Files

• happstack-server.cabal +1/−1
• src/Happstack/Server/Internal/TimeoutManager.hs +18/−7

@@ -1,5 +1,5 @@ Name:                happstack-server-Version:             6.6.3+Version:             6.6.4 Synopsis:            Web related tools and services. Description:         Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course <http://happstack.com/docs/crashcourse/index.html> License:             BSD3

@@ -3,6 +3,7 @@     , Handle     , initialize     , register+    , registerKillThread     , tickle     , pause     , resume@@ -10,14 +11,15 @@     ) where  import qualified Data.IORef as I-import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread) import Control.Monad (forever) import qualified Control.Exception as E  -- FIXME implement stopManager +-- | A timeout manager newtype Manager = Manager (I.IORef [Handle])-data Handle = Handle (IO ()) (I.IORef State)+data Handle = Handle (I.IORef (IO ())) (I.IORef State) data State = Active | Inactive | Paused | Canceled  initialize :: Int -> IO Manager@@ -35,7 +37,8 @@         state <- I.atomicModifyIORef iactive (\x -> (go' x, x))         case state of             Inactive -> do-                onTimeout `E.catch` ignoreAll+                action <- I.readIORef onTimeout+                action `E.catch` ignoreAll                 go rest front             Canceled -> go rest front             _ -> go rest (front . (:) m)@@ -48,12 +51,20 @@ register :: Manager -> IO () -> IO Handle register (Manager ref) onTimeout = do     iactive <- I.newIORef Active-    let h = Handle onTimeout iactive+    action  <- I.newIORef onTimeout+    let h = Handle action iactive     I.atomicModifyIORef ref (\x -> (h : x, ()))     return h +registerKillThread :: Manager -> IO Handle+registerKillThread m = do+    tid <- myThreadId+    register m $ killThread tid+ tickle, pause, resume, cancel :: Handle -> IO ()-tickle (Handle _ iactive) = I.writeIORef iactive Active-pause (Handle _ iactive) = I.writeIORef iactive Paused+tickle (Handle _ iactive) = I.writeIORef iactive $! Active+pause (Handle _ iactive) = I.writeIORef iactive $! Paused resume = tickle-cancel (Handle _ iactive) = I.writeIORef iactive Canceled+cancel (Handle action iactive) = +    do I.writeIORef iactive $! Canceled+       I.writeIORef action $! (return ())