@@ -2,6 +2,7 @@
22
33module Network.Wai.Handler.Warp.FileInfoCache (
44 FileInfo(..)
5+ , Hash
56 , withFileInfoCache
67 , getInfo -- test purpose only
78 ) where
@@ -10,13 +11,16 @@ import Control.Exception as E
1011import Control.Monad (void)
1112import Control.Reaper
1213import Data.ByteString (ByteString)
13−import Data.HashMap.Strict (HashMap)
14−import qualified Data.HashMap.Strict as M
14+import Data.Hashable (hash)
1515import Network.HTTP.Date
16+import Network.Wai.Handler.Warp.HashMap (HashMap)
17+import qualified Network.Wai.Handler.Warp.HashMap as M
1618import System.PosixCompat.Files
1719
1820----------------------------------------------------------------
1921
22+type Hash = Int
23+
2024-- | File information.
2125data FileInfo = FileInfo {
2226 fileInfoName :: !FilePath
@@ -27,7 +31,7 @@ data FileInfo = FileInfo {
2731
2832data Entry = Negative | Positive FileInfo
2933type Cache = HashMap FilePath Entry
30−type FileInfoCache = Reaper Cache (FilePath,Entry)
34+type FileInfoCache = Reaper Cache (Int,FilePath,Entry)
3135
3236----------------------------------------------------------------
3337
@@ -51,25 +55,32 @@ getInfo path = do
5155 else
5256 throwIO (userError "FileInfoCache:getInfo")
5357
58+getInfo' :: Hash -> FilePath -> IO FileInfo
59+getInfo' _ = getInfo
60+
5461----------------------------------------------------------------
5562
5663getAndRegisterInfo :: FileInfoCache -> FilePath -> IO FileInfo
57−getAndRegisterInfo reaper@Reaper{..} path = do
64+getAndRegisterInfo reaper path = getAndRegisterInfo' reaper (hash path) path
65+
66+getAndRegisterInfo' :: FileInfoCache -> Hash -> FilePath -> IO FileInfo
67+getAndRegisterInfo' reaper@Reaper{..} h path = do
5868 cache <- reaperRead
59− case M.lookup path cache of
69+ case M.lookup h path cache of
6070 Just Negative -> throwIO (userError "FileInfoCache:getAndRegisterInfo")
6171 Just (Positive x) -> return x
62− Nothing -> positive reaper path `E.onException` negative reaper path
72+ Nothing -> positive reaper h path
73+ `E.onException` negative reaper h path
6374
64−positive :: FileInfoCache -> FilePath -> IO FileInfo
65−positive Reaper{..} path = do
75+positive :: FileInfoCache -> Hash -> FilePath -> IO FileInfo
76+positive Reaper{..} h path = do
6677 info <- getInfo path
67− reaperAdd (path, Positive info)
78+ reaperAdd (h, path, Positive info)
6879 return info
6980
70−negative :: FileInfoCache -> FilePath -> IO FileInfo
71−negative Reaper{..} path = do
72− reaperAdd (path,Negative)
81+negative :: FileInfoCache -> Hash -> FilePath -> IO FileInfo
82+negative Reaper{..} h path = do
83+ reaperAdd (h, path,Negative)
7384 throwIO (userError "FileInfoCache:negative")
7485
7586----------------------------------------------------------------
@@ -77,19 +88,22 @@ negative Reaper{..} path = do
7788-- | Creating a file information cache
7889-- and executing the action in the second argument.
7990-- The first argument is a cache duration in second.
80−withFileInfoCache :: Int -> ((FilePath -> IO FileInfo) -> IO a) -> IO a
81−withFileInfoCache 0 action = action getInfo
82−withFileInfoCache duration action = E.bracket (initialize duration)
83− terminate
84− (action . getAndRegisterInfo)
85−
86−initialize :: Int -> IO FileInfoCache
91+withFileInfoCache :: Int
92+ -> ((FilePath -> IO FileInfo) -> (Hash -> FilePath -> IO FileInfo) -> IO a)
93+ -> IO a
94+withFileInfoCache 0 action = action getInfo getInfo'
95+withFileInfoCache duration action =
96+ E.bracket (initialize duration)
97+ terminate
98+ (\r -> action (getAndRegisterInfo r) (getAndRegisterInfo' r))
99+
100+initialize :: Hash -> IO FileInfoCache
87101initialize duration = mkReaper settings
88102 where
89103 settings = defaultReaperSettings {
90104 reaperAction = override
91105 , reaperDelay = duration * 1000000
92− , reaperCons = uncurry M.insert
106+ , reaperCons = \(h,k,v) -> M.insert h k v
93107 , reaperNull = M.null
94108 , reaperEmpty = M.empty
95109 }