cabal-doctest-1.0.6/0000755000000000000000000000000013233371307012413 5ustar0000000000000000cabal-doctest-1.0.6/cabal-doctest.cabal0000644000000000000000000000251513233371307016107 0ustar0000000000000000name: cabal-doctest version: 1.0.6 synopsis: A Setup.hs helper for doctests running description: Currently (beginning of 2017), there isn't @cabal doctest@ command. Yet, to properly work doctest needs plenty of configuration. This library provides the common bits for writing custom Setup.hs See for the progress of @cabal doctest@, i.e. whether this library is obsolete. homepage: https://github.com/phadej/cabal-doctest license: BSD3 license-file: LICENSE author: Oleg Grenrus maintainer: Oleg Grenrus copyright: (c) 2017 Oleg Grenrus category: Distribution build-type: Simple cabal-version: >=1.10 extra-source-files: ChangeLog.md README.md tested-with: GHC==7.0.4, GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 source-repository head type: git location: https://github.com/phadej/cabal-doctest library exposed-modules: Distribution.Extra.Doctest other-modules: other-extensions: build-depends: base >=4.3 && <4.11, Cabal >= 1.10 && <2.1, filepath, directory hs-source-dirs: src default-language: Haskell2010 cabal-doctest-1.0.6/ChangeLog.md0000644000000000000000000000214713233371307014570 0ustar0000000000000000# 1.0.6 -- 2018-01-28 * Hook `haddock` build too. Fixes issue when `haddock` fails, as `Build_doctests` isn't generated. # 1.0.5 -- 2018-01-26 * Add a hack so `Build_doctests` module is automatically added to to `other-modules` and `autogen-modules` when compiled with Cabal-2.0. Thanks to that, we don't get warnings because of `-Wmissing-home-modules`. # 1.0.4 -- 2017-12-05 * Add support for doctests in executables and (with `Cabal-2.0` or later) internal libraries. Refer to the `README` for more details. # 1.0.3 -- 2017-11-02 * Add an explicit `Prelude` import to `Build_doctests` # 1.0.2 -- 2017-05-16 * Add `defaultMainAutoconfWithDoctests` and `addDoctestsUserHook`. * Add support for `.hsc` and other preprocessed files ([#8](https://github.com/phadej/cabal-doctest/issues/8)) * Add support for `x-doctest-source-dirs` and `x-doctest-modules`. # 1.0.1 -- 2017-05-05 * Add support for `x-doctest-options` cabal-file field * Proper support for GHC-8.2.1 & Cabal-2.0.0.0 * Add support to `default-extensions` in library. # 1 -- 2017-01-31 * First version. Released on an unsuspecting world. cabal-doctest-1.0.6/LICENSE0000644000000000000000000000276213233371307013427 0ustar0000000000000000Copyright (c) 2017, Oleg Grenrus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cabal-doctest-1.0.6/Setup.hs0000644000000000000000000000005613233371307014050 0ustar0000000000000000import Distribution.Simple main = defaultMain cabal-doctest-1.0.6/README.md0000644000000000000000000001726413233371307013704 0ustar0000000000000000cabal-doctest ============= [![Hackage](https://img.shields.io/hackage/v/cabal-doctest.svg)](https://hackage.haskell.org/package/cabal-doctest) [![Build Status](https://travis-ci.org/phadej/cabal-doctest.svg?branch=master)](https://travis-ci.org/phadej/cabal-doctest) A `Setup.hs` helper for running `doctests`. Simple example -------------- For most use cases—a `.cabal` file with a single library containing doctests—adapting the simple example located [here](https://github.com/phadej/cabal-doctest/tree/master/simple-example) will be sufficient. (Note that this example requires `Cabal-1.24` or later, but you can relax this bound safely, although running doctests won't be supported on versions of `Cabal` older than 1.24.) To use this library in your `Setup.hs`, you should specify a `custom-setup` section in your `.cabal` file. For example: ``` custom-setup setup-depends: base >= 4 && <5, Cabal, cabal-doctest >= 1 && <1.1 ``` /Note:/ `Cabal` dependency is needed because of [Cabal/GH-4288](https://github.com/haskell/cabal/issues/4288) bug. You'll also need to specify `build-type: Custom` at the top of the `.cabal` file. Now put this into your `Setup.hs` file: ```haskell module Main where import Distribution.Extra.Doctest (defaultMainWithDoctests) main :: IO () main = defaultMainWithDoctests "doctests" ``` When you build your project, this `Setup` will generate a `Build_doctests` module. To use it in a testsuite, simply do this: ```haskell module Main where import Build_doctests (flags, pkgs, module_sources) import Data.Foldable (traverse_) import Test.DocTest (doctest) main :: IO () main = do traverse_ putStrLn args -- optionally print arguments doctest args where args = flags ++ pkgs ++ module_sources ``` Example with multiple .cabal components --------------------------------------- `cabal-doctest` also supports more exotic use cases where a `.cabal` file contains more components with doctests than just the main library, including: * Doctests in executables * Doctests in Internal libraries (if using `Cabal-2.0` or later) Unlike the simple example shown above, these examples involve _named_ components. You don't need to change the `Setup.hs` script to support this use case. However, in this scenario `Build_doctests` will generate extra copies of the `flags`, `pkgs`, and `module_sources` values for each additional named component. Simplest approach is to use `x-doctest-components` field, for example ``` x-doctest-components: lib lib:internal exe:example ``` In that case, the testdrive is general: ```haskell module Main where import Build_doctests (Component (..), components) import Data.Foldable (for_) import Test.DocTest (doctest) main :: IO () main = for_ components $ \(Component name flags pkgs sources) -> do print name putStrLn "----------------------------------------" let args = flags ++ pkgs ++ sources for_ args putStrLn doctest args ``` There's also a more explicit approach: if you have an executable named `foo`, then separate values named `flags_exe_foo`, `pkgs_exe_foo`, and `module_sources_exe_foo` will be generated in `Build_doctests`. If the name has hyphens in it (e.g., `my-exe`), then `cabal-doctest` will convert those hyphens to underscores (e.g., you'd get `flags_my_exe`, `pkgs_my_exe`, and `module_sources_my_exe`). Internal library `bar` values will have a `_lib_bar` suffix. An example testsuite driver for this use case might look like this: ```haskell module Main where import Build_doctests (flags, pkgs, module_sources, flags_exe_my_exe, pkgs_exe_my_exe, module_sources_exe_my_exe) import Data.Foldable (traverse_) import Test.DocTest main :: IO () main = do -- doctests for library traverse_ putStrLn libArgs doctest libArgs -- doctests for executable traverse_ putStrLn exeArgs doctest exeArgs where libArgs = flags ++ pkgs ++ module_sources exeArgs = flags_exe_my_exe ++ pkgs_exe_my_exe ++ module_sources_exe_my_exe ``` See [this example](https://github.com/phadej/cabal-doctest/tree/master/multiple-components-example) for more details. Additional configuration ------------------------ The `cabal-doctest` based `Setup.hs` supports few extensions fields in `pkg.cabal` files to customise the `doctest` runner behaviour, without customising the default `doctest.hs`. ``` test-suite doctests: if impl(ghc >= 8.0) x-doctest-options: -fdiagnostics-color=never x-doctest-source-dirs: test x-doctest-modules: Servant.Utils.LinksSpec ... ``` * `x-doctest-options` Additional arguments passed into `doctest` command. * `x-doctest-modules` Additional modules to `doctest`. May be useful if you have `doctest` in test or executables (i.e not default library complonent). * `x-doctest-src-dirs` Additional source directories to look for the modules. Notes ----- * Recent versions of `Cabal` (for instance, 2.0) can choose to build a package's `doctest` test suite _before_ the library. However, in order for `cabal-doctest` to work correctly, the library _must_ be built first, as `doctest` relies on the presence of generated files that are only created when the library is built. See [#19](https://github.com/phadej/cabal-doctest/issues/19). A hacky workaround for this problem is to depend on the library itself in a `doctests` test suite. See [the simple example's .cabal file](https://github.com/phadej/cabal-doctest/blob/master/simple-example/simple-example.cabal) for a demonstration. (This assumes that the test suite has the ability to read build artifacts from the library, a separate build component. In practice, this assumption holds, which is why this library works at all.) * `custom-setup` section is supported starting from `cabal-install-1.24`. For older `cabal-install's` you have to install custom setup dependencies manually. * `stack` respects `custom-setup` starting from version 1.3.3. Before that you have to use `explicit-setup-deps` setting in your `stack.yaml`. ([stack/GH-2094](https://github.com/commercialhaskell/stack/issues/2094)) * There is [an issue in the Cabal issue tracker](https://github.com/haskell/cabal/issues/2327) about adding `cabal doctest` command. After that command is implemented, this library will be deprecated. * You can use `x-doctest-options` field in `test-suite doctests` to pass additional flags to the `doctest`. * For `build-type: Configure` packages, you can use `defaultMainAutoconfWithDoctests` function to make custom `Setup.hs` script. * If you use the default `.` in `hs-source-dirs`, then running `doctests` might fail with weird errors (ambigious module errors). Workaround is to move sources under `src/` or some non-top-level directory. * `extensions:` field isn't supported. Upgrade your `.cabal` file to use at least `cabal-version: >= 1.10` and use `default-extensions` or `other-extensions`. * If you use QuickCheck properties (`prop>`) in your doctests, the `test-suite doctest` should depend on `QuickCheck` and `template-haskell`. This is a little HACK: These dependencies aren't needed to build the `doctests` test-suite executable. However, as we let `Cabal` resolve dependencies, we can pass the resolved (and installed!) package identifiers to to the `doctest` command. This way, `QuickCheck` and `template-haskell` are available to `doctest`, otherwise you'll get errors like: ``` Variable not in scope: mkName :: [Char] -> template-haskell-2.11.1.0:Language.Haskell.TH.Syntax.Name ``` or ``` Variable not in scope: polyQuickCheck :: Language.Haskell.TH.Syntax.Name -> Language.Haskell.TH.Lib.ExpQ ``` Copyright --------- Copyright 2017 Oleg Grenrus. Available under the BSD 3-clause license. cabal-doctest-1.0.6/src/0000755000000000000000000000000013233371307013202 5ustar0000000000000000cabal-doctest-1.0.6/src/Distribution/0000755000000000000000000000000013233371307015661 5ustar0000000000000000cabal-doctest-1.0.6/src/Distribution/Extra/0000755000000000000000000000000013233371307016744 5ustar0000000000000000cabal-doctest-1.0.6/src/Distribution/Extra/Doctest.hs0000644000000000000000000004316513233371307020716 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | The provided 'generateBuildModule' generates 'Build_doctests' module. -- That module exports enough configuration, so your doctests could be simply -- -- @ -- module Main where -- -- import Build_doctests (flags, pkgs, module_sources) -- import Data.Foldable (traverse_) -- import Test.Doctest (doctest) -- -- main :: IO () -- main = do -- traverse_ putStrLn args -- optionally print arguments -- doctest args -- where -- args = flags ++ pkgs ++ module_sources -- @ -- -- To use this library in the @Setup.hs@, you should specify a @custom-setup@ -- section in the cabal file, for example: -- -- @ -- custom-setup -- setup-depends: -- base >= 4 && <5, -- cabal-doctest >= 1 && <1.1 -- @ -- -- /Note:/ you don't need to depend on @Cabal@ if you use only -- 'defaultMainWithDoctests' in the @Setup.hs@. -- module Distribution.Extra.Doctest ( defaultMainWithDoctests, defaultMainAutoconfWithDoctests, addDoctestsUserHook, doctestsUserHooks, generateBuildModule, ) where -- Hacky way to suppress few deprecation warnings. #if MIN_VERSION_Cabal(1,24,0) #define InstalledPackageId UnitId #endif import Control.Monad (when) import Data.List (nub) import Data.Maybe (maybeToList, mapMaybe) import Data.String (fromString) import qualified Data.Foldable as F (for_) import qualified Data.Traversable as T (traverse) import qualified Distribution.ModuleName as ModuleName (fromString) import Distribution.ModuleName (ModuleName) import Distribution.Package (InstalledPackageId) import Distribution.Package (Package (..), PackageId, packageVersion) import Distribution.PackageDescription (BuildInfo (..), Executable (..), Library (..), GenericPackageDescription, PackageDescription (), TestSuite (..)) import Distribution.Simple (UserHooks (..), autoconfUserHooks, defaultMainWithHooks, simpleUserHooks) import Distribution.Simple.BuildPaths (autogenModulesDir) import Distribution.Simple.Compiler (PackageDB (..), showCompilerId) import Distribution.Simple.LocalBuildInfo (ComponentLocalBuildInfo (componentPackageDeps), LocalBuildInfo (), compiler, withExeLBI, withLibLBI, withPackageDB, withTestLBI) import Distribution.Simple.Setup (BuildFlags (buildDistPref, buildVerbosity), HaddockFlags (haddockDistPref, haddockVerbosity), fromFlag, emptyBuildFlags) import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, findFile, rewriteFile) import Distribution.Text (display, simpleParse) import System.FilePath ((), (<.>), dropExtension) import Data.IORef (newIORef, modifyIORef, readIORef) #if MIN_VERSION_Cabal(1,25,0) import Distribution.Simple.BuildPaths (autogenComponentModulesDir) #endif #if MIN_VERSION_Cabal(2,0,0) import Distribution.Types.MungedPackageId (MungedPackageId) import Distribution.Types.UnqualComponentName (unUnqualComponentName) -- For amendGPD import Distribution.Types.GenericPackageDescription (GenericPackageDescription (condTestSuites)) import Distribution.PackageDescription (CondTree (..)) #endif #if MIN_VERSION_directory(1,2,2) import System.Directory (makeAbsolute) #else import System.Directory (getCurrentDirectory) import System.FilePath (isAbsolute) makeAbsolute :: FilePath -> IO FilePath makeAbsolute p | isAbsolute p = return p | otherwise = do cwd <- getCurrentDirectory return $ cwd p #endif -- | A default main with doctests: -- -- @ -- import Distribution.Extra.Doctest -- (defaultMainWithDoctests) -- -- main :: IO () -- main = defaultMainWithDoctests "doctests" -- @ defaultMainWithDoctests :: String -- ^ doctests test-suite name -> IO () defaultMainWithDoctests = defaultMainWithHooks . doctestsUserHooks -- | Like 'defaultMainWithDoctests', for 'build-type: Configure' packages. -- -- @since 1.0.2 defaultMainAutoconfWithDoctests :: String -- ^ doctests test-suite name -> IO () defaultMainAutoconfWithDoctests n = defaultMainWithHooks (addDoctestsUserHook n autoconfUserHooks) -- | 'simpleUserHooks' with 'generateBuildModule' prepended to the 'buildHook'. doctestsUserHooks :: String -- ^ doctests test-suite name -> UserHooks doctestsUserHooks testsuiteName = addDoctestsUserHook testsuiteName simpleUserHooks -- | -- -- @since 1.0.2 addDoctestsUserHook :: String -> UserHooks -> UserHooks addDoctestsUserHook testsuiteName uh = uh { buildHook = \pkg lbi hooks flags -> do generateBuildModule testsuiteName flags pkg lbi buildHook uh pkg lbi hooks flags -- We use confHook to add "Build_Doctests" to otherModules and autogenModules. -- -- We cannot use HookedBuildInfo as it let's alter only the library and executables. , confHook = \(gpd, hbi) flags -> confHook uh (amendGPD testsuiteName gpd, hbi) flags , haddockHook = \pkg lbi hooks flags -> do generateBuildModule testsuiteName (haddockToBuildFlags flags) pkg lbi haddockHook uh pkg lbi hooks flags } -- | Convert only flags used by 'generateBuildModule'. haddockToBuildFlags :: HaddockFlags -> BuildFlags haddockToBuildFlags f = emptyBuildFlags { buildVerbosity = haddockVerbosity f , buildDistPref = haddockDistPref f } data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show) nameToString :: Name -> String nameToString n = case n of NameLib x -> maybe "" (("_lib_" ++) . map fixchar) x NameExe x -> "_exe_" ++ map fixchar x where -- Taken from Cabal: -- https://github.com/haskell/cabal/blob/20de0bfea72145ba1c37e3f500cee5258cc18e51/Cabal/Distribution/Simple/Build/Macros.hs#L156-L158 -- -- Needed to fix component names with hyphens in them, as hyphens aren't -- allowed in Haskell identifier names. fixchar :: Char -> Char fixchar '-' = '_' fixchar c = c data Component = Component Name [String] [String] [String] deriving Show -- | Generate a build module for the test suite. -- -- @ -- import Distribution.Simple -- (defaultMainWithHooks, UserHooks(..), simpleUserHooks) -- import Distribution.Extra.Doctest -- (generateBuildModule) -- -- main :: IO () -- main = defaultMainWithHooks simpleUserHooks -- { buildHook = \pkg lbi hooks flags -> do -- generateBuildModule "doctests" flags pkg lbi -- buildHook simpleUserHooks pkg lbi hooks flags -- } -- @ generateBuildModule :: String -- ^ doctests test-suite name -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule testSuiteName flags pkg lbi = do let verbosity = fromFlag (buildVerbosity flags) let distPref = fromFlag (buildDistPref flags) -- Package DBs let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref "package.conf.inplace" ] let dbFlags = "-hide-all-packages" : packageDbArgs dbStack withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do #if MIN_VERSION_Cabal(1,25,0) let testAutogenDir = autogenComponentModulesDir lbi suitecfg #else let testAutogenDir = autogenModulesDir lbi #endif createDirectoryIfMissingVerbose verbosity True testAutogenDir let buildDoctestsFile = testAutogenDir "Build_doctests.hs" -- First, we create the autogen'd module Build_doctests. -- Initially populate Build_doctests with a simple preamble. writeFile buildDoctestsFile $ unlines [ "module Build_doctests where" , "" , "import Prelude" , "" , "data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show)" , "data Component = Component Name [String] [String] [String] deriving (Eq, Show)" , "" ] -- we cannot traverse, only traverse_ -- so we use IORef to collect components componentsRef <- newIORef [] let testBI = testBuildInfo suite -- TODO: `words` is not proper parser (no support for quotes) let additionalFlags = maybe [] words $ lookup "x-doctest-options" $ customFieldsBI testBI let additionalModules = maybe [] words $ lookup "x-doctest-modules" $ customFieldsBI testBI let additionalDirs' = maybe [] words $ lookup "x-doctest-source-dirs" $ customFieldsBI testBI additionalDirs <- mapM (fmap ("-i" ++) . makeAbsolute) additionalDirs' -- Next, for each component (library or executable), we get to Build_doctests -- the sets of flags needed to run doctest on that component. let getBuildDoctests withCompLBI mbCompName compExposedModules compMainIs compBuildInfo = withCompLBI pkg lbi $ \comp compCfg -> do let compBI = compBuildInfo comp -- modules let modules = compExposedModules comp ++ otherModules compBI -- it seems that doctest is happy to take in module names, not actual files! let module_sources = modules -- We need the directory with the component's cabal_macros.h! #if MIN_VERSION_Cabal(1,25,0) let compAutogenDir = autogenComponentModulesDir lbi compCfg #else let compAutogenDir = autogenModulesDir lbi #endif -- Lib sources and includes iArgsNoPrefix <- mapM makeAbsolute $ compAutogenDir -- autogenerated files : (distPref ++ "/build") -- preprocessed files (.hsc -> .hs); "build" is hardcoded in Cabal. : hsSourceDirs compBI includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs compBI -- We clear all includes, so the CWD isn't used. let iArgs' = map ("-i"++) iArgsNoPrefix iArgs = "-i" : iArgs' -- default-extensions let extensionArgs = map (("-X"++) . display) $ defaultExtensions compBI -- CPP includes, i.e. include cabal_macros.h let cppFlags = map ("-optP"++) $ [ "-include", compAutogenDir ++ "/cabal_macros.h" ] ++ cppOptions compBI -- Unlike other modules, the main-is module of an executable is not -- guaranteed to share a module name with its filepath name. That is, -- even though the main-is module is named Main, its filepath might -- actually be Something.hs. To account for this possibility, we simply -- pass the full path to the main-is module instead. mainIsPath <- T.traverse (findFile iArgsNoPrefix) (compMainIs comp) let all_sources = map display module_sources ++ additionalModules ++ maybeToList mainIsPath let component = Component (mbCompName comp) (formatDeps $ testDeps compCfg suitecfg) (concat [ iArgs , additionalDirs , includeArgs , dbFlags , cppFlags , extensionArgs , additionalFlags ]) all_sources -- modify IORef, append component modifyIORef componentsRef (\cs -> cs ++ [component]) -- For now, we only check for doctests in libraries and executables. getBuildDoctests withLibLBI mbLibraryName exposedModules (const Nothing) libBuildInfo getBuildDoctests withExeLBI (NameExe . executableName) (const []) (Just . modulePath) buildInfo components <- readIORef componentsRef F.for_ components $ \(Component name pkgs flags sources) -> do let compSuffix = nameToString name pkgs_comp = "pkgs" ++ compSuffix flags_comp = "flags" ++ compSuffix module_sources_comp = "module_sources" ++ compSuffix -- write autogen'd file appendFile buildDoctestsFile $ unlines [ -- -package-id etc. flags pkgs_comp ++ " :: [String]" , pkgs_comp ++ " = " ++ show pkgs , "" , flags_comp ++ " :: [String]" , flags_comp ++ " = " ++ show flags , "" , module_sources_comp ++ " :: [String]" , module_sources_comp ++ " = " ++ show sources , "" ] -- write enabled components, i.e. x-doctest-components -- if none enabled, pick library let enabledComponents = maybe [NameLib Nothing] (mapMaybe parseComponentName . words) $ lookup "x-doctest-components" $ customFieldsBI testBI let components' = filter (\(Component n _ _ _) -> n `elem` enabledComponents) components appendFile buildDoctestsFile $ unlines [ "-- " ++ show enabledComponents , "components :: [Component]" , "components = " ++ show components' ] where parseComponentName :: String -> Maybe Name parseComponentName "lib" = Just (NameLib Nothing) parseComponentName ('l' : 'i' : 'b' : ':' : x) = Just (NameLib (Just x)) parseComponentName ('e' : 'x' : 'e' : ':' : x) = Just (NameExe x) parseComponentName _ = Nothing -- we do this check in Setup, as then doctests don't need to depend on Cabal isOldCompiler = maybe False id $ do a <- simpleParse $ showCompilerId $ compiler lbi b <- simpleParse "7.5" return $ packageVersion (a :: PackageId) < b formatDeps = map formatOne formatOne (installedPkgId, pkgId) -- The problem is how different cabal executables handle package databases -- when doctests depend on the library -- -- If the pkgId is current package, we don't output the full package-id -- but only the name -- -- Because of MungedPackageId we compare display version of identifiers -- not the identifiers themfselves. | display (packageId pkg) == display pkgId = "-package=" ++ display pkgId | otherwise = "-package-id=" ++ display installedPkgId -- From Distribution.Simple.Program.GHC packageDbArgs :: [PackageDB] -> [String] packageDbArgs | isOldCompiler = packageDbArgsConf | otherwise = packageDbArgsDb -- GHC <7.6 uses '-package-conf' instead of '-package-db'. packageDbArgsConf :: [PackageDB] -> [String] packageDbArgsConf dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs (GlobalPackageDB:dbs) -> ("-no-user-package-conf") : concatMap specific dbs _ -> ierror where specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] specific _ = ierror ierror = error $ "internal error: unexpected package db stack: " ++ show dbstack -- GHC >= 7.6 uses the '-package-db' flag. See -- https://ghc.haskell.org/trac/ghc/ticket/5977. packageDbArgsDb :: [PackageDB] -> [String] -- special cases to make arguments prettier in common scenarios packageDbArgsDb dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) | all isSpecific dbs -> concatMap single dbs (GlobalPackageDB:dbs) | all isSpecific dbs -> "-no-user-package-db" : concatMap single dbs dbs -> "-clear-package-db" : concatMap single dbs where single (SpecificPackageDB db) = [ "-package-db=" ++ db ] single GlobalPackageDB = [ "-global-package-db" ] single UserPackageDB = [ "-user-package-db" ] isSpecific (SpecificPackageDB _) = True isSpecific _ = False mbLibraryName :: Library -> Name #if MIN_VERSION_Cabal(2,0,0) -- Cabal-2.0 introduced internal libraries, which are named. mbLibraryName = NameLib . fmap unUnqualComponentName . libName #else -- Before that, there was only ever at most one library per -- .cabal file, which has no name. mbLibraryName _ = NameLib Nothing #endif executableName :: Executable -> String #if MIN_VERSION_Cabal(2,0,0) executableName = unUnqualComponentName . exeName #else executableName = exeName #endif -- | In compat settings it's better to omit the type-signature testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo #if MIN_VERSION_Cabal(2,0,0) -> [(InstalledPackageId, MungedPackageId)] #else -> [(InstalledPackageId, PackageId)] #endif testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys amendGPD :: String -- ^ doctests test-suite name -> GenericPackageDescription -> GenericPackageDescription #if !(MIN_VERSION_Cabal(2,0,0)) amendGPD _ = id #else amendGPD testSuiteName gpd = gpd { condTestSuites = map f (condTestSuites gpd) } where f (name, condTree) | name == fromString testSuiteName = (name, condTree') | otherwise = (name, condTree) where -- I miss 'lens' testSuite = condTreeData condTree bi = testBuildInfo testSuite om = otherModules bi am = autogenModules bi -- Cons the module to both other-modules and autogen-modules. -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have -- "all autogen-modules are other-modules if they aren't exposed-modules" -- rule. Hopefully cabal-spec-3.0 will have. -- -- Note: we `nub`, because it's unclear if that's ok to have duplicate -- modules in the lists. om' = nub $ mn : om am' = nub $ mn : am mn = fromString "Build_doctests" bi' = bi { otherModules = om', autogenModules = am' } testSuite' = testSuite { testBuildInfo = bi' } condTree' = condTree { condTreeData = testSuite' } #endif