Add `doctest’ command.

This adds the `doctest` command to cabal.  It does however not yet work as the driver
is baiscally a stub.

This is therfore only the first step towards #2327.

Cabal/Cabal.cabal

@@ -170,6 +170,7 @@ library
     Distribution.Simple.GHC
     Distribution.Simple.GHCJS
     Distribution.Simple.Haddock
+    Distribution.Simple.Doctest
     Distribution.Simple.HaskellSuite
     Distribution.Simple.Hpc
     Distribution.Simple.Install

Cabal/Distribution/Simple.hs

@@ -85,6 +85,7 @@ import Distribution.Simple.BuildPaths
 import Distribution.Simple.Test
 import Distribution.Simple.Install
 import Distribution.Simple.Haddock
+import Distribution.Simple.Doctest
 import Distribution.Simple.Utils
 import Distribution.Utils.NubList
 import Distribution.Verbosity
@@ -175,6 +176,7 @@ defaultMainHelper hooks args = topHandler $
       ,replCommand      progs `commandAddAction` replAction         hooks
       ,installCommand         `commandAddAction` installAction      hooks
       ,copyCommand            `commandAddAction` copyAction         hooks
+      ,doctestCommand         `commandAddAction` doctestAcion       hooks
       ,haddockCommand         `commandAddAction` haddockAction      hooks
       ,cleanCommand           `commandAddAction` cleanAction        hooks
       ,sdistCommand           `commandAddAction` sdistAction        hooks
@@ -290,6 +292,21 @@ hscolourAction hooks flags args = do
                  (getBuildConfig hooks verbosity distPref)
                  hooks flags' args
 
+doctestAcion :: UserHooks -> DoctestFlags -> Args -> IO ()
+doctestAcion hooks flags args = do
+  distPref <- findDistPrefOrDefault (doctestDistPref flags)
+  let verbosity = fromFlag $ doctestVerbosity flags
+
+  lbi <- getBuildConfig hooks verbosity distPref
+  progs <- reconfigurePrograms verbosity
+             (doctestProgramPaths flags)
+             (doctestProgramArgs  flags)
+             (withPrograms lbi)
+
+  hookedAction preDoctest doctestHook postDoctest
+               (return lbi { withPrograms = progs })
+               hooks flags args
+
 haddockAction :: UserHooks -> HaddockFlags -> Args -> IO ()
 haddockAction hooks flags args = do
   distPref <- findDistPrefOrDefault (haddockDistPref flags)
@@ -562,6 +579,7 @@ simpleUserHooks =
        cleanHook = \p _ _ f -> clean p f,
        hscolourHook = \p l h f -> hscolour p l (allSuffixHandlers h) f,
        haddockHook  = \p l h f -> haddock  p l (allSuffixHandlers h) f,
+       doctestHook  = \p l h f -> doctest  p l (allSuffixHandlers h) f,
        regHook   = defaultRegHook,
        unregHook = \p l _ f -> unregister p l f
       }

Cabal/Distribution/Simple/Doctest.hs

+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE RankNTypes    #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Distribution.Simple.Haddock
+-- Copyright   :  Isaac Jones 2003-2005
+-- License     :  BSD3
+--
+-- Maintainer  :  cabal-devel@haskell.org
+-- Portability :  portable
+--
+-- This module deals with the @doctest@ command.
+
+module Distribution.Simple.Doctest (
+  doctest
+  ) where
+
+import Prelude ()
+import Distribution.Compat.Prelude
+
+
+-- local
+import Distribution.PackageDescription as PD hiding (Flag)
+import Distribution.Simple.PreProcess
+import Distribution.Simple.Setup
+import Distribution.Simple.Build
+import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate)
+
+import Distribution.Compat.Semigroup (Any (..))
+
+-- -----------------------------------------------------------------------------
+-- Types
+
+-- | A record that represents the arguments to the doctest executable.
+data DoctestArgs = DoctestArgs {
+  argHelp :: Any,
+  argVersion :: Any,
+  argNoMagic :: Any
+} deriving Generic
+
+-- -----------------------------------------------------------------------------
+-- Doctest support
+
+doctest :: PackageDescription
+        -> LocalBuildInfo
+        -> [PPSuffixHandler]
+        -> DoctestFlags
+        -> IO ()
+doctest pkg_descr lbi suffixes doctestFlags = do
+  let verbosity = flag doctestVerbosity
+      flag f    = fromFlag $ f doctestFlags
+
+  withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do
+     componentInitialBuildSteps (flag doctestDistPref) pkg_descr lbi clbi verbosity
+     preprocessComponent pkg_descr component lbi clbi False verbosity suffixes

Cabal/Distribution/Simple/Program.hs

@@ -112,6 +112,7 @@ module Distribution.Simple.Program (
     , c2hsProgram
     , cpphsProgram
     , hscolourProgram
+    , doctestProgram
     , haddockProgram
     , greencardProgram
     , ldProgram

Cabal/Distribution/Simple/Program/Builtin.hs

@@ -37,6 +37,7 @@ module Distribution.Simple.Program.Builtin (
     c2hsProgram,
     cpphsProgram,
     hscolourProgram,
+    doctestProgram,
     haddockProgram,
     greencardProgram,
     ldProgram,
@@ -85,6 +86,7 @@ builtinPrograms =
     , hpcProgram
     -- preprocessors
     , hscolourProgram
+    , doctestProgram
     , haddockProgram
     , happyProgram
     , alexProgram
@@ -309,6 +311,16 @@ hscolourProgram = (simpleProgram "hscolour") {
         _         -> ""
   }
 
+doctestProgram :: Program
+doctestProgram = (simpleProgram "doctest") {
+    programFindLocation = \v p -> findProgramOnSearchPath v p "doctest"
+  , programFindVersion  = findProgramVersion "--version" $ \str ->
+         -- "doctest version 0.11.2"
+         case words str of
+           (_:_:ver:_) -> ver
+           _           -> ""
+  }
+
 haddockProgram :: Program
 haddockProgram = (simpleProgram "haddock") {
     programFindVersion = findProgramVersion "--version" $ \str ->

Cabal/Distribution/Simple/Setup.hs

@@ -42,6 +42,7 @@ module Distribution.Simple.Setup (
   configAbsolutePaths, readPackageDbList, showPackageDbList,
   CopyFlags(..),     emptyCopyFlags,     defaultCopyFlags,     copyCommand,
   InstallFlags(..),  emptyInstallFlags,  defaultInstallFlags,  installCommand,
+  DoctestFlags(..),  emptyDoctestFlags,  defaultDoctestFlags,  doctestCommand,
   HaddockTarget(..),
   HaddockFlags(..),  emptyHaddockFlags,  defaultHaddockFlags,  haddockCommand,
   HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
@@ -1387,6 +1388,63 @@ hscolourCommand = CommandUI
       ]
   }
 
+-- ------------------------------------------------------------
+-- * Doctest flags
+-- ------------------------------------------------------------
+
+data DoctestFlags = DoctestFlags {
+    doctestProgramPaths :: [(String, FilePath)],
+    doctestProgramArgs  :: [(String, [String])],
+    doctestDistPref     :: Flag FilePath,
+    doctestVerbosity    :: Flag Verbosity
+  }
+   deriving (Show, Generic)
+
+defaultDoctestFlags :: DoctestFlags
+defaultDoctestFlags = DoctestFlags {
+    doctestProgramPaths = mempty,
+    doctestProgramArgs  = [],
+    doctestDistPref     = NoFlag,
+    doctestVerbosity    = Flag normal
+  }
+
+doctestCommand :: CommandUI DoctestFlags
+doctestCommand = CommandUI
+  { commandName         = "doctest"
+  , commandSynopsis     = "Run doctest tests."
+  , commandDescription  = Just $ \_ ->
+      "Requires the program doctest, version 0.12.\n"
+  , commandNotes        = Nothing
+  , commandUsage        = \pname ->
+      "Usage: " ++ pname ++ " doctest [FLAGS]\n"
+  , commandDefaultFlags = defaultDoctestFlags
+  , commandOptions      = \showOrParseArgs ->
+         doctestOptions showOrParseArgs
+      ++ programDbPaths   progDb ParseArgs
+             doctestProgramPaths (\v flags -> flags { doctestProgramPaths = v })
+      ++ programDbOption  progDb showOrParseArgs
+             doctestProgramArgs (\v fs -> fs { doctestProgramArgs = v })
+      ++ programDbOptions progDb ParseArgs
+             doctestProgramArgs (\v flags -> flags { doctestProgramArgs = v })
+  }
+  where
+    progDb = addKnownProgram doctestProgram
+             $ addKnownProgram ghcProgram
+             $ emptyProgramDb
+
+doctestOptions :: ShowOrParseArgs -> [OptionField DoctestFlags]
+doctestOptions showOrParseArgs = []
+
+emptyDoctestFlags :: DoctestFlags
+emptyDoctestFlags = mempty
+
+instance Monoid DoctestFlags where
+  mempty = gmempty
+  mappend = (<>)
+
+instance Semigroup DoctestFlags where
+  (<>) = gmappend
+
 -- ------------------------------------------------------------
 -- * Haddock flags
 -- ------------------------------------------------------------

Cabal/Distribution/Simple/UserHooks.hs

@@ -135,6 +135,13 @@ data UserHooks = UserHooks {
     -- |Hook to run after hscolour command.  Second arg indicates verbosity level.
     postHscolour :: Args -> HscolourFlags -> PackageDescription -> LocalBuildInfo -> IO (),
 
+    -- |Hook to run before doctest command.  Second arg indicates verbosity level.
+    preDoctest  :: Args -> DoctestFlags -> IO HookedBuildInfo,
+    -- |Over-ride this hook to get different behavior during doctest.
+    doctestHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO (),
+    -- |Hook to run after doctest command.  Second arg indicates verbosity level.
+    postDoctest :: Args -> DoctestFlags -> PackageDescription -> LocalBuildInfo -> IO (),
+
     -- |Hook to run before haddock command.  Second arg indicates verbosity level.
     preHaddock  :: Args -> HaddockFlags -> IO HookedBuildInfo,
     -- |Over-ride this hook to get different behavior during haddock.
@@ -197,6 +204,9 @@ emptyUserHooks
       preHscolour  = rn,
       hscolourHook = ru,
       postHscolour = ru,
+      preDoctest   = rn,
+      doctestHook  = ru,
+      postDoctest  = ru,
       preHaddock   = rn,
       haddockHook  = ru,
       postHaddock  = ru,

cabal-install/Distribution/Client/Setup.hs

@@ -172,6 +172,7 @@ globalCommand commands = CommandUI {
           , "freeze"
           , "gen-bounds"
           , "outdated"
+          , "doctest"
           , "haddock"
           , "hscolour"
           , "copy"
@@ -232,6 +233,7 @@ globalCommand commands = CommandUI {
         , addCmd "freeze"
         , addCmd "gen-bounds"
         , addCmd "outdated"
+        , addCmd "doctest"
         , addCmd "haddock"
         , addCmd "hscolour"
         , addCmd "copy"

cabal-install/main/Main.hs

@@ -50,6 +50,7 @@ import Distribution.Client.Setup
          )
 import Distribution.Simple.Setup
          ( HaddockTarget(..)
+         , DoctestFlags(..), doctestCommand, defaultDoctestFlags
          , HaddockFlags(..), haddockCommand, defaultHaddockFlags
          , HscolourFlags(..), hscolourCommand
          , ReplFlags(..)
@@ -270,6 +271,7 @@ mainWorker args = topHandler $
       , regularCmd buildCommand buildAction
       , regularCmd replCommand replAction
       , regularCmd sandboxCommand sandboxAction
+      , regularCmd doctestCommand doctestAcion
       , regularCmd haddockCommand haddockAction
       , regularCmd execCommand execAction
       , regularCmd userConfigCommand userConfigAction
@@ -761,6 +763,14 @@ haddockAction haddockFlags extraArgs globalFlags = do
       createTarGzFile dest docDir name
       notice verbosity $ "Documentation tarball created: " ++ dest
 
+doctestAcion :: DoctestFlags -> [String] -> Action
+doctestAcion doctestFlags extraArgs globalFlags = do
+  let verbosity = fromFlag (doctestVerbosity doctestFlags)
+  (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags
+
+  setupWrapper verbosity defaultSetupScriptOptions Nothing
+    doctestCommand (const doctestFlags) extraArgs
+
 cleanAction :: CleanFlags -> [String] -> Action
 cleanAction cleanFlags extraArgs globalFlags = do
   load <- try (loadConfigOrSandboxConfig verbosity globalFlags)