filecache 0.2.0 → 0.2.1
raw patch · 3 files changed
+57/−9 lines, 3 filesdep +directorydep +filecachedep +lensdep ~base
Dependencies added: directory, filecache, lens, temporary
Dependency ranges changed: base
Files
- Data/FileCache.hs +13/−7
- filecache.cabal +9/−2
- tests/simpletest.hs +35/−0
Data/FileCache.hs view
@@ -7,6 +7,7 @@ import Control.Exception import Control.Monad import Control.Monad.Error.Class+import Control.Exception.Lens data Messages r a = Invalidate !FilePath | Query !FilePath !(IO (S.Either r a)) !(MVar (S.Either r a))@@ -39,17 +40,22 @@ Invalidate fp -> case HM.lookup fp mp of Nothing -> nochange- Just (_,desc) -> removeWatch desc >> change (HM.delete fp)+ Just (_,desc) -> catching_ id (removeWatch desc) (return ()) >> change (HM.delete fp) Query fp action respvar -> case HM.lookup fp mp of Just (x,_) -> putMVar respvar x >> nochange Nothing -> do- valr <- catch action $ \e -> do- let r = strMsg $ "Exception: " ++ show (e :: SomeException)- return (S.Left r)- wm <- addWatch ino [CloseWrite,Delete,Move,Attrib,Create] fp (const $ invalidate fp (FileCache q))- putMVar respvar valr- change (HM.insert fp (valr,wm))+ let addw value = do+ wm <- addWatch ino [CloseWrite,Delete,Move,Attrib,Create] fp (const $ invalidate fp (FileCache q))+ change (HM.insert fp (value,wm))+ withWatch value = do+ putMVar respvar value+ catching_ id (addw value) nochange+ noWatch x = putMVar respvar x >> nochange+ catches (action >>= withWatch)+ [ handler _IOException (\io -> noWatch (S.Left (strMsg $ show io)))+ , handler id (\e -> withWatch (S.Left (strMsg $ show e)))+ ] GetCopy mv -> putMVar mv mp >> nochange case nmp of Just x -> mapMaster x q ino
filecache.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: filecache-version: 0.2.0+version: 0.2.1 synopsis: A Linux-only cache system associating values to files. The values are discarded when the files are modified. -- description: homepage: http://lpuppet.banquise.net/@@ -15,8 +15,15 @@ build-type: Simple cabal-version: >=1.8 +test-suite simpletest+ hs-source-dirs: tests+ type: exitcode-stdio-1.0+ ghc-options: -Wall -rtsopts -threaded -with-rtsopts-N+ build-depends: base, filecache, temporary, directory, unordered-containers+ main-is: simpletest.hs+ library exposed-modules: Data.FileCache ghc-options: -Wall -- other-modules: - build-depends: base ==4.6.*, unordered-containers, hashable, hinotify, strict-base-types >= 0.2, mtl+ build-depends: base ==4.6.*, unordered-containers, hashable, hinotify, strict-base-types >= 0.2, mtl, lens
+ tests/simpletest.hs view
@@ -0,0 +1,35 @@+module Main where++import System.IO.Temp+import Data.FileCache+import Control.Monad+import Control.Exception+import System.Directory+import Control.Concurrent+import qualified Data.HashMap.Strict as HM++computation :: String -> IO (Either String Int)+computation f = do+ c <- readFile f+ if length c `mod` 2 == 0+ then return (Right (length c))+ else return (Left "odd length")++main :: IO ()+main = withSystemTempDirectory "filecacheXXX.tmp" $ \tempdir -> do+ cache <- newFileCache :: IO (FileCache Int)+ let indexes = [1,10,100,1000]+ tofilename :: Int -> String+ tofilename i = tempdir ++ "/temp" ++ show i+ forM_ indexes $ \l -> writeFile (tofilename l) (show l)+ let q l = lazyQuery cache (tofilename l) (computation (tofilename l))+ qf l = lazyQuery cache (tofilename l) (throwIO (AssertionFailed "fail"))+ check x m = unless x (error m)+ lst1 <- mapM q indexes+ lst2 <- mapM qf indexes+ check (lst1 == lst2) "Request result was not cached"+ removeFile (tofilename 10)+ threadDelay (1*10^(6 :: Int))+ cacheInfo <- getCache cache+ check (HM.size cacheInfo == 3) "Invalidation didn't work"+