1
1
mirror of https://github.com/aelve/guide.git synced 2024-11-23 12:15:06 +03:00

Empty the cache at start

This commit is contained in:
Artyom 2016-07-21 16:26:08 +03:00
parent 07bd60341c
commit 364f792175
3 changed files with 13 additions and 0 deletions

View File

@ -66,6 +66,7 @@ executable guide
, http-types
, ilist
, iproute == 1.7.*
, list-t
, lucid >= 2.9.5 && < 3
, megaparsec == 4.4.*
, microlens-platform >= 0.3.2

View File

@ -8,6 +8,7 @@ module Cache
(
CacheKey(..),
invalidateCache,
emptyCache,
cached,
)
where
@ -25,6 +26,7 @@ import qualified Data.ByteString.Lazy as BSL
-- Concurrent map
import qualified STMContainers.Map as STMMap
import Data.Hashable
import qualified ListT
-- Lucid
import Lucid.Base
@ -108,6 +110,12 @@ invalidateCache gs key = liftIO $ atomically $ do
for_ (cacheDepends gs key) $ \k ->
STMMap.delete k cache
-- TODO: Should be easier once
-- https://github.com/nikita-volkov/stm-containers/issues/6 is closed.
emptyCache :: MonadIO m => m ()
emptyCache = liftIO $ atomically $
ListT.traverse_ (\(k,_) -> STMMap.delete k cache) (STMMap.stream cache)
cached :: MonadIO m => CacheKey -> HtmlT m () -> HtmlT m ()
cached key gen = do
mbRes <- liftIO . atomically $ STMMap.lookup key cache

View File

@ -719,6 +719,10 @@ createCheckpoint' db = liftIO $ do
main :: IO ()
main = do
-- Emptying the cache is needed because during development (i.e. in REPL)
-- 'main' can be started many times and if the cache isn't cleared changes
-- won't be visible
emptyCache
config <- readConfig
let emptyState = GlobalState {
_categories = [],