diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 702facc32f7..faf042e7078 100644 --- a/Cabal/Cabal.cabal +++ b/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 diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index cf33a6617d0..cf8b2396e49 100644 --- a/Cabal/Distribution/Simple.hs +++ b/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` doctestAction hooks ,haddockCommand `commandAddAction` haddockAction hooks ,cleanCommand `commandAddAction` cleanAction hooks ,sdistCommand `commandAddAction` sdistAction hooks @@ -290,6 +292,22 @@ hscolourAction hooks flags args = do (getBuildConfig hooks verbosity distPref) hooks flags' args +doctestAction :: UserHooks -> DoctestFlags -> Args -> IO () +doctestAction hooks flags args = do + distPref <- findDistPrefOrDefault (doctestDistPref flags) + let verbosity = fromFlag $ doctestVerbosity flags + flags' = flags { doctestDistPref = toFlag distPref } + + 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 +580,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 } diff --git a/Cabal/Distribution/Simple/BuildPaths.hs b/Cabal/Distribution/Simple/BuildPaths.hs index 753872635ad..1629e72ba69 100644 --- a/Cabal/Distribution/Simple/BuildPaths.hs +++ b/Cabal/Distribution/Simple/BuildPaths.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.BuildPaths @@ -31,11 +33,16 @@ module Distribution.Simple.BuildPaths ( objExtension, dllExtension, staticLibExtension, + -- * Source files & build directories + getSourceFiles, getLibSourceFiles, getExeSourceFiles, + getFLibSourceFiles, exeBuildDir, flibBuildDir, ) where import Prelude () import Distribution.Compat.Prelude +import Distribution.Types.ForeignLib +import Distribution.Types.UnqualComponentName (unUnqualComponentName) import Distribution.Package import Distribution.ModuleName as ModuleName import Distribution.Compiler @@ -44,8 +51,10 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup import Distribution.Text import Distribution.System +import Distribution.Verbosity +import Distribution.Simple.Utils -import System.FilePath ((), (<.>)) +import System.FilePath ((), (<.>), normalise) -- --------------------------------------------------------------------------- -- Build directories and files @@ -104,6 +113,72 @@ autogenPathsModuleName pkg_descr = haddockName :: PackageDescription -> FilePath haddockName pkg_descr = display (packageName pkg_descr) <.> "haddock" +-- ----------------------------------------------------------------------------- +-- Source File helper + +getLibSourceFiles :: Verbosity + -> LocalBuildInfo + -> Library + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules + where + bi = libBuildInfo lib + modules = allLibModules lib clbi + searchpaths = componentBuildDir lbi clbi : hsSourceDirs bi ++ + [ autogenComponentModulesDir lbi clbi + , autogenPackageModulesDir lbi ] + +getExeSourceFiles :: Verbosity + -> LocalBuildInfo + -> Executable + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getExeSourceFiles verbosity lbi exe clbi = do + moduleFiles <- getSourceFiles verbosity searchpaths modules + srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) + return ((ModuleName.main, srcMainPath) : moduleFiles) + where + bi = buildInfo exe + modules = otherModules bi + searchpaths = autogenComponentModulesDir lbi clbi + : autogenPackageModulesDir lbi + : exeBuildDir lbi exe : hsSourceDirs bi + +getFLibSourceFiles :: Verbosity + -> LocalBuildInfo + -> ForeignLib + -> ComponentLocalBuildInfo + -> IO [(ModuleName.ModuleName, FilePath)] +getFLibSourceFiles verbosity lbi flib clbi = getSourceFiles verbosity searchpaths modules + where + bi = foreignLibBuildInfo flib + modules = otherModules bi + searchpaths = autogenComponentModulesDir lbi clbi + : autogenPackageModulesDir lbi + : flibBuildDir lbi flib : hsSourceDirs bi + +getSourceFiles :: Verbosity -> [FilePath] + -> [ModuleName.ModuleName] + -> IO [(ModuleName.ModuleName, FilePath)] +getSourceFiles verbosity dirs modules = flip traverse modules $ \m -> fmap ((,) m) $ + findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m) + >>= maybe (notFound m) (return . normalise) + where + notFound module_ = die' verbosity $ "can't find source for module " ++ display module_ + +-- | The directory where we put build results for an executable +exeBuildDir :: LocalBuildInfo -> Executable -> FilePath +exeBuildDir lbi exe = buildDir lbi nm nm ++ "-tmp" + where + nm = unUnqualComponentName $ exeName exe + +-- | The directory where we put build results for a foreign library +flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath +flibBuildDir lbi flib = buildDir lbi nm nm ++ "-tmp" + where + nm = unUnqualComponentName $ foreignLibName flib + -- --------------------------------------------------------------------------- -- Library file names diff --git a/Cabal/Distribution/Simple/Doctest.hs b/Cabal/Distribution/Simple/Doctest.hs new file mode 100644 index 00000000000..b7c448812f4 --- /dev/null +++ b/Cabal/Distribution/Simple/Doctest.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Doctest +-- Copyright : Moritz Angermann 2017 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- This module deals with the @doctest@ command. + +-- Note: this module is modelled after Distribution.Simple.Haddock + +module Distribution.Simple.Doctest ( + doctest + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.GHCJS as GHCJS + +-- local +import Distribution.PackageDescription as PD hiding (Flag) +import Distribution.Simple.Compiler hiding (Flag) +import Distribution.Simple.Program.GHC +import Distribution.Simple.Program +import Distribution.Simple.PreProcess +import Distribution.Simple.Setup +import Distribution.Simple.Build +import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate) +import Distribution.Simple.Register (internalPackageDBPath) +import Distribution.Simple.BuildPaths +import Distribution.Simple.Utils +import Distribution.System +import Distribution.Utils.NubList +import Distribution.Version +import Distribution.Verbosity + +-- ----------------------------------------------------------------------------- +-- Types + +-- | A record that represents the arguments to the doctest executable. +data DoctestArgs = DoctestArgs { + argTargets :: [FilePath] + -- ^ Modules to process + , argGhcOptions :: Flag (GhcOptions, Version) +} deriving (Show, Generic) + +-- ----------------------------------------------------------------------------- +-- Doctest support + +doctest :: PackageDescription + -> LocalBuildInfo + -> [PPSuffixHandler] + -> DoctestFlags + -> IO () +doctest pkg_descr lbi suffixes doctestFlags = do + let verbosity = flag doctestVerbosity + distPref = flag doctestDistPref + flag f = fromFlag $ f doctestFlags + tmpFileOpts = defaultTempFileOptions + lbi' = lbi { withPackageDB = withPackageDB lbi + ++ [SpecificPackageDB (internalPackageDBPath lbi distPref)] } + + (doctestProg, _version, _) <- + requireProgramVersion verbosity doctestProgram + (orLaterVersion (mkVersion [0,11,3])) (withPrograms lbi) + + withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do + componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity + preprocessComponent pkg_descr component lbi clbi False verbosity suffixes + + case component of + CLib lib -> do + withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ + \tmp -> do + inFiles <- map snd <$> getLibSourceFiles verbosity lbi lib clbi + args <- mkDoctestArgs verbosity tmp lbi' clbi inFiles (libBuildInfo lib) + runDoctest verbosity (compiler lbi) (hostPlatform lbi) doctestProg args + CExe exe -> do + withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ + \tmp -> do + inFiles <- map snd <$> getExeSourceFiles verbosity lbi exe clbi + args <- mkDoctestArgs verbosity tmp lbi' clbi inFiles (buildInfo exe) + runDoctest verbosity (compiler lbi) (hostPlatform lbi) doctestProg args + CFLib _ -> return () -- do not doctest foreign libs + CTest _ -> return () -- do not doctest tests + CBench _ -> return () -- do not doctest benchmarks + +-- ----------------------------------------------------------------------------- +-- Contributions to DoctestArgs (see also Haddock.hs for very similar code). + +componentGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> GhcOptions +componentGhcOptions verbosity lbi bi clbi odir = + let f = case compilerFlavor (compiler lbi) of + GHC -> GHC.componentGhcOptions + GHCJS -> GHCJS.componentGhcOptions + _ -> error $ + "Distribution.Simple.Doctest.componentGhcOptions:" ++ + "doctest only supports GHC and GHCJS" + in f verbosity lbi bi clbi odir + +mkDoctestArgs :: Verbosity + -> FilePath + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> [FilePath] + -> BuildInfo + -> IO DoctestArgs +mkDoctestArgs verbosity tmp lbi clbi inFiles bi = do + let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) + { ghcOptOptimisation = mempty -- no optimizations when runnign doctest + -- disable -Wmissing-home-modules + , ghcOptWarnMissingHomeModules = mempty + -- clear out ghc-options: these are likely not meant for doctest. + -- If so, should be explicitly specified via doctest-ghc-options: again. + , ghcOptExtra = mempty + , ghcOptCabal = toFlag False + + , ghcOptObjDir = toFlag tmp + , ghcOptHiDir = toFlag tmp + , ghcOptStubDir = toFlag tmp } + sharedOpts = vanillaOpts + { ghcOptDynLinkMode = toFlag GhcDynamicOnly + , ghcOptFPic = toFlag True + , ghcOptHiSuffix = toFlag "dyn_hi" + , ghcOptObjSuffix = toFlag "dyn_o" + , ghcOptExtra = toNubListR (hcSharedOptions GHC bi)} + opts <- if withVanillaLib lbi + then return vanillaOpts + else if withSharedLib lbi + then return sharedOpts + else die' verbosity $ "Must have vanilla or shared lirbaries " + ++ "enabled in order to run doctest" + ghcVersion <- maybe (die' verbosity "Compiler has no GHC version") + return + (compilerCompatVersion GHC (compiler lbi)) + return $ DoctestArgs + { argTargets = inFiles + , argGhcOptions = toFlag (opts, ghcVersion) + } + + +-- ----------------------------------------------------------------------------- +-- Call doctest with the specified arguments. +runDoctest :: Verbosity + -> Compiler + -> Platform + -> ConfiguredProgram + -> DoctestArgs + -> IO () +runDoctest verbosity comp platform doctestProg args = do + renderArgs verbosity comp platform args $ + \(flags, files) -> do + runProgram verbosity doctestProg (flags <> files) + +renderArgs :: Verbosity + -> Compiler + -> Platform + -> DoctestArgs + -> (([String],[FilePath]) -> IO a) + -> IO a +renderArgs _verbosity comp platform args k = do + k (flags, argTargets args) + where + flags :: [String] + flags = mconcat + [ pure "--no-magic" -- disable doctests automagic discovery heuristics + , pure "-fdiagnostics-color=never" -- disable ghc's color diagnostics. + , [ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args) + , opt <- renderGhcOptions comp platform opts ] + ] + +-- ------------------------------------------------------------------------------ +-- Boilerplate Monoid instance. +instance Monoid DoctestArgs where + mempty = gmempty + mappend = (<>) + +instance Semigroup DoctestArgs where + (<>) = gmappend diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 38ba1a445c2..066f44bd5aa 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -242,7 +242,7 @@ haddock pkg_descr lbi suffixes flags' = do for_ files $ copyFileTo verbosity (unDir $ argOutputDir commonArgs) -- ------------------------------------------------------------------------------ --- Contributions to HaddockArgs. +-- Contributions to HaddockArgs (see also Doctest.hs for very similar code). fromFlags :: PathTemplateEnv -> HaddockFlags -> HaddockArgs fromFlags env flags = @@ -751,71 +751,6 @@ haddockToHscolour flags = hscolourVerbosity = haddockVerbosity flags, hscolourDistPref = haddockDistPref flags } ---------------------------------------------------------------------------------- --- TODO these should be moved elsewhere. - -getLibSourceFiles :: Verbosity - -> LocalBuildInfo - -> Library - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules - where - bi = libBuildInfo lib - modules = allLibModules lib clbi - searchpaths = componentBuildDir lbi clbi : hsSourceDirs bi ++ - [ autogenComponentModulesDir lbi clbi - , autogenPackageModulesDir lbi ] - -getExeSourceFiles :: Verbosity - -> LocalBuildInfo - -> Executable - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getExeSourceFiles verbosity lbi exe clbi = do - moduleFiles <- getSourceFiles verbosity searchpaths modules - srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) - return ((ModuleName.main, srcMainPath) : moduleFiles) - where - bi = buildInfo exe - modules = otherModules bi - searchpaths = autogenComponentModulesDir lbi clbi - : autogenPackageModulesDir lbi - : exeBuildDir lbi exe : hsSourceDirs bi - -getFLibSourceFiles :: Verbosity - -> LocalBuildInfo - -> ForeignLib - -> ComponentLocalBuildInfo - -> IO [(ModuleName.ModuleName, FilePath)] -getFLibSourceFiles verbosity lbi flib clbi = getSourceFiles verbosity searchpaths modules - where - bi = foreignLibBuildInfo flib - modules = otherModules bi - searchpaths = autogenComponentModulesDir lbi clbi - : autogenPackageModulesDir lbi - : flibBuildDir lbi flib : hsSourceDirs bi - -getSourceFiles :: Verbosity -> [FilePath] - -> [ModuleName.ModuleName] - -> IO [(ModuleName.ModuleName, FilePath)] -getSourceFiles verbosity dirs modules = flip traverse modules $ \m -> fmap ((,) m) $ - findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m) - >>= maybe (notFound m) (return . normalise) - where - notFound module_ = die' verbosity $ "haddock: can't find source for module " ++ display module_ - --- | The directory where we put build results for an executable -exeBuildDir :: LocalBuildInfo -> Executable -> FilePath -exeBuildDir lbi exe = buildDir lbi nm nm ++ "-tmp" - where - nm = unUnqualComponentName $ exeName exe - --- | The directory where we put build results for a foreign library -flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath -flibBuildDir lbi flib = buildDir lbi nm nm ++ "-tmp" - where - nm = unUnqualComponentName $ foreignLibName flib -- ------------------------------------------------------------------------------ -- Boilerplate Monoid instance. diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index a40e5363865..6454ca6b590 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -62,7 +62,7 @@ module Distribution.Simple.LocalBuildInfo ( module Distribution.Simple.InstallDirs, absoluteInstallDirs, prefixRelativeInstallDirs, absoluteComponentInstallDirs, prefixRelativeComponentInstallDirs, - substPathTemplate + substPathTemplate, ) where import Prelude () @@ -383,3 +383,4 @@ substPathTemplate pkgid lbi uid = fromPathTemplate uid (compilerInfo (compiler lbi)) (hostPlatform lbi) + diff --git a/Cabal/Distribution/Simple/Program.hs b/Cabal/Distribution/Simple/Program.hs index ce10570e130..57bd64e169d 100644 --- a/Cabal/Distribution/Simple/Program.hs +++ b/Cabal/Distribution/Simple/Program.hs @@ -112,6 +112,7 @@ module Distribution.Simple.Program ( , c2hsProgram , cpphsProgram , hscolourProgram + , doctestProgram , haddockProgram , greencardProgram , ldProgram diff --git a/Cabal/Distribution/Simple/Program/Builtin.hs b/Cabal/Distribution/Simple/Program/Builtin.hs index 4b52c53b5b1..0a740b4339d 100644 --- a/Cabal/Distribution/Simple/Program/Builtin.hs +++ b/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,18 @@ hscolourProgram = (simpleProgram "hscolour") { _ -> "" } +-- TODO: Ensure that doctest is built against the same GHC as the one +-- that's being used. Same for haddock. @phadej pointed this out. +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 -> diff --git a/Cabal/Distribution/Simple/Program/Types.hs b/Cabal/Distribution/Simple/Program/Types.hs index b4249a2482c..6eb0695017b 100644 --- a/Cabal/Distribution/Simple/Program/Types.hs +++ b/Cabal/Distribution/Simple/Program/Types.hs @@ -76,6 +76,8 @@ data Program = Program { -- it could add args, or environment vars. programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram } +instance Show Program where + show (Program name _ _ _) = "Program: " ++ name type ProgArg = String diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 60f104eb0cb..ba79b60eed3 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/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,68 @@ 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 + emptyProgramDb + +doctestOptions :: ShowOrParseArgs -> [OptionField DoctestFlags] +doctestOptions showOrParseArgs = + [optionVerbosity doctestVerbosity + (\v flags -> flags { doctestVerbosity = v }) + ,optionDistPref + doctestDistPref (\d flags -> flags { doctestDistPref = d }) + showOrParseArgs + ] + +emptyDoctestFlags :: DoctestFlags +emptyDoctestFlags = mempty + +instance Monoid DoctestFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup DoctestFlags where + (<>) = gmappend + -- ------------------------------------------------------------ -- * Haddock flags -- ------------------------------------------------------------ diff --git a/Cabal/Distribution/Simple/UserHooks.hs b/Cabal/Distribution/Simple/UserHooks.hs index 28457b66be9..31e9cd66aea 100644 --- a/Cabal/Distribution/Simple/UserHooks.hs +++ b/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, diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index edaffc8bc5e..ed08589c668 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/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" diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 2e8ad60d539..617788ebb33 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -50,6 +50,7 @@ import Distribution.Client.Setup ) import Distribution.Simple.Setup ( HaddockTarget(..) + , DoctestFlags(..), doctestCommand , HaddockFlags(..), haddockCommand, defaultHaddockFlags , HscolourFlags(..), hscolourCommand , ReplFlags(..) @@ -270,6 +271,7 @@ mainWorker args = topHandler $ , regularCmd buildCommand buildAction , regularCmd replCommand replAction , regularCmd sandboxCommand sandboxAction + , regularCmd doctestCommand doctestAction , regularCmd haddockCommand haddockAction , regularCmd execCommand execAction , regularCmd userConfigCommand userConfigAction @@ -761,6 +763,13 @@ haddockAction haddockFlags extraArgs globalFlags = do createTarGzFile dest docDir name notice verbosity $ "Documentation tarball created: " ++ dest +doctestAction :: DoctestFlags -> [String] -> Action +doctestAction doctestFlags extraArgs _globalFlags = do + let verbosity = fromFlag (doctestVerbosity doctestFlags) + + setupWrapper verbosity defaultSetupScriptOptions Nothing + doctestCommand (const doctestFlags) extraArgs + cleanAction :: CleanFlags -> [String] -> Action cleanAction cleanFlags extraArgs globalFlags = do load <- try (loadConfigOrSandboxConfig verbosity globalFlags)