@@ -1,7 +1,10 @@
1{-# LANGUAGE NoImplicitPrelude #-}
1{-# LANGUAGE NoImplicitPrelude #-}
2+{-# LANGUAGE OverloadedStrings #-}
2-- | General commands related to ghc-pkg.
3-- | General commands related to ghc-pkg.
4−module Stackage.GhcPkg where
5+module Stackage.GhcPkg
6+ ( setupPackageDatabase
6import Data.Conduit
9import Data.Conduit
7import qualified Data.Conduit.List as CL
10import qualified Data.Conduit.List as CL
@@ -23,16 +26,17 @@ import Filesystem (removeTree)
23setupPackageDatabase
26setupPackageDatabase
24 :: Maybe FilePath -- ^ database location, Nothing if using global DB
27 :: Maybe FilePath -- ^ database location, Nothing if using global DB
25 -> FilePath -- ^ documentation root
28 -> FilePath -- ^ documentation root
29+ -> (ByteString -> IO ()) -- ^ logging
26 -> Map PackageName Version -- ^ packages and versions to be installed
30 -> Map PackageName Version -- ^ packages and versions to be installed
27 -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
31 -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
28−setupPackageDatabase mdb docDir toInstall = do
32+setupPackageDatabase mdb docDir log' toInstall = do
29 registered1 <- getRegisteredPackages flags
33 registered1 <- getRegisteredPackages flags
30 forM_ registered1 $ \pi@(PackageIdentifier name version) ->
34 forM_ registered1 $ \pi@(PackageIdentifier name version) ->
31 case lookup name toInstall of
35 case lookup name toInstall of
32− Just version' | version /= version' -> unregisterPackage docDir flags pi
36+ Just version' | version /= version' -> unregisterPackage log' docDir flags pi
33 _ -> return ()
37 _ -> return ()
34 broken <- getBrokenPackages flags
38 broken <- getBrokenPackages flags
35− forM_ broken $ unregisterPackage docDir flags
39+ forM_ broken $ unregisterPackage log' docDir flags
36 foldMap (\(PackageIdentifier name _) -> singletonSet name)
40 foldMap (\(PackageIdentifier name _) -> singletonSet name)
37 <$> getRegisteredPackages flags
41 <$> getRegisteredPackages flags
@@ -73,9 +77,11 @@ parsePackageIdent = fmap fst .
73 readP_to_S parse . T.unpack
77 readP_to_S parse . T.unpack
75-- | Unregister a package.
79-- | Unregister a package.
80+unregisterPackage :: (ByteString -> IO ()) -- ^ log func
76−unregisterPackage :: FilePath -- ^ doc directory
81+ -> FilePath -- ^ doc directory
77 -> [String] -> PackageIdentifier -> IO ()
82 -> [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)
79 void (readProcessWithExitCode
85 void (readProcessWithExitCode
81 ("unregister": flags ++ ["--force", unpack $ display name])
87 ("unregister": flags ++ ["--force", unpack $ display name])