| By | Chris Done |
| At | 2013-02-28 |
| Title | re-enabled cache with a file-system cache |
| Description |
Edit file src/Amelie/Config.hs 33188 → 33188
22 22 <- mapM (get c "ANNOUNCE")
23 23 ["user","pass","host","port"]
24 24 [pghost,pgport,pguser,pgpass,pgdb]
25 25 <- mapM (get c "POSTGRESQL")
26 26 ["host","port","user","pass","db"]
- 27 [domain]
+ 27 [domain,cache]
28 28 <- mapM (get c "WEB")
- 29 ["domain"]
+ 29 ["domain","cache"]
30 30 [commits,url]
31 31 <- mapM (get c "DEV")
32 32 ["commits","repo_url"]
33 33 [prelude]
34 34 <- mapM (get c "STEPEVAL")
… … … … 48 48 , configRepoURL = url
49 49 , configStepevalPrelude = prelude
50 50 , configIrcDir = ircDir
51 51 , configAdmin = Address Nothing (T.pack admin)
52 52 , configSiteAddy = Address Nothing (T.pack siteaddy)
+ 53 , configCacheDir = cache
53 54 }
54 55 case config of
55 56 Left cperr -> error $ show cperr
56 57 Right config -> return config
… … … … Edit file src/Amelie/View/Style.hs 33188 → 33188
207 207 -- | Style for diff groups.
208 208 diff :: CSS Rule
209 209 diff = do
210 210 classRule "diff-both" $
211 211 return ()
- 212 classRule "diff-second" $ do
+ 212 classRule "diff-first" $ do
213 213 backgroundColor "#FDD"
214 214 color "#695B5B"
- 215 classRule "diff-first" $ do
+ 215 classRule "diff-second" $ do
216 216 backgroundColor "#DFD"
217 217 218 218 -- | Tokens colours and styles.
219 219 tokens :: CSS (Either Property Rule)
220 220 tokens = do
… … … … Edit file src/Amelie/Types/Cache.hs 33188 → 33188
13 13 14 14 data Key =
15 15 Home
16 16 | Paste Integer
17 17 | Activity
- 18 | Steps Integer String -- Expr
19 18 deriving (Eq,Ord)
20 19 21 20 data Cache =
22 21 Cache {23 22 cacheMap :: MVar (Map Key Text)
… … … … Edit file src/Amelie/Types/Config.hs 33188 → 33188
17 17 , configRepoURL :: String
18 18 , configStepevalPrelude :: FilePath
19 19 , configIrcDir :: FilePath
20 20 , configAdmin :: Address
21 21 , configSiteAddy :: Address
+ 22 , configCacheDir :: FilePath
22 23 }
23 24 24 25 -- | Announcer configuration.
25 26 data Announcer = Announcer {26 27 announceUser :: String
… … … … Edit file src/Amelie/Controller/Cache.hs 33188 → 33188
6 6 (newCache
7 7 ,cache
8 8 ,resetCache)
9 9 where
10 10 - 11 import Amelie.Types
+ 11 import Amelie.Types (Controller,ControllerState(..))
12 12 import Amelie.Types.Cache
+ 13 import Amelie.Types.Config
13 14 14 15 import Control.Concurrent
15 16 import Control.Monad.IO (io)
+ 17 import Control.Monad
16 18 import Control.Monad.Reader (asks)
17 19 import qualified Data.Map as M
18 20 import Data.Text.Lazy (Text)
+ 21 import qualified Data.Text.Lazy.IO as T
+ 22 import System.Directory
19 23 import Text.Blaze.Html5 (Html)
20 24 import Text.Blaze.Renderer.Text (renderHtml)
21 25 22 26 -- | Create a new cache.
23 27 newCache :: IO Cache
24 28 newCache = do
25 29 var <- newMVar M.empty
26 30 return $ Cache var
27 31 + 32 -- cache :: Key -> Controller (Maybe Html) -> Controller (Maybe Text)
+ 33 -- cache _key generate = fmap (fmap renderHtml) generate
+ 34 + 35 -- | Generate and save into the cache, or retrieve existing from the
+ 36 -- | cache.
28 37 cache :: Key -> Controller (Maybe Html) -> Controller (Maybe Text)
- 29 cache _key generate = fmap (fmap renderHtml) generate
- 30 - 31 -- -- | Generate and save into the cache, or retrieve existing from the
- 32 -- -- | cache.
- 33 -- cache' :: Key -> Controller (Maybe Html) -> Controller (Maybe Text)
- 34 -- cache' key generate = do
- 35 -- Cache var <- asks controllerStateCache
- 36 -- mapping <- io $ readMVar var
- 37 -- case M.lookup key mapping of
- 38 -- Just html -> return $ Just html
- 39 -- Nothing -> do
- 40 -- html <- fmap renderHtml <$> generate
- 41 -- case html of
- 42 -- Just html -> io $ modifyMVar_ var (return . M.insert key html)
- 43 -- Nothing -> return ()
- 44 -- return $ html
+ 38 cache key generate = do
+ 39 Cache var <- asks controllerStateCache
+ 40 tmpdir <- asks (configCacheDir . controllerStateConfig)
+ 41 let cachePath = tmpdir ++ "/" ++ keyToString key
+ 42 exists <- io $ doesFileExist cachePath
+ 43 if exists
+ 44 then do text <- io $ T.readFile cachePath
+ 45 return (Just text)
+ 46 else do text <- fmap (fmap renderHtml) generate
+ 47 case text of
+ 48 Just text' -> do io $ T.writeFile cachePath text'
+ 49 return text
+ 50 Nothing -> return text
45 51 46 52 -- | Reset an item in the cache.
47 53 resetCache :: Key -> Controller ()
48 54 resetCache key = do
- 49 Cache var <- asks controllerStateCache
- 50 io $ modifyMVar_ var (return . M.delete key)
+ 55 tmpdir <- asks (configCacheDir . controllerStateConfig)
+ 56 io $ do
+ 57 let cachePath = tmpdir ++ "/" ++ keyToString key
+ 58 exists <- io $ doesFileExist cachePath
+ 59 when exists $ removeFile cachePath
+ 60 + 61 keyToString :: Key -> String
+ 62 keyToString Home = "home"
+ 63 keyToString Activity = "activity"
+ 64 keyToString (Paste i) = "paste-" ++ show i
… … … …