{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Distribution.Simple.Program.GHC (
    GhcOptions(..),
    GhcMode(..),
    GhcOptimisation(..),
    GhcDynLinkMode(..),
    GhcProfAuto(..),

    ghcInvocation,
    renderGhcOptions,

    runGHC,

    packageDbArgsDb,
    normaliseGhcArgs

  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Backpack
import Distribution.Compat.Semigroup (First'(..), Last'(..), Option'(..))
import Distribution.Simple.GHC.ImplInfo
import Distribution.PackageDescription
import Distribution.ModuleName
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Run
import Distribution.System
import Distribution.Pretty
import Distribution.Types.ComponentId
import Distribution.Verbosity
import Distribution.Version
import Distribution.Utils.NubList
import Language.Haskell.Extension

import Data.List (stripPrefix)
import qualified Data.Map as Map
import Data.Monoid (All(..), Any(..), Endo(..))
import qualified Data.Set as Set

normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
normaliseGhcArgs (Just Version
ghcVersion) PackageDescription{String
[String]
[(String, String)]
[(CompilerFlavor, VersionRange)]
[SymbolicPath PackageDir LicenseFile]
[SourceRepo]
[TestSuite]
[Library]
[ForeignLib]
[Executable]
[Benchmark]
Maybe BuildType
Maybe SetupBuildInfo
Maybe Library
Either License License
ShortText
CabalSpecVersion
PackageIdentifier
testedWith :: PackageDescription -> [(CompilerFlavor, VersionRange)]
testSuites :: PackageDescription -> [TestSuite]
synopsis :: PackageDescription -> ShortText
subLibraries :: PackageDescription -> [Library]
stability :: PackageDescription -> ShortText
specVersion :: PackageDescription -> CabalSpecVersion
sourceRepos :: PackageDescription -> [SourceRepo]
setupBuildInfo :: PackageDescription -> Maybe SetupBuildInfo
pkgUrl :: PackageDescription -> ShortText
package :: PackageDescription -> PackageIdentifier
maintainer :: PackageDescription -> ShortText
licenseRaw :: PackageDescription -> Either License License
licenseFiles :: PackageDescription -> [SymbolicPath PackageDir LicenseFile]
library :: PackageDescription -> Maybe Library
homepage :: PackageDescription -> ShortText
foreignLibs :: PackageDescription -> [ForeignLib]
extraTmpFiles :: PackageDescription -> [String]
extraSrcFiles :: PackageDescription -> [String]
extraDocFiles :: PackageDescription -> [String]
executables :: PackageDescription -> [Executable]
description :: PackageDescription -> ShortText
dataFiles :: PackageDescription -> [String]
dataDir :: PackageDescription -> String
customFieldsPD :: PackageDescription -> [(String, String)]
copyright :: PackageDescription -> ShortText
category :: PackageDescription -> ShortText
buildTypeRaw :: PackageDescription -> Maybe BuildType
bugReports :: PackageDescription -> ShortText
benchmarks :: PackageDescription -> [Benchmark]
author :: PackageDescription -> ShortText
extraDocFiles :: [String]
extraTmpFiles :: [String]
extraSrcFiles :: [String]
dataDir :: String
dataFiles :: [String]
benchmarks :: [Benchmark]
testSuites :: [TestSuite]
foreignLibs :: [ForeignLib]
executables :: [Executable]
subLibraries :: [Library]
library :: Maybe Library
setupBuildInfo :: Maybe SetupBuildInfo
buildTypeRaw :: Maybe BuildType
customFieldsPD :: [(String, String)]
category :: ShortText
description :: ShortText
synopsis :: ShortText
sourceRepos :: [SourceRepo]
bugReports :: ShortText
pkgUrl :: ShortText
homepage :: ShortText
testedWith :: [(CompilerFlavor, VersionRange)]
stability :: ShortText
author :: ShortText
maintainer :: ShortText
copyright :: ShortText
licenseFiles :: [SymbolicPath PackageDir LicenseFile]
licenseRaw :: Either License License
package :: PackageIdentifier
specVersion :: CabalSpecVersion
..} [String]
ghcArgs
   | Version
ghcVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
supportedGHCVersions
   = [String] -> [String]
argumentFilters forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
simpleFilters forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterRtsOpts forall a b. (a -> b) -> a -> b
$ [String]
ghcArgs
  where
    supportedGHCVersions :: VersionRange
    supportedGHCVersions :: VersionRange
supportedGHCVersions = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges
        (Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
8,Int
0]))
        (Version -> VersionRange
earlierVersion ([Int] -> Version
mkVersion [Int
9,Int
1]))

    from :: Monoid m => [Int] -> m -> m
    from :: forall m. Monoid m => [Int] -> m -> m
from [Int]
version m
flags
      | Version
ghcVersion Version -> VersionRange -> Bool
`withinRange` Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int]
version) = m
flags
      | Bool
otherwise = forall a. Monoid a => a
mempty

    to :: Monoid m => [Int] -> m -> m
    to :: forall m. Monoid m => [Int] -> m -> m
to [Int]
version m
flags
      | Version
ghcVersion Version -> VersionRange -> Bool
`withinRange` Version -> VersionRange
earlierVersion ([Int] -> Version
mkVersion [Int]
version) = m
flags
      | Bool
otherwise = forall a. Monoid a => a
mempty

    checkGhcFlags :: forall m . Monoid m => ([String] -> m) -> m
    checkGhcFlags :: forall m. Monoid m => ([String] -> m) -> m
checkGhcFlags [String] -> m
fun = forall a. Monoid a => [a] -> a
mconcat
        [ [String] -> m
fun [String]
ghcArgs
        , forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags Library -> BuildInfo
libBuildInfo [Library]
pkgLibs
        , forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags Executable -> BuildInfo
buildInfo [Executable]
executables
        , forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags TestSuite -> BuildInfo
testBuildInfo [TestSuite]
testSuites
        , forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags Benchmark -> BuildInfo
benchmarkBuildInfo [Benchmark]
benchmarks
        ]
      where
        pkgLibs :: [Library]
pkgLibs = forall a. Maybe a -> [a]
maybeToList Maybe Library
library forall a. [a] -> [a] -> [a]
++ [Library]
subLibraries

        checkComponentFlags :: (a -> BuildInfo) -> [a] -> m
        checkComponentFlags :: forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags a -> BuildInfo
getInfo = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (BuildInfo -> m
checkComponent forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuildInfo
getInfo)
          where
            checkComponent :: BuildInfo -> m
            checkComponent :: BuildInfo -> m
checkComponent = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [String] -> m
fun forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CompilerFlavor, [String])] -> [[String]]
filterGhcOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [(CompilerFlavor, [String])]
allGhcOptions

            allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])]
            allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])]
