From 4396bed20c52a1391af681f6d40788e1470b86c5 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 25 Dec 2014 19:14:05 +0200
Subject: [PATCH] stackage check

---
 ChangeLog.md              |  4 ++++
 Stackage/CompleteBuild.hs | 20 ++++++++++++++++++++
 app/stackage.hs           |  9 +++++----
 stackage.cabal            |  2 +-
 4 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index afff5488..2a524e11 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,7 @@
+## 0.3.1
+
+* Added `justCheck` and `stackage check` command line.
+
 ## 0.3.0.1
 
 Pre-fetch all packages from Hackage to catch Hackage downtime early.
diff --git a/Stackage/CompleteBuild.hs b/Stackage/CompleteBuild.hs
index 872374cf..c1b087ac 100644
--- a/Stackage/CompleteBuild.hs
+++ b/Stackage/CompleteBuild.hs
@@ -5,6 +5,7 @@ module Stackage.CompleteBuild
     ( BuildType (..)
     , BumpType (..)
     , completeBuild
+    , justCheck
     ) where
 import Data.Default.Class        (def)
 import Data.Semigroup            (Max (..), Option (..))
@@ -129,6 +130,25 @@ renderLTSVer lts = fpFromText $ concat
     , ".yaml"
     ]
 
+-- | Generate and check a new build plan, but do not execute it.
+--
+-- Since 0.3.1
+justCheck :: IO ()
+justCheck = withManager tlsManagerSettings $ \man -> do
+    putStrLn "Loading build constraints"
+    bc <- defaultBuildConstraints man
+
+    putStrLn "Creating build plan"
+    plan <- newBuildPlan bc
+
+    putStrLn $ "Writing build plan to check-plan.yaml"
+    encodeFile "check-plan.yaml" plan
+
+    putStrLn "Checking plan"
+    checkBuildPlan plan
+
+    putStrLn "Plan seems valid!"
+
 completeBuild :: BuildType -> IO ()
 completeBuild buildType = withManager tlsManagerSettings $ \man -> do
     hSetBuffering stdout LineBuffering
diff --git a/app/stackage.hs b/app/stackage.hs
index 6f52362e..b78dbb9c 100644
--- a/app/stackage.hs
+++ b/app/stackage.hs
@@ -5,11 +5,12 @@ main :: IO ()
 main = do
     args <- getArgs
     case args of
-        [x] | Just y <- lookup x m -> completeBuild y
+        [x] | Just y <- lookup x m -> y
         _ -> error $ "Expected one argument, one of: " ++ unwords (map fst m)
   where
     m =
-        [ ("nightly", Nightly)
-        , ("lts-major", LTS Major)
-        , ("lts-minor", LTS Minor)
+        [ ("nightly", completeBuild Nightly)
+        , ("lts-major", completeBuild $ LTS Major)
+        , ("lts-minor", completeBuild $ LTS Minor)
+        , ("check", justCheck)
         ]
diff --git a/stackage.cabal b/stackage.cabal
index 5da5a51f..842cdbd7 100644
--- a/stackage.cabal
+++ b/stackage.cabal
@@ -1,5 +1,5 @@
 name:                stackage
-version:             0.3.0.1
+version:             0.3.1
 synopsis:            "Stable Hackage," tools for creating a vetted set of packages from Hackage.
 description:         Please see <http://www.stackage.org/package/stackage> for a description and documentation.
 homepage:            https://github.com/fpco/stackage