git.iko.soy/typeable/http-api-data
on master help sign in
Move flag generation to Setup.lhs
bfb81b2Oleg Grenrus
Setup.lhs+83−27
@@ -3,18 +3,21 @@
3#ifndef MIN_VERSION_Cabal
3#ifndef MIN_VERSION_Cabal
4#define MIN_VERSION_Cabal(x,y,z) 0
4#define MIN_VERSION_Cabal(x,y,z) 0
5#endif
5#endif
6+#if MIN_VERSION_Cabal(1,24,0)
7+#define InstalledPackageId UnitId
8+#endif
6module Main (main) where
9module Main (main) where
7
10
8import Data.List ( nub )
11import Data.List ( nub )
9import Distribution.Package ( InstalledPackageId )
12import Distribution.Package ( InstalledPackageId )
10import Distribution.Package ( PackageId, Package (..), packageVersion, packageName )
13import Distribution.Package ( PackageId, Package (..), packageVersion, packageName )
11−import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
14+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..))
12import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
15import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
13import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )
16import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )
14import Distribution.Simple.BuildPaths ( autogenModulesDir )
17import Distribution.Simple.BuildPaths ( autogenModulesDir )
15−import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))
18+import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))
16−import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler, buildDir )
19+import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler, buildDir )
17−import Distribution.Simple.Compiler ( showCompilerId )
20+import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))
18import Distribution.Text ( display , simpleParse )
21import Distribution.Text ( display , simpleParse )
19import Distribution.Verbosity ( Verbosity, normal )
22import Distribution.Verbosity ( Verbosity, normal )
20import System.FilePath ( (</>) )
23import System.FilePath ( (</>) )
@@ -26,7 +29,7 @@ import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )
26main :: IO ()
29main :: IO ()
27main = defaultMainWithHooks simpleUserHooks
30main = defaultMainWithHooks simpleUserHooks
28 { buildHook = \pkg lbi hooks flags -> do
31 { buildHook = \pkg lbi hooks flags -> do
29− generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
32+ generateBuildModule flags pkg lbi
30 buildHook simpleUserHooks pkg lbi hooks flags
33 buildHook simpleUserHooks pkg lbi hooks flags
31 }
34 }
32
35
@@ -37,41 +40,57 @@ haddockOutputDir flags pkg = destDir where
37 Flag x -> x
40 Flag x -> x
38 destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)
41 destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)
39
42
40−generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
43+generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
41−generateBuildModule verbosity pkg lbi = do
44+generateBuildModule flags pkg lbi = do
42− let dir = autogenModulesDir lbi
45+ let verbosity = fromFlag (buildVerbosity flags)
46+ let distPref = fromFlag (buildDistPref flags)
47+
48+ -- Package DBs
49+ let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]
50+ let dbFlags = "-hide-all-packages" : packageDbArgs dbStack
51+
43 let bdir = buildDir lbi
52 let bdir = buildDir lbi
44− createDirectoryIfMissingVerbose verbosity True dir
45− withLibLBI pkg lbi $ \_ libcfg -> do
53+ withLibLBI pkg lbi $ \lib libcfg -> do
54+ let libBI = libBuildInfo lib
55+
56+ -- Lib sources and includes
57+ let iArgs = map ("-i"++) $ hsSourceDirs libBI
58+ let includeArgs = map ("-I"++) $ includeDirs libBI
59+
46 -- We need the directory with library's cabal_macros.h!
60 -- We need the directory with library's cabal_macros.h!
47#if MIN_VERSION_Cabal(1,25,0)
61#if MIN_VERSION_Cabal(1,25,0)
48− let dir2 = autogenComponentModulesDir lbi libcfg
62+ let libAutogenDir = autogenComponentModulesDir lbi libcfg
49#else
63#else
50− let dir2 = dir
64+ let libAutogenDir = autogenModulesDir lbi
51#endif
65#endif
66+
67+ -- CPP includes, i.e. include cabal_macros.h
68+ let cppFlags = [ "-optP-include", "-optP" ++ libAutogenDir ++ "/cabal_macros.h" ]
69+
52 withTestLBI pkg lbi $ \suite suitecfg -> do
70 withTestLBI pkg lbi $ \suite suitecfg -> do
53− -- when (testName suite == "doctest") $ we need IsString instance
71+ -- when (testName suite == "doctests") $ we need IsString instance
72+
73+ -- get and create autogen dir
74+#if MIN_VERSION_Cabal(1,25,0)
75+ let testAutogenDir = autogenComponentModulesDir lbi suitecfg
76+#else
77+ let testAutogenDir = autogenModulesDir lbi
78+#endif
79+ createDirectoryIfMissingVerbose verbosity True testAutogenDir
80+
81+ -- write autogen'd file
54− rewriteFile (dir </> "Build_doctests.hs") $ unlines
82+ rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines
55 [ "module Build_doctests where"
83 [ "module Build_doctests where"
56 , ""
84 , ""
57− , "autogen_dir :: String"
58− , "autogen_dir = " ++ show dir
59− , ""
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
85 -- -package-id etc. flags
67 , "pkgs :: [String]"
86 , "pkgs :: [String]"
68 , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)
87 , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)
69 , ""
88 , ""
70− , "compiler :: String"
89+ , "flags :: [String]"
71− , "compiler = " ++ (show $ showCompilerId $ compiler lbi)
90+ , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)
72 , ""
91 , ""
73− , "isOldCompiler :: Bool"
92+ , "src_dirs :: [String]"
74− , "isOldCompiler = " ++ show isOldCompiler
93+ , "src_dirs = " ++ show (hsSourceDirs libBI)
75 ]
94 ]
76 where
95 where
77 -- we do this check in Setup, as then doctests don't need to depend on Cabal
96 -- we do this check in Setup, as then doctests don't need to depend on Cabal
@@ -87,6 +106,43 @@ generateBuildModule verbosity pkg lbi = do
87 | packageId pkg == pkgId = "-package=" ++ display pkgId
106 | packageId pkg == pkgId = "-package=" ++ display pkgId
88 | otherwise = "-package-id=" ++ display installedPkgId
107 | otherwise = "-package-id=" ++ display installedPkgId
89
108
109+ -- From Distribution.Simple.Program.GHC
110+ packageDbArgs :: [PackageDB] -> [String]
111+ packageDbArgs | isOldCompiler = packageDbArgsConf
112+ | otherwise = packageDbArgsDb
113+
114+ -- GHC <7.6 uses '-package-conf' instead of '-package-db'.
115+ packageDbArgsConf :: [PackageDB] -> [String]
116+ packageDbArgsConf dbstack = case dbstack of
117+ (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
118+ (GlobalPackageDB:dbs) -> ("-no-user-package-conf")
119+ : concatMap specific dbs
120+ _ -> ierror
121+ where
122+ specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]
123+ specific _ = ierror
124+ ierror = error $ "internal error: unexpected package db stack: "
125+ ++ show dbstack
126+
127+ -- GHC >= 7.6 uses the '-package-db' flag. See
128+ -- https://ghc.haskell.org/trac/ghc/ticket/5977.
129+ packageDbArgsDb :: [PackageDB] -> [String]
130+ -- special cases to make arguments prettier in common scenarios
131+ packageDbArgsDb dbstack = case dbstack of
132+ (GlobalPackageDB:UserPackageDB:dbs)
133+ | all isSpecific dbs -> concatMap single dbs
134+ (GlobalPackageDB:dbs)
135+ | all isSpecific dbs -> "-no-user-package-db"
136+ : concatMap single dbs
137+ dbs -> "-clear-package-db"
138+ : concatMap single dbs
139+ where
140+ single (SpecificPackageDB db) = [ "-package-db=" ++ db ]
141+ single GlobalPackageDB = [ "-global-package-db" ]
142+ single UserPackageDB = [ "-user-package-db" ]
143+ isSpecific (SpecificPackageDB _) = True
144+ isSpecific _ = False
145+
90testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
146testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
91testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
147testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
92
148
http-api-data.cabal+1−1
@@ -81,7 +81,7 @@ test-suite spec
81 , bytestring
81 , bytestring
82 , uuid
82 , uuid
83
83
84−test-suite doctest
84+test-suite doctests
85 ghc-options: -Wall
85 ghc-options: -Wall
86 build-tools: hsc2hs
86 build-tools: hsc2hs
87 build-depends:
87 build-depends:
stack.yaml+2−3
@@ -1,4 +1,4 @@
1−resolver: nightly-2016-07-19
1+resolver: nightly-2016-12-31
2
2
3packages:
3packages:
4- '.'
4- '.'
@@ -7,6 +7,5 @@ flags:
7 http-api-data:
7 http-api-data:
8 use-text-show: false
8 use-text-show: false
9
9
10−extra-deps:
10+extra-deps: []
11−- QuickCheck-2.9.2
12extra-package-dbs: []
11extra-package-dbs: []
test/DocTest.hsc+7−50
@@ -15,7 +15,7 @@
15-----------------------------------------------------------------------------
15-----------------------------------------------------------------------------
16module Main where
16module Main where
17
17
18−import Build_doctests (component_autogen_dir, build_dir, pkgs, compiler, isOldCompiler)
18+import Build_doctests (flags, pkgs, src_dirs)
19#if __GLASGOW_HASKELL__ < 710
19#if __GLASGOW_HASKELL__ < 710
20import Control.Applicative
20import Control.Applicative
21#endif
21#endif
@@ -55,60 +55,17 @@ withUnicode m = m
55
55
56main :: IO ()
56main :: IO ()
57main = withUnicode $ getSources >>= \sources -> do
57main = 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)
58+ mapM_ putStrLn (args sources)
78− -}
79− -- Run doctests
80− doctest (args sources dbs dbs2)
59+ doctest (args sources)
81 where
60 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
61+ args sources =
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
62#ifdef TRUSTWORTHY
105− : "-DTRUSTWORTHY=1"
63+ "-DTRUSTWORTHY=1" :
106#endif
64#endif
107− : pkgs
108− ++ sources
65+ flags ++ pkgs ++ sources
109
66
110getSources :: IO [FilePath]
67getSources :: IO [FilePath]
111−getSources = filter (isSuffixOf ".hs") <$> go "src"
68+getSources = filter (isSuffixOf ".hs") . concat <$> mapM go src_dirs
112 where
69 where
113 go dir = do
70 go dir = do
114 (dirs, files) <- getFilesAndDirectories dir
71 (dirs, files) <- getFilesAndDirectories dir