From e77403edc4cb3496025aea377d9b887a9f681350 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 6 Jan 2015 10:52:45 +0200 Subject: [PATCH] upload-nightly --- ChangeLog.md | 5 ++- Stackage/CompleteBuild.hs | 85 +++++++++++++++++++++++++-------------- app/stackage.hs | 10 +++++ stackage.cabal | 2 +- 4 files changed, 68 insertions(+), 34 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 10080e33..3dd9afc9 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,7 @@ -## 0.4.0.1 +## 0.4.1 -* Print "Still Alive" while checking, to avoid Travis timeouts. +* Print "Still Alive" while checking, to avoid Travis timeouts +* Include `stackage upload-nightly` command ## 0.4.0 diff --git a/Stackage/CompleteBuild.hs b/Stackage/CompleteBuild.hs index be4011eb..acdf682b 100644 --- a/Stackage/CompleteBuild.hs +++ b/Stackage/CompleteBuild.hs @@ -7,6 +7,7 @@ module Stackage.CompleteBuild , BuildFlags (..) , completeBuild , justCheck + , justUploadNightly ) where import Control.Concurrent (threadDelay) @@ -53,28 +54,38 @@ data Settings = Settings , postBuild :: IO () } +nightlyPlanFile :: Text -- ^ day + -> FilePath +nightlyPlanFile day = fpFromText ("nightly-" ++ day) <.> "yaml" + +nightlySettings :: Text -- ^ day + -> BuildPlan + -> Settings +nightlySettings day plan' = Settings + { planFile = nightlyPlanFile day + , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day + , logDir = fpFromText $ "logs/stackage-nightly-" ++ day + , title = \ghcVer -> concat + [ "Stackage Nightly " + , day + , ", GHC " + , ghcVer + ] + , slug = slug' + , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer } + , plan = plan' + , postBuild = return () + } + where + slug' = "nightly-" ++ day + getSettings :: Manager -> BuildType -> IO Settings getSettings man Nightly = do day <- tshow . utctDay <$> getCurrentTime - let slug' = "nightly-" ++ day bc <- defaultBuildConstraints man pkgs <- getLatestAllowedPlans bc plan' <- newBuildPlan pkgs bc - return Settings - { planFile = fpFromText ("nightly-" ++ day) <.> "yaml" - , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day - , logDir = fpFromText $ "logs/stackage-nightly-" ++ day - , title = \ghcVer -> concat - [ "Stackage Nightly " - , day - , ", GHC " - , ghcVer - ] - , slug = slug' - , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer } - , plan = plan' - , postBuild = return () - } + return $ nightlySettings day plan' getSettings man (LTS bumpType) = do Option mlts <- fmap (fmap getMax) $ runResourceT $ sourceDirectory "." @@ -178,6 +189,19 @@ justCheck = stillAlive $ withManager tlsManagerSettings $ \man -> do putStrLn "Plan seems valid!" +getPerformBuild :: BuildFlags -> Settings -> PerformBuild +getPerformBuild buildFlags Settings {..} = PerformBuild + { pbPlan = plan + , pbInstallDest = buildDir + , pbLogDir = logDir + , pbLog = hPut stdout + , pbJobs = 8 + , pbGlobalInstall = False + , pbEnableTests = bfEnableTests buildFlags + , pbEnableLibProfiling = bfEnableLibProfile buildFlags + , pbVerbose = bfVerbose buildFlags + } + -- | Make a complete plan, build, test and upload bundle, docs and -- distro. completeBuild :: BuildType -> BuildFlags -> IO () @@ -194,26 +218,23 @@ completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do checkBuildPlan plan putStrLn "Performing build" - let pb = PerformBuild - { pbPlan = plan - , pbInstallDest = buildDir - , pbLogDir = logDir - , pbLog = hPut stdout - , pbJobs = 8 - , pbGlobalInstall = False - , pbEnableTests = bfEnableTests buildFlags - , pbEnableLibProfiling = bfEnableLibProfile buildFlags - , pbVerbose = bfVerbose buildFlags - } - performBuild pb >>= mapM_ putStrLn + performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn when (bfDoUpload buildFlags) $ - finallyUpload settings man pb + finallyUpload settings man + +justUploadNightly + :: Text -- ^ nightly date + -> IO () +justUploadNightly day = do + plan <- decodeFileEither (fpToString $ nightlyPlanFile day) + >>= either throwM return + withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan -- | The final part of the complete build process: uploading a bundle, -- docs and a distro to hackage. -finallyUpload :: Settings -> Manager -> PerformBuild -> IO () -finallyUpload Settings{..} man pb = do +finallyUpload :: Settings -> Manager -> IO () +finallyUpload settings@Settings{..} man = do putStrLn "Uploading bundle to Stackage Server" token <- readFile "/auth-token" now <- epochTime @@ -253,3 +274,5 @@ finallyUpload Settings{..} man pb = do , udmDocDir = pbDocDir pb , udmPlan = plan } man >>= print + where + pb = getPerformBuild (error "finallyUpload.buildFlags") settings diff --git a/app/stackage.hs b/app/stackage.hs index 08efe846..f9d31f7c 100644 --- a/app/stackage.hs +++ b/app/stackage.hs @@ -4,6 +4,7 @@ module Main where import Control.Monad import Data.Monoid +import Data.String (fromString) import Data.Version import Options.Applicative import Paths_stackage (version) @@ -45,6 +46,11 @@ main = (fmap (LTS Minor, ) buildFlags) "lts-minor" "Build, test and upload the LTS (minor) snapshot" + , cmnd + justUploadNightly + nightlyUploadFlags + "upload-nightly" + "Upload an already-built nightly snapshot" , cmnd (const justCheck) (pure ()) @@ -73,3 +79,7 @@ main = switch (long "verbose" <> short 'v' <> help "Output verbose detail about the build steps") + + nightlyUploadFlags = fromString <$> strArgument + (metavar "DATE" <> + help "Date, in YYYY-MM-DD format") diff --git a/stackage.cabal b/stackage.cabal index 353de1e6..8401a6ad 100644 --- a/stackage.cabal +++ b/stackage.cabal @@ -1,5 +1,5 @@ name: stackage -version: 0.4.0.1 +version: 0.4.1 synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage. description: Please see for a description and documentation. homepage: https://github.com/fpco/stackage