allGhcOptions = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
                [BuildInfo -> PerCompilerFlavor [String]
options, BuildInfo -> PerCompilerFlavor [String]
profOptions, BuildInfo -> PerCompilerFlavor [String]
sharedOptions, BuildInfo -> PerCompilerFlavor [String]
staticOptions]

            filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]]
            filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]]
filterGhcOptions [(CompilerFlavor, [String])]
l = [[String]
opts | (CompilerFlavor
GHC, [String]
opts) <- [(CompilerFlavor, [String])]
l]

    safeToFilterWarnings :: Bool
    safeToFilterWarnings :: Bool
safeToFilterWarnings = All -> Bool
getAll forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => ([String] -> m) -> m
checkGhcFlags [String] -> All
checkWarnings
      where
        checkWarnings :: [String] -> All
        checkWarnings :: [String] -> All
checkWarnings = Bool -> All
All forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Bool
Set.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Set String -> Set String
alter forall a. Set a
Set.empty

        alter :: String -> Set String -> Set String
        alter :: String -> Set String -> Set String
alter String
flag = forall a. Endo a -> a -> a
appEndo forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
            [ \String
s -> forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ if String
s forall a. Eq a => a -> a -> Bool
== String
"-Werror" then forall a. Ord a => a -> Set a -> Set a
Set.insert String
s else forall a. a -> a
id
            , \String
s -> forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ if String
s forall a. Eq a => a -> a -> Bool
== String
"-Wwarn" then forall a b. a -> b -> a
const forall a. Set a
Set.empty else forall a. a -> a
id
            , \String
s -> forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
6] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$
                    if String
s forall a. Eq a => a -> a -> Bool
== String
"-Werror=compat"
                    then forall a. Ord a => Set a -> Set a -> Set a
Set.union Set String
compatWarningSet else forall a. a -> a
id
            , \String
s -> forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
6] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$
                    if String
s forall a. Eq a => a -> a -> Bool
== String
"-Wno-error=compat"
                    then (forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set String
compatWarningSet) else forall a. a -> a
id
            , \String
s -> forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
6] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$
                    if String
s forall a. Eq a => a -> a -> Bool
== String
"-Wwarn=compat"
                    then (forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set String
compatWarningSet) else forall a. a -> a
id
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
4] forall a b. (a -> b) -> a -> b
$ String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
"-Werror=" forall a. Ord a => a -> Set a -> Set a
Set.insert
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
4] forall a b. (a -> b) -> a -> b
$ String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
"-Wwarn=" forall a. Ord a => a -> Set a -> Set a
Set.delete
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
4] forall a b. (a -> b) -> a -> b
$ String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
"-Wno-error=" forall a. Ord a => a -> Set a -> Set a
Set.delete
            ] String
flag

        markFlag
            :: String
            -> (String -> Set String -> Set String)
            -> String
            -> Endo (Set String)
        markFlag :: String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
name String -> Set String -> Set String
update String
flag = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ case forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
name String
flag of
            Just String
rest | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) Bool -> Bool -> Bool
&& String
rest forall a. Eq a => a -> a -> Bool
/= String
"compat" -> String -> Set String -> Set String
update String
rest
            Maybe String
_ -> forall a. a -> a
id

    flagArgumentFilter :: [String] -> [String] -> [String]
    flagArgumentFilter :: [String] -> [String] -> [String]
flagArgumentFilter [String]
flags = [String] -> [String]
go
      where
        makeFilter :: String -> String -> Option' (First' ([String] -> [String]))
        makeFilter :: String -> String -> Option' (First' ([String] -> [String]))
makeFilter String
flag String
arg = forall a. Maybe a -> Option' a
Option' forall a b. (a -> b) -> a -> b
$ forall a. a -> First' a
First' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. String -> [a] -> [a]
filterRest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
flag String
arg
          where
            filterRest :: String -> [a] -> [a]
filterRest String
leftOver = case String -> String
dropEq String
leftOver of
                [] -> forall a. Int -> [a] -> [a]
drop Int
1
                String
_ -> forall a. a -> a
id

        checkFilter :: String -> Maybe ([String] -> [String])
        checkFilter :: String -> Maybe ([String] -> [String])
checkFilter = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. First' a -> a
getFirst' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Option' a -> Maybe a
getOption' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> String -> Option' (First' ([String] -> [String]))
makeFilter [String]
flags

        go :: [String] -> [String]
        go :: [String] -> [String]
go [] = []
        go (String
arg:[String]
args) = case String -> Maybe ([String] -> [String])
checkFilter String
arg of
            Just [String] -> [String]
f -> [String] -> [String]
go ([String] -> [String]
f [String]
args)
            Maybe ([String] -> [String])
Nothing -> String
arg forall a. a -> [a] -> [a]
: [String] -> [String]
go [String]
args

    argumentFilters :: [String] -> [String]
    argumentFilters :: [String] -> [String]
argumentFilters = [String] -> [String] -> [String]
flagArgumentFilter
        [String
"-ghci-script", String
"-H", String
"-interactive-print"]

    filterRtsOpts :: [String] -> [String]
    filterRtsOpts :: [String] -> [String]
filterRtsOpts = Bool -> [String] -> [String]
go Bool
False
      where
        go :: Bool -> [String] -> [String]
        go :: Bool -> [String] -> [String]
go Bool
_ [] = []
        go Bool
_ (String
"+RTS":[String]
opts) = Bool -> [String] -> [String]
go Bool
True [String]
opts
        go Bool
_ (String
"-RTS":[String]
opts) = Bool -> [String] -> [String]
go Bool
False [String]
opts
        go Bool
isRTSopts (String
opt:[String]
opts) = [String] -> [String]
addOpt forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> [String]
go Bool
isRTSopts [String]
opts
          where
            addOpt :: [String] -> [String]
addOpt | Bool
isRTSopts = forall a. a -> a
id
                   | Bool
otherwise = (String
optforall a. a -> [a] -> [a]
:)

    simpleFilters :: String -> Bool
    simpleFilters :: String -> Bool
simpleFilters = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
      [ Set String -> String -> Any
flagIn Set String
simpleFlags
      , Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"-ddump-"
      , Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"-dsuppress-"
      , Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"-dno-suppress-"
      , Set String -> String -> Any
flagIn forall a b. (a -> b) -> a -> b
$ String -> [String] -> Set String
invertibleFlagSet String
"-" [String
"ignore-dot-ghci"]
      , Set String -> String -> Any
flagIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Set String
invertibleFlagSet String
"-f" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
            [ [ String
"reverse-errors", String
"warn-unused-binds", String
"break-on-error"
              , String
"break-on-exception", String
"print-bind-result"
              , String
"print-bind-contents", String
"print-evld-with-show"
              , String
"implicit-import-qualified", String
"error-spans"
              ]
            , forall m. Monoid m => [Int] -> m -> m
from [Int
7,Int
8]
              [ String
"print-explicit-foralls" -- maybe also earlier, but GHC-7.6 doesn't have --show-options
              , String
"print-explicit-kinds"
              ]
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
0]
              [ String
"print-explicit-coercions"
              , String
"print-explicit-runtime-reps"
              , String
"print-equality-relations"
              , String
"print-unicode-syntax"
              , String
"print-expanded-synonyms"
              , String
"print-potential-instances"
              , String
"print-typechecker-elaboration"
              ]
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
2]
                [ String
"diagnostics-show-caret", String
"local-ghci-history"
                , String
"show-warning-groups", String
"hide-source-paths"
                , String
"show-hole-constraints"
                ]
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
4] [String
"show-loaded-modules"]
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
6] [ String
"ghci-leak-check", String
"no-it" ]
            , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
