Use Cabal directly in place of ghc-cabal + make build root configurable (#531)
[hadrian.git] / src / Rules / Library.hs
1 module Rules.Library (
2 buildPackageLibrary, buildPackageGhciLibrary, buildDynamicLib
3 ) where
4
5 import Hadrian.Haskell.Cabal
6 import Hadrian.Haskell.Cabal.PackageData as PD
7 import Hadrian.Haskell.Cabal.Parse (parseCabalPkgId)
8
9 import Base
10 import Context
11 import Expression hiding (way, package)
12 import Flavour
13 import GHC.Packages
14 import Oracles.ModuleFiles
15 import Oracles.Setting
16 import Rules.Gmp
17 import Settings
18 import Target
19 import Utilities
20
21 import qualified System.Directory as IO
22
23 archive :: Way -> String -> String
24 archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a")
25
26 -- | Building a library consist of building
27 -- the artifacts, and copying it somewhere
28 -- with cabal, and finally registering it
29 -- with the compiler via cabal in the
30 -- package database.
31 --
32 -- So we'll assume rules to build all the
33 -- package artifacts, and provide rules for
34 -- the any of the library artifacts.
35 library :: Context -> Rules ()
36 library context@Context{..} = do
37 root <- buildRootRules
38 pkgId <- case pkgCabalFile package of
39 Just file -> liftIO $ parseCabalPkgId file
40 Nothing -> return (pkgName package)
41
42 root -/- libDir context -/- pkgId -/- archive way pkgId %> \_ -> do
43 need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId]
44 return ()
45
46 libraryObjects :: Context -> Action [FilePath]
47 libraryObjects context@Context{..} = do
48 hsObjs <- hsObjects context
49 noHsObjs <- nonHsObjects context
50
51 -- This will create split objects if required (we don't track them
52 -- explicitly as this would needlessly bloat the Shake database).
53 need $ noHsObjs ++ hsObjs
54
55 split <- interpretInContext context =<< splitObjects <$> flavour
56 let getSplitObjs = concatForM hsObjs $ \obj -> do
57 let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
58 contents <- liftIO $ IO.getDirectoryContents dir
59 return . map (dir -/-) $ filter (not . all (== '.')) contents
60
61 (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
62
63 buildDynamicLib :: Context -> Rules ()
64 buildDynamicLib context@Context{..} = do
65 root <- buildRootRules
66 pkgId <- case pkgCabalFile package of
67 Just file -> liftIO $ parseCabalPkgId file
68 Nothing -> return (pkgName package)
69 let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId
70 -- OS X
71 libPrefix ++ "*.dylib" %> buildDynamicLibUnix
72 -- Linux
73 libPrefix ++ "*.so" %> buildDynamicLibUnix
74 -- TODO: Windows
75 where
76 buildDynamicLibUnix lib = do
77 deps <- contextDependencies context
78 need =<< mapM pkgLibraryFile deps
79 objs <- libraryObjects context
80 build $ target context (Ghc LinkHs stage) objs [lib]
81
82 buildPackageLibrary :: Context -> Rules ()
83 buildPackageLibrary context@Context {..} = do
84 root <- buildRootRules
85 pkgId <- case pkgCabalFile package of
86 Just file -> liftIO (parseCabalPkgId file)
87 Nothing -> return (pkgName package)
88 let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId
89 archive = libPrefix ++ (waySuffix way <.> "a")
90 archive %%> \a -> do
91 objs <- libraryObjects context
92 asuf <- libsuf way
93 let isLib0 = ("//*-0" ++ asuf) ?== a
94 removeFile a
95 if isLib0 then build $ target context (Ar Pack stage) [] [a] -- TODO: Scan for dlls
96 else build $ target context (Ar Pack stage) objs [a]
97
98 synopsis <- pkgSynopsis context
99 unless isLib0 . putSuccess $ renderLibrary
100 (quote (pkgName package) ++ " (" ++ show stage ++ ", way "
101 ++ show way ++ ").") a synopsis
102
103 library context
104
105 buildPackageGhciLibrary :: Context -> Rules ()
106 buildPackageGhciLibrary context@Context {..} = priority 2 $ do
107 root <- buildRootRules
108 pkgId <- case pkgCabalFile package of
109 Just file -> liftIO $ parseCabalPkgId file
110 Nothing -> return (pkgName package)
111
112 let libPrefix = root -/- buildDir context -/- "HS" ++ pkgId
113 o = libPrefix ++ "*" ++ (waySuffix way <.> "o")
114 o %> \obj -> do
115 objs <- allObjects context
116 need objs
117 build $ target context (Ld stage) objs [obj]
118
119 allObjects :: Context -> Action [FilePath]
120 allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
121
122 nonHsObjects :: Context -> Action [FilePath]
123 nonHsObjects context = do
124 cObjs <- cObjects context
125 cmmSrcs <- interpretInContext context (getPackageData PD.cmmSrcs)
126 cmmObjs <- mapM (objectPath context) cmmSrcs
127 eObjs <- extraObjects context
128 return $ cObjs ++ cmmObjs ++ eObjs
129
130 cObjects :: Context -> Action [FilePath]
131 cObjects context = do
132 srcs <- interpretInContext context (getPackageData PD.cSrcs)
133 objs <- mapM (objectPath context) srcs
134 return $ if way context == threaded
135 then objs
136 else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
137
138 extraObjects :: Context -> Action [FilePath]
139 extraObjects context
140 | package context == integerGmp = do
141 gmpPath <- gmpBuildPath
142 need [gmpPath -/- gmpLibraryH]
143 map unifyPath <$> getDirectoryFiles "" [gmpPath -/- gmpObjectsDir -/- "*.o"]
144 | otherwise = return []