From 96cf781c0074e3996d9d6388440ddf3f8ff425f0 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 1 Mar 2013 12:27:49 +0200
Subject: [PATCH] --no-docs

---
 Stackage/Build.hs | 1 +
 Stackage/Test.hs  | 3 ++-
 Stackage/Types.hs | 2 ++
 app/stackage.hs   | 6 +++++-
 4 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/Stackage/Build.hs b/Stackage/Build.hs
index bcc10868..40caa75e 100644
--- a/Stackage/Build.hs
+++ b/Stackage/Build.hs
@@ -23,6 +23,7 @@ defaultBuildSettings = BuildSettings
     , expectedFailuresBuild = defaultExpectedFailures
     , extraArgs = const ["-fnetwork23"]
     , testWorkerThreads = 4
+    , buildDocs = True
     }
 
 build :: BuildSettings -> BuildPlan -> IO ()
diff --git a/Stackage/Test.hs b/Stackage/Test.hs
index 24b3f737..aaf6b88e 100644
--- a/Stackage/Test.hs
+++ b/Stackage/Test.hs
@@ -100,7 +100,8 @@ runTestSuite settings testdir (packageName, SelectedPackageInfo {..}) = do
         when spiHasTests $ do
             getHandle AppendMode $ run "cabal" ["build"] dir
             getHandle AppendMode $ runGhcPackagePath "cabal" ["test"] dir
-        getHandle AppendMode $ run "cabal" ["haddock"] dir
+        when (buildDocs settings) $
+            getHandle AppendMode $ run "cabal" ["haddock"] dir
         return True
     let expectedFailure = packageName `Set.member` expectedFailuresBuild settings
     if passed
diff --git a/Stackage/Types.hs b/Stackage/Types.hs
index 8837d51a..8ef0f949 100644
--- a/Stackage/Types.hs
+++ b/Stackage/Types.hs
@@ -124,6 +124,8 @@ data BuildSettings = BuildSettings
     , expectedFailuresBuild :: Set PackageName
     , testWorkerThreads     :: Int
     -- ^ How many threads to spawn for running test suites.
+    , buildDocs             :: Bool
+    -- ^ Build docs as part of the test procedure.
     }
 
 -- | A wrapper around a @Map@ providing a better @Monoid@ instance.
diff --git a/app/stackage.hs b/app/stackage.hs
index 5624d8ce..41f64dc8 100644
--- a/app/stackage.hs
+++ b/app/stackage.hs
@@ -45,6 +45,7 @@ data BuildArgs = BuildArgs
     { sandbox      :: String
     , buildPlanSrc :: FilePath
     , extraArgs'   :: [String] -> [String]
+    , noDocs       :: Bool
     }
 
 parseBuildArgs :: [String] -> IO BuildArgs
@@ -53,12 +54,14 @@ parseBuildArgs =
         { sandbox = sandboxRoot defaultBuildSettings
         , buildPlanSrc = defaultBuildPlan
         , extraArgs' = id
+        , noDocs = False
         }
   where
     loop x [] = return x
     loop x ("--sandbox":y:rest) = loop x { sandbox = y } rest
     loop x ("--build-plan":y:rest) = loop x { buildPlanSrc = y } rest
     loop x ("--arg":y:rest) = loop x { extraArgs' = extraArgs' x . (y:) } rest
+    loop x ("--no-docs":rest) = loop x { noDocs = True } rest
     loop _ (y:_) = error $ "Did not understand argument: " ++ y
 
 defaultBuildPlan :: FilePath
@@ -71,6 +74,7 @@ withBuildSettings args f = do
     let settings = defaultBuildSettings
             { sandboxRoot = sandbox
             , extraArgs = extraArgs' . extraArgs defaultBuildSettings
+            , buildDocs = not noDocs
             }
     f settings bp
 
@@ -114,4 +118,4 @@ main = do
             putStrLn "    select [--no-clean] [--no-platform] [--exclude package...] [--only-permissive] [--allow package] [--build-plan file]"
             putStrLn "    check [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"
             putStrLn "    build [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"
-            putStrLn "    test [--build-plan file] [--sandbox rootdir] [--arg cabal-arg]"
+            putStrLn "    test [--build-plan file] [--sandbox rootdir] [--arg cabal-arg] [--no-docs]"