summaryrefslogtreecommitdiff
path: root/hadrian/src/Context.hs
blob: c7d321eba9eaa20c00cbaa7da4c5a369b6d32e93 (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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
module Context (
    -- * Context
    Context (..), vanillaContext, stageContext,

    -- * Expressions
    getStage, getPackage, getWay, getStagedSettingList, getBuildPath,

    -- * Paths
    contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
    pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile,
    pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir,
    haddockStatsFilesDir
    ) where

import Base
import Context.Path
import Context.Type
import Hadrian.Expression
import Hadrian.Haskell.Cabal
import Oracles.Setting

-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
vanillaContext :: Stage -> Package -> Context
vanillaContext s p = Context s p vanilla

-- | Partial context with undefined 'Package' field. Useful for 'Packages'
-- expressions that only read the environment and current 'Stage'.
stageContext :: Stage -> Context
stageContext s = vanillaContext s $ error "stageContext: package not set"

-- | Get the 'Stage' of the current 'Context'.
getStage :: Expr Context b Stage
getStage = stage <$> getContext

-- | Get the 'Package' of the current 'Context'.
getPackage :: Expr Context b Package
getPackage = package <$> getContext

-- | Get the 'Way' of the current 'Context'.
getWay :: Expr Context b Way
getWay = way <$> getContext

-- | Get a list of configuration settings for the current stage.
getStagedSettingList :: (Stage -> SettingList) -> Args Context b
getStagedSettingList f = getSettingList . f =<< getStage

-- | Path to the directory containg the final artifact in a given 'Context'.
libPath :: Context -> Action FilePath
libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib"))

-- | Get the directory name for binary distribution files
-- @<arch>-<os>-ghc-<version>@.
--
-- We preform some renaming to accommodate Cabal's slightly different naming
-- conventions (see 'cabalOsString' and 'cabalArchString').
distDir :: Stage -> Action FilePath
distDir st = do
    let (os,arch) = case st of
            Stage0 -> (HostOs , HostArch)
            _      -> (TargetOs, TargetArch)
    version        <- ghcVersionStage st
    hostOs         <- cabalOsString <$> setting os
    hostArch       <- cabalArchString <$> setting arch
    return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version

pkgFileName :: Package -> String -> String -> Action FilePath
pkgFileName package prefix suffix = do
    pid  <- pkgIdentifier package
    return $ prefix ++ pid ++ suffix

pkgFile :: Context -> String -> String -> Action FilePath
pkgFile context@Context {..} prefix suffix = do
    path <- buildPath context
    fileName <- pkgFileName package prefix suffix
    return $ path -/- fileName

-- | Path to inplace package configuration file of a given 'Context'.
pkgInplaceConfig :: Context -> Action FilePath
pkgInplaceConfig context = contextPath context <&> (-/- "inplace-pkg-config")

-- | Path to the @setup-config@ of a given 'Context'.
pkgSetupConfigFile :: Context -> Action FilePath
pkgSetupConfigFile context = contextPath context <&> (-/- "setup-config")

-- | Path to the haddock file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
pkgHaddockFile :: Context -> Action FilePath
pkgHaddockFile Context {..} = do
    root <- buildRoot
    let name = pkgName package
    return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock"

-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@
-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@
pkgRegisteredLibraryFile :: Context -> Action FilePath
pkgRegisteredLibraryFile context@Context {..} = do
    libDir    <- libPath context
    pkgId     <- pkgIdentifier package
    extension <- libsuf stage way
    fileName  <- pkgFileName package "libHS" extension
    distDir   <- distDir stage
    return $ if Dynamic `wayUnit` way
        then libDir -/- distDir -/- fileName
        else libDir -/- distDir -/- pkgId -/- fileName

-- | Path to the library file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
pkgLibraryFile :: Context -> Action FilePath
pkgLibraryFile context@Context {..} = do
    extension <- libsuf stage way
    pkgFile context "libHS" extension

-- | Path to the GHCi library file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.
pkgGhciLibraryFile :: Context -> Action FilePath
pkgGhciLibraryFile context@Context {..} = do
    let extension = "" <.> osuf way
    pkgFile context "HS" extension

-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
pkgConfFile Context {..} = do
    pid  <- pkgIdentifier package
    dbPath <- packageDbPath stage
    return $ dbPath -/- pid <.> "conf"

-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
-- to its object file. For example:
-- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
-- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
objectPath :: Context -> FilePath -> Action FilePath
objectPath context@Context {..} src = do
    isGenerated <- isGeneratedSource src
    path        <- buildPath context
    let extension = drop 1 $ takeExtension src
        obj       = src -<.> osuf way
        result | isGenerated          = obj
               | "*hs*" ?== extension = path -/- obj
               | otherwise            = path -/- extension -/- obj
    return result