git.iko.soy/typeable/http-api-data
on master help sign in
Try to fix doctests
commit89b599cacbcfaaef42f800f56692e6bf7ad90258 authorOleg Grenrus <oleg.grenrus@iki.fi> dateThu 12 Jan 2017, 17:38 (10 years ago) parent08d1b70
4 files changed+188−46
compare with master
unifiedsplit
Setup.lhs+60−15 http-api-data.cabal+8 test/DocTest.hs−31 test/DocTest.hsc+120
Setup.lhs+60−15
@@ -1,20 +1,28 @@
1−#!/usr/bin/runhaskell
21\begin{code}
3−{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE CPP #-}
3+#ifndef MIN_VERSION_Cabal
4+#define MIN_VERSION_Cabal(x,y,z) 0
5+#endif
46module Main (main) where
57
68import Data.List ( nub )
7−import Data.Version ( showVersion )
8−import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )
9+import Distribution.Package ( InstalledPackageId )
10+import Distribution.Package ( PackageId, Package (..), packageVersion, packageName )
911import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
1012import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
11−import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )
13+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )
1214import Distribution.Simple.BuildPaths ( autogenModulesDir )
13−import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )
14−import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
15−import Distribution.Verbosity ( Verbosity )
15+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))
16+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler, buildDir )
17+import Distribution.Simple.Compiler ( showCompilerId )
18+import Distribution.Text ( display , simpleParse )
19+import Distribution.Verbosity ( Verbosity, normal )
1620import System.FilePath ( (</>) )
1721
22+#if MIN_VERSION_Cabal(1,25,0)
23+import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )
24+#endif
25+
1826main :: IO ()
1927main = defaultMainWithHooks simpleUserHooks
2028 { buildHook = \pkg lbi hooks flags -> do
@@ -22,25 +30,62 @@ main = defaultMainWithHooks simpleUserHooks
2230 buildHook simpleUserHooks pkg lbi hooks flags
2331 }
2432
33+haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath
34+haddockOutputDir flags pkg = destDir where
35+ baseDir = case haddockDistPref flags of
36+ NoFlag -> "."
37+ Flag x -> x
38+ destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)
39+
2540generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
2641generateBuildModule verbosity pkg lbi = do
2742 let dir = autogenModulesDir lbi
43+ let bdir = buildDir lbi
2844 createDirectoryIfMissingVerbose verbosity True dir
2945 withLibLBI pkg lbi $ \_ libcfg -> do
46+ -- We need the directory with library's cabal_macros.h!
47+#if MIN_VERSION_Cabal(1,25,0)
48+ let dir2 = autogenComponentModulesDir lbi libcfg
49+#else
50+ let dir2 = dir
51+#endif
3052 withTestLBI pkg lbi $ \suite suitecfg -> do
31− rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines
32− [ "module Build_" ++ testName suite ++ " where"
53+ -- when (testName suite == "doctest") $ we need IsString instance
54+ rewriteFile (dir </> "Build_doctests.hs") $ unlines
55+ [ "module Build_doctests where"
3356 , ""
3457 , "autogen_dir :: String"
3558 , "autogen_dir = " ++ show dir
3659 , ""
37− , "deps :: [String]"
38− , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))
60+ , "component_autogen_dir :: String"
61+ , "component_autogen_dir = " ++ show dir2
62+ , ""
63+ , "build_dir :: String"
64+ , "build_dir = " ++ show bdir
65+ , ""
66+ -- -package-id etc. flags
67+ , "pkgs :: [String]"
68+ , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)
69+ , ""
70+ , "compiler :: String"
71+ , "compiler = " ++ (show $ showCompilerId $ compiler lbi)
72+ , ""
73+ , "isOldCompiler :: Bool"
74+ , "isOldCompiler = " ++ show isOldCompiler
3975 ]
4076 where
41− formatdeps = map (formatone . snd)
42− formatone p = case packageName p of
43− PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
77+ -- we do this check in Setup, as then doctests don't need to depend on Cabal
78+ isOldCompiler = maybe False id $ do
79+ a <- simpleParse $ showCompilerId $ compiler lbi
80+ b <- simpleParse "7.5"
81+ return $ packageVersion (a :: PackageId) < b
82+
83+ formatDeps = map formatOne
84+ formatOne (installedPkgId, pkgId)
85+ -- The problem is how different cabal executables handle package databases
86+ -- when doctests depend on the library
87+ | packageId pkg == pkgId = "-package=" ++ display pkgId
88+ | otherwise = "-package-id=" ++ display installedPkgId
4489
4590testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
4691testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
http-api-data.cabal+8
@@ -22,6 +22,13 @@ tested-with:
2222 GHC==8.0.2,
2323 GHC==8.1.*
2424
25+custom-setup
26+ setup-depends:
27+ base >= 4.7 && <4.10,
28+ Cabal >= 1.18 && <1.26,
29+ filepath,
30+ directory
31+
2532flag use-text-show
2633 description: Use text-show library for efficient ToHttpApiData implementations.
2734 default: False
@@ -76,6 +83,7 @@ test-suite spec
7683
7784test-suite doctest
7885 ghc-options: -Wall
86+ build-tools: hsc2hs
7987 build-depends:
8088 base,
8189 directory >= 1.0,
test/DocTest.hsdeleted−31
@@ -1,31 +0,0 @@
1−module Main where
2−
3−import Build_doctest (autogen_dir, deps)
4−import Control.Applicative
5−import Control.Monad
6−import Data.List
7−import System.Directory
8−import System.FilePath
9−import Test.DocTest
10−
11−main :: IO ()
12−main = getSources >>= \sources -> doctest $
13− "-isrc"
14− : "-Iinclude"
15− : ("-i" ++ autogen_dir)
16− : "-optP-include"
17− : ("-optP" ++ autogen_dir ++ "/cabal_macros.h")
18− : "-hide-all-packages"
19− : map ("-package="++) deps ++ sources
20−
21−getSources :: IO [FilePath]
22−getSources = filter (isSuffixOf ".hs") <$> go "src"
23− where
24− go dir = do
25− (dirs, files) <- getFilesAndDirectories dir
26− (files ++) . concat <$> mapM go dirs
27−
28−getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
29−getFilesAndDirectories dir = do
30− c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
31− (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
test/DocTest.hscnew file+120
@@ -0,0 +1,120 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ForeignFunctionInterface #-}
3+-----------------------------------------------------------------------------
4+-- |
5+-- Module : Main (doctests)
6+-- Copyright : (C) 2012-14 Edward Kmett
7+-- License : BSD-style (see the file LICENSE)
8+-- Maintainer : Edward Kmett <ekmett@gmail.com>
9+-- Stability : provisional
10+-- Portability : portable
11+--
12+-- This module provides doctests for a project based on the actual versions
13+-- of the packages it was built with. It requires a corresponding Setup.lhs
14+-- to be added to the project
15+-----------------------------------------------------------------------------
16+module Main where
17+
18+import Build_doctests (component_autogen_dir, build_dir, pkgs, compiler, isOldCompiler)
19+#if __GLASGOW_HASKELL__ < 710
20+import Control.Applicative
21+#endif
22+import Control.Monad
23+import Data.List
24+import System.Directory
25+import System.FilePath
26+import Test.DocTest
27+
28+##if defined(mingw32_HOST_OS)
29+##if defined(i386_HOST_ARCH)
30+##define USE_CP
31+import Control.Applicative
32+import Control.Exception
33+import Foreign.C.Types
34+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
35+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
36+##elif defined(x86_64_HOST_ARCH)
37+##define USE_CP
38+import Control.Applicative
39+import Control.Exception
40+import Foreign.C.Types
41+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
42+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
43+##endif
44+##endif
45+
46+-- | Run in a modified codepage where we can print UTF-8 values on Windows.
47+withUnicode :: IO a -> IO a
48+##ifdef USE_CP
49+withUnicode m = do
50+ cp <- c_GetConsoleCP
51+ (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp
52+##else
53+withUnicode m = m
54+##endif
55+
56+main :: IO ()
57+main = withUnicode $ getSources >>= \sources -> do
58+ -- Let us find potential databases, cabal new-build
59+ home <- getHomeDirectory
60+ cwd <- getCurrentDirectory
61+ -- new-build
62+ let storedb = home </> ".cabal" </> "store" </> compiler </> "package.db"
63+ let localdb = cwd </> "dist-newstyle" </> "packagedb" </> compiler
64+ let inplacedb = build_dir </> "package.conf.inplace"
65+ -- "old" build, inc sandboxes
66+ let inplacedb2 = cwd </> "dist" </> "package.conf.inplace"
67+ -- filter out non-existing directories
68+ dbs <- filterM doesPE [storedb,localdb,inplacedb]
69+ dbs2 <- filterM doesPE [inplacedb2]
70+ {-
71+ -- Might be helpful in future:
72+ print [storedb,localdb,inplacedb]
73+ print dbs
74+ print [inplacedb2]
75+ print dbs2
76+ print [home,cwd,build_dir]
77+ print (args sources dbs dbs2)
78+ -}
79+ -- Run doctests
80+ doctest (args sources dbs dbs2)
81+ where
82+ -- doesPathExist is since directory-1.2.7.0
83+ doesPE p = do
84+ a <- doesDirectoryExist p
85+ b <- doesFileExist p
86+ return (a || b)
87+
88+ -- Distribution.Simple.Program.GHC is only Cabal >=1.16
89+ (noUserPkgDbFlag,pkgDbFlag)
90+ | isOldCompiler = ("-no-user-package-conf", "-package-conf=")
91+ | otherwise = ("-no-user-package-db", "-package-db=")
92+
93+ args sources dbs dbs2
94+ = "-isrc"
95+ : "-Iinclude"
96+ -- if there are not cabal new-build databases, we should use user db
97+ : (if null dbs then [] else [ noUserPkgDbFlag ])
98+ ++ map (pkgDbFlag++) dbs
99+ ++ map (pkgDbFlag++) dbs2
100+ ++ ("-i" ++ component_autogen_dir)
101+ : "-optP-include"
102+ : ("-optP" ++ component_autogen_dir ++ "/cabal_macros.h")
103+ : "-hide-all-packages"
104+#ifdef TRUSTWORTHY
105+ : "-DTRUSTWORTHY=1"
106+#endif
107+ : pkgs
108+ ++ sources
109+
110+getSources :: IO [FilePath]
111+getSources = filter (isSuffixOf ".hs") <$> go "src"
112+ where
113+ go dir = do
114+ (dirs, files) <- getFilesAndDirectories dir
115+ (files ++) . concat <$> mapM go dirs
116+
117+getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
118+getFilesAndDirectories dir = do
119+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
120+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c