packages feed

stackage-curator 0.7.2 → 0.7.2.1

raw patch · 4 files changed

+74/−103 lines, 4 files

Files

ChangeLog.md view
@@ -1,3 +1,10 @@+## 0.7.3++* Number of jobs == number of capabilities+* `--bundle-dest`+* `--skip-git-push`+* Removed some of the old upload stuff+ ## 0.7.2  * Add `diff` command
Stackage/CompleteBuild.hs view
@@ -8,11 +8,10 @@     , BuildFlags (..)     , completeBuild     , justCheck-    , justUploadNightly     , getStackageAuthToken     ) where -import Control.Concurrent        (threadDelay)+import Control.Concurrent        (threadDelay, getNumCapabilities) import Control.Concurrent.Async  (withAsync) import Data.Default.Class        (def) import Data.Semigroup            (Max (..), Option (..))@@ -41,9 +40,11 @@     , bfEnableExecDyn    :: !Bool     , bfVerbose          :: !Bool     , bfSkipCheck        :: !Bool-    , bfUploadV1         :: !Bool     , bfServer           :: !StackageServer     , bfBuildHoogle      :: !Bool+    , bfBundleDest       :: !(Maybe FilePath)+    , bfGitPush          :: !Bool+    -- ^ push to Git (when doing an LTS build)     } deriving (Show)  data BuildType = Nightly | LTS BumpType Text@@ -71,9 +72,10 @@ nightlyPlanFile day = fpFromText ("nightly-" ++ day) <.> "yaml"  nightlySettings :: Text -- ^ day+                -> BuildFlags                 -> BuildPlan                 -> Settings-nightlySettings day plan' = Settings+nightlySettings day bf plan' = Settings     { planFile = nightlyPlanFile day     , buildDir = fpFromText $ "builds/nightly"     , logDir = fpFromText $ "logs/stackage-nightly-" ++ day@@ -89,7 +91,9 @@     , postBuild = return ()     , distroName = "Stackage"     , snapshotType = STNightly-    , bundleDest = fpFromText $ "stackage-nightly-" ++ day ++ ".bundle"+    , bundleDest = fromMaybe+        (fpFromText $ "stackage-nightly-" ++ day ++ ".bundle")+        (bfBundleDest bf)     }   where     slug' = "nightly-" ++ day@@ -119,14 +123,14 @@     deriving (Show, Typeable) instance Exception ParseGoalFailure -getSettings :: Manager -> BuildType -> IO Settings-getSettings man Nightly = do+getSettings :: Manager -> BuildFlags -> BuildType -> IO Settings+getSettings man bf Nightly = do     day <- tshow . utctDay <$> getCurrentTime     bc <- defaultBuildConstraints man     pkgs <- getLatestAllowedPlans bc     plan' <- newBuildPlan pkgs bc-    return $ nightlySettings day plan'-getSettings man (LTS bumpType goal) = do+    return $ nightlySettings day bf plan'+getSettings man bf (LTS bumpType goal) = do     matchesGoal <- parseGoal bumpType goal     Option mlts <- fmap (fmap getMax) $ runResourceT         $ sourceDirectory "."@@ -176,13 +180,16 @@             putStrLn "Committing new LTS file to Git"             git ["add", fpToString newfile]             git ["commit", "-m", "Added new LTS release: " ++ show new]-            putStrLn "Pushing to Git repository"-            git ["push"]+            when (bfGitPush bf) $ do+                putStrLn "Pushing to Git repository"+                git ["push"]         , distroName = "LTSHaskell"         , snapshotType =             case new of                 LTSVer x y -> STLTS x y-        , bundleDest = fpFromText $ "stackage-lts-" ++ tshow new ++ ".bundle"+        , bundleDest = fromMaybe+            (fpFromText $ "stackage-lts-" ++ tshow new ++ ".bundle")+            (bfBundleDest bf)         }  data LTSVer = LTSVer !Int !Int@@ -242,22 +249,24 @@      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-    , pbEnableHaddock = bfEnableHaddock buildFlags-    , pbEnableLibProfiling = bfEnableLibProfile buildFlags-    , pbEnableExecDyn = bfEnableExecDyn buildFlags-    , pbVerbose = bfVerbose buildFlags-    , pbAllowNewer = bfSkipCheck buildFlags-    , pbBuildHoogle = bfBuildHoogle buildFlags-    }+getPerformBuild :: BuildFlags -> Settings -> IO PerformBuild+getPerformBuild buildFlags Settings {..} = do+    jobs <- getNumCapabilities+    return PerformBuild+        { pbPlan = plan+        , pbInstallDest = buildDir+        , pbLogDir = logDir+        , pbLog = hPut stdout+        , pbJobs = jobs+        , pbGlobalInstall = False+        , pbEnableTests = bfEnableTests buildFlags+        , pbEnableHaddock = bfEnableHaddock buildFlags+        , pbEnableLibProfiling = bfEnableLibProfile buildFlags+        , pbEnableExecDyn = bfEnableExecDyn buildFlags+        , pbVerbose = bfVerbose buildFlags+        , pbAllowNewer = bfSkipCheck buildFlags+        , pbBuildHoogle = bfBuildHoogle buildFlags+        }  -- | Make a complete plan, build, test and upload bundle, docs and -- distro.@@ -266,7 +275,7 @@     hSetBuffering stdout LineBuffering      putStrLn $ "Loading settings for: " ++ tshow buildType-    settings@Settings {..} <- getSettings man buildType+    settings@Settings {..} <- getSettings man buildFlags buildType      putStrLn $ "Writing build plan to: " ++ fpToText planFile     encodeFile (fpToString planFile) plan@@ -278,7 +287,7 @@             checkBuildPlan plan      putStrLn "Performing build"-    let pb = getPerformBuild buildFlags settings+    pb <- getPerformBuild buildFlags settings     performBuild pb >>= mapM_ putStrLn      putStrLn $ "Creating bundle (v2) at: " ++ fpToText bundleDest@@ -289,21 +298,14 @@         , cb2Dest = bundleDest         } +    postBuild `catchAny` print+     when (bfDoUpload buildFlags) $         finallyUpload-            (not $ bfUploadV1 buildFlags)-            (bfServer buildFlags)+            buildFlags             settings             man -justUploadNightly-    :: Text -- ^ nightly date-    -> IO ()-justUploadNightly day = do-    plan <- decodeFileEither (fpToString $ nightlyPlanFile day)-        >>= either throwM return-    withManager tlsManagerSettings $ finallyUpload False def $ nightlySettings day plan- getStackageAuthToken :: IO Text getStackageAuthToken = do     mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"@@ -313,52 +315,22 @@  -- | The final part of the complete build process: uploading a bundle, -- docs and a distro to hackage.-finallyUpload :: Bool -- ^ use v2 upload-              -> StackageServer+finallyUpload :: BuildFlags               -> Settings -> Manager -> IO ()-finallyUpload useV2 server settings@Settings{..} man = do+finallyUpload buildFlags settings@Settings{..} man = do+    let server = bfServer buildFlags+    pb <- getPerformBuild buildFlags settings+     putStrLn "Uploading bundle to Stackage Server"      token <- getStackageAuthToken -    if useV2-        then do-            res <- flip uploadBundleV2 man UploadBundleV2-                { ub2Server = server-                , ub2AuthToken = token-                , ub2Bundle = bundleDest-                }-            putStrLn $ "New snapshot available at: " ++ res-        else do-            now <- epochTime-            let ghcVer = display $ siGhcVersion $ bpSystemInfo plan-            (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def-                { ubContents = serverBundle now (title ghcVer) slug plan-                , ubAuthToken = token-                }-            putStrLn $ "New ident: " ++ unSnapshotIdent ident-            forM_ mloc $ \loc ->-                putStrLn $ "Track progress at: " ++ loc--            putStrLn "Uploading docs to Stackage Server"-            res1 <- tryAny $ uploadDocs UploadDocs-                { udServer = def-                , udAuthToken = token-                , udDocs = pbDocDir pb-                , udSnapshot = ident-                } man-            putStrLn $ "Doc upload response: " ++ tshow res1--            putStrLn "Uploading doc map"-            tryAny (uploadDocMap UploadDocMap-                { udmServer = def-                , udmAuthToken = token-                , udmSnapshot = ident-                , udmDocDir = pbDocDir pb-                , udmPlan = plan-                } man) >>= print--    postBuild `catchAny` print+    res <- flip uploadBundleV2 man UploadBundleV2+        { ub2Server = server+        , ub2AuthToken = token+        , ub2Bundle = bundleDest+        }+    putStrLn $ "New snapshot available at: " ++ res      ecreds <- tryIO $ readFile "/hackage-creds"     case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of@@ -367,5 +339,3 @@             res2 <- uploadHackageDistroNamed distroName plan username password man             putStrLn $ "Distro upload response: " ++ tshow res2         _ -> putStrLn "No creds found, skipping Hackage distro upload"-  where-    pb = getPerformBuild (error "finallyUpload.buildFlags") settings
app/stackage.hs view
@@ -59,11 +59,6 @@                   "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 ())                   "check"@@ -74,10 +69,10 @@                   "install"                   "Install a snapshot from an existing build plan"             , cmnd-                  uploadv2-                  uploadv2Flags-                  "upload2"-                  "Upload a pre-existing v2 bundle"+                  upload+                  uploadFlags+                  "upload"+                  "Upload a pre-existing bundle"             , cmnd                   printStats                   printStatsFlags@@ -125,9 +120,6 @@         switch             (long "skip-check" <>              help "Skip the check phase, and pass --allow-newer to cabal configure") <*>-        switch-            (long "upload-v1" <>-             help "Use the V1 upload code") <*>         (fmap fromString (strOption             (long "server-url" <>              metavar "SERVER-URL" <>@@ -137,11 +129,13 @@             not             (switch                  (long "skip-hoogle" <>-                  help "Skip generating Hoogle input files"))--    nightlyUploadFlags = fromString <$> strArgument-        (metavar "DATE" <>-         help "Date, in YYYY-MM-DD format")+                  help "Skip generating Hoogle input files")) <*>+        (fmap (Just . fromString) (strOption+            (long "bundle-dest" <> metavar "FILENAME"))+            <|> pure Nothing) <*>+        (fmap not (switch+            (long "skip-git-push" <>+             help "Do not perform a git push after completion (for LTS builds only)")))      installFlags =         InstallFlags <$>@@ -206,7 +200,7 @@                  (long "skip-hoogle" <>                   help "Skip generating Hoogle input files")) -    uploadv2 (path, url) = withManager tlsManagerSettings $ \man -> do+    upload (path, url) = withManager tlsManagerSettings $ \man -> do         token <- getStackageAuthToken         res <- flip uploadBundleV2 man UploadBundleV2             { ub2AuthToken = token@@ -215,7 +209,7 @@             }         putStrLn $ "New URL: " ++ T.unpack res -    uploadv2Flags = (,)+    uploadFlags = (,)         <$> (strArgument                 (metavar "BUNDLE-PATH" <>                  help "Bundle path"))
stackage-curator.cabal view
@@ -1,5 +1,5 @@ name:                stackage-curator-version:             0.7.2+version:             0.7.2.1 synopsis:            Tools for curating Stackage bundles description:         Please see <http://www.stackage.org/package/stackage-curator> for a description and documentation. homepage:            https://github.com/fpco/stackage