Use cabal-doctest
This commit is contained in:
parent
60716b10f3
commit
9bc4de6906
4 changed files with 73 additions and 77 deletions
|
@ -1,5 +1,19 @@
|
|||
\begin{code}
|
||||
{-# 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
|
||||
|
@ -9,10 +23,10 @@
|
|||
#if MIN_VERSION_Cabal(1,24,0)
|
||||
#define InstalledPackageId UnitId
|
||||
#endif
|
||||
module Main (main) where
|
||||
|
||||
import Control.Monad ( when )
|
||||
import Data.List ( nub )
|
||||
import Data.String ( fromString )
|
||||
import Distribution.Package ( InstalledPackageId )
|
||||
import Distribution.Package ( PackageId, Package (..), packageVersion )
|
||||
import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..))
|
||||
|
@ -42,15 +56,8 @@ makeAbsolute p | isAbsolute p = return p
|
|||
return $ cwd </> p
|
||||
#endif
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMainWithHooks simpleUserHooks
|
||||
{ buildHook = \pkg lbi hooks flags -> do
|
||||
generateBuildModule flags pkg lbi
|
||||
buildHook simpleUserHooks pkg lbi hooks flags
|
||||
}
|
||||
|
||||
generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
|
||||
generateBuildModule flags pkg lbi = do
|
||||
generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
|
||||
generateBuildModule testsuiteName flags pkg lbi = do
|
||||
let verbosity = fromFlag (buildVerbosity flags)
|
||||
let distPref = fromFlag (buildDistPref flags)
|
||||
|
||||
|
@ -74,7 +81,7 @@ generateBuildModule flags pkg lbi = do
|
|||
#endif
|
||||
|
||||
-- Lib sources and includes
|
||||
iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ "test" : libAutogenDir : hsSourceDirs libBI
|
||||
iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI
|
||||
includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI
|
||||
|
||||
-- CPP includes, i.e. include cabal_macros.h
|
||||
|
@ -82,9 +89,7 @@ generateBuildModule flags pkg lbi = do
|
|||
[ "-include", libAutogenDir ++ "/cabal_macros.h" ]
|
||||
++ cppOptions libBI
|
||||
|
||||
-- Actually we need to check whether testName suite == "doctests"
|
||||
-- pending https://github.com/haskell/cabal/pull/4229 getting into GHC HEAD tree
|
||||
withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == "doctests") $ do
|
||||
withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do
|
||||
|
||||
-- get and create autogen dir
|
||||
#if MIN_VERSION_Cabal(1,25,0)
|
||||
|
@ -106,7 +111,7 @@ generateBuildModule flags pkg lbi = do
|
|||
, "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)
|
||||
, ""
|
||||
, "module_sources :: [String]"
|
||||
, "module_sources = " ++ show ("Servant.Utils.LinksSpec" : map display module_sources)
|
||||
, "module_sources = " ++ show (map display module_sources)
|
||||
]
|
||||
where
|
||||
-- we do this check in Setup, as then doctests don't need to depend on Cabal
|
||||
|
@ -162,4 +167,16 @@ generateBuildModule flags pkg lbi = do
|
|||
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}
|
||||
|
|
|
@ -27,7 +27,7 @@ source-repository head
|
|||
|
||||
custom-setup
|
||||
setup-depends:
|
||||
Cabal >=1.14, base, filepath, directory
|
||||
Cabal >=1.14, base, cabal-doctest
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
|
@ -134,7 +134,7 @@ test-suite spec
|
|||
test-suite doctests
|
||||
build-depends: base
|
||||
, servant
|
||||
, doctest
|
||||
, doctest >=0.11.1 && <0.12
|
||||
, filemanip
|
||||
, directory
|
||||
, filepath
|
||||
|
@ -144,5 +144,4 @@ test-suite doctests
|
|||
buildable: True
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -threaded
|
||||
build-tools: hsc2hs
|
||||
include-dirs: include
|
||||
|
|
39
servant/test/doctests.hs
Normal file
39
servant/test/doctests.hs
Normal file
|
@ -0,0 +1,39 @@
|
|||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- 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 (flags, pkgs, module_sources)
|
||||
import Data.Foldable (traverse_)
|
||||
import Data.List (isPrefixOf, isSuffixOf)
|
||||
import Test.DocTest
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
traverse_ putStrLn args
|
||||
doctest args
|
||||
where
|
||||
args =
|
||||
"-XOverloadedStrings" :
|
||||
"-XFlexibleInstances" :
|
||||
"-XMultiParamTypeClasses" :
|
||||
flags ++ flags' ++ pkgs ++
|
||||
"Servant.Utils.LinksSpec" :
|
||||
module_sources
|
||||
|
||||
-- HACK: find -i.../src, and change it ot -i.../test
|
||||
flags'
|
||||
= map (\x -> take (length x - 4) x ++ "/test")
|
||||
. filter (\x -> "-i" `isPrefixOf` x && "/src" `isSuffixOf` x)
|
||||
$ flags
|
||||
|
|
@ -1,59 +0,0 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- 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 (flags, pkgs, module_sources)
|
||||
import Data.Foldable (traverse_)
|
||||
import Test.DocTest
|
||||
|
||||
##if defined(mingw32_HOST_OS)
|
||||
##if defined(i386_HOST_ARCH)
|
||||
##define USE_CP
|
||||
import Control.Applicative
|
||||
import Control.Exception
|
||||
import Foreign.C.Types
|
||||
foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
|
||||
foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
|
||||
##elif defined(x86_64_HOST_ARCH)
|
||||
##define USE_CP
|
||||
import Control.Applicative
|
||||
import Control.Exception
|
||||
import Foreign.C.Types
|
||||
foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
|
||||
foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
|
||||
##endif
|
||||
##endif
|
||||
|
||||
-- | Run in a modified codepage where we can print UTF-8 values on Windows.
|
||||
withUnicode :: IO a -> IO a
|
||||
##ifdef USE_CP
|
||||
withUnicode m = do
|
||||
cp <- c_GetConsoleCP
|
||||
(c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp
|
||||
##else
|
||||
withUnicode m = m
|
||||
##endif
|
||||
|
||||
main :: IO ()
|
||||
main = withUnicode $ do
|
||||
traverse_ putStrLn args
|
||||
doctest args
|
||||
where
|
||||
args =
|
||||
"-XOverloadedStrings" :
|
||||
"-XFlexibleInstances" :
|
||||
"-XMultiParamTypeClasses" :
|
||||
flags ++ pkgs ++ module_sources
|
Loading…
Reference in a new issue