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