haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-03-11 03:06:35 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Print out new packages that'll be installed

Browse Source
This commit is contained in:
Chris Done 2015-01-18 21:41:55 +01:00
parent 5e089315d9
commit adafabb225
1 changed files with 38 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
Stackage/ShakeBuild.hs
View File

@ -50,7 +50,9 @@ performBuild pb = do
createDirectoryIfMissing True shakeDir createDirectoryIfMissing True shakeDir
haddockFiles <- liftIO (newTVarIO mempty) haddockFiles <- liftIO (newTVarIO mempty)
registerLock <- liftIO (newMVar ()) registerLock <- liftIO (newMVar ())
cleanOldPackages pb shakeDir pkgs <- getRegisteredPackages shakeDir
cleanOldPackages pb shakeDir pkgs
printNewPackages pb pkgs
withArgs [] $ withArgs [] $
shakeArgs shakeArgs
shakeOptions shakeOptions
@ -381,9 +383,34 @@ data PurgeReason
| Replaced Version | Replaced Version
| Broken | Broken
-- | Print the new packages.
printNewPackages :: PerformBuild -> [PackageIdentifier] -> IO (Map PackageName Version)
printNewPackages pb pkgs = do
unless
(M.null new)
(do putStrLn
("There are " ++
show (M.size new) ++
" packages to build and install: ")
forM_
(take maxDisplay (M.toList new))
(\(name,ver) ->
putStrLn (display name))
when (M.size new > maxDisplay)
(putStrLn ("And " ++ show (M.size new - maxDisplay) ++ " more.")))
return new
where maxDisplay = 10
new = M.filterWithKey
(\name ver ->
isNothing (find ((== name) . pkgName) pkgs))
versions
versions = (M.map ppVersion .
M.filter (not . S.null . sdModules . ppDesc) .
bpPackages . pbPlan) pb
-- | Clean up old versions of packages that are no longer in use. -- | Clean up old versions of packages that are no longer in use.
cleanOldPackages :: PerformBuild -> FilePath -> IO () cleanOldPackages :: PerformBuild -> FilePath -> [PackageIdentifier] -> IO ()
cleanOldPackages pb shakeDir = do cleanOldPackages pb shakeDir pkgs = do
putStrLn "Collecting garbage" putStrLn "Collecting garbage"
pkgs <- getRegisteredPackages shakeDir pkgs <- getRegisteredPackages shakeDir
let toRemove = mapMaybe let toRemove = mapMaybe
@ -396,12 +423,10 @@ cleanOldPackages pb shakeDir = do
(name, version, (Replaced newVersion)) (name, version, (Replaced newVersion))
Nothing -> Just (name, version, NoLongerIncluded)) Nothing -> Just (name, version, NoLongerIncluded))
pkgs pkgs
broken <- getBrokenPackages shakeDir
unless (null toRemove) unless (null toRemove)
(putStrLn ("There are " ++ show (length toRemove) ++ " packages to be purged.")) (putStrLn ("There are " ++ show (length toRemove) ++ " packages to be purged."))
unless (null broken) when (length toRemove > 0)
(putStrLn ("There are " ++ show (length broken) ++ " broken packages to be purged."))
when (length broken + length toRemove > 0)
(do putStrLn "Waiting 3 seconds before proceeding to remove ..." (do putStrLn "Waiting 3 seconds before proceeding to remove ..."
threadDelay (1000 * 1000 * 3)) threadDelay (1000 * 1000 * 3))
forM_ pkgs $ forM_ pkgs $
@ -416,6 +441,12 @@ cleanOldPackages pb shakeDir = do
version version
(Replaced newVersion) (Replaced newVersion)
Nothing -> purgePackage shakeDir name version NoLongerIncluded Nothing -> purgePackage shakeDir name version NoLongerIncluded
broken <- getBrokenPackages shakeDir
unless (null broken)
(putStrLn ("There are " ++ show (length broken) ++ " broken packages to be purged."))
when (length broken > 0)
(do putStrLn "Waiting 3 seconds before proceeding to remove ..."
threadDelay (1000 * 1000 * 3))
forM_ forM_
broken broken
(\(PackageIdentifier name version) -> (\(PackageIdentifier name version) ->