@@ -1,7 +1,10 @@
11{-# LANGUAGE NoImplicitPrelude #-}
2+{-# LANGUAGE OverloadedStrings #-}
23-- | General commands related to ghc-pkg.
34
4−module Stackage.GhcPkg where
5+module Stackage.GhcPkg
6+ ( setupPackageDatabase
7+ ) where
58
69import Data.Conduit
710import qualified Data.Conduit.List as CL
@@ -23,16 +26,17 @@ import Filesystem (removeTree)
2326setupPackageDatabase
2427 :: Maybe FilePath -- ^ database location, Nothing if using global DB
2528 -> FilePath -- ^ documentation root
29+ -> (ByteString -> IO ()) -- ^ logging
2630 -> Map PackageName Version -- ^ packages and versions to be installed
2731 -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
28−setupPackageDatabase mdb docDir toInstall = do
32+setupPackageDatabase mdb docDir log' toInstall = do
2933 registered1 <- getRegisteredPackages flags
3034 forM_ registered1 $ \pi@(PackageIdentifier name version) ->
3135 case lookup name toInstall of
32− Just version' | version /= version' -> unregisterPackage docDir flags pi
36+ Just version' | version /= version' -> unregisterPackage log' docDir flags pi
3337 _ -> return ()
3438 broken <- getBrokenPackages flags
35− forM_ broken $ unregisterPackage docDir flags
39+ forM_ broken $ unregisterPackage log' docDir flags
3640 foldMap (\(PackageIdentifier name _) -> singletonSet name)
3741 <$> getRegisteredPackages flags
3842 where
@@ -73,9 +77,11 @@ parsePackageIdent = fmap fst .
7377 readP_to_S parse . T.unpack
7478
7579-- | Unregister a package.
76−unregisterPackage :: FilePath -- ^ doc directory
80+unregisterPackage :: (ByteString -> IO ()) -- ^ log func
81+ -> FilePath -- ^ doc directory
7782 -> [String] -> PackageIdentifier -> IO ()
78−unregisterPackage docDir flags ident@(PackageIdentifier name _) = do
83+unregisterPackage log' docDir flags ident@(PackageIdentifier name _) = do
84+ log' $ "Unregistering " ++ encodeUtf8 (display ident)
7985 void (readProcessWithExitCode
8086 "ghc-pkg"
8187 ("unregister": flags ++ ["--force", unpack $ display name])