Program.hs 4.59 KB
Newer Older
Andrey Mokhov's avatar
Andrey Mokhov committed
1 2
module Rules.Program (buildProgram) where

Ben Gamari's avatar
Ben Gamari committed
3 4
import Data.Char

Ben Gamari's avatar
Ben Gamari committed
5
import Base
6
import Context
7
import Expression hiding (stage, way)
8
import GHC
9
import Oracles.ModuleFiles
Andrey Mokhov's avatar
Andrey Mokhov committed
10
import Oracles.PackageData
11
import Oracles.Setting
12
import Rules.Wrappers
Andrey Mokhov's avatar
Andrey Mokhov committed
13
import Settings
14
import Settings.Path
15
import Target
Andrey Mokhov's avatar
Andrey Mokhov committed
16
import UserSettings
17
import Utilities
Andrey Mokhov's avatar
Andrey Mokhov committed
18

19
buildProgram :: [(Resource, Int)] -> Context -> Rules ()
Andrey Mokhov's avatar
Andrey Mokhov committed
20
buildProgram rs context@Context {..} = when (isProgram package) $ do
Andrey Mokhov's avatar
Andrey Mokhov committed
21
    let installStage = do
Andrey Mokhov's avatar
Andrey Mokhov committed
22
            latest <- latestBuildStage package -- fromJust below is safe
Andrey Mokhov's avatar
Andrey Mokhov committed
23 24
            return $ if package == ghc then stage else fromJust latest

Andrey Mokhov's avatar
Andrey Mokhov committed
25 26 27
    buildPath context -/- programName context <.> exe %>
        buildBinaryAndWrapper rs context

28 29
    when (package == ghc) $ want inplaceLibCopyTargets

Andrey Mokhov's avatar
Andrey Mokhov committed
30
    -- Rules for programs built in install directories
Andrey Mokhov's avatar
Andrey Mokhov committed
31
    when (stage == Stage0 || package == ghc) $ do
32 33
        -- Some binaries in inplace/bin are wrapped
        inplaceBinPath -/- programName context <.> exe %> \bin -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
34
            binStage <- installStage
Andrey Mokhov's avatar
Andrey Mokhov committed
35
            buildBinaryAndWrapper rs (context { stage = binStage }) bin
Zhen Zhang's avatar
Zhen Zhang committed
36

37
        inplaceLibBinPath -/- programName context <.> exe %> \bin -> do
Zhen Zhang's avatar
Zhen Zhang committed
38 39 40 41 42 43 44 45 46 47
            binStage <- installStage
            if package /= iservBin then
                -- We *normally* build only unwrapped binaries in inplace/lib/bin,
                buildBinary rs (context { stage = binStage }) bin
            else
                -- build both binary and wrapper in inplace/lib/bin
                -- for ghc-iserv on *nix platform now
                buildBinaryAndWrapperLib rs (context { stage = binStage }) bin

        inplaceLibBinPath -/- programName context <.> "bin" %> \bin -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
48 49
            binStage <- installStage
            buildBinary rs (context { stage = binStage }) bin
Andrey Mokhov's avatar
Andrey Mokhov committed
50

Zhen Zhang's avatar
Zhen Zhang committed
51 52 53 54 55 56 57 58 59 60 61 62 63 64
buildBinaryAndWrapperLib :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildBinaryAndWrapperLib rs context bin = do
    windows <- windowsHost
    if windows
    then buildBinary rs context bin -- We don't build wrappers on Windows
    else case lookup context inplaceWrappers of
        Nothing      -> buildBinary rs context bin -- No wrapper found
        Just wrapper -> do
            top <- topDirectory
            let libdir = top -/- inplaceLibPath
            let wrappedBin = inplaceLibBinPath -/- programName context <.> "bin"
            need [wrappedBin]
            buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName wrappedBin))

Andrey Mokhov's avatar
Andrey Mokhov committed
65 66 67 68 69
buildBinaryAndWrapper :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildBinaryAndWrapper rs context bin = do
    windows <- windowsHost
    if windows
    then buildBinary rs context bin -- We don't build wrappers on Windows
Zhen Zhang's avatar
Zhen Zhang committed
70
    else case lookup context inplaceWrappers of
Andrey Mokhov's avatar
Andrey Mokhov committed
71 72
        Nothing      -> buildBinary rs context bin -- No wrapper found
        Just wrapper -> do
73 74 75
            top <- topDirectory
            let libdir = top -/- inplaceLibPath
            let wrappedBin = inplaceLibBinPath -/- takeFileName bin
Andrey Mokhov's avatar
Andrey Mokhov committed
76
            need [wrappedBin]
77
            buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName bin))
Andrey Mokhov's avatar
Andrey Mokhov committed
78

79 80 81
buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
    contents <- interpretInContext context $ wrapper wrapped
Andrey Mokhov's avatar
Andrey Mokhov committed
82
    writeFileChanged wrapperPath contents
83
    makeExecutable wrapperPath
Andrey Mokhov's avatar
Andrey Mokhov committed
84 85
    putSuccess $ "| Successfully created wrapper for " ++
        quote (pkgNameString package) ++ " (" ++ show stage ++ ")."
Andrey Mokhov's avatar
Andrey Mokhov committed
86 87

-- TODO: Get rid of the Paths_hsc2hs.o hack.
88
buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
Andrey Mokhov's avatar
Andrey Mokhov committed
89 90
buildBinary rs context@Context {..} bin = do
    binDeps <- if stage == Stage0 && package == ghcCabal
91
        then hsSources context
Andrey Mokhov's avatar
Andrey Mokhov committed
92
        else do
93
            needLibrary =<< contextDependencies context
94
            when (stage > Stage0) $ do
95
                ways <- interpretInContext context (getLibraryWays <> getRtsWays)
96
                needLibrary [ rtsContext { way = w } | w <- ways ]
Andrey Mokhov's avatar
Andrey Mokhov committed
97
            let path = buildPath context
98 99 100 101 102
            cObjs  <- map (objectPath context) <$> pkgDataList (CSrcs path)
            hsObjs <- hsObjects context
            return $ cObjs ++ hsObjs
                  ++ [ path -/- "Paths_hsc2hs.o"  | package == hsc2hs  ]
                  ++ [ path -/- "Paths_haddock.o" | package == haddock ]
Andrey Mokhov's avatar
Andrey Mokhov committed
103
    need binDeps
104
    buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
105
    synopsis <- interpretInContext context $ getPkgData Synopsis
Moritz Angermann's avatar
Moritz Angermann committed
106
    putSuccess $ renderProgram
Andrey Mokhov's avatar
Andrey Mokhov committed
107
        (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
Moritz Angermann's avatar
Moritz Angermann committed
108 109
        bin
        (dropWhileEnd isPunctuation synopsis)