From 9bc4de69068678b3f13aabeb2e9f90e8ba14a62c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 12 Feb 2017 22:12:03 +0200 Subject: [PATCH] Use cabal-doctest --- servant/Setup.lhs | 47 +++++++++++++++++++++---------- servant/servant.cabal | 5 ++-- servant/test/doctests.hs | 39 ++++++++++++++++++++++++++ servant/test/doctests.hsc | 59 --------------------------------------- 4 files changed, 73 insertions(+), 77 deletions(-) create mode 100644 servant/test/doctests.hs delete mode 100644 servant/test/doctests.hsc diff --git a/servant/Setup.lhs b/servant/Setup.lhs index 0e04e46c..5555bb34 100644 --- a/servant/Setup.lhs +++ b/servant/Setup.lhs @@ -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} diff --git a/servant/servant.cabal b/servant/servant.cabal index ec4de2a3..855d34f0 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -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 diff --git a/servant/test/doctests.hs b/servant/test/doctests.hs new file mode 100644 index 00000000..3f516363 --- /dev/null +++ b/servant/test/doctests.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Main (doctests) +-- Copyright : (C) 2012-14 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- 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 + diff --git a/servant/test/doctests.hsc b/servant/test/doctests.hsc deleted file mode 100644 index 4956d631..00000000 --- a/servant/test/doctests.hsc +++ /dev/null @@ -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 --- 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