summaryrefslogtreecommitdiff
path: root/hadrian/src/Main.hs
blob: bc04c707d8a796dab1aabae553ae511ae476964e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
module Main (main) where

import System.Directory (getCurrentDirectory)
import Development.Shake
import Hadrian.Expression
import Hadrian.Utilities
import Settings.Parser

import qualified Base
import qualified CommandLine
import qualified Environment
import qualified Rules
import qualified Rules.Clean
import qualified Rules.Documentation
import qualified Rules.Nofib
import qualified Rules.SourceDist
import qualified Rules.Selftest
import qualified Rules.Test
import qualified UserSettings

main :: IO ()
main = do
    -- Provide access to command line arguments and some user settings through
    -- Shake's type-indexed map 'shakeExtra'.
    argsMap <- CommandLine.cmdLineArgsMap
    let extra = insertExtra UserSettings.buildProgressColour
              $ insertExtra UserSettings.successColour
              $ insertExtra (VerboseCommand UserSettings.verboseCommand) argsMap

        BuildRoot buildRoot = CommandLine.lookupBuildRoot argsMap

        rebuild = [ (RebuildLater, buildRoot -/- "stage0/**")
                  | CommandLine.lookupFreeze1 argsMap ||
                    CommandLine.lookupFreeze2 argsMap
                  ] ++
                  [ (RebuildLater, buildRoot -/- "stage1/**")
                  | CommandLine.lookupFreeze2 argsMap
                  ] ++
                  (if CommandLine.lookupSkipDepends argsMap
                   then [(RebuildLater, buildRoot -/- "**/.dependencies.mk"), (RebuildLater, buildRoot -/- "**/.dependencies")]
                   else [])

    cwd <- getCurrentDirectory
    shakeColor <- shouldUseColor
    let options :: ShakeOptions
        options = shakeOptions
            { shakeChange   = ChangeModtimeAndDigest
            , shakeFiles    = buildRoot -/- Base.shakeFilesDir
            , shakeProgress = progressSimple
            , shakeRebuild  = rebuild
            , shakeTimings  = True
            , shakeColor    = shakeColor
            , shakeExtra    = extra

            -- Setting shakeSymlink to False ensures files are copied out of
            -- shake's cloud cache instead of hard linked. This is important as
            -- the hard link mode makes all such files read only to avoid
            -- accidentally modifying cache files via the hard link. It turns
            -- out, many Hadrian rules attempt read access to such files and
            -- hence would in the hard link mode. These rules could be
            -- refactored to avoid write access, but setting shakeSymlink to
            -- False is a much simpler solution.
            , shakeSymlink  = False

            -- Enable linting file accesses in the build dir and ghc root dir
            -- (cwd) when using the `--lint-fsatrace` option.
            , shakeLintInside = [ cwd, buildRoot ]
            , shakeLintIgnore =
                -- Ignore access to the package database caches.
                -- They are managed externally by the ghc-pkg tool.
                [ buildRoot -/- "**/package.conf.d/package.cache"

                -- Ignore access to autom4te.cache directories.
                -- They are managed externally by auto tools.
                , "//autom4te.cache/**"

                -- Ignore in-tree GMP objects
                , buildRoot -/- "**/gmp/objs/**"
                ]
            }

        rules :: Rules ()
        rules = do
            Rules.buildRules
            Rules.Documentation.documentationRules
            Rules.Clean.cleanRules
            Rules.Nofib.nofibRules
            Rules.oracleRules
            Rules.Selftest.selftestRules
            Rules.SourceDist.sourceDistRules
            Rules.Test.testRules
            Rules.topLevelTargets
            Rules.toolArgsTarget

    shakeArgsWith options CommandLine.optDescrs $ \_ targets -> do
        let targets' = filter (not . null) $ removeKVs targets
        Environment.setupEnvironment
        return . Just $ if null targets'
                        then rules
                        else want targets' >> withoutActions rules