mirror of
https://github.com/aelve/guide.git
synced 2024-11-27 10:10:50 +03:00
Empty the cache at start
This commit is contained in:
parent
07bd60341c
commit
364f792175
@ -66,6 +66,7 @@ executable guide
|
|||||||
, http-types
|
, http-types
|
||||||
, ilist
|
, ilist
|
||||||
, iproute == 1.7.*
|
, iproute == 1.7.*
|
||||||
|
, list-t
|
||||||
, lucid >= 2.9.5 && < 3
|
, lucid >= 2.9.5 && < 3
|
||||||
, megaparsec == 4.4.*
|
, megaparsec == 4.4.*
|
||||||
, microlens-platform >= 0.3.2
|
, microlens-platform >= 0.3.2
|
||||||
|
@ -8,6 +8,7 @@ module Cache
|
|||||||
(
|
(
|
||||||
CacheKey(..),
|
CacheKey(..),
|
||||||
invalidateCache,
|
invalidateCache,
|
||||||
|
emptyCache,
|
||||||
cached,
|
cached,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
@ -25,6 +26,7 @@ import qualified Data.ByteString.Lazy as BSL
|
|||||||
-- Concurrent map
|
-- Concurrent map
|
||||||
import qualified STMContainers.Map as STMMap
|
import qualified STMContainers.Map as STMMap
|
||||||
import Data.Hashable
|
import Data.Hashable
|
||||||
|
import qualified ListT
|
||||||
-- Lucid
|
-- Lucid
|
||||||
import Lucid.Base
|
import Lucid.Base
|
||||||
|
|
||||||
@ -108,6 +110,12 @@ invalidateCache gs key = liftIO $ atomically $ do
|
|||||||
for_ (cacheDepends gs key) $ \k ->
|
for_ (cacheDepends gs key) $ \k ->
|
||||||
STMMap.delete k cache
|
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 :: MonadIO m => CacheKey -> HtmlT m () -> HtmlT m ()
|
||||||
cached key gen = do
|
cached key gen = do
|
||||||
mbRes <- liftIO . atomically $ STMMap.lookup key cache
|
mbRes <- liftIO . atomically $ STMMap.lookup key cache
|
||||||
|
@ -719,6 +719,10 @@ createCheckpoint' db = liftIO $ do
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
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
|
config <- readConfig
|
||||||
let emptyState = GlobalState {
|
let emptyState = GlobalState {
|
||||||
_categories = [],
|
_categories = [],
|
||||||
|
Loading…
Reference in New Issue
Block a user