Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 62 lines (55 sloc) 1.876 kb
48fd38e @kazu-yamamoto prefork logger.
kazu-yamamoto authored
1 module FileCache (fileCacheInit) where
e8c59b4 @kazu-yamamoto file info cache.
kazu-yamamoto authored
2
4cf4aa0 @kazu-yamamoto file cache remover.
kazu-yamamoto authored
3 import Control.Concurrent
e8c59b4 @kazu-yamamoto file info cache.
kazu-yamamoto authored
4 import Control.Exception
5 import Data.ByteString (ByteString)
6 import qualified Data.ByteString.Char8 as BS
7 import Data.HashMap (Map)
8 import qualified Data.HashMap as M
9 import Data.IORef
10 import Network.HTTP.Date
4cf4aa0 @kazu-yamamoto file cache remover.
kazu-yamamoto authored
11 import Network.Wai.Application.Classic
e8c59b4 @kazu-yamamoto file info cache.
kazu-yamamoto authored
12 import System.IO.Unsafe
13 import System.Posix.Files
14
15 data Entry = Negative | Positive FileInfo
16 type Cache = Map ByteString Entry
17 type GetInfo = ByteString -> IO (Maybe FileInfo)
18
19 fileInfo :: IORef Cache -> GetInfo
20 fileInfo ref path = atomicModifyIORef ref (lok path)
21
22 lok :: ByteString -> Cache -> (Cache, Maybe FileInfo)
23 lok path cache = unsafePerformIO $ do
24 let ment = M.lookup path cache
25 case ment of
26 Nothing -> handle handler $ do
27 let sfile = BS.unpack path
28 fs <- getFileStatus sfile
29 if doesExist fs then pos fs sfile else neg
30 Just Negative -> return (cache, Nothing)
31 Just (Positive x) -> return (cache, Just x)
32 where
33 size = fromIntegral . fileSize
34 mtime = epochTimeToHTTPDate . modificationTime
35 doesExist = not . isDirectory
36 pos fs sfile = do
37 let info = FileInfo {
38 fileInfoName = sfile
39 , fileInfoSize = size fs
40 , fileInfoTime = mtime fs
41 }
42 entry = Positive info
43 cache' = M.insert path entry cache
44 return (cache', Just info)
45 neg = do
46 let cache' = M.insert path Negative cache
47 return (cache', Nothing)
48 handler :: SomeException -> IO (Cache, Maybe FileInfo)
49 handler _ = neg
50
50d9f72 @kazu-yamamoto Completing log system.
kazu-yamamoto authored
51 fileCacheInit :: IO GetInfo
48fd38e @kazu-yamamoto prefork logger.
kazu-yamamoto authored
52 fileCacheInit = do
e8c59b4 @kazu-yamamoto file info cache.
kazu-yamamoto authored
53 ref <- newIORef M.empty
4cf4aa0 @kazu-yamamoto file cache remover.
kazu-yamamoto authored
54 forkIO (remover ref)
e8c59b4 @kazu-yamamoto file info cache.
kazu-yamamoto authored
55 return $ fileInfo ref
4cf4aa0 @kazu-yamamoto file cache remover.
kazu-yamamoto authored
56
57 remover :: IORef Cache -> IO ()
58 remover ref = do
59 threadDelay 10000000
ece2b4e @kazu-yamamoto removing undefined.
kazu-yamamoto authored
60 _ <- atomicModifyIORef ref (\_ -> (M.empty, ()))
4cf4aa0 @kazu-yamamoto file cache remover.
kazu-yamamoto authored
61 remover ref
Something went wrong with that request. Please try again.