-
-
Save brinchj/30b94760abc27b05ec7c to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
flushProcess :: (Show k, Ord k, NFData k, Hashable k, KV.KVBackend m k v) => | |
Param m k v -> IO () | |
flushProcess p = go | |
where | |
go = do | |
debug "flush: meh" | |
xs <- evalCacheSTM p $ CacheSTM $ lift $ | |
do c <- H.size ht | |
when (c <= maxSize * 2) $ | |
retry -- traceShow c retry | |
H.toList ht | |
debug "flush: still meh" | |
xsat <- mapM getAt xs | |
let (_, lru) = L.splitAt (maxSize `div` 2) $! | |
map (\(_, a, b) -> (a, b)) $! | |
L.sortBy (\(a, _, _) (b, _, _) -> compare b a) xsat | |
let mv = lock p | |
debug "flush: take lock" | |
atomically $ do x <- readTVar mv | |
when (x /= 0) retry | |
writeTVar mv 1 | |
debug "flush: got lock" | |
flushAll mv lru | |
-- putStrLn "done here" | |
debug "flush: done" | |
go | |
ht = table p | |
maxSize = cacheSize p | |
readMany l 0 _ = return l | |
readMany l n ch = do | |
x <- atomically $ readTChan ch | |
readMany (x:l) (n-1) ch | |
getAt (k, p@(Ref _ _ tvat)) = do | |
at <- liftIO $ atomically $ readTVar tvat | |
return (at, k, p) | |
flushAll mv ls = do | |
mapM flushKey ls | |
debug "release lock" | |
atomically $ writeTVar mv 0 | |
flushKey (k, Ref tvst tvex _) = do | |
liftIO $ evalCacheSTM p $ CacheSTM $ do | |
debug' k | |
s <- lift $ readTVar tvst | |
ex <- lift $ readTVar tvex | |
ev <- asks toIO | |
debug' 2 | |
case s of | |
Write Nothing -> do | |
-- when (ex == Exist) $ | |
-- unsafeIO' $ ev $ KV.remove k | |
debug' 23 | |
lift $ writeTVar tvst (Read Nothing) | |
Write (Just v) -> do | |
-- unsafeIO' $ ev $ KV.store k v | |
debug' 24 | |
lift $ writeTVar tvst Unknown | |
return () | |
_ -> return () | |
debug' "flushKey done" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment