1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3
4module Distribution.Types.BuildInfo (
5    BuildInfo(..),
6
7    emptyBuildInfo,
8    allLanguages,
9    allExtensions,
10    usedExtensions,
11    usesTemplateHaskellOrQQ,
12
13    hcOptions,
14    hcProfOptions,
15    hcSharedOptions,
16    hcStaticOptions,
17) where
18
19import Prelude ()
20import Distribution.Compat.Prelude
21
22import Distribution.Types.Mixin
23import Distribution.Types.Dependency
24import Distribution.Types.ExeDependency
25import Distribution.Types.LegacyExeDependency
26import Distribution.Types.PkgconfigDependency
27
28import Distribution.ModuleName
29import Distribution.Compiler
30import Language.Haskell.Extension
31
32-- Consider refactoring into executable and library versions.
33data BuildInfo = BuildInfo {
34        -- | component is buildable here
35        buildable         :: Bool,
36        -- | Tools needed to build this bit.
37        --
38        -- This is a legacy field that 'buildToolDepends' largely supersedes.
39        --
40        -- Unless use are very sure what you are doing, use the functions in
41        -- "Distribution.Simple.BuildToolDepends" rather than accessing this
42        -- field directly.
43        buildTools        :: [LegacyExeDependency],
44        -- | Haskell tools needed to build this bit
45        --
46        -- This field is better than 'buildTools' because it allows one to
47        -- precisely specify an executable in a package.
48        --
49        -- Unless use are very sure what you are doing, use the functions in
50        -- "Distribution.Simple.BuildToolDepends" rather than accessing this
51        -- field directly.
52        buildToolDepends  :: [ExeDependency],
53        cppOptions        :: [String],  -- ^ options for pre-processing Haskell code
54        asmOptions        :: [String],  -- ^ options for assmebler
55        cmmOptions        :: [String],  -- ^ options for C-- compiler
56        ccOptions         :: [String],  -- ^ options for C compiler
57        cxxOptions        :: [String],  -- ^ options for C++ compiler
58        ldOptions         :: [String],  -- ^ options for linker
59        pkgconfigDepends  :: [PkgconfigDependency], -- ^ pkg-config packages that are used
60        frameworks        :: [String], -- ^support frameworks for Mac OS X
61        extraFrameworkDirs:: [String], -- ^ extra locations to find frameworks.
62        asmSources        :: [FilePath], -- ^ Assembly files.
63        cmmSources        :: [FilePath], -- ^ C-- files.
64        cSources          :: [FilePath],
65        cxxSources        :: [FilePath],
66        jsSources         :: [FilePath],
67        hsSourceDirs      :: [FilePath], -- ^ where to look for the Haskell module hierarchy
68        otherModules      :: [ModuleName], -- ^ non-exposed or non-main modules
69        virtualModules    :: [ModuleName], -- ^ exposed modules that do not have a source file (e.g. @GHC.Prim@ from @ghc-prim@ package)
70        autogenModules    :: [ModuleName], -- ^ not present on sdist, Paths_* or user-generated with a custom Setup.hs
71
72        defaultLanguage   :: Maybe Language,-- ^ language used when not explicitly specified
73        otherLanguages    :: [Language],    -- ^ other languages used within the package
74        defaultExtensions :: [Extension],   -- ^ language extensions used by all modules
75        otherExtensions   :: [Extension],   -- ^ other language extensions used within the package
76        oldExtensions     :: [Extension],   -- ^ the old extensions field, treated same as 'defaultExtensions'
77
78        extraLibs         :: [String], -- ^ what libraries to link with when compiling a program that uses your package
79        extraGHCiLibs     :: [String], -- ^ if present, overrides extraLibs when package is loaded with GHCi.
80        extraBundledLibs  :: [String], -- ^ if present, adds libs to hs-libraries, which become part of the package.
81                                       --   Example: the Cffi library shipping with the rts, alognside the HSrts-1.0.a,.o,...
82                                       --   Example 2: a library that is being built by a foreing tool (e.g. rust)
83                                       --              and copied and registered together with this library.  The
84                                       --              logic on how this library is built will have to be encoded in a
85                                       --              custom Setup for now.  Oherwise cabal would need to lear how to
86                                       --              call arbitrary library builders.
87        extraLibFlavours  :: [String], -- ^ Hidden Flag.  This set of strings, will be appended to all libraries when
88                                       --   copying. E.g. [libHS<name>_<flavour> | flavour <- extraLibFlavours]. This
89                                       --   should only be needed in very specific cases, e.g. the `rts` package, where
90                                       --   there are multiple copies of slightly differently built libs.
91        extraDynLibFlavours :: [String], -- ^ Hidden Flag. This set of strings will be be appended to all /dynamic/
92                                         --   libraries when copying. This is particularly useful with the `rts` package,
93                                         --   where we want different dynamic flavours of the RTS library to be installed.
94        extraLibDirs      :: [String],
95        includeDirs       :: [FilePath], -- ^directories to find .h files
96        includes          :: [FilePath], -- ^ The .h files to be found in includeDirs
97        autogenIncludes   :: [FilePath], -- ^ The .h files to be generated (e.g. by @autoconf@)
98        installIncludes   :: [FilePath], -- ^ .h files to install with the package
99        options           :: PerCompilerFlavor [String],
100        profOptions       :: PerCompilerFlavor [String],
101        sharedOptions     :: PerCompilerFlavor [String],
102        staticOptions     :: PerCompilerFlavor [String],
103        customFieldsBI    :: [(String,String)], -- ^Custom fields starting
104                                                -- with x-, stored in a
105                                                -- simple assoc-list.
106        targetBuildDepends :: [Dependency], -- ^ Dependencies specific to a library or executable target
107        mixins :: [Mixin]
108    }
109    deriving (Generic, Show, Read, Eq, Typeable, Data)
110
111instance Binary BuildInfo
112
113instance NFData BuildInfo where rnf = genericRnf
114
115instance Monoid BuildInfo where
116  mempty = BuildInfo {
117    buildable           = True,
118    buildTools          = [],
119    buildToolDepends    = [],
120    cppOptions          = [],
121    asmOptions          = [],
122    cmmOptions          = [],
123    ccOptions           = [],
124    cxxOptions          = [],
125    ldOptions           = [],
126    pkgconfigDepends    = [],
127    frameworks          = [],
128    extraFrameworkDirs  = [],
129    asmSources          = [],
130    cmmSources          = [],
131    cSources            = [],
132    cxxSources          = [],
133    jsSources           = [],
134    hsSourceDirs        = [],
135    otherModules        = [],
136    virtualModules      = [],
137    autogenModules      = [],
138    defaultLanguage     = Nothing,
139    otherLanguages      = [],
140    defaultExtensions   = [],
141    otherExtensions     = [],
142    oldExtensions       = [],
143    extraLibs           = [],
144    extraGHCiLibs       = [],
145    extraBundledLibs    = [],
146    extraLibFlavours    = [],
147    extraDynLibFlavours = [],
148    extraLibDirs        = [],
149    includeDirs         = [],
150    includes            = [],
151    autogenIncludes     = [],
152    installIncludes     = [],
153    options             = mempty,
154    profOptions         = mempty,
155    sharedOptions       = mempty,
156    staticOptions       = mempty,
157    customFieldsBI      = [],
158    targetBuildDepends  = [],
159    mixins              = []
160  }
161  mappend = (<>)
162
163instance Semigroup BuildInfo where
164  a <> b = BuildInfo {
165    buildable           = buildable a && buildable b,
166    buildTools          = combine    buildTools,
167    buildToolDepends    = combine    buildToolDepends,
168    cppOptions          = combine    cppOptions,
169    asmOptions          = combine    asmOptions,
170    cmmOptions          = combine    cmmOptions,
171    ccOptions           = combine    ccOptions,
172    cxxOptions          = combine    cxxOptions,
173    ldOptions           = combine    ldOptions,
174    pkgconfigDepends    = combine    pkgconfigDepends,
175    frameworks          = combineNub frameworks,
176    extraFrameworkDirs  = combineNub extraFrameworkDirs,
177    asmSources          = combineNub asmSources,
178    cmmSources          = combineNub cmmSources,
179    cSources            = combineNub cSources,
180    cxxSources          = combineNub cxxSources,
181    jsSources           = combineNub jsSources,
182    hsSourceDirs        = combineNub hsSourceDirs,
183    otherModules        = combineNub otherModules,
184    virtualModules      = combineNub virtualModules,
185    autogenModules      = combineNub autogenModules,
186    defaultLanguage     = combineMby defaultLanguage,
187    otherLanguages      = combineNub otherLanguages,
188    defaultExtensions   = combineNub defaultExtensions,
189    otherExtensions     = combineNub otherExtensions,
190    oldExtensions       = combineNub oldExtensions,
191    extraLibs           = combine    extraLibs,
192    extraGHCiLibs       = combine    extraGHCiLibs,
193    extraBundledLibs    = combine    extraBundledLibs,
194    extraLibFlavours    = combine    extraLibFlavours,
195    extraDynLibFlavours = combine    extraDynLibFlavours,
196    extraLibDirs        = combineNub extraLibDirs,
197    includeDirs         = combineNub includeDirs,
198    includes            = combineNub includes,
199    autogenIncludes     = combineNub autogenIncludes,
200    installIncludes     = combineNub installIncludes,
201    options             = combine    options,
202    profOptions         = combine    profOptions,
203    sharedOptions       = combine    sharedOptions,
204    staticOptions       = combine    staticOptions,
205    customFieldsBI      = combine    customFieldsBI,
206    targetBuildDepends  = combineNub targetBuildDepends,
207    mixins              = combine    mixins
208  }
209    where
210      combine    field = field a `mappend` field b
211      combineNub field = nub (combine field)
212      combineMby field = field b `mplus` field a
213
214emptyBuildInfo :: BuildInfo
215emptyBuildInfo = mempty
216
217-- | The 'Language's used by this component
218--
219allLanguages :: BuildInfo -> [Language]
220allLanguages bi = maybeToList (defaultLanguage bi)
221               ++ otherLanguages bi
222
223-- | The 'Extension's that are used somewhere by this component
224--
225allExtensions :: BuildInfo -> [Extension]
226allExtensions bi = usedExtensions bi
227                ++ otherExtensions bi
228
229-- | The 'Extensions' that are used by all modules in this component
230--
231usedExtensions :: BuildInfo -> [Extension]
232usedExtensions bi = oldExtensions bi
233                 ++ defaultExtensions bi
234
235-- | Whether any modules in this component use Template Haskell or
236-- Quasi Quotes
237usesTemplateHaskellOrQQ :: BuildInfo -> Bool
238usesTemplateHaskellOrQQ bi = any p (allExtensions bi)
239  where
240    p ex = ex `elem`
241      [EnableExtension TemplateHaskell, EnableExtension QuasiQuotes]
242
243-- |Select options for a particular Haskell compiler.
244hcOptions :: CompilerFlavor -> BuildInfo -> [String]
245hcOptions = lookupHcOptions options
246
247hcProfOptions :: CompilerFlavor -> BuildInfo -> [String]
248hcProfOptions = lookupHcOptions profOptions
249
250hcSharedOptions :: CompilerFlavor -> BuildInfo -> [String]
251hcSharedOptions = lookupHcOptions sharedOptions
252
253hcStaticOptions :: CompilerFlavor -> BuildInfo -> [String]
254hcStaticOptions = lookupHcOptions staticOptions
255
256lookupHcOptions :: (BuildInfo -> PerCompilerFlavor [String])
257                -> CompilerFlavor -> BuildInfo -> [String]
258lookupHcOptions f hc bi = case f bi of
259    PerCompilerFlavor ghc ghcjs
260        | hc == GHC   -> ghc
261        | hc == GHCJS -> ghcjs
262        | otherwise   -> mempty
263