Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[inferno-vc] Improve cached client hit ratio #136

Closed
wants to merge 1 commit into from
+8 −5
Closed

[inferno-vc] Improve cached client hit ratio #136

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions inferno-vc/CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,9 @@
# Revision History for inferno-vc
*Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH)

## 0.3.8.0 -- 2024-10-10
* Improve cache-hit ratio

## 0.3.7.1 -- 2024-09-23
* Fix overflowing threadDelay on armv7l

Expand Down
2 changes: 1 addition & 1 deletion inferno-vc/inferno-vc.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: >=1.10
name: inferno-vc
version: 0.3.7.1
version: 0.3.8.0
synopsis: Version control server for Inferno
description: A version control server for Inferno scripts
category: DSL,Scripting
Expand Down
8 changes: 4 additions & 4 deletions inferno-vc/src/Inferno/VersionControl/Client/Cached.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ data CachedVCClientError

initVCCachedClient :: FilePath -> IO VCCacheEnv
initVCCachedClient cachePath = do
createDirectoryIfMissing True $ cachePath </> "deps"
createDirectoryIfMissing True cachePath
cacheInFlight <- newTVarIO mempty
pure VCCacheEnv {cachePath, cacheInFlight}

Expand All @@ -106,12 +106,12 @@ fetchVCObjectClosure fetchVCObjects remoteFetchVCObjectClosureHashes objHash = d
env@VCCacheEnv {cachePath} <- asks getTyped
deps <-
withInFlight env [objHash] $
liftIO (doesFileExist $ cachePath </> "deps" </> show objHash) >>= \case
liftIO (doesFileExist $ cachePath </> show objHash) >>= \case
False -> do
deps <- liftServantClient $ remoteFetchVCObjectClosureHashes objHash
liftIO
$ atomicWriteFile
(cachePath </> "deps" </> show objHash)
(cachePath </> show objHash)
$ BL.concat [BL.fromStrict (vcObjectHashToByteString h) <> "\n" | h <- deps]
pure deps
True -> fetchVCObjectClosureHashes objHash
Expand Down Expand Up @@ -149,7 +149,7 @@ fetchVCObjectClosureHashes ::
m [VCObjectHash]
fetchVCObjectClosureHashes h = do
VCCacheEnv {cachePath} <- asks getTyped
let fp = cachePath </> "deps" </> show h
let fp = cachePath </> show h
readVCObjectHashTxt fp

readVCObjectHashTxt ::
Expand Down
Loading