10]
                [ String
"defer-diagnostics"      -- affects printing of diagnostics
                , String
"keep-going"             -- try harder, the build will still fail if it's erroneous
                , String
"print-axiom-incomps"    -- print more debug info for closed type families
                ]
            ]
      , Set String -> String -> Any
flagIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Set String
invertibleFlagSet String
"-d" forall a b. (a -> b) -> a -> b
$ [ String
"ppr-case-as-let", String
"ppr-ticks" ]
      , String -> Any
isOptIntFlag
      , String -> Any
isIntFlag
      , if Bool
safeToFilterWarnings
           then String -> Any
isWarning forall a. Semigroup a => a -> a -> a
<> (Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-w"forall a. Eq a => a -> a -> Bool
==))
           else forall a. Monoid a => a
mempty
      , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
6] forall a b. (a -> b) -> a -> b
$
        if Bool
safeToFilterHoles
           then String -> Any
isTypedHoleFlag
           else forall a. Monoid a => a
mempty
      ]

    flagIn :: Set String -> String -> Any
    flagIn :: Set String -> String -> Any
flagIn Set String
set String
flag = Bool -> Any
Any forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Bool
Set.member String
flag Set String
set

    isWarning :: String -> Any
    isWarning :: String -> Any
isWarning = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf)
        [String
"-fwarn-", String
"-fno-warn-", String
"-W", String
"-Wno-"]

    simpleFlags :: Set String
    simpleFlags :: Set String
simpleFlags = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
      [ [ String
"-n", String
"-#include", String
"-Rghc-timing", String
"-dstg-stats"
        , String
"-dth-dec-file", String
"-dsource-stats", String
"-dverbose-core2core"
        , String
"-dverbose-stg2stg", String
"-dcore-lint", String
"-dstg-lint", String
"-dcmm-lint"
        , String
"-dasm-lint", String
"-dannot-lint", String
"-dshow-passes", String
"-dfaststring-stats"
        , String
"-fno-max-relevant-binds", String
"-recomp", String
"-no-recomp", String
"-fforce-recomp"
        , String
"-fno-force-recomp"
        ]

      , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
2]
          [ String
"-fno-max-errors", String
"-fdiagnostics-color=auto"
          , String
"-fdiagnostics-color=always", String
"-fdiagnostics-color=never"
          , String
"-dppr-debug", String
"-dno-debug-output"
          ]

      , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
4] [ String
"-ddebug-output" ]
      , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
4] forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => [Int] -> m -> m
to [Int
8,Int
6] [ String
"-fno-max-valid-substitutions" ]
      , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
6] [ String
"-dhex-word-literals" ]
      , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
8] [ String
"-fshow-docs-of-hole-fits", String
"-fno-show-docs-of-hole-fits" ]
      , forall m. Monoid m => [Int] -> m -> m
from [Int
9,Int
0] [ String
"-dlinear-core-lint" ]
      ]

    isOptIntFlag :: String -> Any
    isOptIntFlag :: String -> Any
isOptIntFlag = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> String -> Any
dropIntFlag Bool
True) forall a b. (a -> b) -> a -> b
$ [String
"-v", String
"-j"]

    isIntFlag :: String -> Any
    isIntFlag :: String -> Any
isIntFlag = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> String -> Any
dropIntFlag Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
        [ [ String
"-fmax-relevant-binds", String
"-ddpr-user-length", String
"-ddpr-cols"
          , String
"-dtrace-level", String
"-fghci-hist-size" ]
        , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
2] [String
"-fmax-uncovered-patterns", String
"-fmax-errors"]
        , forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
4] forall a b. (a -> b) -> a -> b
$ forall m. Monoid m => [Int] -> m -> m
to [Int
8,Int
6] [String
"-fmax-valid-substitutions"]
        ]

    dropIntFlag :: Bool -> String -> String -> Any
    dropIntFlag :: Bool -> String -> String -> Any
dropIntFlag Bool
isOpt String
flag String
input = Bool -> Any
Any forall a b. (a -> b) -> a -> b
$ case forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
flag String
input of
        Maybe String
Nothing -> Bool
False
        Just String
rest | Bool
isOpt Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest -> Bool
True
                  | Bool
otherwise -> case String -> Maybe Int
parseInt String
rest of
                        Just Int
_ -> Bool
True
                        Maybe Int
Nothing -> Bool
False
      where
        parseInt :: String -> Maybe Int
        parseInt :: String -> Maybe Int
parseInt = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropEq

    dropEq :: String -> String
    dropEq :: String -> String
dropEq (Char
'=':String
s) = String
s
    dropEq String
s = String
s

    invertibleFlagSet :: String -> [String] -> Set String
    invertibleFlagSet :: String -> [String] -> Set String
invertibleFlagSet String
prefix [String]
flagNames =
      forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
prefix, String
prefix forall a. [a] -> [a] -> [a]
++ String
"no-"] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String]
flagNames

    compatWarningSet :: Set String
    compatWarningSet :: Set String
compatWarningSet = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ forall m. Monoid m => [Int] -> m -> m
from [Int
8,Int
6]
            [ String
"missing-monadfail-instances", String
"semigroup"
            , String
"noncanonical-monoid-instances", String
"implicit-kind-vars" ]
        ]

    safeToFilterHoles :: Bool
    safeToFilterHoles :: Bool
safeToFilterHoles = All -> Bool
getAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Monoid m => ([String] -> m) -> m
checkGhcFlags forall a b. (a -> b) -> a -> b
$
        Bool -> All
All forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Last' a -> a
getLast' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Option' a -> Maybe a
getOption' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> Option' (Last' Bool)
notDeferred
      where
        notDeferred :: String -> Option' (Last' Bool)
        notDeferred :: String -> Option' (Last' Bool)
notDeferred String
"-fdefer-typed-holes" = forall a. Maybe a -> Option' a
Option' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last' a
Last' forall a b. (a -> b) -> a -> b
$ Bool
False
        notDeferred String
