Base.hs 8.37 KB
Newer Older
1
2
3
4
5
6
7
{-# LANGUAGE NoImplicitPrelude #-}
module Package.Base (
    module Base,
    module Ways,
    module Util,
    module Oracles,
    Package (..), Settings (..), TodoItem (..),
8
    defaultSettings, libraryPackage, standardLibrary,
9
    commonCcArgs, commonLdArgs, commonCppArgs, commonCcWarninigArgs,
Andrey Mokhov's avatar
Andrey Mokhov committed
10
11
    pathArgs, packageArgs,
    includeGccArgs, includeGhcArgs, pkgHsSources,
12
    pkgDepHsObjects, pkgLibHsObjects, pkgCObjects,
13
    argSizeLimit,
14
15
16
    sourceDependecies,
    argList, argListWithComment,
    argListPath
17
18
19
20
21
22
    ) where

import Base
import Ways
import Util
import Oracles
Andrey Mokhov's avatar
Andrey Mokhov committed
23
import qualified System.Directory as S
24
25
26
27
28
29
30
31
32
33
34
35
36

data Settings = Settings
     {
         customConfArgs  :: Args,
         customCcArgs    :: Args,
         customLdArgs    :: Args,
         customCppArgs   :: Args,
         customDllArgs   :: Args,
         registerPackage :: Bool,
         ways            :: Action [Way]
     }

defaultSettings :: Stage -> Settings
37
38
defaultSettings stage =
    Settings mempty mempty mempty mempty mempty True (defaultWays stage)
39
40

-- Stage is the stage of the GHC that we use to build the package
41
42
43
44
45
-- FilePath is the directory to put the build results (relative to pkgPath)
-- The typical structure of that directory is:
-- * build/           : contains compiled object code
-- * doc/             : produced by haddock
-- * package-data.mk  : contains output of ghc-cabal applied to package.cabal
46
47
48
-- Settings may be different for different combinations of Stage & FilePath
type TodoItem = (Stage, FilePath, Settings)

49
50
51
-- pkgPath is the path to the source code relative to the root
data Package = Package
     {
52
53
54
         pkgName :: String,    -- For example: "deepseq"
         pkgPath :: FilePath,  -- "libraries/deepseq"
         pkgTodo :: [TodoItem] -- [(Stage1, "dist-install", defaultSettings)]
55
56
     }

57
58
libraryPackage :: String -> [Stage] -> (Stage -> Settings) -> Package
libraryPackage name stages settings =
59
60
    Package
        name
61
        (unifyPath $ "libraries" </> name)
62
        [ (stage
63
        , if stage == Stage0 then "dist-boot" else "dist-install"
64
65
        , settings stage)
        | stage <- stages ]
66

67
68
69
standardLibrary :: String -> [Stage] -> Package
standardLibrary name stages = libraryPackage name stages defaultSettings

70
commonCcArgs :: Args
71
commonCcArgs = when Validating $ args ["-Werror", "-Wall"]
72
73
74
75
76
77
78
79

commonLdArgs :: Args
commonLdArgs = mempty -- TODO: Why empty? Perhaps drop it altogether?

commonCppArgs :: Args
commonCppArgs = mempty -- TODO: Why empty? Perhaps drop it altogether?

commonCcWarninigArgs :: Args
80
81
82
83
84
commonCcWarninigArgs = when Validating $
    args [ when GccIsClang                      $ arg "-Wno-unknown-pragmas"
         , when (not GccIsClang && not GccLt46) $ arg "-Wno-error=inline"
         , when (GccIsClang && not GccLt46 && windowsHost) $
           arg "-Werror=unused-but-set-variable" ]
85

86
pathArgs :: ShowArgs a => String -> FilePath -> a -> Args
87
pathArgs key path as = map (\a -> key ++ unifyPath (path </> a)) <$> args as
88

89
packageArgs :: Stage -> FilePath -> Args
Andrey Mokhov's avatar
Andrey Mokhov committed
90
packageArgs stage pathDist = do
91
    usePackageKey <- SupportsPackageKey || stage /= Stage0
92
93
94
95
96
97
98
99
100
101
    args [ arg "-hide-all-packages"
         , arg "-no-user-package-db"
         , arg "-include-pkg-deps"
         , when (stage == Stage0) $
           arg "-package-db libraries/bootstrapping.conf"
         , if usePackageKey
           then productArgs "-this-package-key" (arg  $ PackageKey pathDist)
             <> productArgs "-package-key"      (args $ DepKeys    pathDist)
           else productArgs "-package-name"     (arg  $ PackageKey pathDist)
             <> productArgs "-package"          (args $ Deps       pathDist) ]
102

Andrey Mokhov's avatar
Andrey Mokhov committed
103
104
105
106
107
108
includeGccArgs :: FilePath -> FilePath -> Args
includeGccArgs path dist =
    let pathDist = path </> dist
    in args [ pathArgs "-I" path $ IncludeDirs pathDist
            , pathArgs "-I" path $ DepIncludeDirs pathDist ]

109
110
includeGhcArgs :: FilePath -> FilePath -> Args
includeGhcArgs path dist =
Andrey Mokhov's avatar
Andrey Mokhov committed
111
    let pathDist = path </> dist
112
        buildDir = unifyPath $ pathDist </> "build"
113
114
115
    in args [ arg "-i"
            , pathArgs "-i" path $ SrcDirs pathDist
            , concatArgs ["-i", "-I"]
116
              [buildDir, unifyPath $ buildDir </> "autogen"]
117
118
119
            , pathArgs "-I" path $ IncludeDirs pathDist
            , arg "-optP-include" -- TODO: Shall we also add -cpp?
            , concatArgs "-optP" $
120
              unifyPath $ buildDir </> "autogen/cabal_macros.h" ]
121

122
123
pkgHsSources :: FilePath -> FilePath -> Action [FilePath]
pkgHsSources path dist = do
Andrey Mokhov's avatar
Andrey Mokhov committed
124
    let pathDist = path </> dist
Andrey Mokhov's avatar
Andrey Mokhov committed
125
        autogen = pathDist </> "build/autogen"
126
    dirs <- map (path </>) <$> args (SrcDirs pathDist)
Andrey Mokhov's avatar
Andrey Mokhov committed
127
    findModuleFiles pathDist (autogen:dirs) [".hs", ".lhs"]
128

129
130
131
132
133
-- TODO: look for non-{hs,c} objects too

-- Find Haskell objects we depend on (we don't want to depend on split objects)
pkgDepHsObjects :: FilePath -> FilePath -> Way -> Action [FilePath]
pkgDepHsObjects path dist way = do
Andrey Mokhov's avatar
Andrey Mokhov committed
134
135
    let pathDist = path </> dist
        buildDir = pathDist </> "build"
136
    dirs <- map (unifyPath . (path </>)) <$> args (SrcDirs pathDist)
Andrey Mokhov's avatar
Andrey Mokhov committed
137
    fmap concat $ forM dirs $ \d ->
138
        map (unifyPath . (buildDir ++) . (-<.> osuf way) . drop (length d))
Andrey Mokhov's avatar
Andrey Mokhov committed
139
        <$> (findModuleFiles pathDist [d] [".hs", ".lhs"])
140

141
142
143
144
145
pkgCObjects :: FilePath -> FilePath -> Way -> Action [FilePath]
pkgCObjects path dist way = do
    let pathDist = path </> dist
        buildDir = pathDist </> "build"
    srcs <- args $ CSrcs pathDist
146
    return $ map (unifyPath . (buildDir </>) . (-<.> osuf way)) srcs
147
148
149
150

-- Find Haskell objects that go to library
pkgLibHsObjects :: FilePath -> FilePath -> Stage -> Way -> Action [FilePath]
pkgLibHsObjects path dist stage way = do
Andrey Mokhov's avatar
Andrey Mokhov committed
151
    let pathDist = path </> dist
152
        buildDir = unifyPath $ pathDist </> "build"
153
    split <- splitObjects stage
Andrey Mokhov's avatar
Andrey Mokhov committed
154
    depObjs <- pkgDepHsObjects path dist way
155
156
    if split
    then do
Andrey Mokhov's avatar
Andrey Mokhov committed
157
         need depObjs -- Otherwise, split objects may not yet be available
Andrey Mokhov's avatar
Andrey Mokhov committed
158
159
         let suffix = "_" ++ osuf way ++ "_split/*." ++ osuf way
         findModuleFiles pathDist [buildDir] [suffix]
Andrey Mokhov's avatar
Andrey Mokhov committed
160
    else do return depObjs
161
162

findModuleFiles :: FilePath -> [FilePath] -> [String] -> Action [FilePath]
Andrey Mokhov's avatar
Andrey Mokhov committed
163
findModuleFiles pathDist directories suffixes = do
164
    modPaths <- map (replaceEq '.' pathSeparator) <$> args (Modules pathDist)
Andrey Mokhov's avatar
Andrey Mokhov committed
165
166
167
168
169
170
171
    fileList <- forM [ dir </> modPath ++ suffix
                     | dir     <- directories
                     , modPath <- modPaths
                     , suffix  <- suffixes
                     ] $ \file -> do
                         let dir = takeDirectory file
                         dirExists <- liftIO $ S.doesDirectoryExist dir
172
                         when dirExists $ return $ unifyPath file
Andrey Mokhov's avatar
Andrey Mokhov committed
173
    files <- getDirectoryFiles "" fileList
174
    return $ map unifyPath files
175
176
177
178
179
180
181
182
183
184

-- The argument list has a limited size on Windows. Since Windows 7 the limit
-- is 32768 (theoretically). In practice we use 31000 to leave some breathing
-- space for the builder's path & name, auxiliary flags, and other overheads.
-- Use this function to set limits for other operating systems if necessary.
argSizeLimit :: Action Int
argSizeLimit = do
    windows <- windowsHost
    return $ if windows
             then 31000
185
             else 4194304 -- Cabal needs a bit more than 2MB!
186
187
188
189
190
191
192
193
194
195
196
197

-- List of source files, which need to be tracked by the build system
-- to make sure the argument lists have not changed.
sourceDependecies :: [FilePath]
sourceDependecies = [ "shake/src/Package/Base.hs"
                    , "shake/src/Oracles/Base.hs"
                    , "shake/src/Oracles/Flag.hs"
                    , "shake/src/Oracles/Option.hs"
                    , "shake/src/Oracles/Builder.hs"
                    , "shake/src/Oracles/PackageData.hs"
                    , "shake/src/Ways.hs"
                    , "shake/src/Util.hs"
198
                    , "shake/src/Oracles.hs" ]
199

200
201
202
203
-- Convert Builder's argument list to a printable String
argListWithComment :: String -> Builder -> Args -> Action String
argListWithComment comment builder args = do
    args' <- args
204
    return $ show builder ++ " arguments"
205
206
207
208
209
           ++ (if null comment then "" else " (" ++ comment ++ ")")
           ++ ":\n" ++ concatMap (\s -> "    " ++ s ++ "\n") args'

argList :: Builder -> Args -> Action String
argList = argListWithComment ""
210
211
212
213
214

-- Path to argument list for a given Package/Stage combination
argListPath :: FilePath -> Package -> Stage -> FilePath
argListPath dir (Package name _ _) stage =
    dir </> takeBaseName name ++ " (stage " ++ show stage ++ ")" <.> "txt"