haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-02-03 18:10:26 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Delete previous results when unregistering

Browse Source 
Previously, package install status was determined by checking the
package database. However, this didn't work for executables, so I
switched it to keep explicit track of build results. I forgot to then
clear those results when unregistering a package.

Pinging @manny-fp @chrisdone
This commit is contained in:
Michael Snoyman 2015-03-14 20:47:14 +02:00
parent e404fd2178
commit 8f74bbee49
2 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Stackage/GhcPkg.hs
View File

@ -28,15 +28,16 @@ setupPackageDatabase
-> FilePath -- ^ documentation root -> FilePath -- ^ documentation root
-> (ByteString -> IO ()) -- ^ logging -> (ByteString -> IO ()) -- ^ logging
-> Map PackageName Version -- ^ packages and versions to be installed -> Map PackageName Version -- ^ packages and versions to be installed
-> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package
-> IO (Set PackageName) -- ^ packages remaining in the database after cleanup -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
setupPackageDatabase mdb docDir log' toInstall = do setupPackageDatabase mdb docDir log' toInstall onUnregister = do
registered1 <- getRegisteredPackages flags registered1 <- getRegisteredPackages flags
forM_ registered1 $ \pi@(PackageIdentifier name version) -> forM_ registered1 $ \pi@(PackageIdentifier name version) ->
case lookup name toInstall of case lookup name toInstall of
Just version' | version /= version' -> unregisterPackage log' docDir flags pi Just version' | version /= version' -> unregisterPackage log' onUnregister docDir flags pi
_ -> return () _ -> return ()
broken <- getBrokenPackages flags broken <- getBrokenPackages flags
forM_ broken $ unregisterPackage log' docDir flags forM_ broken $ unregisterPackage log' onUnregister docDir flags
foldMap (\(PackageIdentifier name _) -> singletonSet name) foldMap (\(PackageIdentifier name _) -> singletonSet name)
<$> getRegisteredPackages flags <$> getRegisteredPackages flags
where where
@ -78,10 +79,12 @@ parsePackageIdent = fmap fst .
-- | Unregister a package. -- | Unregister a package.
unregisterPackage :: (ByteString -> IO ()) -- ^ log func unregisterPackage :: (ByteString -> IO ()) -- ^ log func
-> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package
-> FilePath -- ^ doc directory -> FilePath -- ^ doc directory
-> [String] -> PackageIdentifier -> IO () -> [String] -> PackageIdentifier -> IO ()
unregisterPackage log' docDir flags ident@(PackageIdentifier name _) = do unregisterPackage log' onUnregister docDir flags ident@(PackageIdentifier name _) = do
log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n" log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"
onUnregister ident
void (readProcessWithExitCode void (readProcessWithExitCode
"ghc-pkg" "ghc-pkg"
("unregister": flags ++ ["--force", unpack $ display name]) ("unregister": flags ++ ["--force", unpack $ display name])

1
Stackage/PerformBuild.hs
View File

@ -198,6 +198,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
(pbDocDir pb) (pbDocDir pb)
pbLog pbLog
(ppVersion <$> bpPackages pbPlan) (ppVersion <$> bpPackages pbPlan)
(deletePreviousResults pb)
forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages
SingleBuild SingleBuild