"-fno-defer-typed-holes" = forall a. Maybe a -> Option' a
Option' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last' a
Last' forall a b. (a -> b) -> a -> b
$ Bool
True
        notDeferred String
_ = forall a. Maybe a -> Option' a
Option' forall a. Maybe a
Nothing

    isTypedHoleFlag :: String -> Any
    isTypedHoleFlag :: String -> Any
isTypedHoleFlag = forall a. Monoid a => [a] -> a
mconcat
        [ Set String -> String -> Any
flagIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Set String
invertibleFlagSet String
"-f" forall a b. (a -> b) -> a -> b
$
            [ String
"show-hole-constraints", String
"show-valid-substitutions"
            , String
"show-valid-hole-fits", String
"sort-valid-hole-fits"
            , String
"sort-by-size-hole-fits", String
"sort-by-subsumption-hole-fits"
            , String
"abstract-refinement-hole-fits", String
"show-provenance-of-hole-fits"
            , String
"show-hole-matches-of-hole-fits", String
"show-type-of-hole-fits"
            , String
"show-type-app-of-hole-fits", String
"show-type-app-vars-of-hole-fits"
            , String
"unclutter-valid-hole-fits"
            ]
        , Set String -> String -> Any
flagIn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
            [ String
"-fno-max-valid-hole-fits", String
"-fno-max-refinement-hole-fits"
            , String
"-fno-refinement-level-hole-fits" ]
        , forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> String -> Any
dropIntFlag Bool
False) forall a b. (a -> b) -> a -> b
$
            [ String
"-fmax-valid-hole-fits", String
"-fmax-refinement-hole-fits"
            , String
"-frefinement-level-hole-fits" ]
        ]

normaliseGhcArgs Maybe Version
_ PackageDescription
_ [String]
args = [String]
args

