snap-app 0.3.0 → 0.3.1

raw patch · 2 files changed

+96/−2 lines, 2 filesdep +directorydep +filepath

Dependencies added: directory, filepath

Files

• snap-app.cabal +5/−2
• src/Snap/App/Cache.hs +91/−0

@@ -1,5 +1,5 @@ name:                snap-app-version:             0.3.0+version:             0.3.1 synopsis:            Simple modules for writing apps with Snap, abstracted from hpaste. homepage:            Simple modules for writing apps with Snap, abstracted from hpaste. license:             BSD3@@ -14,6 +14,7 @@   ghc-options:       -O2   hs-source-dirs:    src   exposed-modules:   Snap.App, Snap.App.Types, Snap.App.Controller, Snap.App.Model, Snap.App.Migrate,+                     Snap.App.Cache,                      Data.Pagination, Text.Blaze.Extra, Text.Blaze.Pagination,                      Control.Monad.Env, Data.Monoid.Operator,                      Network.URI.Params@@ -30,4 +31,6 @@                      bytestring,                      MonadCatchIO-transformers,                      cgi,-                     data-default+                     data-default,+                     filepath,+                     directory

@@ -0,0 +1,91 @@+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}++-- | Caching of Blaze HTML pages caching.++module Snap.App.Cache+  (cache+  ,cacheIf+  ,resetCache+  ,clearCache+  ,resetCacheModel+  ,viewCached+  ,Key(..)+  ,CacheDir(..))+  where++import           Control.Monad.Reader+import           Data.Text.Lazy           (Text)+import qualified Data.Text.Lazy.IO as T+import           Snap.App+import           System.Directory+import           System.FilePath+import           Text.Blaze+import           Text.Blaze.Renderer.Text++-- | A key for the cache.+class Key key where+  keyToString :: key -> FilePath++-- | A config that can return a cache directory.+class CacheDir config where+  getCacheDir :: config -> FilePath++-- | Cache conditionally.+cacheIf :: (CacheDir c,Key key) => Bool -> key -> Controller c s (Maybe Html) -> Controller c s (Maybe Text)+cacheIf pred key generate =+  if pred+     then cache key generate+     else fmap (fmap renderHtml) generate++-- | Generate and save into the cache, or retrieve existing from the+-- | cache.+cache :: (CacheDir c,Key key) => key -> Controller c s (Maybe Html) -> Controller c s (Maybe Text)+cache key generate = do+  tmpdir <- asks (getCacheDir . controllerStateConfig)+  let cachePath = tmpdir ++ "/" ++ keyToString key+  exists <- io $ doesFileExist cachePath+  if exists+     then do text <- io $ T.readFile cachePath+     	     return (Just text)+     else do text <- fmap (fmap renderHtml) generate+     	     case text of+	       Just text' -> do io $ createDirectoryIfMissing True tmpdir+                                io $ T.writeFile cachePath text'+	       	    	        return text+               Nothing -> return text++-- | Clear the whole cache.+clearCache :: CacheDir c => c -> IO ()+clearCache config = do+  files <- getDirectoryContents dir+  forM_ (filter (not . all (=='.')) files) $ removeFile . (dir </>)++  where dir = getCacheDir config++-- | Reset an item in the cache.+resetCache :: (CacheDir c,Key key) => key -> Controller c s ()+resetCache key = do+  tmpdir <- asks (getCacheDir . controllerStateConfig)+  io $ do+   let cachePath = tmpdir ++ "/" ++ keyToString key+   exists <- io $ doesFileExist cachePath+   when exists $ removeFile cachePath++-- | Reset an item in the cache.+resetCacheModel :: (CacheDir c,Key key) => key -> Model c s ()+resetCacheModel key = do+  tmpdir <- asks (getCacheDir . modelStateConfig)+  io $ do+   let cachePath = tmpdir ++ "/" ++ keyToString key+   exists <- io $ doesFileExist cachePath+   when exists $ removeFile cachePath++-- | Because.+io :: MonadIO m => IO a -> m a+io = liftIO++-- | View some HTML generator cached.+viewCached :: (CacheDir c,Key key) => key -> Controller c s Html -> Controller c s ()+viewCached key generate = do+  text <- cache key (fmap Just generate)+  maybe (return ()) outputText text