From 64a2393ca59e08c58e16fa49af56d0e0c39c8164 Mon Sep 17 00:00:00 2001
From: Chris Done <chrisdone@gmail.com>
Date: Thu, 8 Jan 2015 21:11:46 +0100
Subject: [PATCH] Basic build test in preparation for Shake

---
 Stackage/CompleteBuild.hs        |  3 ++
 Stackage/ShakeBuild.hs           | 10 ++++++
 stackage.cabal                   |  1 +
 test/Stackage/BuildPlanSpec.hs   | 55 ++++++++++++++++++++++++++++++++
 test/full-build-constraints.yaml | 20 ++++++++++++
 5 files changed, 89 insertions(+)
 create mode 100644 Stackage/ShakeBuild.hs
 create mode 100644 test/full-build-constraints.yaml

diff --git a/Stackage/CompleteBuild.hs b/Stackage/CompleteBuild.hs
index cf74eef2..89b443b7 100644
--- a/Stackage/CompleteBuild.hs
+++ b/Stackage/CompleteBuild.hs
@@ -5,9 +5,12 @@ module Stackage.CompleteBuild
     ( BuildType (..)
     , BumpType (..)
     , BuildFlags (..)
+    , Settings (..)
     , completeBuild
     , justCheck
     , justUploadNightly
+    , getPerformBuild
+    , nightlySettings
     ) where
 
 import Control.Concurrent        (threadDelay)
diff --git a/Stackage/ShakeBuild.hs b/Stackage/ShakeBuild.hs
new file mode 100644
index 00000000..42600e11
--- /dev/null
+++ b/Stackage/ShakeBuild.hs
@@ -0,0 +1,10 @@
+-- |
+
+module Stackage.ShakeBuild where
+
+import Data.Text (Text)
+import Stackage.PerformBuild (PerformBuild(..))
+
+-- | Run the shake builder.
+performBuild :: PerformBuild -> IO [Text]
+performBuild = undefined
diff --git a/stackage.cabal b/stackage.cabal
index 94b42da9..877e9349 100644
--- a/stackage.cabal
+++ b/stackage.cabal
@@ -29,6 +29,7 @@ library
                        Stackage.ServerBundle
                        Stackage.Upload
                        Stackage.PerformBuild
+                       Stackage.ShakeBuild
                        Stackage.CompleteBuild
   build-depends:       base >= 4 && < 5
                      , containers
diff --git a/test/Stackage/BuildPlanSpec.hs b/test/Stackage/BuildPlanSpec.hs
index b87c74d2..e0180e1e 100644
--- a/test/Stackage/BuildPlanSpec.hs
+++ b/test/Stackage/BuildPlanSpec.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
 module Stackage.BuildPlanSpec (spec) where
@@ -13,8 +14,11 @@ import           Network.HTTP.Client.TLS (tlsManagerSettings)
 import           Stackage.BuildConstraints
 import           Stackage.BuildPlan
 import           Stackage.CheckBuildPlan
+import           Stackage.CompleteBuild
 import           Stackage.PackageDescription
+import           Stackage.PerformBuild
 import           Stackage.Prelude
+import qualified Stackage.ShakeBuild as Shake
 import           Stackage.UpdateBuildPlan
 import           Test.Hspec
 
@@ -37,6 +41,12 @@ spec = do
         ,("bar", [0, 0, 0], [("mu", thisV [0, 0, 0])])
         ,("mu", [0, 0, 0], [("foo", thisV [0, 0, 0])])]
     {- Shouldn't be testing this actually
+    it "basic build" $ basicBuild $ makePackageSet
+        [("acme-strtok", [0,1,0,3], [("mtl", thisV [2, 2, 1])])
+        ,("acme-dont", [1,1], [])
+        ,("mtl",[2,2,1],[("base",anyV)
+                        ,("transformers",anyV)])
+        ,("transformers",[0,4,1,0],[("base",anyV)])]
     it "default package set checks ok" $
       check defaultBuildConstraints getLatestAllowedPlans
     -}
@@ -53,6 +63,34 @@ badBuildPlan m _ = do
         Right () ->
             error "Expected bad build plan."
 
+-- | Perform a basic build.
+basicBuild :: (BuildConstraints -> IO (Map PackageName PackagePlan))
+             -> void
+             -> IO ()
+basicBuild getPlans _ = do
+    withManager
+        tlsManagerSettings
+        (\man ->
+              do settings@Settings{..} <- getTestSettings man
+                                                          Nightly
+                                                          fullBuildConstraints
+                                                          getPlans
+                 let pb = (getPerformBuild buildFlags settings)
+                 print (pbPlan pb)
+
+                 logs <- performBuild
+                             pb
+                 mapM_ putStrLn logs)
+    where buildType =
+              Nightly
+          buildFlags =
+              BuildFlags
+                { bfEnableTests      = False
+                , bfDoUpload         = False
+                , bfEnableLibProfile = False
+                , bfVerbose          = False
+                }
+
 -- | Check build plan with the given package set getter.
 check :: (Manager -> IO BuildConstraints)
       -> (BuildConstraints -> IO (Map PackageName PackagePlan))
@@ -134,6 +172,23 @@ thisV ver = thisVersion (Version ver [])
 anyV :: VersionRange
 anyV = anyVersion
 
+-- | Get settings for doing test builds.
+getTestSettings :: Manager -> BuildType -> (Manager -> IO BuildConstraints) -> (BuildConstraints -> IO (Map PackageName PackagePlan)) -> IO Settings
+getTestSettings man Nightly readPlanFile getPlans = do
+    day <- tshow . utctDay <$> getCurrentTime
+    bc <- readPlanFile man
+    plans <- getPlans bc
+    bp <- newBuildPlan plans bc
+    return $ nightlySettings day bp
+
+-- | Test plan.
+fullBuildConstraints :: void -> IO BuildConstraints
+fullBuildConstraints _ =
+    decodeFileEither
+        (fpToString fp) >>=
+    either throwIO toBC
+    where fp = "test/full-build-constraints.yaml"
+
 -- | Test plan.
 testBuildConstraints :: void -> IO BuildConstraints
 testBuildConstraints _ =
diff --git a/test/full-build-constraints.yaml b/test/full-build-constraints.yaml
new file mode 100644
index 00000000..ea4f1b20
--- /dev/null
+++ b/test/full-build-constraints.yaml
@@ -0,0 +1,20 @@
+packages:
+    "Test":
+       - acme-dont
+       - acme-strtok
+
+global-flags: []
+
+skipped-tests: []
+expected-test-failures: []
+expected-haddock-failures: []
+skipped-benchmarks: []
+skipped-profiling: []
+
+github-users:
+  bar:
+    - demo
+
+package-flags:
+  foo:
+    demo: true