Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Upgrade the Setup.hs harness to use cabal-doctest.
This upgrades the `Setup.hs` harness to use `cabal-doctest`, making it compatible with `Cabal-1.25` (shipped with GHC 8.2). See ekmett/lens#709 Make sure to add a dependency on bits in the doctests test-suite to avoid haskellari/cabal-doctest#5
- Loading branch information
Showing
4 changed files
with
194 additions
and
55 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,48 +1,182 @@ | ||
#!/usr/bin/runhaskell | ||
\begin{code} | ||
{-# OPTIONS_GHC -Wall #-} | ||
{-# LANGUAGE CPP #-} | ||
{-# LANGUAGE OverloadedStrings #-} | ||
module Main (main) where | ||
#ifndef MIN_VERSION_cabal_doctest | ||
#define MIN_VERSION_cabal_doctest(x,y,z) 0 | ||
#endif | ||
#if MIN_VERSION_cabal_doctest(1,0,0) | ||
import Distribution.Extra.Doctest ( defaultMainWithDoctests ) | ||
#else | ||
-- Otherwise we provide a shim | ||
#ifndef MIN_VERSION_Cabal | ||
#define MIN_VERSION_Cabal(x,y,z) 0 | ||
#endif | ||
#ifndef MIN_VERSION_directory | ||
#define MIN_VERSION_directory(x,y,z) 0 | ||
#endif | ||
#if MIN_VERSION_Cabal(1,24,0) | ||
#define InstalledPackageId UnitId | ||
#endif | ||
import Control.Monad ( when ) | ||
import Data.List ( nub ) | ||
import Data.Version ( showVersion ) | ||
import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) | ||
import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) | ||
import Data.String ( fromString ) | ||
import Distribution.Package ( InstalledPackageId ) | ||
import Distribution.Package ( PackageId, Package (..), packageVersion ) | ||
import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) | ||
import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) | ||
import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) | ||
import Distribution.Simple.BuildPaths ( autogenModulesDir ) | ||
import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) | ||
import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) | ||
import Distribution.Verbosity ( Verbosity ) | ||
import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag) | ||
import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler ) | ||
import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..)) | ||
import Distribution.Text ( display , simpleParse ) | ||
import System.FilePath ( (</>) ) | ||
main :: IO () | ||
main = defaultMainWithHooks simpleUserHooks | ||
{ buildHook = \pkg lbi hooks flags -> do | ||
generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi | ||
buildHook simpleUserHooks pkg lbi hooks flags | ||
} | ||
#if MIN_VERSION_Cabal(1,25,0) | ||
import Distribution.Simple.BuildPaths ( autogenComponentModulesDir ) | ||
#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 | ||
generateBuildModule :: String -> 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 | ||
withLibLBI pkg lbi $ \lib libcfg -> do | ||
let libBI = libBuildInfo lib | ||
-- modules | ||
let modules = exposedModules lib ++ otherModules libBI | ||
-- it seems that doctest is happy to take in module names, not actual files! | ||
let module_sources = modules | ||
-- We need the directory with library's cabal_macros.h! | ||
#if MIN_VERSION_Cabal(1,25,0) | ||
let libAutogenDir = autogenComponentModulesDir lbi libcfg | ||
#else | ||
let libAutogenDir = autogenModulesDir lbi | ||
#endif | ||
generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () | ||
generateBuildModule verbosity pkg lbi = do | ||
let dir = autogenModulesDir lbi | ||
createDirectoryIfMissingVerbose verbosity True dir | ||
withLibLBI pkg lbi $ \_ libcfg -> do | ||
withTestLBI pkg lbi $ \suite suitecfg -> do | ||
rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines | ||
[ "module Build_" ++ testName suite ++ " where" | ||
-- Lib sources and includes | ||
iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI | ||
includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI | ||
-- CPP includes, i.e. include cabal_macros.h | ||
let cppFlags = map ("-optP"++) $ | ||
[ "-include", libAutogenDir ++ "/cabal_macros.h" ] | ||
++ cppOptions libBI | ||
withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do | ||
-- get and create autogen dir | ||
#if MIN_VERSION_Cabal(1,25,0) | ||
let testAutogenDir = autogenComponentModulesDir lbi suitecfg | ||
#else | ||
let testAutogenDir = autogenModulesDir lbi | ||
#endif | ||
createDirectoryIfMissingVerbose verbosity True testAutogenDir | ||
-- write autogen'd file | ||
rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines | ||
[ "module Build_doctests where" | ||
, "" | ||
, "autogen_dir :: String" | ||
, "autogen_dir = " ++ show dir | ||
-- -package-id etc. flags | ||
, "pkgs :: [String]" | ||
, "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) | ||
, "" | ||
, "deps :: [String]" | ||
, "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) | ||
, "flags :: [String]" | ||
, "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags) | ||
, "" | ||
, "module_sources :: [String]" | ||
, "module_sources = " ++ show (map display module_sources) | ||
] | ||
where | ||
formatdeps = map (formatone . snd) | ||
formatone p = case packageName p of | ||
PackageName n -> n ++ "-" ++ showVersion (packageVersion p) | ||
-- 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 | ||
| packageId pkg == 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 | ||
testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] | ||
testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys | ||
defaultMainWithDoctests :: String -> IO () | ||
defaultMainWithDoctests testSuiteName = defaultMainWithHooks simpleUserHooks | ||
{ buildHook = \pkg lbi hooks flags -> do | ||
generateBuildModule testSuiteName flags pkg lbi | ||
buildHook simpleUserHooks pkg lbi hooks flags | ||
} | ||
#endif | ||
main :: IO () | ||
main = defaultMainWithDoctests "doctests" | ||
\end{code} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,32 +1,25 @@ | ||
----------------------------------------------------------------------------- | ||
-- | | ||
-- Module : Main (doctests) | ||
-- Copyright : (C) 2012-14 Edward Kmett | ||
-- License : BSD-style (see the file LICENSE) | ||
-- Maintainer : Edward Kmett <ekmett@gmail.com> | ||
-- Stability : provisional | ||
-- Portability : portable | ||
-- | ||
-- This module provides doctests for a project based on the actual versions | ||
-- of the packages it was built with. It requires a corresponding Setup.lhs | ||
-- to be added to the project | ||
----------------------------------------------------------------------------- | ||
module Main where | ||
|
||
import Build_doctests (autogen_dir, deps) | ||
import Control.Applicative | ||
import Control.Monad | ||
import Data.List | ||
import System.Directory | ||
import System.FilePath | ||
import Build_doctests (flags, pkgs, module_sources) | ||
import Data.Foldable (traverse_) | ||
import Test.DocTest | ||
|
||
main :: IO () | ||
main = getSources >>= \sources -> doctest $ | ||
"-isrc" | ||
: ("-i" ++ autogen_dir) | ||
: "-optP-include" | ||
: ("-optP" ++ autogen_dir ++ "/cabal_macros.h") | ||
: "-optP-I" | ||
: "-optPinclude" | ||
: "-hide-all-packages" | ||
: map ("-package="++) deps ++ sources | ||
|
||
getSources :: IO [FilePath] | ||
getSources = filter (isSuffixOf ".hs") <$> go "src" | ||
main = do | ||
traverse_ putStrLn args | ||
doctest args | ||
where | ||
go dir = do | ||
(dirs, files) <- getFilesAndDirectories dir | ||
(files ++) . concat <$> mapM go dirs | ||
|
||
getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) | ||
getFilesAndDirectories dir = do | ||
c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir | ||
(,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c | ||
args = flags ++ pkgs ++ module_sources |