@@ -1,5 +1,6 @@
11{-# LANGUAGE OverloadedStrings, CPP #-}
22{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
3+{-# LANGUAGE BangPatterns #-}
34
45module Network.Wai.Handler.Warp.HTTP2.Types where
56
@@ -10,7 +11,7 @@ import Control.Applicative ((<$>),(<*>))
1011import Control.Concurrent (forkIO)
1112import Control.Concurrent.STM
1213import Control.Exception (SomeException)
13−import Control.Monad (void)
14+import Control.Monad (void,(<$!>))
1415import Control.Reaper
1516import Data.ByteString (ByteString)
1617import qualified Data.ByteString as BS
@@ -121,7 +122,9 @@ newContext = Context <$> newIORef defaultSettings
121122 <*> newTVarIO defaultInitialWindowSize
122123
123124clearContext :: Context -> IO ()
124−clearContext ctx = void $ reaperStop $ streamTable ctx
125+clearContext ctx = do
126+ !_ <- reaperStop $ streamTable ctx
127+ return ()
125128
126129----------------------------------------------------------------
127130
@@ -223,13 +226,13 @@ initialize duration = mkReaper settings
223226
224227clean :: IntMap Stream -> IO (IntMap Stream -> IntMap Stream)
225228clean old = do
226− new <- M.fromAscList <$> prune oldlist []
227− return $ M.union new
229+ !new <- M.fromAscList <$> prune oldlist []
230+ return $! M.union new
228231 where
229− oldlist = M.toDescList old
232+ !oldlist = M.toDescList old
230233 prune [] lst = return lst
231234 prune (x@(_,s):xs) lst = do
232− st <- readIORef (streamState s)
235+ !st <- readIORef (streamState s)
233236 if isClosed st then
234237 prune xs lst
235238 else
@@ -239,7 +242,7 @@ insert :: StreamTable -> M.Key -> Stream -> IO ()
239242insert strmtbl k v = reaperAdd strmtbl (k,v)
240243
241244search :: StreamTable -> M.Key -> IO (Maybe Stream)
242−search strmtbl k = M.lookup k <$> reaperRead strmtbl
245+search strmtbl k = M.lookup k <$!> reaperRead strmtbl
243246
244247
245248-- INVARIANT: streams in the output queue have non-zero window size.