diff --git a/Stackage/CompleteBuild.hs b/Stackage/CompleteBuild.hs index 89b443b7..0ac4c84d 100644 --- a/Stackage/CompleteBuild.hs +++ b/Stackage/CompleteBuild.hs @@ -26,6 +26,7 @@ import Stackage.BuildConstraints import Stackage.BuildPlan import Stackage.CheckBuildPlan import Stackage.PerformBuild +import qualified Stackage.ShakeBuild as Shake import Stackage.Prelude import Stackage.ServerBundle import Stackage.UpdateBuildPlan @@ -230,7 +231,7 @@ completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do checkBuildPlan plan putStrLn "Performing build" - performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn + Shake.performBuild (getPerformBuild buildFlags settings) -- >>= mapM_ putStrLn when (bfDoUpload buildFlags) $ finallyUpload settings man diff --git a/Stackage/PerformBuild.hs b/Stackage/PerformBuild.hs index a3b46c5a..52e37cd5 100644 --- a/Stackage/PerformBuild.hs +++ b/Stackage/PerformBuild.hs @@ -12,6 +12,7 @@ module Stackage.PerformBuild , pbDocDir , copyBuiltInHaddocks , renameOrCopy + , copyDir ) where import Control.Concurrent.Async (async) diff --git a/Stackage/ShakeBuild.hs b/Stackage/ShakeBuild.hs index 55b49ddc..aed743ab 100644 --- a/Stackage/ShakeBuild.hs +++ b/Stackage/ShakeBuild.hs @@ -4,12 +4,13 @@ module Stackage.ShakeBuild where +import Control.Concurrent import Control.Monad import Stackage.BuildConstraints import Stackage.BuildPlan import Stackage.CheckBuildPlan import Stackage.PackageDescription -import Stackage.PerformBuild (PerformBuild(..),copyBuiltInHaddocks,renameOrCopy) +import Stackage.PerformBuild (PerformBuild(..),copyBuiltInHaddocks,renameOrCopy,copyDir) import Stackage.Prelude (unFlagName) import Control.Concurrent.MVar @@ -89,12 +90,28 @@ shakePlan haddockFiles registerLock pb shakeDir = do target (targetForDocs shakeDir name (ppVersion plan)) $ do need [targetForPackage shakeDir name (ppVersion plan)] packageDocs haddockFiles shakeDir pb plan name - want haddockTargets + build <- target (targetForBuild pb) + (do need haddockTargets + copyToBuild pb shakeDir) + want [build] where versionMappings = M.toList (M.map ppVersion (bpPackages (pbPlan pb))) corePackages = M.keys $ siCorePackages $ bpSystemInfo $ pbPlan pb normalPackages = filter (not . (`elem` corePackages) . fst) $ M.toList $ bpPackages $ pbPlan pb +-- | Copy the build as a whole to builds/. +copyToBuild :: PerformBuild -> String -> Action () +copyToBuild pb shakeDir = do + copy pbBinDir + copy pbLibDir + copy pbDataDir + copy pbDocDir + makeFile (targetForBuild pb) + where copy mkPath = liftIO $ + copyDir + (FP.decodeString $ mkPath shakeDir) + (FP.decodeString $ mkPath $ FP.encodeString $ pbInstallDest pb) + -- | Generate haddock docs for the package. packageDocs :: TVar (Map String FilePath) -> FilePattern @@ -328,6 +345,10 @@ targetForDocs :: FilePath -> PackageName -> Version -> FilePath targetForDocs shakeDir name version = shakeDir "packages" nameVer name version "dist" "shake-docs" +-- | Target for the complete, copied build under builds/date/. +targetForBuild :: PerformBuild -> FilePattern +targetForBuild pb = FP.encodeString (pbInstallDest pb) "shake-built" + -- | Get a package database path. targetForDb :: FilePath -> FilePath targetForDb shakeDir = @@ -360,6 +381,24 @@ cleanOldPackages :: PerformBuild -> FilePath -> IO () cleanOldPackages pb shakeDir = do putStrLn "Collecting garbage" pkgs <- getRegisteredPackages shakeDir + let toRemove = mapMaybe + (\(PackageIdentifier name version) -> + case M.lookup name versions of + Just version' + | version' == version -> + Nothing + Just newVersion -> Just + (name, version, (Replaced newVersion)) + Nothing -> Just (name, version, NoLongerIncluded)) + pkgs + broken <- getBrokenPackages shakeDir + unless (null toRemove) + (putStrLn ("There are " ++ show (length toRemove) ++ " packages to be purged.")) + unless (null broken) + (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 ..." + threadDelay (1000 * 1000 * 3)) forM_ pkgs $ \(PackageIdentifier name version) -> case M.lookup name versions of @@ -372,7 +411,6 @@ cleanOldPackages pb shakeDir = do version (Replaced newVersion) Nothing -> purgePackage shakeDir name version NoLongerIncluded - broken <- getBrokenPackages shakeDir forM_ broken (\(PackageIdentifier name version) ->