filecache (empty) → 0.2.0
raw patch · 4 files changed
+146/−0 lines, 4 filesdep +basedep +hashabledep +hinotifysetup-changed
Dependencies added: base, hashable, hinotify, mtl, strict-base-types, unordered-containers
Files
- Data/FileCache.hs +92/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- filecache.cabal +22/−0
+ Data/FileCache.hs view
@@ -0,0 +1,92 @@+module Data.FileCache (FileCache, FileCacheR, newFileCache, killFileCache, invalidate, query, getCache, lazyQuery) where++import qualified Data.HashMap.Strict as HM+import System.INotify+import Control.Concurrent+import qualified Data.Either.Strict as S+import Control.Exception+import Control.Monad+import Control.Monad.Error.Class++data Messages r a = Invalidate !FilePath+ | Query !FilePath !(IO (S.Either r a)) !(MVar (S.Either r a))+ | GetCopy !(MVar (HM.HashMap FilePath (S.Either r a, WatchDescriptor)))+ | Stop++data FileCacheR r a = FileCache !(Chan (Messages r a))+type FileCache = FileCacheR String++-- | Generates a new file cache. The opaque type is for use with other+-- functions.+newFileCache :: Error r => IO (FileCacheR r a)+newFileCache = do+ q <- newChan+ ino <- initINotify+ void $ forkIO (mapMaster HM.empty q ino)+ return (FileCache q)++-- | Destroys the thread running the FileCache. Pretty dangerous stuff.+killFileCache :: FileCacheR r a -> IO ()+killFileCache (FileCache q) = writeChan q Stop++mapMaster :: Error r => HM.HashMap FilePath (S.Either r a, WatchDescriptor) -> Chan (Messages r a) -> INotify -> IO ()+mapMaster mp q ino = do+ let nochange = return (Just mp)+ change x = return (Just (x mp))+ msg <- readChan q+ nmp <- case msg of+ Stop -> killINotify ino >> return Nothing+ Invalidate fp ->+ case HM.lookup fp mp of+ Nothing -> nochange+ Just (_,desc) -> removeWatch desc >> 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))+ GetCopy mv -> putMVar mv mp >> nochange+ case nmp of+ Just x -> mapMaster x q ino+ Nothing -> return ()++-- | Manually invalidates an entry.+invalidate :: Error r => FilePath -> FileCacheR r a -> IO ()+invalidate fp (FileCache q) = writeChan q (Invalidate fp)++-- | Queries the cache, populating it if necessary.+query :: Error r+ => FileCacheR r a+ -> FilePath -- ^ Path of the file entry+ -> IO (S.Either r a) -- ^ The computation that will be used to populate the cache+ -> IO (S.Either r a)+query (FileCache q) fp generate = do+ v <- newEmptyMVar+ writeChan q (Query fp generate v)+ readMVar v++-- | Just like `query`, but with the standard "Either" type.+lazyQuery :: Error r+ => FileCacheR r a+ -> FilePath -- ^ Path of the file entry+ -> IO (Either r a) -- ^ The computation that will be used to populate the cache+ -> IO (Either r a)+lazyQuery q fp generate = fmap unstrict (query q fp (fmap strict generate))+ where+ strict (Left x) = S.Left x+ strict (Right x) = S.Right x+ unstrict (S.Left x) = Left x+ unstrict (S.Right x) = Right x++-- | Gets a copy of the cache.+getCache :: Error r => FileCacheR r a -> IO (HM.HashMap FilePath (S.Either r a, WatchDescriptor))+getCache (FileCache q) = do+ v <- newEmptyMVar+ writeChan q (GetCopy v)+ readMVar v+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Simon Marechal++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Simon Marechal nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ filecache.cabal view
@@ -0,0 +1,22 @@+-- Initial filecache.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: filecache+version: 0.2.0+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/+license: BSD3+license-file: LICENSE+author: Simon Marechal+maintainer: bartavelle@gmail.com+-- copyright: +category: Data+build-type: Simple+cabal-version: >=1.8++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