Skip to content

@brinchj /gist:30b94760abc27b05ec7c secret
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
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
Something went wrong with that request. Please try again.