1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE RankNTypes #-}
4{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6
7module Distribution.Simple.Program.GHC (
8    GhcOptions(..),
9    GhcMode(..),
10    GhcOptimisation(..),
11    GhcDynLinkMode(..),
12    GhcProfAuto(..),
13
14    ghcInvocation,
15    renderGhcOptions,
16
17    runGHC,
18
19    packageDbArgsDb,
20    normaliseGhcArgs
21
22  ) where
23
24import Prelude ()
25import Distribution.Compat.Prelude
26
27import Distribution.Backpack
28import Distribution.Compat.Semigroup (First'(..), Last'(..), Option'(..))
29import Distribution.Simple.GHC.ImplInfo
30import Distribution.PackageDescription
31import Distribution.ModuleName
32import Distribution.Simple.Compiler
33import Distribution.Simple.Flag
34import Distribution.Simple.Program.Types
35import Distribution.Simple.Program.Run
36import Distribution.System
37import Distribution.Pretty
38import Distribution.Types.ComponentId
39import Distribution.Verbosity
40import Distribution.Version
41import Distribution.Utils.NubList
42import Language.Haskell.Extension
43
44import Data.List (stripPrefix)
45import qualified Data.Map as Map
46import Data.Monoid (All(..), Any(..), Endo(..))
47import qualified Data.Set as Set
48
49normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
50normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs
51   | ghcVersion `withinRange` supportedGHCVersions
52   = argumentFilters . filter simpleFilters . filterRtsOpts $ ghcArgs
53  where
54    supportedGHCVersions :: VersionRange
55    supportedGHCVersions = intersectVersionRanges
56        (orLaterVersion (mkVersion [8,0]))
57        (earlierVersion (mkVersion [9,1]))
58
59    from :: Monoid m => [Int] -> m -> m
60    from version flags
61      | ghcVersion `withinRange` orLaterVersion (mkVersion version) = flags
62      | otherwise = mempty
63
64    to :: Monoid m => [Int] -> m -> m
65    to version flags
66      | ghcVersion `withinRange` earlierVersion (mkVersion version) = flags
67      | otherwise = mempty
68
69    checkGhcFlags :: forall m . Monoid m => ([String] -> m) -> m
70    checkGhcFlags fun = mconcat
71        [ fun ghcArgs
72        , checkComponentFlags libBuildInfo pkgLibs
73        , checkComponentFlags buildInfo executables
74        , checkComponentFlags testBuildInfo testSuites
75        , checkComponentFlags benchmarkBuildInfo benchmarks
76        ]
77      where
78        pkgLibs = maybeToList library ++ subLibraries
79
80        checkComponentFlags :: (a -> BuildInfo) -> [a] -> m
81        checkComponentFlags getInfo = foldMap (checkComponent . getInfo)
82          where
83            checkComponent :: BuildInfo -> m
84            checkComponent = foldMap fun . filterGhcOptions . allGhcOptions
85
86            allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])]
87            allGhcOptions = foldMap (perCompilerFlavorToList .)
88                [options, profOptions, sharedOptions, staticOptions]
89
90            filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]]
91            filterGhcOptions l = [opts | (GHC, opts) <- l]
92
93    safeToFilterWarnings :: Bool
94    safeToFilterWarnings = getAll $ checkGhcFlags checkWarnings
95      where
96        checkWarnings :: [String] -> All
97        checkWarnings = All . Set.null . foldr alter Set.empty
98
99        alter :: String -> Set String -> Set String
100        alter flag = appEndo $ mconcat
101            [ \s -> Endo $ if s == "-Werror" then Set.insert s else id
102            , \s -> Endo $ if s == "-Wwarn" then const Set.empty else id
103            , \s -> from [8,6] . Endo $
104                    if s == "-Werror=compat"
105                    then Set.union compatWarningSet else id
106            , \s -> from [8,6] . Endo $
107                    if s == "-Wno-error=compat"
108                    then (`Set.difference` compatWarningSet) else id
109            , \s -> from [8,6] . Endo $
110                    if s == "-Wwarn=compat"
111                    then (`Set.difference` compatWarningSet) else id
112            , from [8,4] $ markFlag "-Werror=" Set.insert
113            , from [8,4] $ markFlag "-Wwarn=" Set.delete
114            , from [8,4] $ markFlag "-Wno-error=" Set.delete
115            ] flag
116
117        markFlag
118            :: String
119            -> (String -> Set String -> Set String)
120            -> String
121            -> Endo (Set String)
122        markFlag name update flag = Endo $ case stripPrefix name flag of
123            Just rest | not (null rest) && rest /= "compat" -> update rest
124            _ -> id
125
126    flagArgumentFilter :: [String] -> [String] -> [String]
127    flagArgumentFilter flags = go
128      where
129        makeFilter :: String -> String -> Option' (First' ([String] -> [String]))
130        makeFilter flag arg = Option' $ First' . filterRest <$> stripPrefix flag arg
131          where
132            filterRest leftOver = case dropEq leftOver of
133                [] -> drop 1
134                _ -> id
135
136        checkFilter :: String -> Maybe ([String] -> [String])
137        checkFilter = fmap getFirst' . getOption' . foldMap makeFilter flags
138
139        go :: [String] -> [String]
140        go [] = []
141        go (arg:args) = case checkFilter arg of
142            Just f -> go (f args)
143            Nothing -> arg : go args
144
145    argumentFilters :: [String] -> [String]
146    argumentFilters = flagArgumentFilter
147        ["-ghci-script", "-H", "-interactive-print"]
148
149    filterRtsOpts :: [String] -> [String]
150    filterRtsOpts = go False
151      where
152        go :: Bool -> [String] -> [String]
153        go _ [] = []
154        go _ ("+RTS":opts) = go True opts
155        go _ ("-RTS":opts) = go False opts
156        go isRTSopts (opt:opts) = addOpt $ go isRTSopts opts
157          where
158            addOpt | isRTSopts = id
159                   | otherwise = (opt:)
160
161    simpleFilters :: String -> Bool
162    simpleFilters = not . getAny . mconcat
163      [ flagIn simpleFlags
164      , Any . isPrefixOf "-ddump-"
165      , Any . isPrefixOf "-dsuppress-"
166      , Any . isPrefixOf "-dno-suppress-"
167      , flagIn $ invertibleFlagSet "-" ["ignore-dot-ghci"]
168      , flagIn . invertibleFlagSet "-f" . mconcat $
169            [ [ "reverse-errors", "warn-unused-binds", "break-on-error"
170              , "break-on-exception", "print-bind-result"
171              , "print-bind-contents", "print-evld-with-show"
172              , "implicit-import-qualified", "error-spans"
173              ]
174            , from [7,8]
175              [ "print-explicit-foralls" -- maybe also earlier, but GHC-7.6 doesn't have --show-options
176              , "print-explicit-kinds"
177              ]
178            , from [8,0]
179              [ "print-explicit-coercions"
180              , "print-explicit-runtime-reps"
181              , "print-equality-relations"
182              , "print-unicode-syntax"
183              , "print-expanded-synonyms"
184              , "print-potential-instances"
185              , "print-typechecker-elaboration"
186              ]
187            , from [8,2]
188                [ "diagnostics-show-caret", "local-ghci-history"
189                , "show-warning-groups", "hide-source-paths"
190                , "show-hole-constraints"
191                ]
192            , from [8,4] ["show-loaded-modules"]
193            , from [8,6] [ "ghci-leak-check", "no-it" ]
194            , from [8,10]
195                [ "defer-diagnostics"      -- affects printing of diagnostics
196                , "keep-going"             -- try harder, the build will still fail if it's erroneous
197                , "print-axiom-incomps"    -- print more debug info for closed type families
198                ]
199            ]
200      , flagIn . invertibleFlagSet "-d" $ [ "ppr-case-as-let", "ppr-ticks" ]
201      , isOptIntFlag
202      , isIntFlag
203      , if safeToFilterWarnings
204           then isWarning <> (Any . ("-w"==))
205           else mempty
206      , from [8,6] $
207        if safeToFilterHoles
208           then isTypedHoleFlag
209           else mempty
210      ]
211
212    flagIn :: Set String -> String -> Any
213    flagIn set flag = Any $ Set.member flag set
214
215    isWarning :: String -> Any
216    isWarning = mconcat $ map ((Any .) . isPrefixOf)
217        ["-fwarn-", "-fno-warn-", "-W", "-Wno-"]
218
219    simpleFlags :: Set String
220    simpleFlags = Set.fromList . mconcat $
221      [ [ "-n", "-#include", "-Rghc-timing", "-dstg-stats"
222        , "-dth-dec-file", "-dsource-stats", "-dverbose-core2core"
223        , "-dverbose-stg2stg", "-dcore-lint", "-dstg-lint", "-dcmm-lint"
224        , "-dasm-lint", "-dannot-lint", "-dshow-passes", "-dfaststring-stats"
225        , "-fno-max-relevant-binds", "-recomp", "-no-recomp", "-fforce-recomp"
226        , "-fno-force-recomp"
227        ]
228
229      , from [8,2]
230          [ "-fno-max-errors", "-fdiagnostics-color=auto"
231          , "-fdiagnostics-color=always", "-fdiagnostics-color=never"
232          , "-dppr-debug", "-dno-debug-output"
233          ]
234
235      , from [8,4] [ "-ddebug-output" ]
236      , from [8,4] $ to [8,6] [ "-fno-max-valid-substitutions" ]
237      , from [8,6] [ "-dhex-word-literals" ]
238      , from [8,8] [ "-fshow-docs-of-hole-fits", "-fno-show-docs-of-hole-fits" ]
239      , from [9,0] [ "-dlinear-core-lint" ]
240      ]
241
242    isOptIntFlag :: String -> Any
243    isOptIntFlag = mconcat . map (dropIntFlag True) $ ["-v", "-j"]
244
245    isIntFlag :: String -> Any
246    isIntFlag = mconcat . map (dropIntFlag False) . mconcat $
247        [ [ "-fmax-relevant-binds", "-ddpr-user-length", "-ddpr-cols"
248          , "-dtrace-level", "-fghci-hist-size" ]
249        , from [8,2] ["-fmax-uncovered-patterns", "-fmax-errors"]
250        , from [8,4] $ to [8,6] ["-fmax-valid-substitutions"]
251        ]
252
253    dropIntFlag :: Bool -> String -> String -> Any
254    dropIntFlag isOpt flag input = Any $ case stripPrefix flag input of
255        Nothing -> False
256        Just rest | isOpt && null rest -> True
257                  | otherwise -> case parseInt rest of
258                        Just _ -> True
259                        Nothing -> False
260      where
261        parseInt :: String -> Maybe Int
262        parseInt = readMaybe . dropEq
263
264    dropEq :: String -> String
265    dropEq ('=':s) = s
266    dropEq s = s
267
268    invertibleFlagSet :: String -> [String] -> Set String
269    invertibleFlagSet prefix flagNames =
270      Set.fromList $ (++) <$> [prefix, prefix ++ "no-"] <*> flagNames
271
272    compatWarningSet :: Set String
273    compatWarningSet = Set.fromList $ mconcat
274        [ from [8,6]
275            [ "missing-monadfail-instances", "semigroup"
276            , "noncanonical-monoid-instances", "implicit-kind-vars" ]
277        ]
278
279    safeToFilterHoles :: Bool
280    safeToFilterHoles = getAll . checkGhcFlags $
281        All . fromMaybe True . fmap getLast' . getOption' . foldMap notDeferred
282      where
283        notDeferred :: String -> Option' (Last' Bool)
284        notDeferred "-fdefer-typed-holes" = Option' . Just . Last' $ False
285        notDeferred "-fno-defer-typed-holes" = Option' . Just . Last' $ True
286        notDeferred _ = Option' Nothing
287
288    isTypedHoleFlag :: String -> Any
289    isTypedHoleFlag = mconcat
290        [ flagIn . invertibleFlagSet "-f" $
291            [ "show-hole-constraints", "show-valid-substitutions"
292            , "show-valid-hole-fits", "sort-valid-hole-fits"
293            , "sort-by-size-hole-fits", "sort-by-subsumption-hole-fits"
294            , "abstract-refinement-hole-fits", "show-provenance-of-hole-fits"
295            , "show-hole-matches-of-hole-fits", "show-type-of-hole-fits"
296            , "show-type-app-of-hole-fits", "show-type-app-vars-of-hole-fits"
297            , "unclutter-valid-hole-fits"
298            ]
299        , flagIn . Set.fromList $
300            [ "-fno-max-valid-hole-fits", "-fno-max-refinement-hole-fits"
301            , "-fno-refinement-level-hole-fits" ]
302        , mconcat . map (dropIntFlag False) $
303            [ "-fmax-valid-hole-fits", "-fmax-refinement-hole-fits"
304            , "-frefinement-level-hole-fits" ]
305        ]
306
307normaliseGhcArgs _ _ args = args
308
309-- | A structured set of GHC options/flags
310--
311-- Note that options containing lists fall into two categories:
312--
313--  * options that can be safely deduplicated, e.g. input modules or
314--    enabled extensions;
315--  * options that cannot be deduplicated in general without changing
316--    semantics, e.g. extra ghc options or linking options.
317data GhcOptions = GhcOptions {
318
319  -- | The major mode for the ghc invocation.
320  ghcOptMode          :: Flag GhcMode,
321
322  -- | Any extra options to pass directly to ghc. These go at the end and hence
323  -- override other stuff.
324  ghcOptExtra         :: [String],
325
326  -- | Extra default flags to pass directly to ghc. These go at the beginning
327  -- and so can be overridden by other stuff.
328  ghcOptExtraDefault  :: [String],
329
330  -----------------------
331  -- Inputs and outputs
332
333  -- | The main input files; could be .hs, .hi, .c, .o, depending on mode.
334  ghcOptInputFiles    :: NubListR FilePath,
335
336  -- | The names of input Haskell modules, mainly for @--make@ mode.
337  ghcOptInputModules  :: NubListR ModuleName,
338
339  -- | Location for output file; the @ghc -o@ flag.
340  ghcOptOutputFile    :: Flag FilePath,
341
342  -- | Location for dynamic output file in 'GhcStaticAndDynamic' mode;
343  -- the @ghc -dyno@ flag.
344  ghcOptOutputDynFile :: Flag FilePath,
345
346  -- | Start with an empty search path for Haskell source files;
347  -- the @ghc -i@ flag (@-i@ on its own with no path argument).
348  ghcOptSourcePathClear :: Flag Bool,
349
350  -- | Search path for Haskell source files; the @ghc -i@ flag.
351  ghcOptSourcePath    :: NubListR FilePath,
352
353  -------------
354  -- Packages
355
356  -- | The unit ID the modules will belong to; the @ghc -this-unit-id@
357  -- flag (or @-this-package-key@ or @-package-name@ on older
358  -- versions of GHC).  This is a 'String' because we assume you've
359  -- already figured out what the correct format for this string is
360  -- (we need to handle backwards compatibility.)
361  ghcOptThisUnitId   :: Flag String,
362
363  -- | GHC doesn't make any assumptions about the format of
364  -- definite unit ids, so when we are instantiating a package it
365  -- needs to be told explicitly what the component being instantiated
366  -- is.  This only gets set when 'ghcOptInstantiatedWith' is non-empty
367  ghcOptThisComponentId :: Flag ComponentId,
368
369  -- | How the requirements of the package being compiled are to
370  -- be filled.  When typechecking an indefinite package, the 'OpenModule'
371  -- is always a 'OpenModuleVar'; otherwise, it specifies the installed module
372  -- that instantiates a package.
373  ghcOptInstantiatedWith :: [(ModuleName, OpenModule)],
374
375  -- | No code? (But we turn on interface writing
376  ghcOptNoCode :: Flag Bool,
377
378  -- | GHC package databases to use, the @ghc -package-conf@ flag.
379  ghcOptPackageDBs    :: PackageDBStack,
380
381  -- | The GHC packages to bring into scope when compiling,
382  -- the @ghc -package-id@ flags.
383  ghcOptPackages      ::
384    NubListR (OpenUnitId, ModuleRenaming),
385
386  -- | Start with a clean package set; the @ghc -hide-all-packages@ flag
387  ghcOptHideAllPackages :: Flag Bool,
388
389  -- | Warn about modules, not listed in command line
390  ghcOptWarnMissingHomeModules :: Flag Bool,
391
392  -- | Don't automatically link in Haskell98 etc; the @ghc
393  -- -no-auto-link-packages@ flag.
394  ghcOptNoAutoLinkPackages :: Flag Bool,
395
396  -----------------
397  -- Linker stuff
398
399  -- | Names of libraries to link in; the @ghc -l@ flag.
400  ghcOptLinkLibs      :: [FilePath],
401
402  -- | Search path for libraries to link in; the @ghc -L@ flag.
403  ghcOptLinkLibPath  :: NubListR FilePath,
404
405  -- | Options to pass through to the linker; the @ghc -optl@ flag.
406  ghcOptLinkOptions   :: [String],
407
408  -- | OSX only: frameworks to link in; the @ghc -framework@ flag.
409  ghcOptLinkFrameworks :: NubListR String,
410
411  -- | OSX only: Search path for frameworks to link in; the
412  -- @ghc -framework-path@ flag.
413  ghcOptLinkFrameworkDirs :: NubListR String,
414
415  -- | Don't do the link step, useful in make mode; the @ghc -no-link@ flag.
416  ghcOptNoLink :: Flag Bool,
417
418  -- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@
419  -- flag.
420  ghcOptLinkNoHsMain :: Flag Bool,
421
422  -- | Module definition files (Windows specific)
423  ghcOptLinkModDefFiles :: NubListR FilePath,
424
425  --------------------
426  -- C and CPP stuff
427
428  -- | Options to pass through to the C compiler; the @ghc -optc@ flag.
429  ghcOptCcOptions     :: [String],
430
431  -- | Options to pass through to the C++ compiler.
432  ghcOptCxxOptions     :: [String],
433
434  -- | Options to pass through to the Assembler.
435  ghcOptAsmOptions     :: [String],
436
437  -- | Options to pass through to CPP; the @ghc -optP@ flag.
438  ghcOptCppOptions    :: [String],
439
440  -- | Search path for CPP includes like header files; the @ghc -I@ flag.
441  ghcOptCppIncludePath :: NubListR FilePath,
442
443  -- | Extra header files to include at CPP stage; the @ghc -optP-include@ flag.
444  ghcOptCppIncludes    :: NubListR FilePath,
445
446  -- | Extra header files to include for old-style FFI; the @ghc -#include@ flag.
447  ghcOptFfiIncludes    :: NubListR FilePath,
448
449  ----------------------------
450  -- Language and extensions
451
452  -- | The base language; the @ghc -XHaskell98@ or @-XHaskell2010@ flag.
453  ghcOptLanguage      :: Flag Language,
454
455  -- | The language extensions; the @ghc -X@ flag.
456  ghcOptExtensions    :: NubListR Extension,
457
458  -- | A GHC version-dependent mapping of extensions to flags. This must be
459  -- set to be able to make use of the 'ghcOptExtensions'.
460  ghcOptExtensionMap    :: Map Extension (Maybe CompilerFlag),
461
462  ----------------
463  -- Compilation
464
465  -- | What optimisation level to use; the @ghc -O@ flag.
466  ghcOptOptimisation  :: Flag GhcOptimisation,
467
468    -- | Emit debug info; the @ghc -g@ flag.
469  ghcOptDebugInfo     :: Flag DebugInfoLevel,
470
471  -- | Compile in profiling mode; the @ghc -prof@ flag.
472  ghcOptProfilingMode :: Flag Bool,
473
474  -- | Automatically add profiling cost centers; the @ghc -fprof-auto*@ flags.
475  ghcOptProfilingAuto :: Flag GhcProfAuto,
476
477  -- | Use the \"split sections\" feature; the @ghc -split-sections@ flag.
478  ghcOptSplitSections :: Flag Bool,
479
480  -- | Use the \"split object files\" feature; the @ghc -split-objs@ flag.
481  ghcOptSplitObjs     :: Flag Bool,
482
483  -- | Run N jobs simultaneously (if possible).
484  ghcOptNumJobs       :: Flag (Maybe Int),
485
486  -- | Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags.
487  ghcOptHPCDir        :: Flag FilePath,
488
489  ----------------
490  -- GHCi
491
492  -- | Extra GHCi startup scripts; the @-ghci-script@ flag
493  ghcOptGHCiScripts    :: [FilePath],
494
495  ------------------------
496  -- Redirecting outputs
497
498  ghcOptHiSuffix      :: Flag String,
499  ghcOptObjSuffix     :: Flag String,
500  ghcOptDynHiSuffix   :: Flag String,   -- ^ only in 'GhcStaticAndDynamic' mode
501  ghcOptDynObjSuffix  :: Flag String,   -- ^ only in 'GhcStaticAndDynamic' mode
502  ghcOptHiDir         :: Flag FilePath,
503  ghcOptObjDir        :: Flag FilePath,
504  ghcOptOutputDir     :: Flag FilePath,
505  ghcOptStubDir       :: Flag FilePath,
506
507  --------------------
508  -- Creating libraries
509
510  ghcOptDynLinkMode   :: Flag GhcDynLinkMode,
511  ghcOptStaticLib     :: Flag Bool,
512  ghcOptShared        :: Flag Bool,
513  ghcOptFPic          :: Flag Bool,
514  ghcOptDylibName     :: Flag String,
515  ghcOptRPaths        :: NubListR FilePath,
516
517  ---------------
518  -- Misc flags
519
520  -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag.
521  ghcOptVerbosity     :: Flag Verbosity,
522
523  -- | Put the extra folders in the PATH environment variable we invoke
524  -- GHC with
525  ghcOptExtraPath     :: NubListR FilePath,
526
527  -- | Let GHC know that it is Cabal that's calling it.
528  -- Modifies some of the GHC error messages.
529  ghcOptCabal         :: Flag Bool
530
531} deriving (Show, Generic)
532
533
534data GhcMode = GhcModeCompile     -- ^ @ghc -c@
535             | GhcModeLink        -- ^ @ghc@
536             | GhcModeMake        -- ^ @ghc --make@
537             | GhcModeInteractive -- ^ @ghci@ \/ @ghc --interactive@
538             | GhcModeAbiHash     -- ^ @ghc --abi-hash@
539--             | GhcModeDepAnalysis -- ^ @ghc -M@
540--             | GhcModeEvaluate    -- ^ @ghc -e@
541 deriving (Show, Eq)
542
543data GhcOptimisation = GhcNoOptimisation             -- ^ @-O0@
544                     | GhcNormalOptimisation         -- ^ @-O@
545                     | GhcMaximumOptimisation        -- ^ @-O2@
546                     | GhcSpecialOptimisation String -- ^ e.g. @-Odph@
547 deriving (Show, Eq)
548
549data GhcDynLinkMode = GhcStaticOnly       -- ^ @-static@
550                    | GhcDynamicOnly      -- ^ @-dynamic@
551                    | GhcStaticAndDynamic -- ^ @-static -dynamic-too@
552 deriving (Show, Eq)
553
554data GhcProfAuto = GhcProfAutoAll       -- ^ @-fprof-auto@
555                 | GhcProfAutoToplevel  -- ^ @-fprof-auto-top@
556                 | GhcProfAutoExported  -- ^ @-fprof-auto-exported@
557 deriving (Show, Eq)
558
559runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> Platform  -> GhcOptions
560       -> IO ()
561runGHC verbosity ghcProg comp platform opts = do
562  runProgramInvocation verbosity (ghcInvocation ghcProg comp platform opts)
563
564
565ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions
566              -> ProgramInvocation
567ghcInvocation prog comp platform opts =
568    (programInvocation prog (renderGhcOptions comp platform opts)) {
569        progInvokePathEnv = fromNubListR (ghcOptExtraPath opts)
570    }
571
572renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
573renderGhcOptions comp _platform@(Platform _arch os) opts
574  | compilerFlavor comp `notElem` [GHC, GHCJS] =
575    error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
576    ++ "compiler flavor must be 'GHC' or 'GHCJS'!"
577  | otherwise =
578  concat
579  [ case flagToMaybe (ghcOptMode opts) of
580       Nothing                 -> []
581       Just GhcModeCompile     -> ["-c"]
582       Just GhcModeLink        -> []
583       Just GhcModeMake        -> ["--make"]
584       Just GhcModeInteractive -> ["--interactive"]
585       Just GhcModeAbiHash     -> ["--abi-hash"]
586--     Just GhcModeDepAnalysis -> ["-M"]
587--     Just GhcModeEvaluate    -> ["-e", expr]
588
589  , ghcOptExtraDefault opts
590
591  , [ "-no-link" | flagBool ghcOptNoLink ]
592
593  ---------------
594  -- Misc flags
595
596  , maybe [] verbosityOpts (flagToMaybe (ghcOptVerbosity opts))
597
598  , [ "-fbuilding-cabal-package" | flagBool ghcOptCabal ]
599
600  ----------------
601  -- Compilation
602
603  , case flagToMaybe (ghcOptOptimisation opts) of
604      Nothing                         -> []
605      Just GhcNoOptimisation          -> ["-O0"]
606      Just GhcNormalOptimisation      -> ["-O"]
607      Just GhcMaximumOptimisation     -> ["-O2"]
608      Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph
609
610  , case flagToMaybe (ghcOptDebugInfo opts) of
611      Nothing                                -> []
612      Just NoDebugInfo                       -> []
613      Just MinimalDebugInfo                  -> ["-g1"]
614      Just NormalDebugInfo                   -> ["-g2"]
615      Just MaximalDebugInfo                  -> ["-g3"]
616
617  , [ "-prof" | flagBool ghcOptProfilingMode ]
618
619  , case flagToMaybe (ghcOptProfilingAuto opts) of
620      _ | not (flagBool ghcOptProfilingMode)
621                                -> []
622      Nothing                   -> []
623      Just GhcProfAutoAll
624        | flagProfAuto implInfo -> ["-fprof-auto"]
625        | otherwise             -> ["-auto-all"] -- not the same, but close
626      Just GhcProfAutoToplevel
627        | flagProfAuto implInfo -> ["-fprof-auto-top"]
628        | otherwise             -> ["-auto-all"]
629      Just GhcProfAutoExported
630        | flagProfAuto implInfo -> ["-fprof-auto-exported"]
631        | otherwise             -> ["-auto"]
632
633  , [ "-split-sections" | flagBool ghcOptSplitSections ]
634  , [ "-split-objs" | flagBool ghcOptSplitObjs ]
635
636  , case flagToMaybe (ghcOptHPCDir opts) of
637      Nothing -> []
638      Just hpcdir -> ["-fhpc", "-hpcdir", hpcdir]
639
640  , if parmakeSupported comp
641    then case ghcOptNumJobs opts of
642      NoFlag  -> []
643      Flag n  -> ["-j" ++ maybe "" show n]
644    else []
645
646  --------------------
647  -- Creating libraries
648
649  , [ "-staticlib" | flagBool ghcOptStaticLib ]
650  , [ "-shared"    | flagBool ghcOptShared    ]
651  , case flagToMaybe (ghcOptDynLinkMode opts) of
652      Nothing                  -> []
653      Just GhcStaticOnly       -> ["-static"]
654      Just GhcDynamicOnly      -> ["-dynamic"]
655      Just GhcStaticAndDynamic -> ["-static", "-dynamic-too"]
656  , [ "-fPIC"    | flagBool ghcOptFPic ]
657
658  , concat [ ["-dylib-install-name", libname] | libname <- flag ghcOptDylibName ]
659
660  ------------------------
661  -- Redirecting outputs
662
663  , concat [ ["-osuf",    suf] | suf <- flag ghcOptObjSuffix ]
664  , concat [ ["-hisuf",   suf] | suf <- flag ghcOptHiSuffix  ]
665  , concat [ ["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix ]
666  , concat [ ["-dynhisuf",suf] | suf <- flag ghcOptDynHiSuffix  ]
667  , concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir ]
668  , concat [ ["-odir",    dir] | dir <- flag ghcOptObjDir ]
669  , concat [ ["-hidir",   dir] | dir <- flag ghcOptHiDir  ]
670  , concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir ]
671
672  -----------------------
673  -- Source search path
674
675  , [ "-i"        | flagBool ghcOptSourcePathClear ]
676  , [ "-i" ++ dir | dir <- flags ghcOptSourcePath ]
677
678  --------------------
679
680  --------------------
681  -- CPP, C, and C++ stuff
682
683  , [ "-I"    ++ dir | dir <- flags ghcOptCppIncludePath ]
684  , [ "-optP" ++ opt | opt <- ghcOptCppOptions opts]
685  , concat [ [ "-optP-include", "-optP" ++ inc]
686           | inc <- flags ghcOptCppIncludes ]
687  , [ "-optc" ++ opt | opt <- ghcOptCcOptions opts]
688  , -- C++ compiler options: GHC >= 8.10 requires -optcxx, older requires -optc
689    let cxxflag = case compilerCompatVersion GHC comp of
690                Just v | v >= mkVersion [8, 10] -> "-optcxx"
691                _ -> "-optc"
692    in [ cxxflag ++ opt | opt <- ghcOptCxxOptions opts]
693  , [ "-opta" ++ opt | opt <- ghcOptAsmOptions opts]
694
695  -----------------
696  -- Linker stuff
697
698  , [ "-optl" ++ opt | opt <- ghcOptLinkOptions opts]
699  , ["-l" ++ lib     | lib <- ghcOptLinkLibs opts]
700  , ["-L" ++ dir     | dir <- flags ghcOptLinkLibPath ]
701  , if isOSX
702    then concat [ ["-framework", fmwk]
703                | fmwk <- flags ghcOptLinkFrameworks ]
704    else []
705  , if isOSX
706    then concat [ ["-framework-path", path]
707                | path <- flags ghcOptLinkFrameworkDirs ]
708    else []
709  , [ "-no-hs-main"  | flagBool ghcOptLinkNoHsMain ]
710  , [ "-dynload deploy" | not (null (flags ghcOptRPaths)) ]
711  , concat [ [ "-optl-Wl,-rpath," ++ dir]
712           | dir <- flags ghcOptRPaths ]
713  , [ modDefFile | modDefFile <- flags ghcOptLinkModDefFiles ]
714
715  -------------
716  -- Packages
717
718  , concat [ [ case () of
719                _ | unitIdSupported comp     -> "-this-unit-id"
720                  | packageKeySupported comp -> "-this-package-key"
721                  | otherwise                -> "-package-name"
722             , this_arg ]
723             | this_arg <- flag ghcOptThisUnitId ]
724
725  , concat [ ["-this-component-id", prettyShow this_cid ]
726           | this_cid <- flag ghcOptThisComponentId ]
727
728  , if null (ghcOptInstantiatedWith opts)
729        then []
730        else "-instantiated-with"
731             : intercalate "," (map (\(n,m) -> prettyShow n ++ "="
732                                            ++ prettyShow m)
733                                    (ghcOptInstantiatedWith opts))
734             : []
735
736  , concat [ ["-fno-code", "-fwrite-interface"] | flagBool ghcOptNoCode ]
737
738  , [ "-hide-all-packages"     | flagBool ghcOptHideAllPackages ]
739  , [ "-Wmissing-home-modules" | flagBool ghcOptWarnMissingHomeModules ]
740  , [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ]
741
742  , packageDbArgs implInfo (ghcOptPackageDBs opts)
743
744  , concat $ let space "" = ""
745                 space xs = ' ' : xs
746             in [ ["-package-id", prettyShow ipkgid ++ space (prettyShow rns)]
747                | (ipkgid,rns) <- flags ghcOptPackages ]
748
749  ----------------------------
750  -- Language and extensions
751
752  , if supportsHaskell2010 implInfo
753    then [ "-X" ++ prettyShow lang | lang <- flag ghcOptLanguage ]
754    else []
755
756  , [ ext'
757    | ext  <- flags ghcOptExtensions
758    , ext' <- case Map.lookup ext (ghcOptExtensionMap opts) of
759        Just (Just arg) -> [arg]
760        Just Nothing    -> []
761        Nothing         ->
762            error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
763                  ++ prettyShow ext ++ " not present in ghcOptExtensionMap."
764    ]
765
766  ----------------
767  -- GHCi
768
769  , concat [ [ "-ghci-script", script ] | script <- ghcOptGHCiScripts opts
770                                        , flagGhciScript implInfo ]
771
772  ---------------
773  -- Inputs
774
775  -- Specify the input file(s) first, so that in ghci the `main-is` module is
776  -- in scope instead of the first module defined in `other-modules`.
777  , flags ghcOptInputFiles
778  , [ prettyShow modu | modu <- flags ghcOptInputModules ]
779
780  , concat [ [ "-o",    out] | out <- flag ghcOptOutputFile ]
781  , concat [ [ "-dyno", out] | out <- flag ghcOptOutputDynFile ]
782
783  ---------------
784  -- Extra
785
786  , ghcOptExtra opts
787
788  ]
789
790
791  where
792    implInfo     = getImplInfo comp
793    isOSX        = os == OSX
794    flag     flg = flagToList (flg opts)
795    flags    flg = fromNubListR . flg $ opts
796    flagBool flg = fromFlagOrDefault False (flg opts)
797
798verbosityOpts :: Verbosity -> [String]
799verbosityOpts verbosity
800  | verbosity >= deafening = ["-v"]
801  | verbosity >= normal    = []
802  | otherwise              = ["-w", "-v0"]
803
804
805-- | GHC <7.6 uses '-package-conf' instead of '-package-db'.
806packageDbArgsConf :: PackageDBStack -> [String]
807packageDbArgsConf dbstack = case dbstack of
808  (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
809  (GlobalPackageDB:dbs)               -> ("-no-user-package-conf")
810                                       : concatMap specific dbs
811  _ -> ierror
812  where
813    specific (SpecificPackageDB db) = [ "-package-conf", db ]
814    specific _                      = ierror
815    ierror = error $ "internal error: unexpected package db stack: "
816                  ++ show dbstack
817
818-- | GHC >= 7.6 uses the '-package-db' flag. See
819-- https://gitlab.haskell.org/ghc/ghc/-/issues/5977.
820packageDbArgsDb :: PackageDBStack -> [String]
821-- special cases to make arguments prettier in common scenarios
822packageDbArgsDb dbstack = case dbstack of
823  (GlobalPackageDB:UserPackageDB:dbs)
824    | all isSpecific dbs              -> concatMap single dbs
825  (GlobalPackageDB:dbs)
826    | all isSpecific dbs              -> "-no-user-package-db"
827                                       : concatMap single dbs
828  dbs                                 -> "-clear-package-db"
829                                       : concatMap single dbs
830 where
831   single (SpecificPackageDB db) = [ "-package-db", db ]
832   single GlobalPackageDB        = [ "-global-package-db" ]
833   single UserPackageDB          = [ "-user-package-db" ]
834   isSpecific (SpecificPackageDB _) = True
835   isSpecific _                     = False
836
837packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String]
838packageDbArgs implInfo
839  | flagPackageConf implInfo = packageDbArgsConf
840  | otherwise                = packageDbArgsDb
841
842-- -----------------------------------------------------------------------------
843-- Boilerplate Monoid instance for GhcOptions
844
845instance Monoid GhcOptions where
846  mempty = gmempty
847  mappend = (<>)
848
849instance Semigroup GhcOptions where
850  (<>) = gmappend
851