warp 3.0.2.1 → 3.0.2.2

raw patch · 3 files changed

+65/−8 lines, 3 filesdep ~atomic-primopsdep ~base

Dependency ranges changed: atomic-primops, base

Files

• Network/Wai/Handler/Warp/Counter.hs +21/−0
• Network/Wai/Handler/Warp/Timeout.hs +35/−5
• warp.cabal +9/−3

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Network.Wai.Handler.Warp.Counter (     Counter   , newCounter@@ -6,6 +7,7 @@   , decrease   ) where +#if USE_ATOMIC_PRIMOPS import qualified Data.Atomics.Counter.Unboxed as C import Control.Applicative ((<$>)) @@ -22,3 +24,22 @@  decrease :: Counter -> IO () decrease (Counter ref) = C.incrCounter_ (-1) ref+#else++import Network.Wai.Handler.Warp.IORef+import Control.Applicative ((<$>))++newtype Counter = Counter (IORef Int)++newCounter :: IO Counter+newCounter = Counter <$> newIORef 0++isZero :: Counter -> IO Bool+isZero (Counter ref) = (== 0) <$> readIORef ref++increase :: Counter -> IO ()+increase (Counter ref) = atomicModifyIORef' ref (\x -> (x + 1, ()))++decrease :: Counter -> IO ()+decrease (Counter ref) = atomicModifyIORef' ref (\x -> (x - 1, ()))+#endif

@@ -59,7 +59,12 @@ import System.Mem.Weak (deRefWeak) import Data.Typeable (Typeable) import Control.Reaper+#if USE_ATOMIC_PRIMOPS import qualified Data.Atomics.Counter.Unboxed as C+import Data.Atomics.Counter.Unboxed (casCounter)+#else+import Network.Wai.Handler.Warp.IORef+#endif  ---------------------------------------------------------------- @@ -70,7 +75,12 @@ type TimeoutAction = IO ()  -- | A handle used by 'Manager'-data Handle = Handle TimeoutAction {-# UNPACK #-} !C.AtomicCounter+data Handle = Handle TimeoutAction+#if USE_ATOMIC_PRIMOPS+    {-# UNPACK #-} !C.AtomicCounter+#else+    {-# UNPACK #-} !(IORef Int)+#endif  -- Four states for the AtomicCounter: --@@ -91,7 +101,7 @@   where     prune m@(Handle onTimeout iactive) = do         -- Try to change from active to inactive-        (wasActive, newState) <- C.casCounter iactive 1 2+        (wasActive, newState) <- casCounter iactive 1 2         case newState of             2 | not wasActive -> do -- inactive                 onTimeout `E.catch` ignoreAll@@ -99,6 +109,14 @@             4 -> return Nothing -- canceled             _        -> return $ Just m +#if !USE_ATOMIC_PRIMOPS+casCounter :: IORef Int -> Int -> Int -> IO (Bool, Int)+casCounter ref old new = atomicModifyIORef' ref $ \curr ->+    if old == curr+        then (new, (True, new))+        else (old, (False, old))+#endif+ ----------------------------------------------------------------  -- | Stopping timeout manager.@@ -115,7 +133,11 @@ -- | Registering a timeout action. register :: Manager -> TimeoutAction -> IO Handle register mgr onTimeout = do+#if USE_ATOMIC_PRIMOPS     iactive <- C.newCounter 1+#else+    iactive <- newIORef 1+#endif     let h = Handle onTimeout iactive     reaperAdd mgr h     return h@@ -149,20 +171,28 @@  ---------------------------------------------------------------- +writeCounter :: Int -> Handle -> IO ()+#if USE_ATOMIC_PRIMOPS+writeCounter i (Handle _ iactive) = C.writeCounter iactive i+#else+writeCounter i (Handle _ iactive) = writeIORef iactive i+#endif+{-# INLINE writeCounter #-}+ -- | Setting the state to active. --   'Manager' turns active to inactive repeatedly. tickle :: Handle -> IO ()-tickle (Handle _ iactive) = C.writeCounter iactive 1+tickle = writeCounter 1  -- | Setting the state to canceled. --   'Manager' eventually removes this without timeout action. cancel :: Handle -> IO ()-cancel (Handle _ iactive) = C.writeCounter iactive 4+cancel = writeCounter 4  -- | Setting the state to paused. --   'Manager' does not change the value. pause :: Handle -> IO ()-pause (Handle _ iactive) = C.writeCounter iactive 3+pause = writeCounter 3  -- | Setting the paused state to active. --   This is an alias to 'tickle'.

@@ -1,5 +1,5 @@ Name:                warp-Version:             3.0.2.1+Version:             3.0.2.2 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE@@ -52,7 +52,10 @@                    , wai                       >= 3.0      && < 3.1                    , text                    , streaming-commons         >= 0.1.2-                   , atomic-primops            >= 0.6++  if impl(ghc >= 7.8)+      Build-Depends: atomic-primops            >= 0.6+      cpp-options:   -DUSE_ATOMIC_PRIMOPS   if flag(network-bytestring)       Build-Depends: network                   >= 2.2.1.5  && < 2.2.3                    , network-bytestring        >= 0.1.3    && < 0.1.4@@ -144,7 +147,10 @@                    , text                    , streaming-commons >= 0.1.1                    , async-                   , atomic-primops++  if impl(ghc >= 7.8)+      Build-Depends: atomic-primops            >= 0.6+      cpp-options:   -DUSE_ATOMIC_PRIMOPS    if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)     Cpp-Options:   -DSENDFILEFD