From bff71d5566053ca374b42dafbf0f3b09d1e868bd Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 12 Dec 2014 10:55:58 +0200
Subject: [PATCH] stackage-nightly executable (lts-bump needs work)

---
 Stackage2/CompleteBuild.hs | 88 ++++++++++++++++++++++++++++++++++++++
 Stackage2/PerformBuild.hs  |  1 +
 app/lts-bump.hs            |  4 ++
 app/stackage-nightly.hs    |  4 ++
 stackage.cabal             | 15 +++++++
 5 files changed, 112 insertions(+)
 create mode 100644 Stackage2/CompleteBuild.hs
 create mode 100644 app/lts-bump.hs
 create mode 100644 app/stackage-nightly.hs

diff --git a/Stackage2/CompleteBuild.hs b/Stackage2/CompleteBuild.hs
new file mode 100644
index 00000000..503bf631
--- /dev/null
+++ b/Stackage2/CompleteBuild.hs
@@ -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 ()
diff --git a/Stackage2/PerformBuild.hs b/Stackage2/PerformBuild.hs
index 98b17772..b8911723 100644
--- a/Stackage2/PerformBuild.hs
+++ b/Stackage2/PerformBuild.hs
@@ -9,6 +9,7 @@ module Stackage2.PerformBuild
     ( performBuild
     , PerformBuild (..)
     , BuildException (..)
+    , pbDocDir
     ) where
 
 import Stackage2.BuildConstraints
diff --git a/app/lts-bump.hs b/app/lts-bump.hs
new file mode 100644
index 00000000..14450f43
--- /dev/null
+++ b/app/lts-bump.hs
@@ -0,0 +1,4 @@
+import Stackage2.CompleteBuild
+
+main :: IO ()
+main = completeBuild LTS
diff --git a/app/stackage-nightly.hs b/app/stackage-nightly.hs
new file mode 100644
index 00000000..1f78ab3a
--- /dev/null
+++ b/app/stackage-nightly.hs
@@ -0,0 +1,4 @@
+import Stackage2.CompleteBuild
+
+main :: IO ()
+main = completeBuild Nightly
diff --git a/stackage.cabal b/stackage.cabal
index 2bf92a34..488be7fe 100644
--- a/stackage.cabal
+++ b/stackage.cabal
@@ -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