bfb81b2 · typeable/http-api-data

git.iko.soy/typeable/http-api-data

Move flag generation to Setup.lhs

commitbfb81b2e1814949e58197394e0deb291df26814c authorOleg Grenrus <oleg.grenrus@iki.fi> dateFri 13 Jan 2017, 09:27 (10 years ago) parentb18aa5d

4 files changed+93−81

compare with master

unifiedsplit

Setup.lhs+83−27 http-api-data.cabal+1−1 stack.yaml+2−3 test/DocTest.hsc+7−50

Setup.lhs+83−27

@@ -3,18 +3,21 @@

33#ifndef MIN_VERSION_Cabal

44#define MIN_VERSION_Cabal(x,y,z) 0

55#endif

6+#if MIN_VERSION_Cabal(1,24,0)

7+#define InstalledPackageId UnitId

8+#endif

69module Main (main) where

710

811import Data.List ( nub )

912import Distribution.Package ( InstalledPackageId )

1013import Distribution.Package ( PackageId, Package (..), packageVersion, packageName )

11−import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )

14+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..))

1215import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )

1316import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )

1417import Distribution.Simple.BuildPaths ( autogenModulesDir )

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.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))

19+import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler, buildDir )

20+import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))

1821import Distribution.Text ( display , simpleParse )

1922import Distribution.Verbosity ( Verbosity, normal )

2023import System.FilePath ( (</>) )

@@ -26,7 +29,7 @@ import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )

2629main :: IO ()

2730main = defaultMainWithHooks simpleUserHooks

2831 { buildHook = \pkg lbi hooks flags -> do

29− generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi

32+ generateBuildModule flags pkg lbi

3033 buildHook simpleUserHooks pkg lbi hooks flags

3134 }

3235

@@ -37,41 +40,57 @@ haddockOutputDir flags pkg = destDir where

3740 Flag x -> x

3841 destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)

3942

40−generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()

41−generateBuildModule verbosity pkg lbi = do

42− let dir = autogenModulesDir lbi

43+generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()

44+generateBuildModule flags pkg lbi = do

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+

4352 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+

4660 -- We need the directory with library's cabal_macros.h!

4761#if MIN_VERSION_Cabal(1,25,0)

48− let dir2 = autogenComponentModulesDir lbi libcfg

62+ let libAutogenDir = autogenComponentModulesDir lbi libcfg

4963#else

50− let dir2 = dir

64+ let libAutogenDir = autogenModulesDir lbi

5165#endif

66+

67+ -- CPP includes, i.e. include cabal_macros.h

68+ let cppFlags = [ "-optP-include", "-optP" ++ libAutogenDir ++ "/cabal_macros.h" ]

69+

5270 withTestLBI pkg lbi $ \suite suitecfg -> do

53− -- when (testName suite == "doctest") $ we need IsString instance

54− rewriteFile (dir </> "Build_doctests.hs") $ unlines

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

82+ rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines

5583 [ "module Build_doctests where"

5684 , ""

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− , ""

6685 -- -package-id etc. flags

6786 , "pkgs :: [String]"

6887 , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)

6988 , ""

70− , "compiler :: String"

71− , "compiler = " ++ (show $ showCompilerId $ compiler lbi)

89+ , "flags :: [String]"

90+ , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)

7291 , ""

73− , "isOldCompiler :: Bool"

74− , "isOldCompiler = " ++ show isOldCompiler

92+ , "src_dirs :: [String]"

93+ , "src_dirs = " ++ show (hsSourceDirs libBI)

7594 ]

7695 where

7796 -- 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

87106 | packageId pkg == pkgId = "-package=" ++ display pkgId

88107 | otherwise = "-package-id=" ++ display installedPkgId

89108

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+

90146testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]

91147testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys

92148

http-api-data.cabal+1−1

@@ -81,7 +81,7 @@ test-suite spec

8181 , bytestring

8282 , uuid

8383

84−test-suite doctest

84+test-suite doctests

8585 ghc-options: -Wall

8686 build-tools: hsc2hs

8787 build-depends:

stack.yaml+2−3

@@ -1,4 +1,4 @@

1−resolver: nightly-2016-07-19

1+resolver: nightly-2016-12-31

33packages:

44- '.'

@@ -7,6 +7,5 @@ flags:

77 http-api-data:

88 use-text-show: false

10−extra-deps:

11−- QuickCheck-2.9.2

10+extra-deps: []

1211extra-package-dbs: []

test/DocTest.hsc+7−50

@@ -15,7 +15,7 @@

1515-----------------------------------------------------------------------------

1616module Main where

1717

18−import Build_doctests (component_autogen_dir, build_dir, pkgs, compiler, isOldCompiler)

18+import Build_doctests (flags, pkgs, src_dirs)

1919#if __GLASGOW_HASKELL__ < 710

2020import Control.Applicative

2121#endif

@@ -55,60 +55,17 @@ withUnicode m = m

5555

5656main :: IO ()

5757main = 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)

58+ mapM_ putStrLn (args sources)

59+ doctest (args sources)

8160 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"

61+ args sources =

10462#ifdef TRUSTWORTHY

105− : "-DTRUSTWORTHY=1"

63+ "-DTRUSTWORTHY=1" :

10664#endif

107− : pkgs

108− ++ sources

65+ flags ++ pkgs ++ sources

10966

11067getSources :: IO [FilePath]

111−getSources = filter (isSuffixOf ".hs") <$> go "src"

68+getSources = filter (isSuffixOf ".hs") . concat <$> mapM go src_dirs

11269 where

11370 go dir = do

11471 (dirs, files) <- getFilesAndDirectories dir