@@ -7,6 +7,7 @@ module Stackage.CompleteBuild
77 , BuildFlags (..)
88 , completeBuild
99 , justCheck
10+ , justUploadNightly
1011 ) where
1112
1213import Control.Concurrent (threadDelay)
@@ -53,28 +54,38 @@ data Settings = Settings
5354 , postBuild :: IO ()
5455 }
5556
57+nightlyPlanFile :: Text -- ^ day
58+ -> FilePath
59+nightlyPlanFile day = fpFromText ("nightly-" ++ day) <.> "yaml"
60+
61+nightlySettings :: Text -- ^ day
62+ -> BuildPlan
63+ -> Settings
64+nightlySettings day plan' = Settings
65+ { planFile = nightlyPlanFile day
66+ , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day
67+ , logDir = fpFromText $ "logs/stackage-nightly-" ++ day
68+ , title = \ghcVer -> concat
69+ [ "Stackage Nightly "
70+ , day
71+ , ", GHC "
72+ , ghcVer
73+ ]
74+ , slug = slug'
75+ , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
76+ , plan = plan'
77+ , postBuild = return ()
78+ }
79+ where
80+ slug' = "nightly-" ++ day
81+
5682getSettings :: Manager -> BuildType -> IO Settings
5783getSettings man Nightly = do
5884 day <- tshow . utctDay <$> getCurrentTime
59− let slug' = "nightly-" ++ day
6085 bc <- defaultBuildConstraints man
6186 pkgs <- getLatestAllowedPlans bc
6287 plan' <- newBuildPlan pkgs bc
63− return Settings
64− { planFile = fpFromText ("nightly-" ++ day) <.> "yaml"
65− , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day
66− , logDir = fpFromText $ "logs/stackage-nightly-" ++ day
67− , title = \ghcVer -> concat
68− [ "Stackage Nightly "
69− , day
70− , ", GHC "
71− , ghcVer
72− ]
73− , slug = slug'
74− , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
75− , plan = plan'
76− , postBuild = return ()
77− }
88+ return $ nightlySettings day plan'
7889getSettings man (LTS bumpType) = do
7990 Option mlts <- fmap (fmap getMax) $ runResourceT
8091 $ sourceDirectory "."
@@ -178,6 +189,19 @@ justCheck = stillAlive $ withManager tlsManagerSettings $ \man -> do
178189
179190 putStrLn "Plan seems valid!"
180191
192+getPerformBuild :: BuildFlags -> Settings -> PerformBuild
193+getPerformBuild buildFlags Settings {..} = PerformBuild
194+ { pbPlan = plan
195+ , pbInstallDest = buildDir
196+ , pbLogDir = logDir
197+ , pbLog = hPut stdout
198+ , pbJobs = 8
199+ , pbGlobalInstall = False
200+ , pbEnableTests = bfEnableTests buildFlags
201+ , pbEnableLibProfiling = bfEnableLibProfile buildFlags
202+ , pbVerbose = bfVerbose buildFlags
203+ }
204+
181205-- | Make a complete plan, build, test and upload bundle, docs and
182206-- distro.
183207completeBuild :: BuildType -> BuildFlags -> IO ()
@@ -194,26 +218,23 @@ completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do
194218 checkBuildPlan plan
195219
196220 putStrLn "Performing build"
197− let pb = PerformBuild
198− { pbPlan = plan
199− , pbInstallDest = buildDir
200− , pbLogDir = logDir
201− , pbLog = hPut stdout
202− , pbJobs = 8
203− , pbGlobalInstall = False
204− , pbEnableTests = bfEnableTests buildFlags
205− , pbEnableLibProfiling = bfEnableLibProfile buildFlags
206− , pbVerbose = bfVerbose buildFlags
207− }
208− performBuild pb >>= mapM_ putStrLn
221+ performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn
209222
210223 when (bfDoUpload buildFlags) $
211− finallyUpload settings man pb
224+ finallyUpload settings man
225+
226+justUploadNightly
227+ :: Text -- ^ nightly date
228+ -> IO ()
229+justUploadNightly day = do
230+ plan <- decodeFileEither (fpToString $ nightlyPlanFile day)
231+ >>= either throwM return
232+ withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan
212233
213234-- | The final part of the complete build process: uploading a bundle,
214235-- docs and a distro to hackage.
215−finallyUpload :: Settings -> Manager -> PerformBuild -> IO ()
216−finallyUpload Settings{..} man pb = do
236+finallyUpload :: Settings -> Manager -> IO ()
237+finallyUpload settings@Settings{..} man = do
217238 putStrLn "Uploading bundle to Stackage Server"
218239 token <- readFile "/auth-token"
219240 now <- epochTime
@@ -253,3 +274,5 @@ finallyUpload Settings{..} man pb = do
253274 , udmDocDir = pbDocDir pb
254275 , udmPlan = plan
255276 } man >>= print
277+ where
278+ pb = getPerformBuild (error "finallyUpload.buildFlags") settings