-- | A structured set of GHC options/flags
--
-- Note that options containing lists fall into two categories:
--
--  * options that can be safely deduplicated, e.g. input modules or
--    enabled extensions;
--  * options that cannot be deduplicated in general without changing
--    semantics, e.g. extra ghc options or linking options.
data GhcOptions = GhcOptions {

  -- | The major mode for the ghc invocation.
  GhcOptions -> Flag GhcMode
ghcOptMode          :: Flag GhcMode,

  -- | Any extra options to pass directly to ghc. These go at the end and hence
  -- override other stuff.
  GhcOptions -> [String]
ghcOptExtra         :: [String],

  -- | Extra default flags to pass directly to ghc. These go at the beginning
  -- and so can be overridden by other stuff.
  GhcOptions -> [String]
ghcOptExtraDefault  :: [String],

  -----------------------
  -- Inputs and outputs

  -- | The main input files; could be .hs, .hi, .c, .o, depending on mode.
  GhcOptions -> NubListR String
ghcOptInputFiles    :: NubListR FilePath,

  -- | The names of input Haskell modules, mainly for @--make@ mode.
  GhcOptions -> NubListR ModuleName
ghcOptInputModules  :: NubListR ModuleName,

  -- | Location for output file; the @ghc -o@ flag.
  GhcOptions -> Flag String
ghcOptOutputFile    :: Flag FilePath,

  -- | Location for dynamic output file in 'GhcStaticAndDynamic' mode;
  -- the @ghc -dyno@ flag.
  GhcOptions -> Flag String
ghcOptOutputDynFile :: Flag FilePath,

  -- | Start with an empty search path for Haskell source files;
  -- the @ghc -i@ flag (@-i@ on its own with no path argument).
  GhcOptions -> Flag Bool
ghcOptSourcePathClear :: Flag Bool,

  -- | Search path for Haskell source files; the @ghc -i@ flag.
  GhcOptions -> NubListR String
ghcOptSourcePath    :: NubListR FilePath,

  -------------
  -- Packages

  -- | The unit ID the modules will belong to; the @ghc -this-unit-id@
  -- flag (or @-this-package-key@ or @-package-name@ on older
  -- versions of GHC).  This is a 'String' because we assume you've
  -- already figured out what the correct format for this string is
  -- (we need to handle backwards compatibility.)
  GhcOptions -> Flag String
ghcOptThisUnitId   :: Flag String,

  -- | GHC doesn't make any assumptions about the format of
  -- definite unit ids, so when we are instantiating a package it
  -- needs to be told explicitly what the component being instantiated
  -- is.  This only gets set when 'ghcOptInstantiatedWith' is non-empty
  GhcOptions -> Flag ComponentId
ghcOptThisComponentId :: Flag ComponentId,

  -- | How the requirements of the package being compiled are to
  -- be filled.  When typechecking an indefinite package, the 'OpenModule'
  -- is always a 'OpenModuleVar'; otherwise, it specifies the installed module
  -- that instantiates a package.
  GhcOptions -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith :: [(ModuleName, OpenModule)],

  -- | No code? (But we turn on interface writing
  GhcOptions -> Flag Bool
ghcOptNoCode :: Flag Bool,

  -- | GHC package databases to use, the @ghc -package-conf@ flag.
  GhcOptions -> PackageDBStack
ghcOptPackageDBs    :: PackageDBStack,

  -- | The GHC packages to bring into scope when compiling,
  -- the @ghc -package-id@ flags.
  GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages      ::
    NubListR (OpenUnitId, ModuleRenaming),

  -- | Start with a clean package set; the @ghc -hide-all-packages@ flag
  GhcOptions -> Flag Bool
ghcOptHideAllPackages :: Flag Bool,

  -- | Warn about modules, not listed in command line
  GhcOptions -> Flag Bool
ghcOptWarnMissingHomeModules :: Flag Bool,

  -- | Don't automatically link in Haskell98 etc; the @ghc
  -- -no-auto-link-packages@ flag.
  GhcOptions -> Flag Bool
ghcOptNoAutoLinkPackages :: Flag Bool,

  -----------------
  -- Linker stuff

  -- | Names of libraries to link in; the @ghc -l@ flag.
  GhcOptions -> [String]
ghcOptLinkLibs      :: [FilePath],

  -- | Search path for libraries to link in; the @ghc -L@ flag.
  GhcOptions -> NubListR String
ghcOptLinkLibPath  :: NubListR FilePath,

  -- | Options to pass through to the linker; the @ghc -optl@ flag.
  GhcOptions -> [String]
ghcOptLinkOptions   :: [String],

  -- | OSX only: frameworks to link in; the @ghc -framework@ flag.
  GhcOptions -> NubListR String
ghcOptLinkFrameworks :: NubListR String,

  -- | OSX only: Search path for frameworks to link in; the
  -- @ghc -framework-path@ flag.
  GhcOptions -> NubListR String
ghcOptLinkFrameworkDirs :: NubListR String,

  -- | Don't do the link step, useful in make mode; the @ghc -no-link@ flag.
  GhcOptions -> Flag Bool
ghcOptNoLink :: Flag Bool,

  -- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@
  -- flag.
  GhcOptions -> Flag Bool
ghcOptLinkNoHsMain :: Flag Bool,

  -- | Module definition files (Windows specific)
  GhcOptions -> NubListR String
ghcOptLinkModDefFiles :: NubListR FilePath,

  --------------------
  -- C and CPP stuff

  -- | Options to pass through to the C compiler; the @ghc -optc@ flag.
  GhcOptions -> [String]
ghcOptCcOptions     :: [String],

  -- | Options to pass through to the C++ compiler.
  GhcOptions -> [String]
ghcOptCxxOptions     :: [String],

  -- | Options to pass through to the Assembler.
  GhcOptions -> [String]
ghcOptAsmOptions     :: [String],

  -- | Options to pass through to CPP; the @ghc -optP@ flag.
  GhcOptions -> [String]
ghcOptCppOptions    :: [String],

  -- | Search path for CPP includes like header files; the @ghc -I@ flag.
  GhcOptions -> NubListR String
ghcOptCppIncludePath :: NubListR FilePath,

  -- | Extra header files to include at CPP stage; the @ghc -optP-include@ flag.
  GhcOptions -> NubListR String
ghcOptCppIncludes    :: NubListR FilePath,

  -- | Extra header files to include for old-style FFI; the @ghc -#include@ flag.
  GhcOptions -> NubListR String
ghcOptFfiIncludes    :: NubListR FilePath,

  ----------------------------
  -- Language and extensions

  -- | The base language; the @ghc -XHaskell98@ or @-XHaskell2010@ flag.
  GhcOptions -> Flag Language
ghcOptLanguage      :: Flag Language,

  -- | The language extensions; the @ghc -X@ flag.
  GhcOptions -> NubListR Extension
ghcOptExtensions    :: NubListR Extension,

  -- | A GHC version-dependent mapping of extensions to flags. This must be
  -- set to be able to make use of the 'ghcOptExtensions'.
  GhcOptions -> Map Extension (Maybe String)
ghcOptExtensionMap    :: Map Extension (Maybe CompilerFlag),

  ----------------
  -- Compilation

  -- | What optimisation level to use; the @ghc -O@ flag.
  GhcOptions -> Flag GhcOptimisation
ghcOptOptimisation  :: Flag GhcOptimisation,

    -- | Emit debug info; the @ghc -g@ flag.
  GhcOptions -> Flag DebugInfoLevel
ghcOptDebugInfo     :: Flag DebugInfoLevel,

  -- | Compile in profiling mode; the @ghc -prof@ flag.
  GhcOptions -> Flag Bool
ghcOptProfilingMode :: Flag Bool,

  -- | Automatically add profiling cost centers; the @ghc -fprof-auto*@ flags.
  GhcOptions -> Flag GhcProfAuto
ghcOptProfilingAuto :: Flag GhcProfAuto,

  -- | Use the \"split sections\" feature; the @ghc -split-sections@ flag.
  GhcOptions -> Flag Bool
ghcOptSplitSections :: Flag Bool,

  -- | Use the \"split object files\" feature; the @ghc -split-objs@ flag.
  GhcOptions -> Flag Bool
ghcOptSplitObjs     :: Flag Bool,

  -- | Run N jobs simultaneously (if possible).
  GhcOptions -> Flag (Maybe Int)
ghcOptNumJobs       :: Flag (Maybe Int),

  -- | Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags.
  GhcOptions -> Flag String
ghcOptHPCDir        :: Flag FilePath,

  ----------------
  -- GHCi

  -- | Extra GHCi startup scripts; the @-ghci-script@ flag
  GhcOptions -> [String]
ghcOptGHCiScripts    :: [FilePath],

  ------------------------
  -- Redirecting outputs

  GhcOptions -> Flag String
ghcOptHiSuffix      :: Flag String,
  GhcOptions -> Flag String
ghcOptObjSuffix     :: Flag String,
  GhcOptions -> Flag String
ghcOptDynHiSuffix   :: Flag String,   -- ^ only in 'GhcStaticAndDynamic' mode
  GhcOptions -> Flag String
ghcOptDynObjSuffix  :: Flag String,   -- ^ only in 'GhcStaticAndDynamic' mode
  GhcOptions -> Flag String
ghcOptHiDir         :: Flag FilePath,
  GhcOptions -> Flag String
ghcOptObjDir        :: Flag FilePath,
  GhcOptions -> Flag String
ghcOptOutputDir     :: Flag FilePath,
  GhcOptions -> Flag String
ghcOptStubDir       :: Flag FilePath,

  --------------------
  -- Creating libraries

  GhcOptions -> Flag GhcDynLinkMode
ghcOptDynLinkMode   :: Flag GhcDynLinkMode,
  GhcOptions -> Flag Bool
ghcOptStaticLib     :: Flag Bool,
  GhcOptions -> Flag Bool
ghcOptShared        :: Flag Bool,
  GhcOptions -> Flag Bool
ghcOptFPic          :: Flag Bool,
  GhcOptions -> Flag String
ghcOptDylibName     :: Flag String,
  GhcOptions -> NubListR String
ghcOptRPaths        :: NubListR FilePath,

  ---------------
  -- Misc flags

  -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag.
  GhcOptions -> Flag Verbosity
ghcOptVerbosity     :: Flag Verbosity,

  -- | Put the extra folders in the PATH environment variable we invoke
  -- GHC with
  GhcOptions -> NubListR String
ghcOptExtraPath     :: NubListR FilePath,

  -- | Let GHC know that it is Cabal that's calling it.
  -- Modifies some of the GHC error messages.
  GhcOptions -> Flag Bool
ghcOptCabal         :: Flag Bool

} deriving (Int -> GhcOptions -> String -> String
[GhcOptions] -> String -> String
GhcOptions -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GhcOptions] -> String -> String
$cshowList :: [GhcOptions] -> String -> String
show :: GhcOptions -> String
$cshow :: GhcOptions -> String
showsPrec :: Int -> GhcOptions -> String -> String
$cshowsPrec :: Int -> GhcOptions -> String -> String
Show, forall x. Rep GhcOptions x -> GhcOptions
forall x. GhcOptions -> Rep GhcOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GhcOptions x -> GhcOptions
$cfrom :: forall x. GhcOptions -> Rep GhcOptions x
Generic)


data GhcMode = GhcModeCompile     -- ^ @ghc -c@
             | GhcModeLink        -- ^ @ghc@
             | GhcModeMake        -- ^ @ghc --make@
             | GhcModeInteractive -- ^ @ghci@ \/ @ghc --interactive@
             | GhcModeAbiHash     -- ^ @ghc --abi-hash@
