@@ -18,19 +18,21 @@ import qualified Filesystem.Path.CurrentOS as FP
18import Data.Map (Map)
18import Data.Map (Map)
19import Data.Version (Version)
19import Data.Version (Version)
20import Stackage.Prelude
20import Stackage.Prelude
21+import Filesystem (removeTree)
22setupPackageDatabase
23setupPackageDatabase
23 :: Maybe FilePath -- ^ database location, Nothing if using global DB
24 :: Maybe FilePath -- ^ database location, Nothing if using global DB
25+ -> FilePath -- ^ documentation root
24 -> Map PackageName Version -- ^ packages and versions to be installed
26 -> Map PackageName Version -- ^ packages and versions to be installed
25 -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
27 -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
26−setupPackageDatabase mdb toInstall = do
28+setupPackageDatabase mdb docDir toInstall = do
27 registered1 <- getRegisteredPackages flags
29 registered1 <- getRegisteredPackages flags
28− forM_ registered1 $ \(PackageIdentifier name version) ->
30+ forM_ registered1 $ \pi@(PackageIdentifier name version) ->
29 case lookup name toInstall of
31 case lookup name toInstall of
30− Just version' | version /= version' -> unregisterPackage flags name
32+ Just version' | version /= version' -> unregisterPackage docDir flags pi
31 _ -> return ()
33 _ -> return ()
32 broken <- getBrokenPackages flags
34 broken <- getBrokenPackages flags
33− forM_ broken $ \(PackageIdentifier name _) -> unregisterPackage flags name
35+ forM_ broken $ unregisterPackage docDir flags
34 foldMap (\(PackageIdentifier name _) -> singletonSet name)
36 foldMap (\(PackageIdentifier name _) -> singletonSet name)
35 <$> getRegisteredPackages flags
37 <$> getRegisteredPackages flags
@@ -71,9 +73,12 @@ parsePackageIdent = fmap fst .
71 readP_to_S parse . T.unpack
73 readP_to_S parse . T.unpack
73-- | Unregister a package.
75-- | Unregister a package.
74−unregisterPackage :: [String] -> PackageName -> IO ()
76+unregisterPackage :: FilePath -- ^ doc directory
77+ -> [String] -> PackageIdentifier -> IO ()
75−unregisterPackage flags ident = do
78+unregisterPackage docDir flags ident@(PackageIdentifier name _) = do
76 void (readProcessWithExitCode
79 void (readProcessWithExitCode
78− ("unregister": flags ++ ["--force", unpack $ display ident])
81+ ("unregister": flags ++ ["--force", unpack $ display name])
84+ void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)