054fa04 · elk · git.iko.soy

git.iko.soy/elk

use less granular lock when verifying packages

I was worried that different executables would get locks on different packages, so you'd end up needing to swap between them a bunch. So instead, each executable just gets a lock for the whole package verification phase.

commit054fa04074fd819958affd04a526e10f69aa5197 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 2 Jul 2019, 23:55 (7 years ago) parent8ce703f

3 files changed+33−37

compare with master

unifiedsplit

builder/src/Deps/Solver.hs+27−24 builder/src/Elm/Details.hs+3−3 builder/src/Stuff.hs+3−10

builder/src/Deps/Solver.hs+27−24

@@ -94,6 +94,7 @@ data Details =

9494

9595verify :: Stuff.PackageCache -> Connection -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details))

9696verify cache connection registry constraints =

97+ Stuff.withRegistryLock cache $

9798 case try constraints of

9899 Solver solver ->

99100 solver (State cache connection registry Map.empty)

@@ -130,6 +131,7 @@ data AppSolution =

130131

131132addToApp :: Stuff.PackageCache -> Connection -> Registry.Registry -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution)

132133addToApp cache connection registry pkg outline@(Outline.AppOutline _ _ direct indirect testDirect testIndirect) =

134+ Stuff.withRegistryLock cache $

133135 let

134136 allIndirects = Map.union indirect testIndirect

135137 allDirects = Map.union direct testDirect

@@ -349,30 +351,31 @@ data Env =

349351

350352initEnv :: IO (Either Exit.RegistryProblem Env)

351353initEnv =

352− Stuff.withRegistryLock $ \cache ->

353− do mvar <- newEmptyMVar

354− _ <- forkIO $ putMVar mvar =<< Http.getManager

355− maybeRegistry <- Registry.read cache

356− manager <- readMVar mvar

357−

358− case maybeRegistry of

359− Nothing ->

360− do eitherRegistry <- Registry.fetch manager cache

361− case eitherRegistry of

362− Right latestRegistry ->

363− return $ Right $ Env cache manager (Online manager) latestRegistry

364−

365− Left problem ->

366− return $ Left $ problem

367−

368− Just cachedRegistry ->

369− do eitherRegistry <- Registry.update manager cache cachedRegistry

370− case eitherRegistry of

371− Right latestRegistry ->

372− return $ Right $ Env cache manager (Online manager) latestRegistry

373−

374− Left _ ->

375− return $ Right $ Env cache manager Offline cachedRegistry

354+ do mvar <- newEmptyMVar

355+ _ <- forkIO $ putMVar mvar =<< Http.getManager

356+ cache <- Stuff.getPackageCache

357+ Stuff.withRegistryLock cache $

358+ do maybeRegistry <- Registry.read cache

359+ manager <- readMVar mvar

360+

361+ case maybeRegistry of

362+ Nothing ->

363+ do eitherRegistry <- Registry.fetch manager cache

364+ case eitherRegistry of

365+ Right latestRegistry ->

366+ return $ Right $ Env cache manager (Online manager) latestRegistry

367+

368+ Left problem ->

369+ return $ Left $ problem

370+

371+ Just cachedRegistry ->

372+ do eitherRegistry <- Registry.update manager cache cachedRegistry

373+ case eitherRegistry of

374+ Right latestRegistry ->

375+ return $ Right $ Env cache manager (Online manager) latestRegistry

376+

377+ Left _ ->

378+ return $ Right $ Env cache manager Offline cachedRegistry

376379

377380

378381

builder/src/Elm/Details.hs+3−3

@@ -291,11 +291,12 @@ fork work =

291291

292292

293293verifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Task Details

294−verifyDependencies env@(Env key scope root _ _ _ _) time outline solution directDeps =

294+verifyDependencies env@(Env key scope root cache _ _ _) time outline solution directDeps =

295295 Task.eio id $

296296 do Reporting.report key (Reporting.DStart (Map.size solution))

297297 mvar <- newEmptyMVar

298− mvars <- Map.traverseWithKey (\k v -> fork (verifyDep env mvar solution k v)) solution

298+ mvars <- Stuff.withRegistryLock cache $

299+ Map.traverseWithKey (\k v -> fork (verifyDep env mvar solution k v)) solution

299300 putMVar mvar mvars

300301 deps <- traverse readMVar mvars

301302 case sequence deps of

@@ -358,7 +359,6 @@ type Dep =

358359

359360verifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Pkg.Name -> Solver.Details -> IO Dep

360361verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg details@(Solver.Details vsn directDeps) =

361− Stuff.withPackageLock cache pkg vsn $

362362 do let fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps

363363 exists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn </> "src")

364364 if exists

builder/src/Stuff.hs+3−10

@@ -10,7 +10,6 @@ module Stuff

1010 , findRoot

1111 , withRootLock

1212 , withRegistryLock

13− , withPackageLock

1413 , PackageCache

1514 , getPackageCache

1615 , registry

@@ -128,15 +127,9 @@ withRootLock root work =

128127 Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)

129128

130129

131−withRegistryLock :: (PackageCache -> IO a) -> IO a

132−withRegistryLock callback =

133− do cache@(PackageCache dir) <- getPackageCache

134− Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> callback cache)

135−

136−

137−withPackageLock :: PackageCache -> Pkg.Name -> V.Version -> IO a -> IO a

138−withPackageLock cache pkg vsn work =

139− Lock.withFileLock (package cache pkg vsn </> "lock") Lock.Exclusive (\_ -> work)

130+withRegistryLock :: PackageCache -> IO a -> IO a

131+withRegistryLock (PackageCache dir) work =

132+ Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)

140133

141134

142135