diff --git a/Stackage/GhcPkg.hs b/Stackage/GhcPkg.hs index 4985d2f2..c741e96a 100644 --- a/Stackage/GhcPkg.hs +++ b/Stackage/GhcPkg.hs @@ -18,19 +18,21 @@ import qualified Filesystem.Path.CurrentOS as FP import Data.Map (Map) import Data.Version (Version) import Stackage.Prelude +import Filesystem (removeTree) setupPackageDatabase :: Maybe FilePath -- ^ database location, Nothing if using global DB + -> FilePath -- ^ documentation root -> Map PackageName Version -- ^ packages and versions to be installed -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup -setupPackageDatabase mdb toInstall = do +setupPackageDatabase mdb docDir toInstall = do registered1 <- getRegisteredPackages flags - forM_ registered1 $ \(PackageIdentifier name version) -> + forM_ registered1 $ \pi@(PackageIdentifier name version) -> case lookup name toInstall of - Just version' | version /= version' -> unregisterPackage flags name + Just version' | version /= version' -> unregisterPackage docDir flags pi _ -> return () broken <- getBrokenPackages flags - forM_ broken $ \(PackageIdentifier name _) -> unregisterPackage flags name + forM_ broken $ unregisterPackage docDir flags foldMap (\(PackageIdentifier name _) -> singletonSet name) <$> getRegisteredPackages flags where @@ -71,9 +73,12 @@ parsePackageIdent = fmap fst . readP_to_S parse . T.unpack -- | Unregister a package. -unregisterPackage :: [String] -> PackageName -> IO () -unregisterPackage flags ident = do +unregisterPackage :: FilePath -- ^ doc directory + -> [String] -> PackageIdentifier -> IO () +unregisterPackage docDir flags ident@(PackageIdentifier name _) = do void (readProcessWithExitCode "ghc-pkg" - ("unregister": flags ++ ["--force", unpack $ display ident]) + ("unregister": flags ++ ["--force", unpack $ display name]) "") + + void $ tryIO $ removeTree $ docDir fpFromText (display ident) diff --git a/Stackage/PerformBuild.hs b/Stackage/PerformBuild.hs index fe8dac4a..5597cd63 100644 --- a/Stackage/PerformBuild.hs +++ b/Stackage/PerformBuild.hs @@ -194,6 +194,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do registeredPackages <- setupPackageDatabase (pbDatabase pb) + (pbDocDir pb) (ppVersion <$> bpPackages pbPlan) forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages @@ -366,7 +367,6 @@ singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} = unless (pname `member` registeredPackages) $ withConfiged $ do deletePreviousResults pb pname - -- FIXME delete old Haddocks? log' $ "Building " ++ namever run "cabal" ["build"]