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:
parent
07bd60341c
commit
364f792175
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 = [],
|
||||
|
Loading…
Reference in New Issue
Block a user