@@ -18,19 +18,21 @@ import qualified Filesystem.Path.CurrentOS as FP
1818import Data.Map (Map)
1919import Data.Version (Version)
2020import Stackage.Prelude
21+import Filesystem (removeTree)
2122
2223setupPackageDatabase
2324 :: Maybe FilePath -- ^ database location, Nothing if using global DB
25+ -> FilePath -- ^ documentation root
2426 -> Map PackageName Version -- ^ packages and versions to be installed
2527 -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
26−setupPackageDatabase mdb toInstall = do
28+setupPackageDatabase mdb docDir toInstall = do
2729 registered1 <- getRegisteredPackages flags
28− forM_ registered1 $ \(PackageIdentifier name version) ->
30+ forM_ registered1 $ \pi@(PackageIdentifier name version) ->
2931 case lookup name toInstall of
30− Just version' | version /= version' -> unregisterPackage flags name
32+ Just version' | version /= version' -> unregisterPackage docDir flags pi
3133 _ -> return ()
3234 broken <- getBrokenPackages flags
33− forM_ broken $ \(PackageIdentifier name _) -> unregisterPackage flags name
35+ forM_ broken $ unregisterPackage docDir flags
3436 foldMap (\(PackageIdentifier name _) -> singletonSet name)
3537 <$> getRegisteredPackages flags
3638 where
@@ -71,9 +73,12 @@ parsePackageIdent = fmap fst .
7173 readP_to_S parse . T.unpack
7274
7375-- | Unregister a package.
74−unregisterPackage :: [String] -> PackageName -> IO ()
75−unregisterPackage flags ident = do
76+unregisterPackage :: FilePath -- ^ doc directory
77+ -> [String] -> PackageIdentifier -> IO ()
78+unregisterPackage docDir flags ident@(PackageIdentifier name _) = do
7679 void (readProcessWithExitCode
7780 "ghc-pkg"
78− ("unregister": flags ++ ["--force", unpack $ display ident])
81+ ("unregister": flags ++ ["--force", unpack $ display name])
7982 "")
83+
84+ void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)