stackage-nightly executable (lts-bump needs work)

This commit is contained in:
Michael Snoyman 2014-12-12 10:55:58 +02:00
parent 461ed9d568
commit bff71d5566
5 changed files with 112 additions and 0 deletions

View File

@ -0,0 +1,88 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Stackage2.CompleteBuild
( BuildType (..)
, completeBuild
) where
import Data.Default.Class (def)
import Data.Time
import Data.Yaml (encodeFile)
import Network.HTTP.Client
import Stackage2.BuildConstraints
import Stackage2.BuildPlan
import Stackage2.CheckBuildPlan
import Stackage2.PerformBuild
import Stackage2.Prelude
import Stackage2.ServerBundle
import Stackage2.UpdateBuildPlan
import Stackage2.Upload
import System.IO (BufferMode (LineBuffering), hSetBuffering)
data BuildType = Nightly | LTS
data Settings = Settings
{ plan :: BuildPlan
, planFile :: FilePath
, buildDir :: FilePath
, title :: Text -> Text -- ^ GHC version -> title
, slug :: Text
, setArgs :: Text -> UploadBundle -> UploadBundle
}
getSettings :: BuildType -> IO Settings
getSettings Nightly = do
day <- tshow . utctDay <$> getCurrentTime
let slug' = "nightly-" ++ day
plan' <- defaultBuildConstraints >>= newBuildPlan
return Settings
{ planFile = fpFromText ("nightly-" ++ day) <.> "yaml"
, buildDir = fpFromText $ "/tmp/stackage-nightly-" ++ day
, title = \ghcVer -> concat
[ "Stackage Nightly "
, day
, ", GHC "
, ghcVer
]
, slug = slug'
, setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
, plan = plan'
}
completeBuild :: BuildType -> IO ()
completeBuild buildType = withManager defaultManagerSettings $ \man -> do
hSetBuffering stdout LineBuffering
Settings {..} <- getSettings buildType
encodeFile (fpToString planFile) plan
checkBuildPlan plan
let pb = PerformBuild
{ pbPlan = plan
, pbInstallDest = buildDir
, pbLogDir = buildDir </> "logs"
, pbLog = hPut stdout
, pbJobs = 8
}
performBuild pb
token <- readFile "/auth-token"
now <- epochTime
let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
ident <- flip uploadBundle man $ setArgs ghcVer def
{ ubContents = serverBundle now (title ghcVer) slug plan
, ubAuthToken = decodeUtf8 token
, ubAlias = Just slug
}
uploadDocs UploadDocs
{ udServer = def
, udAuthToken = decodeUtf8 token
, udDocs = pbDocDir pb
, udSnapshot = ident
} man >>= print
creds <- readFile "/hackage-creds"
case map encodeUtf8 $ words $ decodeUtf8 creds of
[username, password] ->
uploadHackageDistro plan username password man >>= print
_ -> return ()

View File

@ -9,6 +9,7 @@ module Stackage2.PerformBuild
( performBuild
, PerformBuild (..)
, BuildException (..)
, pbDocDir
) where
import Stackage2.BuildConstraints

4
app/lts-bump.hs Normal file
View File

@ -0,0 +1,4 @@
import Stackage2.CompleteBuild
main :: IO ()
main = completeBuild LTS

4
app/stackage-nightly.hs Normal file
View File

@ -0,0 +1,4 @@
import Stackage2.CompleteBuild
main :: IO ()
main = completeBuild Nightly

View File

@ -43,6 +43,7 @@ library
Stackage2.ServerBundle
Stackage2.Upload
Stackage2.PerformBuild
Stackage2.CompleteBuild
build-depends: base >= 4 && < 5
, containers
, Cabal >= 1.14
@ -82,6 +83,20 @@ executable stackage
, stackage
, containers
executable stackage-nightly
default-language: Haskell2010
hs-source-dirs: app
main-is: stackage-nightly.hs
build-depends: base
, stackage
executable lts-bump
default-language: Haskell2010
hs-source-dirs: app
main-is: lts-bump.hs
build-depends: base
, stackage
test-suite spec
type: exitcode-stdio-1.0
default-language: Haskell2010