Merge pull request #664 from phadej/new-build
Make servant buildable with cabal new-build
This commit is contained in:
commit
094f28b42d
13 changed files with 472 additions and 89 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -1,4 +1,5 @@
|
||||||
**/*/dist
|
**/*/dist
|
||||||
|
dist-newstyle
|
||||||
/bin
|
/bin
|
||||||
/lib
|
/lib
|
||||||
/share
|
/share
|
||||||
|
|
7
cabal.project
Normal file
7
cabal.project
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
packages:
|
||||||
|
servant/
|
||||||
|
servant-client/
|
||||||
|
servant-docs/
|
||||||
|
servant-foreign/
|
||||||
|
servant-server/
|
||||||
|
doc/tutorial/
|
|
@ -47,6 +47,7 @@ library
|
||||||
, http-client
|
, http-client
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -pgmL markdown-unlit
|
ghc-options: -Wall -pgmL markdown-unlit
|
||||||
|
build-tool-depends: markdown-unlit:markdown-unlit
|
||||||
|
|
||||||
test-suite spec
|
test-suite spec
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
|
|
@ -1,2 +0,0 @@
|
||||||
import Distribution.Simple
|
|
||||||
main = defaultMain
|
|
165
servant-server/Setup.lhs
Normal file
165
servant-server/Setup.lhs
Normal file
|
@ -0,0 +1,165 @@
|
||||||
|
\begin{code}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
#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
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Control.Monad ( when )
|
||||||
|
import Data.List ( nub )
|
||||||
|
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(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 ( (</>) )
|
||||||
|
|
||||||
|
#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
|
||||||
|
|
||||||
|
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
|
||||||
|
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
|
||||||
|
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
-- 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"
|
||||||
|
, ""
|
||||||
|
-- -package-id etc. flags
|
||||||
|
, "pkgs :: [String]"
|
||||||
|
, "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)
|
||||||
|
, ""
|
||||||
|
, "flags :: [String]"
|
||||||
|
, "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)
|
||||||
|
, ""
|
||||||
|
, "module_sources :: [String]"
|
||||||
|
, "module_sources = " ++ show (map display module_sources)
|
||||||
|
]
|
||||||
|
where
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
\end{code}
|
|
@ -19,7 +19,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
|
copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
|
||||||
category: Web
|
category: Web
|
||||||
build-type: Simple
|
build-type: Custom
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC >= 7.8
|
tested-with: GHC >= 7.8
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
|
@ -31,6 +31,9 @@ source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: http://github.com/haskell-servant/servant.git
|
location: http://github.com/haskell-servant/servant.git
|
||||||
|
|
||||||
|
custom-setup
|
||||||
|
setup-depends:
|
||||||
|
Cabal >=1.14, base, filepath, directory
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
|
@ -144,7 +147,7 @@ test-suite doctests
|
||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: test/Doctests.hs
|
main-is: test/doctests.hs
|
||||||
buildable: True
|
buildable: True
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -threaded
|
ghc-options: -Wall -threaded
|
||||||
|
|
|
@ -1,41 +0,0 @@
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Data.List (isPrefixOf)
|
|
||||||
import System.Directory
|
|
||||||
import System.FilePath
|
|
||||||
import System.FilePath.Find
|
|
||||||
import Test.DocTest
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
files <- find always (extension ==? ".hs") "src"
|
|
||||||
mCabalMacrosFile <- getCabalMacrosFile
|
|
||||||
doctest $ "-isrc" : "-Iinclude" :
|
|
||||||
(maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
|
|
||||||
"-XOverloadedStrings" :
|
|
||||||
"-XFlexibleInstances" :
|
|
||||||
"-XMultiParamTypeClasses" :
|
|
||||||
"-XDataKinds" :
|
|
||||||
"-XTypeOperators" :
|
|
||||||
files
|
|
||||||
|
|
||||||
getCabalMacrosFile :: IO (Maybe FilePath)
|
|
||||||
getCabalMacrosFile = do
|
|
||||||
exists <- doesDirectoryExist "dist"
|
|
||||||
if exists
|
|
||||||
then do
|
|
||||||
contents <- getDirectoryContents "dist"
|
|
||||||
let rest = "build" </> "autogen" </> "cabal_macros.h"
|
|
||||||
whenExists $ case filter ("dist-sandbox-" `isPrefixOf`) contents of
|
|
||||||
[x] -> "dist" </> x </> rest
|
|
||||||
[] -> "dist" </> rest
|
|
||||||
xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n"
|
|
||||||
++ show xs ++ "\nTry cabal clean"
|
|
||||||
else return Nothing
|
|
||||||
where
|
|
||||||
whenExists :: FilePath -> IO (Maybe FilePath)
|
|
||||||
whenExists file = do
|
|
||||||
exists <- doesFileExist file
|
|
||||||
return $ if exists
|
|
||||||
then Just file
|
|
||||||
else Nothing
|
|
61
servant-server/test/doctests.hsc
Normal file
61
servant-server/test/doctests.hsc
Normal file
|
@ -0,0 +1,61 @@
|
||||||
|
{-# 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" :
|
||||||
|
"-XDataKinds" :
|
||||||
|
"-XTypeOperators" :
|
||||||
|
flags ++ pkgs ++ module_sources
|
|
@ -1,2 +0,0 @@
|
||||||
import Distribution.Simple
|
|
||||||
main = defaultMain
|
|
165
servant/Setup.lhs
Normal file
165
servant/Setup.lhs
Normal file
|
@ -0,0 +1,165 @@
|
||||||
|
\begin{code}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
#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
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Control.Monad ( when )
|
||||||
|
import Data.List ( nub )
|
||||||
|
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(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 ( (</>) )
|
||||||
|
|
||||||
|
#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
|
||||||
|
|
||||||
|
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
|
||||||
|
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
|
||||||
|
|
||||||
|
-- Lib sources and includes
|
||||||
|
iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ "test" : 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
|
||||||
|
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
-- 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"
|
||||||
|
, ""
|
||||||
|
-- -package-id etc. flags
|
||||||
|
, "pkgs :: [String]"
|
||||||
|
, "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)
|
||||||
|
, ""
|
||||||
|
, "flags :: [String]"
|
||||||
|
, "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)
|
||||||
|
, ""
|
||||||
|
, "module_sources :: [String]"
|
||||||
|
, "module_sources = " ++ show ("Servant.Utils.LinksSpec" : map display module_sources)
|
||||||
|
]
|
||||||
|
where
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
\end{code}
|
|
@ -15,7 +15,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
|
copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
|
||||||
category: Web
|
category: Web
|
||||||
build-type: Simple
|
build-type: Custom
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC >= 7.8
|
tested-with: GHC >= 7.8
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
|
@ -25,6 +25,10 @@ source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: http://github.com/haskell-servant/servant.git
|
location: http://github.com/haskell-servant/servant.git
|
||||||
|
|
||||||
|
custom-setup
|
||||||
|
setup-depends:
|
||||||
|
Cabal >=1.14, base, filepath, directory
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.API
|
Servant.API
|
||||||
|
@ -133,9 +137,11 @@ test-suite doctests
|
||||||
, filemanip
|
, filemanip
|
||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
|
, hspec
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: test/Doctests.hs
|
main-is: test/doctests.hs
|
||||||
buildable: True
|
buildable: True
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -threaded
|
ghc-options: -Wall -threaded
|
||||||
|
build-tools: hsc2hs
|
||||||
include-dirs: include
|
include-dirs: include
|
||||||
|
|
|
@ -1,40 +0,0 @@
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Data.List (isPrefixOf)
|
|
||||||
import System.Directory
|
|
||||||
import System.FilePath
|
|
||||||
import System.FilePath.Find
|
|
||||||
import Test.DocTest
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
files <- find always (extension ==? ".hs") "src"
|
|
||||||
tfiles <- find always (extension ==? ".hs") "test/Servant"
|
|
||||||
mCabalMacrosFile <- getCabalMacrosFile
|
|
||||||
doctest $ "-isrc" : "-Iinclude" :
|
|
||||||
(maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
|
|
||||||
"-XOverloadedStrings" :
|
|
||||||
"-XFlexibleInstances" :
|
|
||||||
"-XMultiParamTypeClasses" :
|
|
||||||
(files ++ tfiles)
|
|
||||||
|
|
||||||
getCabalMacrosFile :: IO (Maybe FilePath)
|
|
||||||
getCabalMacrosFile = do
|
|
||||||
exists <- doesDirectoryExist "dist"
|
|
||||||
if exists
|
|
||||||
then do
|
|
||||||
contents <- getDirectoryContents "dist"
|
|
||||||
let rest = "build" </> "autogen" </> "cabal_macros.h"
|
|
||||||
whenExists $ case filter ("dist-sandbox-" `isPrefixOf`) contents of
|
|
||||||
[x] -> "dist" </> x </> rest
|
|
||||||
[] -> "dist" </> rest
|
|
||||||
xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n"
|
|
||||||
++ show xs ++ "\nTry cabal clean"
|
|
||||||
else return Nothing
|
|
||||||
where
|
|
||||||
whenExists :: FilePath -> IO (Maybe FilePath)
|
|
||||||
whenExists file = do
|
|
||||||
exists <- doesFileExist file
|
|
||||||
return $ if exists
|
|
||||||
then Just file
|
|
||||||
else Nothing
|
|
59
servant/test/doctests.hsc
Normal file
59
servant/test/doctests.hsc
Normal file
|
@ -0,0 +1,59 @@
|
||||||
|
{-# 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