--             | GhcModeDepAnalysis -- ^ @ghc -M@
--             | GhcModeEvaluate    -- ^ @ghc -e@
 deriving (Int -> GhcMode -> String -> String
[GhcMode] -> String -> String
GhcMode -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GhcMode] -> String -> String
$cshowList :: [GhcMode] -> String -> String
show :: GhcMode -> String
$cshow :: GhcMode -> String
showsPrec :: Int -> GhcMode -> String -> String
$cshowsPrec :: Int -> GhcMode -> String -> String
Show, GhcMode -> GhcMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcMode -> GhcMode -> Bool
$c/= :: GhcMode -> GhcMode -> Bool
== :: GhcMode -> GhcMode -> Bool
$c== :: GhcMode -> GhcMode -> Bool
Eq)

data GhcOptimisation = GhcNoOptimisation             -- ^ @-O0@
                     | GhcNormalOptimisation         -- ^ @-O@
                     | GhcMaximumOptimisation        -- ^ @-O2@
                     | GhcSpecialOptimisation String -- ^ e.g. @-Odph@
 deriving (Int -> GhcOptimisation -> String -> String
[GhcOptimisation] -> String -> String
GhcOptimisation -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GhcOptimisation] -> String -> String
$cshowList :: [GhcOptimisation] -> String -> String
show :: GhcOptimisation -> String
$cshow :: GhcOptimisation -> String
showsPrec :: Int -> GhcOptimisation -> String -> String
$cshowsPrec :: Int -> GhcOptimisation -> String -> String
Show, GhcOptimisation -> GhcOptimisation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcOptimisation -> GhcOptimisation -> Bool
$c/= :: GhcOptimisation -> GhcOptimisation -> Bool
== :: GhcOptimisation -> GhcOptimisation -> Bool
$c== :: GhcOptimisation -> GhcOptimisation -> Bool
Eq)

data GhcDynLinkMode = GhcStaticOnly       -- ^ @-static@
                    | GhcDynamicOnly      -- ^ @-dynamic@
                    | GhcStaticAndDynamic -- ^ @-static -dynamic-too@
 deriving (Int -> GhcDynLinkMode -> String -> String
[GhcDynLinkMode] -> String -> String
GhcDynLinkMode -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GhcDynLinkMode] -> String -> String
$cshowList :: [GhcDynLinkMode] -> String -> String
show :: GhcDynLinkMode -> String
$cshow :: GhcDynLinkMode -> String
showsPrec :: Int -> GhcDynLinkMode -> String -> String
$cshowsPrec :: Int -> GhcDynLinkMode -> String -> String
Show, GhcDynLinkMode -> GhcDynLinkMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcDynLinkMode -> GhcDynLinkMode -> Bool
$c/= :: GhcDynLinkMode -> GhcDynLinkMode -> Bool
== :: GhcDynLinkMode -> GhcDynLinkMode -> Bool
$c== :: GhcDynLinkMode -> GhcDynLinkMode -> Bool
Eq)

data GhcProfAuto = GhcProfAutoAll       -- ^ @-fprof-auto@
                 | GhcProfAutoToplevel  -- ^ @-fprof-auto-top@
                 | GhcProfAutoExported  -- ^ @-fprof-auto-exported@
 deriving (Int -> GhcProfAuto -> String -> String
[GhcProfAuto] -> String -> String
GhcProfAuto -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GhcProfAuto] -> String -> String
$cshowList :: [GhcProfAuto] -> String -> String
show :: GhcProfAuto -> String
$cshow :: GhcProfAuto -> String
showsPrec :: Int -> GhcProfAuto -> String -> String
$cshowsPrec :: Int -> GhcProfAuto -> String -> String
Show, GhcProfAuto -> GhcProfAuto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcProfAuto -> GhcProfAuto -> Bool
$c/= :: GhcProfAuto -> GhcProfAuto -> Bool
== :: GhcProfAuto -> GhcProfAuto -> Bool
$c== :: GhcProfAuto -> GhcProfAuto -> Bool
Eq)

runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> Platform  -> GhcOptions
       -> IO ()
runGHC :: Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform GhcOptions
opts = do
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
ghcProg Compiler
comp Platform
platform GhcOptions
opts)


ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions
              -> ProgramInvocation
ghcInvocation :: ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
prog Compiler
comp Platform
platform GhcOptions
opts =
    (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog (Compiler -> Platform -> GhcOptions -> [String]
renderGhcOptions Compiler
comp Platform
platform GhcOptions
opts)) {
        progInvokePathEnv :: [String]
progInvokePathEnv = forall a. NubListR a -> [a]
fromNubListR (GhcOptions -> NubListR String
ghcOptExtraPath GhcOptions
opts)
    }

renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
renderGhcOptions Compiler
comp _platform :: Platform
_platform@(Platform Arch
_arch OS
os) GhcOptions
opts
  | Compiler -> CompilerFlavor
compilerFlavor Compiler
comp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CompilerFlavor
GHC, CompilerFlavor
GHCJS] =
    forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Distribution.Simple.Program.GHC.renderGhcOptions: "
    forall a. [a] -> [a] -> [a]
++ String
"compiler flavor must be 'GHC' or 'GHCJS'!"
  | Bool
otherwise =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ case forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag GhcMode
ghcOptMode GhcOptions
opts) of
       Maybe GhcMode
Nothing                 -> []
       Just GhcMode
GhcModeCompile     -> [String
"-c"]
       Just GhcMode
GhcModeLink        -> []
       Just GhcMode
GhcModeMake        -> [String
"--make"]
       Just GhcMode
GhcModeInteractive -> [String
"--interactive"]
       Just GhcMode
GhcModeAbiHash     -> [String
"--abi-hash"]
--     Just GhcModeDepAnalysis -> ["-M"]
--     Just GhcModeEvaluate    -> ["-e", expr]

  , GhcOptions -> [String]
ghcOptExtraDefault GhcOptions
opts

  , [ String
"-no-link" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoLink ]

  ---------------
  -- Misc flags

  , forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Verbosity -> [String]
verbosityOpts (forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag Verbosity
ghcOptVerbosity GhcOptions
opts))

  , [ String
"-fbuilding-cabal-package" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptCabal ]

  ----------------
  -- Compilation

  , case forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag GhcOptimisation
ghcOptOptimisation GhcOptions
opts) of
      Maybe GhcOptimisation
Nothing                         -> []
      Just GhcOptimisation
GhcNoOptimisation          -> [String
"-O0"]
      Just GhcOptimisation
GhcNormalOptimisation      -> [String
"-O"]
      Just GhcOptimisation
GhcMaximumOptimisation     -> [String
"-O2"]
      Just (GhcSpecialOptimisation String
s) -> [String
"-O" forall a. [a] -> [a] -> [a]
++ String
s] -- eg -Odph

  , case forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag DebugInfoLevel
ghcOptDebugInfo GhcOptions
opts) of
      Maybe DebugInfoLevel
Nothing                                -> []
      Just DebugInfoLevel
