cbd66de · typeable/wai

git.iko.soy/typeable/wai

adopting the new reaper APIs.

commitcbd66de684b7f89a515f13076752a3254dcfa6d8 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 6 Aug 2014, 15:53 (12 years ago) parent50532f6

2 files changed+12−25

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/FdCache.hs+7−14 warp/Network/Wai/Handler/Warp/Timeout.hs+5−11

warp/Network/Wai/Handler/Warp/FdCache.hs+7−14

@@ -30,7 +30,6 @@ import Network.Wai.Handler.Warp.MultiMap

3030import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)

3131import System.Posix.Types (Fd)

3232import Control.Reaper

33−import Data.Maybe (fromMaybe)

3433

3534----------------------------------------------------------------

3635

@@ -68,12 +67,10 @@ type Hash = Int

6867type FdCache = MMap Hash FdEntry

6968

7069-- | Mutable Fd cacher.

71−data MutableFdCache = MutableFdCache

72− ((Hash, FdEntry) -> IO ())

73− (IORef (Maybe FdCache))

70+type MutableFdCache = Reaper FdCache (Hash, FdEntry)

7471

7572fdCache :: MutableFdCache -> IO FdCache

76−fdCache (MutableFdCache _ ref) = fromMaybe empty <$> readIORef ref

73+fdCache mfc = reaperRead mfc

7774

7875look :: MutableFdCache -> FilePath -> Hash -> IO (Maybe FdEntry)

7976look mfc path key = searchWith key check <$> fdCache mfc

@@ -99,8 +96,7 @@ withFdCache duration action = bracket (initialize duration)

9996-- The first argument is a cache duration in second.

10097initialize :: Int -> IO (Maybe MutableFdCache)

10198initialize 0 = return Nothing

102−initialize duration = fmap (Just . uncurry MutableFdCache)

103− $ mkReaper defaultReaperSettings

99+initialize duration = Just <$> mkReaper defaultReaperSettings

104100 { reaperAction = clean

105101 , reaperDelay = duration

106102 , reaperCons = uncurry insert

@@ -133,11 +129,8 @@ prune k (Tom ent@(FdEntry _ fd mst) vs) = status mst >>= prune'

133129

134130terminate :: Maybe MutableFdCache -> IO ()

135131terminate Nothing = return ()

136−terminate (Just (MutableFdCache _ ref)) = do

137− !t <- atomicModifyIORef ref $ \mm ->

138− case mm of

139− Nothing -> (Nothing, empty)

140− Just m -> (Just empty, m)

132+terminate (Just mfc) = do

133+ !t <- reaperStop mfc

141134 mapM_ closeIt $ toList t

142135 where

143136 closeIt (_, FdEntry _ fd _) = closeFd fd

@@ -146,12 +139,12 @@ terminate (Just (MutableFdCache _ ref)) = do

146139

147140-- | Getting 'Fd' and 'Refresh' from the mutable Fd cacher.

148141getFd :: MutableFdCache -> FilePath -> IO (Fd, Refresh)

149−getFd mfc@(MutableFdCache add _) path = look mfc path key >>= getFd'

142+getFd mfc path = look mfc path key >>= getFd'

150143 where

151144 key = hash path

152145 getFd' Nothing = do

153146 ent@(FdEntry _ fd mst) <- newFdEntry path

154− add (key, ent)

147+ reaperAdd mfc (key, ent)

155148 return (fd, refresh mst)

156149 getFd' (Just (FdEntry _ fd mst)) = do

157150 refresh mst

warp/Network/Wai/Handler/Warp/Timeout.hs+5−11

@@ -61,7 +61,7 @@ import Control.Reaper

6161----------------------------------------------------------------

6262

6363-- | A timeout manager

64−data Manager = Manager (Handle -> IO ()) (IORef (Maybe [Handle]))

64+type Manager = Reaper [Handle] Handle

6565

6666-- | An action to be performed on timeout.

6767type TimeoutAction = IO ()

@@ -79,8 +79,7 @@ data State = Active -- Manager turns it to Inactive.

7979-- | Creating timeout manager which works every N micro seconds

8080-- where N is the first argument.

8181initialize :: Int -> IO Manager

82−initialize timeout =

83− fmap (uncurry Manager) $ mkReaper defaultReaperSettings

82+initialize timeout = mkReaper defaultReaperSettings

8483 { reaperAction = mkListAction prune

8584 , reaperDelay = timeout

8685 }

@@ -101,12 +100,7 @@ initialize timeout =

101100

102101-- | Stopping timeout manager.

103102stopManager :: Manager -> IO ()

104−stopManager (Manager _ ref) = E.mask_ $ do

105− handles <- I.atomicModifyIORef ref $ \x ->

106− case x of

107− Nothing -> (Nothing, [])

108− Just y -> (Just [], y)

109− mapM_ fire handles

103+stopManager mgr = E.mask_ (reaperStop mgr >>= mapM_ fire)

110104 where

111105 fire (Handle onTimeout _) = onTimeout `E.catch` ignoreAll

112106

@@ -117,10 +111,10 @@ ignoreAll _ = return ()

117111

118112-- | Registering a timeout action.

119113register :: Manager -> TimeoutAction -> IO Handle

120−register (Manager add _) onTimeout = do

114+register mgr onTimeout = do

121115 iactive <- I.newIORef Active

122116 let h = Handle onTimeout iactive

123− add h

117+ reaperAdd mgr h

124118 return h

125119

126120-- | Registering a timeout action of killing this thread.