Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use cabal-doctest #27

Merged
merged 9 commits into from
Jan 31, 2017
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
dist
dist-newstyle
docs
wiki
TAGS
Expand Down
13 changes: 7 additions & 6 deletions .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ matrix:
compiler: ": #GHC 8.0.2"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}

- env: CABALVER=1.24 GHCVER=head BUILD=cabal
- env: CABALVER=1.24 GHCVER=head BUILD=cabal CABALFLAGS=--allow-newer
compiler: ": #GHC head"
addons: {apt: {packages: [cabal-install-1.24,ghc-head,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}

Expand All @@ -61,7 +61,7 @@ matrix:
allow_failures:
- env: CABALVER=1.18 GHCVER=7.0.4 BUILD=cabal
- env: CABALVER=1.18 GHCVER=7.2.2 BUILD=cabal
- env: CABALVER=1.24 GHCVER=head BUILD=cabal
- env: CABALVER=1.24 GHCVER=head BUILD=cabal CABALFLAGS=--allow-newer

before_install:
- unset CC
Expand Down Expand Up @@ -91,7 +91,7 @@ install:
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
fi;
travis_retry cabal update;
cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt;
cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v $CABALFLAGS> installplan.txt;
sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt;
if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then
echo "cabal build-cache HIT";
Expand All @@ -102,7 +102,7 @@ install:
echo "cabal build-cache MISS";
rm -rf $HOME/.cabsnap;
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
cabal install --only-dependencies --enable-tests --enable-benchmarks;
cabal install --only-dependencies --enable-tests --enable-benchmarks $CABALFLAGS;
if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi;
fi;
if [ ! -d $HOME/.cabsnap ]; then
Expand All @@ -122,12 +122,13 @@ script:
stack)
scripts/travis_long stack --no-terminal $STACK_OPTIONS build -j2;;
cabal)
cabal configure --enable-tests -v2;
cabal configure --enable-tests -v2 $CABALFLAGS;
cabal build;
cabal test --show-details=always;
cabal bench || true;
cabal sdist || true;
SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ");;
SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz;
if [ -f $SRC_TGZ ]; then (cd dist && cabal install --force-reinstalls "$SRC_TGZ"); fi;
esac

notifications:
Expand Down
192 changes: 163 additions & 29 deletions Setup.lhs
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}
9 changes: 6 additions & 3 deletions distributive.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,11 @@ source-repository head
type: git
location: git://github.com/ekmett/distributive.git

custom-setup
setup-depends:
base >= 4 && <5,
cabal-doctest >= 1 && <1.1

flag semigroups
manual: True
default: True
Expand Down Expand Up @@ -77,9 +82,7 @@ test-suite doctests
main-is: doctests.hs
build-depends:
base >= 4,
directory >= 1.0,
doctest >= 0.9.1,
filepath >= 1.2
doctest >= 0.11.1 && <0.12
ghc-options: -Wall -threaded
hs-source-dirs: tests

Expand Down
47 changes: 19 additions & 28 deletions tests/doctests.hs
Original file line number Diff line number Diff line change
@@ -1,34 +1,25 @@
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- 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)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
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"
: "-isrc-compat"
: ("-i" ++ autogen_dir)
: "-optP-include"
: ("-optP" ++ autogen_dir ++ "/cabal_macros.h")
: "-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