NoDebugInfo                       -> []
      Just DebugInfoLevel
MinimalDebugInfo                  -> [String
"-g1"]
      Just DebugInfoLevel
NormalDebugInfo                   -> [String
"-g2"]
      Just DebugInfoLevel
MaximalDebugInfo                  -> [String
"-g3"]

  , [ String
"-prof" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptProfilingMode ]

  , case forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag GhcProfAuto
ghcOptProfilingAuto GhcOptions
opts) of
      Maybe GhcProfAuto
_ | Bool -> Bool
not ((GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptProfilingMode)
                                -> []
      Maybe GhcProfAuto
Nothing                   -> []
      Just GhcProfAuto
GhcProfAutoAll
        | GhcImplInfo -> Bool
flagProfAuto GhcImplInfo
implInfo -> [String
"-fprof-auto"]
        | Bool
otherwise             -> [String
"-auto-all"] -- not the same, but close
      Just GhcProfAuto
GhcProfAutoToplevel
        | GhcImplInfo -> Bool
flagProfAuto GhcImplInfo
implInfo -> [String
"-fprof-auto-top"]
        | Bool
otherwise             -> [String
"-auto-all"]
      Just GhcProfAuto
GhcProfAutoExported
        | GhcImplInfo -> Bool
flagProfAuto GhcImplInfo
implInfo -> [String
"-fprof-auto-exported"]
        | Bool
otherwise             -> [String
"-auto"]

  , [ String
"-split-sections" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSplitSections ]
  , [ String
"-split-objs" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSplitObjs ]

  , case forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag String
ghcOptHPCDir GhcOptions
opts) of
      Maybe String
Nothing -> []
      Just String
hpcdir -> [String
"-fhpc", String
"-hpcdir", String
hpcdir]

  , if Compiler -> Bool
parmakeSupported Compiler
comp
    then case GhcOptions -> Flag (Maybe Int)
ghcOptNumJobs GhcOptions
opts of
      Flag (Maybe Int)
NoFlag  -> []
      Flag Maybe Int
n  -> [String
"-j" forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Show a => a -> String
show Maybe Int
n]
    else []

  --------------------
  -- Creating libraries

  , [ String
"-staticlib" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptStaticLib ]
  , [ String
"-shared"    | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptShared    ]
  , case forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag GhcDynLinkMode
ghcOptDynLinkMode GhcOptions
opts) of
      Maybe GhcDynLinkMode
Nothing                  -> []
      Just GhcDynLinkMode
GhcStaticOnly       -> [String
"-static"]
      Just GhcDynLinkMode
GhcDynamicOnly      -> [String
"-dynamic"]
      Just GhcDynLinkMode
GhcStaticAndDynamic -> [String
"-static", String
"-dynamic-too"]
  , [ String
"-fPIC"    | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptFPic ]

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-dylib-install-name", String
libname] | String
libname <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptDylibName ]

  ------------------------
  -- Redirecting outputs

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-osuf",    String
suf] | String
suf <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptObjSuffix ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-hisuf",   String
suf] | String
suf <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptHiSuffix  ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-dynosuf", String
suf] | String
suf <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptDynObjSuffix ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-dynhisuf",String
suf] | String
suf <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptDynHiSuffix  ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-outputdir", String
dir] | String
dir <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptOutputDir ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-odir",    String
dir] | String
dir <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptObjDir ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-hidir",   String
dir] | String
dir <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptHiDir  ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-stubdir", String
dir] | String
dir <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptStubDir ]

  -----------------------
  -- Source search path

  , [ String
"-i"        | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSourcePathClear ]
  , [ String
"-i" forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptSourcePath ]

  --------------------

  --------------------
  -- CPP, C, and C++ stuff

  , [ String
"-I"    forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptCppIncludePath ]
  , [ String
"-optP" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptCppOptions GhcOptions
opts]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ String
"-optP-include", String
"-optP" forall a. [a] -> [a] -> [a]
++ String
inc]
           | String
inc <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptCppIncludes ]
  , [ String
"-optc" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptCcOptions GhcOptions
opts]
  , -- C++ compiler options: GHC >= 8.10 requires -optcxx, older requires -optc
    let cxxflag :: String
cxxflag = case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
comp of
                Just Version
v | Version
v forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
10] -> String
"-optcxx"
                Maybe Version
_ -> String
"-optc"
    in [ String
cxxflag forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptCxxOptions GhcOptions
opts]
  , [ String
"-opta" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptAsmOptions GhcOptions
opts]

  -----------------
  -- Linker stuff

  , [ String
"-optl" forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptLinkOptions GhcOptions
opts]
  , [String
"-l" forall a. [a] -> [a] -> [a]
++ String
lib     | String
lib <- GhcOptions -> [String]
ghcOptLinkLibs GhcOptions
opts]
  , [String
"-L" forall a. [a] -> [a] -> [a]
++ String
dir     | String
dir <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkLibPath ]
  , if Bool
isOSX
    then forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-framework", String
fmwk]
                | String
fmwk <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkFrameworks ]
    else []
  , if Bool
isOSX
    then forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-framework-path", String
path]
                | String
path <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkFrameworkDirs ]
    else []
  , [ String
"-no-hs-main"  | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptLinkNoHsMain ]
  , [ String
"-dynload deploy" | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptRPaths)) ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ String
"-optl-Wl,-rpath," forall a. [a] -> [a] -> [a]
++ String
dir]
           | String
dir <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptRPaths ]
  , [ String
modDefFile | String
modDefFile <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkModDefFiles ]

  -------------
  -- Packages

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ case () of
                ()
_ | Compiler -> Bool
unitIdSupported Compiler
comp     -> String
"-this-unit-id"
                  | Compiler -> Bool
packageKeySupported Compiler
comp -> String
"-this-package-key"
                  | Bool
otherwise                -> String
"-package-name"
             , String
this_arg ]
             | String
this_arg <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptThisUnitId ]

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-this-component-id", forall a. Pretty a => a -> String
prettyShow ComponentId
this_cid ]
           | ComponentId
this_cid <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag ComponentId
ghcOptThisComponentId ]

  , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GhcOptions -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith GhcOptions
opts)
        then []
        else String
"-instantiated-with"
             forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
n,OpenModule
m) -> forall a. Pretty a => a -> String
prettyShow ModuleName
n forall a. [a] -> [a] -> [a]
++ String
"="
                                            forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow OpenModule
m)
                                    (GhcOptions -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith GhcOptions
opts))
             forall a. a -> [a] -> [a]
: []

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-fno-code", String
"-fwrite-interface"] | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoCode ]

  , [ String
"-hide-all-packages"     | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptHideAllPackages ]
  , [ String
"-Wmissing-home-modules" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptWarnMissingHomeModules ]
  , [ String
"-no-auto-link-packages" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoAutoLinkPackages ]

  , GhcImplInfo -> PackageDBStack -> [String]
