git.iko.soy/typeable/http-api-data
on v0.3.4 help sign in
typeable/http-api-data/Setup.lhs
165 lines 6.7 kB history raw
1\begin{code}
2{-# LANGUAGE CPP #-}
3#ifndef MIN_VERSION_Cabal
4#define MIN_VERSION_Cabal(x,y,z) 0
5#endif
6#ifndef MIN_VERSION_directory
7#define MIN_VERSION_directory(x,y,z) 0
8#endif
9#if MIN_VERSION_Cabal(1,24,0)
10#define InstalledPackageId UnitId
11#endif
12module Main (main) where
14import Control.Monad ( when )
15import Data.List ( nub )
16import Distribution.Package ( InstalledPackageId )
17import Distribution.Package ( PackageId, Package (..), packageVersion )
18import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..))
19import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
20import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )
21import Distribution.Simple.BuildPaths ( autogenModulesDir )
22import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag)
23import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler )
24import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))
25import Distribution.Text ( display , simpleParse )
26import System.FilePath ( (</>) )
28#if MIN_VERSION_Cabal(1,25,0)
29import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )
30#endif
32#if MIN_VERSION_directory(1,2,2)
33import System.Directory (makeAbsolute)
34#else
35import System.Directory (getCurrentDirectory)
36import System.FilePath (isAbsolute)
38makeAbsolute :: FilePath -> IO FilePath
39makeAbsolute p | isAbsolute p = return p
40 | otherwise = do
41 cwd <- getCurrentDirectory
42 return $ cwd </> p
43#endif
45main :: IO ()
46main = defaultMainWithHooks simpleUserHooks
47 { buildHook = \pkg lbi hooks flags -> do
48 generateBuildModule flags pkg lbi
49 buildHook simpleUserHooks pkg lbi hooks flags
50 }
52generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
53generateBuildModule flags pkg lbi = do
54 let verbosity = fromFlag (buildVerbosity flags)
55 let distPref = fromFlag (buildDistPref flags)
57 -- Package DBs
58 let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]
59 let dbFlags = "-hide-all-packages" : packageDbArgs dbStack
61 withLibLBI pkg lbi $ \lib libcfg -> do
62 let libBI = libBuildInfo lib
64 -- modules
65 let modules = exposedModules lib ++ otherModules libBI
66 -- it seems that doctest is happy to take in module names, not actual files!
67 let module_sources = modules
69 -- We need the directory with library's cabal_macros.h!
70#if MIN_VERSION_Cabal(1,25,0)
71 let libAutogenDir = autogenComponentModulesDir lbi libcfg
72#else
73 let libAutogenDir = autogenModulesDir lbi
74#endif
76 -- Lib sources and includes
77 iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI
78 includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI
80 -- CPP includes, i.e. include cabal_macros.h
81 let cppFlags = map ("-optP"++) $
82 [ "-include", libAutogenDir ++ "/cabal_macros.h" ]
83 ++ cppOptions libBI
85 -- Actually we need to check whether testName suite == "doctests"
86 -- pending https://github.com/haskell/cabal/pull/4229 getting into GHC HEAD tree
87 withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == testName suite) $ do
89 -- get and create autogen dir
90#if MIN_VERSION_Cabal(1,25,0)
91 let testAutogenDir = autogenComponentModulesDir lbi suitecfg
92#else
93 let testAutogenDir = autogenModulesDir lbi
94#endif
95 createDirectoryIfMissingVerbose verbosity True testAutogenDir
97 -- write autogen'd file
98 rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines
99 [ "module Build_doctests where"
100 , ""
101 -- -package-id etc. flags
102 , "pkgs :: [String]"
103 , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)
104 , ""
105 , "flags :: [String]"
106 , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)
107 , ""
108 , "module_sources :: [String]"
109 , "module_sources = " ++ show (map display module_sources)
110 ]
111 where
112 -- we do this check in Setup, as then doctests don't need to depend on Cabal
113 isOldCompiler = maybe False id $ do
114 a <- simpleParse $ showCompilerId $ compiler lbi
115 b <- simpleParse "7.5"
116 return $ packageVersion (a :: PackageId) < b
118 formatDeps = map formatOne
119 formatOne (installedPkgId, pkgId)
120 -- The problem is how different cabal executables handle package databases
121 -- when doctests depend on the library
122 | packageId pkg == pkgId = "-package=" ++ display pkgId
123 | otherwise = "-package-id=" ++ display installedPkgId
125 -- From Distribution.Simple.Program.GHC
126 packageDbArgs :: [PackageDB] -> [String]
127 packageDbArgs | isOldCompiler = packageDbArgsConf
128 | otherwise = packageDbArgsDb
130 -- GHC <7.6 uses '-package-conf' instead of '-package-db'.
131 packageDbArgsConf :: [PackageDB] -> [String]
132 packageDbArgsConf dbstack = case dbstack of
133 (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
134 (GlobalPackageDB:dbs) -> ("-no-user-package-conf")
135 : concatMap specific dbs
136 _ -> ierror
137 where
138 specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]
139 specific _ = ierror
140 ierror = error $ "internal error: unexpected package db stack: "
141 ++ show dbstack
143 -- GHC >= 7.6 uses the '-package-db' flag. See
144 -- https://ghc.haskell.org/trac/ghc/ticket/5977.
145 packageDbArgsDb :: [PackageDB] -> [String]
146 -- special cases to make arguments prettier in common scenarios
147 packageDbArgsDb dbstack = case dbstack of
148 (GlobalPackageDB:UserPackageDB:dbs)
149 | all isSpecific dbs -> concatMap single dbs
150 (GlobalPackageDB:dbs)
151 | all isSpecific dbs -> "-no-user-package-db"
152 : concatMap single dbs
153 dbs -> "-clear-package-db"
154 : concatMap single dbs
155 where
156 single (SpecificPackageDB db) = [ "-package-db=" ++ db ]
157 single GlobalPackageDB = [ "-global-package-db" ]
158 single UserPackageDB = [ "-user-package-db" ]
159 isSpecific (SpecificPackageDB _) = True
160 isSpecific _ = False
162testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
163testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
165\end{code}