packageDbArgs GhcImplInfo
implInfo (GhcOptions -> PackageDBStack
ghcOptPackageDBs GhcOptions
opts)

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ let space :: String -> String
space String
"" = String
""
                 space String
xs = Char
' ' forall a. a -> [a] -> [a]
: String
xs
             in [ [String
"-package-id", forall a. Pretty a => a -> String
prettyShow OpenUnitId
ipkgid forall a. [a] -> [a] -> [a]
++ String -> String
space (forall a. Pretty a => a -> String
prettyShow ModuleRenaming
rns)]
                | (OpenUnitId
ipkgid,ModuleRenaming
rns) <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages ]

  ----------------------------
  -- Language and extensions

  , if GhcImplInfo -> Bool
supportsHaskell2010 GhcImplInfo
implInfo
    then [ String
"-X" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Language
lang | Language
lang <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag Language
ghcOptLanguage ]
    else []

  , [ String
ext'
    | Extension
ext  <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR Extension
ghcOptExtensions
    , String
ext' <- case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Extension
ext (GhcOptions -> Map Extension (Maybe String)
ghcOptExtensionMap GhcOptions
opts) of
        Just (Just String
arg) -> [String
arg]
        Just Maybe String
Nothing    -> []
        Maybe (Maybe String)
Nothing         ->
            forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Distribution.Simple.Program.GHC.renderGhcOptions: "
                  forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Extension
ext forall a. [a] -> [a] -> [a]
++ String
" not present in ghcOptExtensionMap."
    ]

  ----------------
  -- GHCi

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ String
"-ghci-script", String
script ] | String
script <- GhcOptions -> [String]
ghcOptGHCiScripts GhcOptions
opts
                                        , GhcImplInfo -> Bool
flagGhciScript GhcImplInfo
implInfo ]

  ---------------
  -- Inputs

  -- Specify the input file(s) first, so that in ghci the `main-is` module is
  -- in scope instead of the first module defined in `other-modules`.
  , forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptInputFiles
  , [ forall a. Pretty a => a -> String
prettyShow ModuleName
modu | ModuleName
modu <- forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR ModuleName
ghcOptInputModules ]

  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ String
"-o",    String
out] | String
out <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptOutputFile ]
  , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ String
"-dyno", String
out] | String
out <- forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptOutputDynFile ]

  ---------------
  -- Extra

  , GhcOptions -> [String]
ghcOptExtra GhcOptions
opts

  ]


  where
    implInfo :: GhcImplInfo
implInfo     = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
    isOSX :: Bool
isOSX        = OS
os forall a. Eq a => a -> a -> Bool
== OS
OSX
    flag :: (GhcOptions -> Flag a) -> [a]
flag     GhcOptions -> Flag a
flg = forall a. Flag a -> [a]
flagToList (GhcOptions -> Flag a
flg GhcOptions
opts)
    flags :: (GhcOptions -> NubListR a) -> [a]
flags    GhcOptions -> NubListR a
flg = forall a. NubListR a -> [a]
fromNubListR forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcOptions -> NubListR a
flg forall a b. (a -> b) -> a -> b
$ GhcOptions
opts
    flagBool :: (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
flg = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (GhcOptions -> Flag Bool
flg GhcOptions
opts)

verbosityOpts :: Verbosity -> [String]
verbosityOpts :: Verbosity -> [String]
verbosityOpts Verbosity
verbosity
  | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening = [String
"-v"]
  | Verbosity
verbosity forall a. Ord a => a -> a -> Bool
>= Verbosity
normal    = []
  | Bool
otherwise              = [String
"-w", String
"-v0"]


-- | GHC <7.6 uses '-package-conf' instead of '-package-db'.
packageDbArgsConf :: PackageDBStack -> [String]
packageDbArgsConf :: PackageDBStack -> [String]
packageDbArgsConf PackageDBStack
dbstack = case PackageDBStack
dbstack of
  (PackageDB
GlobalPackageDB:PackageDB
UserPackageDB:PackageDBStack
dbs) -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
specific PackageDBStack
dbs
  (PackageDB
GlobalPackageDB:PackageDBStack
dbs)               -> (String
"-no-user-package-conf")
                                       forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
specific PackageDBStack
dbs
  PackageDBStack
_ -> forall {a}. a
ierror
  where
    specific :: PackageDB -> [String]
specific (SpecificPackageDB String
db) = [ String
"-package-conf", String
db ]
    specific PackageDB
_                      = forall {a}. a
ierror
    ierror :: a
ierror = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"internal error: unexpected package db stack: "
                  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PackageDBStack
dbstack

-- | GHC >= 7.6 uses the '-package-db' flag. See
-- https://gitlab.haskell.org/ghc/ghc/-/issues/5977.
packageDbArgsDb :: PackageDBStack -> [String]
-- special cases to make arguments prettier in common scenarios
packageDbArgsDb :: PackageDBStack -> [String]
packageDbArgsDb PackageDBStack
dbstack = case PackageDBStack
dbstack of
  (PackageDB
GlobalPackageDB:PackageDB
UserPackageDB:PackageDBStack
dbs)
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDB -> Bool
isSpecific PackageDBStack
dbs              -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single PackageDBStack
dbs
  (PackageDB
GlobalPackageDB:PackageDBStack
dbs)
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDB -> Bool
isSpecific PackageDBStack
dbs              -> String
"-no-user-package-db"
                                       forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single PackageDBStack
dbs
  PackageDBStack
dbs                                 -> String
"-clear-package-db"
                                       forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single PackageDBStack
dbs
 where
   single :: PackageDB -> [String]
single (SpecificPackageDB String
db) = [ String
"-package-db", String
db ]
   single PackageDB
GlobalPackageDB        = [ String
"-global-package-db" ]
   single PackageDB
UserPackageDB          = [ String
"-user-package-db" ]
   isSpecific :: PackageDB -> Bool
isSpecific (SpecificPackageDB String
_) = Bool
True
   isSpecific PackageDB
_                     = Bool
False

packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String]
packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String]
packageDbArgs GhcImplInfo
implInfo
  | GhcImplInfo -> Bool
flagPackageConf GhcImplInfo
implInfo = PackageDBStack -> [String]
packageDbArgsConf
  | Bool
otherwise                = PackageDBStack -> [String]
packageDbArgsDb

-- -----------------------------------------------------------------------------
-- Boilerplate Monoid instance for GhcOptions

instance Monoid GhcOptions where
  mempty :: GhcOptions
mempty = forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: GhcOptions -> GhcOptions -> GhcOptions
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup GhcOptions where
  <> :: GhcOptions -> GhcOptions -> GhcOptions
(<>) = forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend