{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Distribution.Simple.Program.GHC
  ( GhcOptions (..)
  , GhcMode (..)
  , GhcOptimisation (..)
  , GhcDynLinkMode (..)
  , GhcObjectMode (..)
  , GhcProfAuto (..)
  , ghcInvocation
  , renderGhcOptions
  , runGHC
  , runGHCWithResponseFile
  , runReplProgram
  , packageDbArgsDb
  , normaliseGhcArgs
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Data.Semigroup (First (..), Last (..))
import Distribution.Backpack
import Distribution.ModuleName
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.GHC.ImplInfo
import Distribution.Simple.Program.Find (getExtraPathEnv)
import Distribution.Simple.Program.ResponseFile
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils (TempFileOptions, infoNoWrap)
import Distribution.System
import Distribution.Types.ComponentId
import Distribution.Types.ParStrat
import Distribution.Utils.NubList
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version

import GHC.IO.Encoding (TextEncoding)
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
import qualified System.Process as Process

normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
normaliseGhcArgs :: Maybe Version -> PackageDescription -> [[Char]] -> [[Char]]
normaliseGhcArgs (Just Version
ghcVersion) PackageDescription{[([Char], [Char])]
[(CompilerFlavor, VersionRange)]
[SourceRepo]
[RelativePath DataDir 'File]
[RelativePath Pkg 'File]
[TestSuite]
[Library]
[ForeignLib]
[Executable]
[Benchmark]
Maybe BuildType
Maybe SetupBuildInfo
Maybe Library
Either License License
CabalSpecVersion
SymbolicPath Pkg ('Dir DataDir)
PackageIdentifier
ShortText
specVersion :: CabalSpecVersion
package :: PackageIdentifier
licenseRaw :: Either License License
licenseFiles :: [RelativePath Pkg 'File]
copyright :: ShortText
maintainer :: ShortText
author :: ShortText
stability :: ShortText
testedWith :: [(CompilerFlavor, VersionRange)]
homepage :: ShortText
pkgUrl :: ShortText
bugReports :: ShortText
sourceRepos :: [SourceRepo]
synopsis :: ShortText
description :: ShortText
category :: ShortText
customFieldsPD :: [([Char], [Char])]
buildTypeRaw :: Maybe BuildType
setupBuildInfo :: Maybe SetupBuildInfo
library :: Maybe Library
subLibraries :: [Library]
executables :: [Executable]
foreignLibs :: [ForeignLib]
testSuites :: [TestSuite]
benchmarks :: [Benchmark]
dataFiles :: [RelativePath DataDir 'File]
dataDir :: SymbolicPath Pkg ('Dir DataDir)
extraSrcFiles :: [RelativePath Pkg 'File]
extraTmpFiles :: [RelativePath Pkg 'File]
extraDocFiles :: [RelativePath Pkg 'File]
extraFiles :: [RelativePath Pkg 'File]
extraFiles :: PackageDescription -> [RelativePath Pkg 'File]
extraDocFiles :: PackageDescription -> [RelativePath Pkg 'File]
extraTmpFiles :: PackageDescription -> [RelativePath Pkg 'File]
extraSrcFiles :: PackageDescription -> [RelativePath Pkg 'File]
dataDir :: PackageDescription -> SymbolicPath Pkg ('Dir DataDir)
dataFiles :: PackageDescription -> [RelativePath DataDir 'File]
benchmarks :: PackageDescription -> [Benchmark]
testSuites :: PackageDescription -> [TestSuite]
foreignLibs :: PackageDescription -> [ForeignLib]
executables :: PackageDescription -> [Executable]
subLibraries :: PackageDescription -> [Library]
library :: PackageDescription -> Maybe Library
setupBuildInfo :: PackageDescription -> Maybe SetupBuildInfo
buildTypeRaw :: PackageDescription -> Maybe BuildType
customFieldsPD :: PackageDescription -> [([Char], [Char])]
category :: PackageDescription -> ShortText
description :: PackageDescription -> ShortText
synopsis :: PackageDescription -> ShortText
sourceRepos :: PackageDescription -> [SourceRepo]
bugReports :: PackageDescription -> ShortText
pkgUrl :: PackageDescription -> ShortText
homepage :: PackageDescription -> ShortText
testedWith :: PackageDescription -> [(CompilerFlavor, VersionRange)]
stability :: PackageDescription -> ShortText
author :: PackageDescription -> ShortText
maintainer :: PackageDescription -> ShortText
copyright :: PackageDescription -> ShortText
licenseFiles :: PackageDescription -> [RelativePath Pkg 'File]
licenseRaw :: PackageDescription -> Either License License
package :: PackageDescription -> PackageIdentifier
specVersion :: PackageDescription -> CabalSpecVersion
..} [[Char]]
ghcArgs
  | Version
ghcVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
supportedGHCVersions =
      [[Char]] -> [[Char]]
argumentFilters ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
simpleFilters ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
filterRtsArgs ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
ghcArgs
  where
    supportedGHCVersions :: VersionRange
    supportedGHCVersions :: VersionRange
supportedGHCVersions = Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
8, Int
0])
    -- we (weakly) support unknown future GHC versions for the purpose
    -- of filtering GHC arguments

    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 = m
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 = m
forall a. Monoid a => a
mempty

    checkGhcFlags :: forall m. Monoid m => ([String] -> m) -> m
    checkGhcFlags :: forall m. Monoid m => ([[Char]] -> m) -> m
checkGhcFlags [[Char]] -> m
fun =
      [m] -> m
forall a. Monoid a => [a] -> a
mconcat
        [ [[Char]] -> m
fun [[Char]]
ghcArgs
        , (Library -> BuildInfo) -> [Library] -> m
forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags Library -> BuildInfo
libBuildInfo [Library]
pkgLibs
        , (Executable -> BuildInfo) -> [Executable] -> m
forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags Executable -> BuildInfo
buildInfo [Executable]
executables
        , (TestSuite -> BuildInfo) -> [TestSuite] -> m
forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags TestSuite -> BuildInfo
testBuildInfo [TestSuite]
testSuites
        , (Benchmark -> BuildInfo) -> [Benchmark] -> m
forall a. (a -> BuildInfo) -> [a] -> m
checkComponentFlags Benchmark -> BuildInfo
benchmarkBuildInfo [Benchmark]
benchmarks
        ]
      where
        pkgLibs :: [Library]
pkgLibs = Maybe Library -> [Library]
forall a. Maybe a -> [a]
maybeToList Maybe Library
library [Library] -> [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 = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (BuildInfo -> m
checkComponent (BuildInfo -> m) -> (a -> BuildInfo) -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuildInfo
getInfo)
          where
            checkComponent :: BuildInfo -> m
            checkComponent :: BuildInfo -> m
checkComponent = ([[Char]] -> m) -> [[[Char]]] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [[Char]] -> m
fun ([[[Char]]] -> m) -> (BuildInfo -> [[[Char]]]) -> BuildInfo -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CompilerFlavor, [[Char]])] -> [[[Char]]]
filterGhcOptions ([(CompilerFlavor, [[Char]])] -> [[[Char]]])
-> (BuildInfo -> [(CompilerFlavor, [[Char]])])
-> BuildInfo
-> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [(CompilerFlavor, [[Char]])]
allGhcOptions

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

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

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

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

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

    flagArgumentFilter :: [String] -> [String] -> [String]
    flagArgumentFilter :: [[Char]] -> [[Char]] -> [[Char]]
flagArgumentFilter [[Char]]
flags = [[Char]] -> [[Char]]
go
      where
        makeFilter :: String -> String -> Maybe (First ([String] -> [String]))
        makeFilter :: [Char] -> [Char] -> Maybe (First ([[Char]] -> [[Char]]))
makeFilter [Char]
flag [Char]
arg = ([[Char]] -> [[Char]]) -> First ([[Char]] -> [[Char]])
([[Char]] -> [[Char]]) -> First ([[Char]] -> [[Char]])
forall a. a -> First a
First (([[Char]] -> [[Char]]) -> First ([[Char]] -> [[Char]]))
-> ([Char] -> [[Char]] -> [[Char]])
-> [Char]
-> First ([[Char]] -> [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
filterRest ([Char] -> First ([[Char]] -> [[Char]]))
-> Maybe [Char] -> Maybe (First ([[Char]] -> [[Char]]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
flag [Char]
arg
          where
            -- Drop the next argument, whether it comes after a `=` or
            -- is stand-alone.
            filterRest :: String -> [String] -> [String]
            filterRest :: [Char] -> [[Char]] -> [[Char]]
filterRest [Char]
leftOver = case [Char] -> [Char]
dropEq [Char]
leftOver of
              [] -> Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1
              [Char]
_ -> [[Char]] -> [[Char]]
forall a. a -> a
id

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

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

    -- Options that take parameters and do not modify the generated artifacts
    -- are filtered out.
    argumentFilters :: [String] -> [String]
    argumentFilters :: [[Char]] -> [[Char]]
argumentFilters =
      [[Char]] -> [[Char]] -> [[Char]]
flagArgumentFilter
        [ [Char]
"-ghci-script"
        , [Char]
"-H"
        , [Char]
"-interactive-print"
        , [Char]
"-fghci-browser-assets-dir"
        ]

    -- \| Remove RTS arguments from a list.
    filterRtsArgs :: [String] -> [String]
    filterRtsArgs :: [[Char]] -> [[Char]]
filterRtsArgs = ([[Char]], [[Char]]) -> [[Char]]
forall a b. (a, b) -> b
snd (([[Char]], [[Char]]) -> [[Char]])
-> ([[Char]] -> ([[Char]], [[Char]])) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> ([[Char]], [[Char]])
splitRTSArgs

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

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

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

    simpleFlags :: Set String
    simpleFlags :: Set [Char]
simpleFlags =
      [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char])
-> ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> Set [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat ([[[Char]]] -> Set [Char]) -> [[[Char]]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$
        [
          [ [Char]
"-n"
          , [Char]
"-#include"
          , [Char]
"-Rghc-timing"
          , [Char]
"-dstg-stats"
          , [Char]
"-dth-dec-file"
          , [Char]
"-dsource-stats"
          , [Char]
"-dverbose-core2core"
          , [Char]
"-dverbose-stg2stg"
          , [Char]
"-dcore-lint"
          , [Char]
"-dstg-lint"
          , [Char]
"-dcmm-lint"
          , [Char]
"-dasm-lint"
          , [Char]
"-dannot-lint"
          , [Char]
"-dshow-passes"
          , [Char]
"-dfaststring-stats"
          , [Char]
"-fno-max-relevant-binds"
          , [Char]
"-recomp"
          , [Char]
"-no-recomp"
          , [Char]
"-fforce-recomp"
          , [Char]
"-fno-force-recomp"
          ]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from
            [Int
8, Int
2]
            [ [Char]
"-fno-max-errors"
            , [Char]
"-fdiagnostics-color=auto"
            , [Char]
"-fdiagnostics-color=always"
            , [Char]
"-fdiagnostics-color=never"
            , [Char]
"-dppr-debug"
            , [Char]
"-dno-debug-output"
            ]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] [[Char]
"-ddebug-output"]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
to [Int
8, Int
6] [[Char]
"-fno-max-valid-substitutions"]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
6] [[Char]
"-dhex-word-literals"]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
8] [[Char]
"-fshow-docs-of-hole-fits", [Char]
"-fno-show-docs-of-hole-fits"]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
9, Int
0] [[Char]
"-dlinear-core-lint"]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
9, Int
10] [[Char]
"-dipe-stats"]
        ]

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

    isIntFlag :: String -> Any
    isIntFlag :: [Char] -> Any
isIntFlag =
      [[Char] -> Any] -> [Char] -> Any
forall a. Monoid a => [a] -> a
mconcat ([[Char] -> Any] -> [Char] -> Any)
-> ([[[Char]]] -> [[Char] -> Any]) -> [[[Char]]] -> [Char] -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> Any) -> [[Char]] -> [[Char] -> Any]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Char] -> [Char] -> Any
dropIntFlag Bool
False) ([[Char]] -> [[Char] -> Any])
-> ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char] -> Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat ([[[Char]]] -> [Char] -> Any) -> [[[Char]]] -> [Char] -> Any
forall a b. (a -> b) -> a -> b
$
        [
          [ [Char]
"-fmax-relevant-binds"
          , [Char]
"-ddpr-user-length"
          , [Char]
"-ddpr-cols"
          , [Char]
"-dtrace-level"
          , [Char]
"-fghci-hist-size"
          , [Char]
"-dinitial-unique"
          , [Char]
"-dunique-increment"
          ]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
2] [[Char]
"-fmax-uncovered-patterns", [Char]
"-fmax-errors"]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
to [Int
8, Int
6] [[Char]
"-fmax-valid-substitutions"]
        , [Int] -> [[Char]] -> [[Char]]
forall m. Monoid m => [Int] -> m -> m
from [Int
9, Int
12] [[Char]
"-fmax-forced-spec-args", [Char]
"-fwrite-if-compression"]
        ]

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

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

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

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

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

    isTypedHoleFlag :: String -> Any
    isTypedHoleFlag :: [Char] -> Any
isTypedHoleFlag =
      [[Char] -> Any] -> [Char] -> Any
forall a. Monoid a => [a] -> a
mconcat
        [ Set [Char] -> [Char] -> Any
flagIn (Set [Char] -> [Char] -> Any)
-> ([[Char]] -> Set [Char]) -> [[Char]] -> [Char] -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> Set [Char]
invertibleFlagSet [Char]
"-f" ([[Char]] -> [Char] -> Any) -> [[Char]] -> [Char] -> Any
forall a b. (a -> b) -> a -> b
$
            [ [Char]
"show-hole-constraints"
            , [Char]
"show-valid-substitutions"
            , [Char]
"show-valid-hole-fits"
            , [Char]
"sort-valid-hole-fits"
            , [Char]
"sort-by-size-hole-fits"
            , [Char]
"sort-by-subsumption-hole-fits"
            , [Char]
"abstract-refinement-hole-fits"
            , [Char]
"show-provenance-of-hole-fits"
            , [Char]
"show-hole-matches-of-hole-fits"
            , [Char]
"show-type-of-hole-fits"
            , [Char]
"show-type-app-of-hole-fits"
            , [Char]
"show-type-app-vars-of-hole-fits"
            , [Char]
"unclutter-valid-hole-fits"
            ]
        , Set [Char] -> [Char] -> Any
flagIn (Set [Char] -> [Char] -> Any)
-> ([[Char]] -> Set [Char]) -> [[Char]] -> [Char] -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> [Char] -> Any) -> [[Char]] -> [Char] -> Any
forall a b. (a -> b) -> a -> b
$
            [ [Char]
"-fno-max-valid-hole-fits"
            , [Char]
"-fno-max-refinement-hole-fits"
            , [Char]
"-fno-refinement-level-hole-fits"
            ]
        , [[Char] -> Any] -> [Char] -> Any
forall a. Monoid a => [a] -> a
mconcat ([[Char] -> Any] -> [Char] -> Any)
-> ([[Char]] -> [[Char] -> Any]) -> [[Char]] -> [Char] -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> Any) -> [[Char]] -> [[Char] -> Any]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Char] -> [Char] -> Any
dropIntFlag Bool
False) ([[Char]] -> [Char] -> Any) -> [[Char]] -> [Char] -> Any
forall a b. (a -> b) -> a -> b
$
            [ [Char]
"-fmax-valid-hole-fits"
            , [Char]
"-fmax-refinement-hole-fits"
            , [Char]
"-frefinement-level-hole-fits"
            ]
        ]
normaliseGhcArgs Maybe Version
_ PackageDescription
_ [[Char]]
args = [[Char]]
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
  { GhcOptions -> Flag GhcMode
ghcOptMode :: Flag GhcMode
  -- ^ The major mode for the ghc invocation.
  , GhcOptions -> [[Char]]
ghcOptExtra :: [String]
  -- ^ Any extra options to pass directly to ghc. These go at the end and hence
  -- override other stuff.
  , GhcOptions -> [[Char]]
ghcOptExtraDefault :: [String]
  -- ^ Extra default flags to pass directly to ghc. These go at the beginning
  -- and so can be overridden by other stuff.
  , -----------------------
    -- Inputs and outputs

    GhcOptions -> NubListR (SymbolicPath Pkg 'File)
ghcOptInputFiles :: NubListR (SymbolicPath Pkg File)
  -- ^ The main input files; could be .hs, .hi, .c, .o, depending on mode.
  , GhcOptions -> NubListR (SymbolicPath Pkg 'File)
ghcOptInputScripts :: NubListR (SymbolicPath Pkg File)
  -- ^ Script files with irregular extensions that need -x hs.
  , GhcOptions -> NubListR ModuleName
ghcOptInputModules :: NubListR ModuleName
  -- ^ The names of input Haskell modules, mainly for @--make@ mode.
  , GhcOptions -> Flag (SymbolicPath Pkg 'File)
ghcOptOutputFile :: Flag (SymbolicPath Pkg File)
  -- ^ Location for output file; the @ghc -o@ flag.
  , GhcOptions -> Flag [Char]
ghcOptOutputDynFile :: Flag FilePath
  -- ^ Location for dynamic output file in 'GhcStaticAndDynamic' mode;
  -- the @ghc -dyno@ flag.
  , GhcOptions -> Flag Bool
ghcOptSourcePathClear :: Flag Bool
  -- ^ Start with an empty search path for Haskell source files;
  -- the @ghc -i@ flag (@-i@ on its own with no path argument).
  , GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Source))
ghcOptSourcePath :: NubListR (SymbolicPath Pkg (Dir Source))
  -- ^ Search path for Haskell source files; the @ghc -i@ flag.
  , GhcOptions -> [[Char]]
ghcOptUnitFiles :: [FilePath]
  -- ^ Unit files to load; the @ghc -unit@ flag.
  , -------------
    -- Packages

    GhcOptions -> Flag [Char]
ghcOptThisUnitId :: Flag String
  -- ^ 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 ComponentId
ghcOptThisComponentId :: Flag ComponentId
  -- ^ 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 -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith :: [(ModuleName, OpenModule)]
  -- ^ 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 -> Flag Bool
ghcOptNoCode :: Flag Bool
  -- ^ No code? (But we turn on interface writing
  , GhcOptions -> PackageDBStack
ghcOptPackageDBs :: PackageDBStack
  -- ^ GHC package databases to use, the @ghc -package-conf@ flag.
  , GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages
      :: NubListR (OpenUnitId, ModuleRenaming)
  -- ^ The GHC packages to bring into scope when compiling,
  -- the @ghc -package-id@ flags.
  , GhcOptions -> Flag Bool
ghcOptHideAllPackages :: Flag Bool
  -- ^ Start with a clean package set; the @ghc -hide-all-packages@ flag
  , GhcOptions -> Flag Bool
ghcOptWarnMissingHomeModules :: Flag Bool
  -- ^ Warn about modules, not listed in command line
  , GhcOptions -> Flag Bool
ghcOptNoAutoLinkPackages :: Flag Bool
  -- ^ Don't automatically link in Haskell98 etc; the @ghc
  -- -no-auto-link-packages@ flag.
  , -----------------
    -- Linker stuff

    GhcOptions -> [[Char]]
ghcOptLinkLibs :: [FilePath]
  -- ^ Names of libraries to link in; the @ghc -l@ flag.
  , GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Lib))
ghcOptLinkLibPath :: NubListR (SymbolicPath Pkg (Dir Lib))
  -- ^ Search path for libraries to link in; the @ghc -L@ flag.
  , GhcOptions -> [[Char]]
ghcOptLinkOptions :: [String]
  -- ^ Options to pass through to the linker; the @ghc -optl@ flag.
  , GhcOptions -> NubListR [Char]
ghcOptLinkFrameworks :: NubListR String
  -- ^ OSX only: frameworks to link in; the @ghc -framework@ flag.
  , GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Framework))
ghcOptLinkFrameworkDirs :: NubListR (SymbolicPath Pkg (Dir Framework))
  -- ^ OSX only: Search path for frameworks to link in; the
  -- @ghc -framework-path@ flag.
  , GhcOptions -> Flag Bool
ghcOptLinkRts :: Flag Bool
  -- ^ Instruct GHC to link against @libHSrts@ when producing a shared library.
  , GhcOptions -> Flag Bool
ghcOptNoLink :: Flag Bool
  -- ^ Don't do the link step, useful in make mode; the @ghc -no-link@ flag.
  , GhcOptions -> Flag Bool
ghcOptLinkNoHsMain :: Flag Bool
  -- ^ Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@
  -- flag.
  , GhcOptions -> NubListR [Char]
ghcOptLinkModDefFiles :: NubListR FilePath
  -- ^ Module definition files (Windows specific)
  , --------------------
    -- C and CPP stuff

    GhcOptions -> [[Char]]
ghcOptCcOptions :: [String]
  -- ^ Options to pass through to the C compiler; the @ghc -optc@ flag.
  , GhcOptions -> [[Char]]
ghcOptCxxOptions :: [String]
  -- ^ Options to pass through to the C++ compiler.
  , GhcOptions -> [[Char]]
ghcOptAsmOptions :: [String]
  -- ^ Options to pass through to the Assembler.
  , GhcOptions -> [[Char]]
ghcOptCppOptions :: [String]
  -- ^ Options to pass through to CPP; the @ghc -optP@ flag.
  , GhcOptions -> [[Char]]
ghcOptJSppOptions :: [String]
  -- ^ Options to pass through to CPP; the @ghc -optJSP@ flag. @since 3.16.0.0
  , GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Include))
ghcOptCppIncludePath :: NubListR (SymbolicPath Pkg (Dir Include))
  -- ^ Search path for CPP includes like header files; the @ghc -I@ flag.
  , GhcOptions -> NubListR (SymbolicPath Pkg 'File)
ghcOptCppIncludes :: NubListR (SymbolicPath Pkg File)
  -- ^ Extra header files to include at CPP stage; the @ghc -optP-include@ flag.
  , GhcOptions -> NubListR [Char]
ghcOptFfiIncludes :: NubListR FilePath
  -- ^ Extra header files to include for old-style FFI; the @ghc -#include@ flag.
  , GhcOptions -> Flag [Char]
ghcOptCcProgram :: Flag FilePath
  -- ^ Program to use for the C compiler; the @ghc -pgmc@ flag.
  , GhcOptions -> Flag [Char]
ghcOptGppProgram :: Flag FilePath
  -- ^ Program to use for the C++ compiler; the @ghc -pgmcxx@ flag.
  , ----------------------------
    -- Language and extensions

    GhcOptions -> Flag Language
ghcOptLanguage :: Flag Language
  -- ^ The base language; the @ghc -XHaskell98@ or @-XHaskell2010@ flag.
  , GhcOptions -> NubListR Extension
ghcOptExtensions :: NubListR Extension
  -- ^ The language extensions; the @ghc -X@ flag.
  , GhcOptions -> Map Extension (Maybe [Char])
ghcOptExtensionMap :: Map Extension (Maybe CompilerFlag)
  -- ^ A GHC version-dependent mapping of extensions to flags. This must be
  -- set to be able to make use of the 'ghcOptExtensions'.
  , ----------------
    -- Compilation

    GhcOptions -> Flag GhcOptimisation
ghcOptOptimisation :: Flag GhcOptimisation
  -- ^ What optimisation level to use; the @ghc -O@ flag.
  , GhcOptions -> Flag DebugInfoLevel
ghcOptDebugInfo :: Flag DebugInfoLevel
  -- ^ Emit debug info; the @ghc -g@ flag.
  , GhcOptions -> Flag Bool
ghcOptProfilingMode :: Flag Bool
  -- ^ Compile in profiling mode; the @ghc -prof@ flag.
  , GhcOptions -> Flag GhcProfAuto
ghcOptProfilingAuto :: Flag GhcProfAuto
  -- ^ Automatically add profiling cost centers; the @ghc -fprof-auto*@ flags.
  , GhcOptions -> Flag Bool
ghcOptSplitSections :: Flag Bool
  -- ^ Use the \"split sections\" feature; the @ghc -split-sections@ flag.
  , GhcOptions -> Flag Bool
ghcOptSplitObjs :: Flag Bool
  -- ^ Use the \"split object files\" feature; the @ghc -split-objs@ flag.
  , GhcOptions -> Flag ParStrat
ghcOptNumJobs :: Flag ParStrat
  -- ^ Run N jobs simultaneously (if possible).
  , GhcOptions -> Flag (SymbolicPath Pkg ('Dir Mix))
ghcOptHPCDir :: Flag (SymbolicPath Pkg (Dir Mix))
  -- ^ Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags.
  , ----------------
    -- GHCi

    GhcOptions -> [[Char]]
ghcOptGHCiScripts :: [FilePath]
  -- ^ Extra GHCi startup scripts; the @-ghci-script@ flag
  , ------------------------
    -- Redirecting outputs

    GhcOptions -> Flag [Char]
ghcOptHiSuffix :: Flag String
  , GhcOptions -> Flag [Char]
ghcOptObjSuffix :: Flag String
  , GhcOptions -> Flag [Char]
ghcOptDynHiSuffix :: Flag String
  -- ^ only in 'GhcStaticAndDynamic' mode
  , GhcOptions -> Flag [Char]
ghcOptDynObjSuffix :: Flag String
  -- ^ only in 'GhcStaticAndDynamic' mode
  , GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptHiDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
  , GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptHieDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
  , GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptObjDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
  , GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptOutputDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
  , GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptStubDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
  , GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptBytecodeDir :: Flag (SymbolicPath Pkg (Dir Artifacts))
  , --------------------
    -- Creating libraries

    GhcOptions -> Flag GhcDynLinkMode
ghcOptDynLinkMode :: Flag GhcDynLinkMode
  , GhcOptions -> Flag GhcObjectMode
ghcOptObjectMode :: Flag GhcObjectMode
  , GhcOptions -> Flag Bool
ghcOptStaticLib :: Flag Bool
  , GhcOptions -> Flag Bool
ghcOptShared :: Flag Bool
  , GhcOptions -> Flag Bool
ghcOptBytecodeLib :: Flag Bool
  , GhcOptions -> Flag Bool
ghcOptFPic :: Flag Bool
  , GhcOptions -> Flag [Char]
ghcOptDylibName :: Flag String
  , GhcOptions -> NubListR [Char]
ghcOptRPaths :: NubListR FilePath
  , ---------------
    -- Misc flags

    GhcOptions -> Flag VerbosityLevel
ghcOptVerbosity :: Flag VerbosityLevel
  -- ^ Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag.
  , GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Build))
ghcOptExtraPath :: NubListR (SymbolicPath Pkg (Dir Build))
  -- ^ Put the extra folders in the PATH environment variable we invoke
  -- GHC with
  , GhcOptions -> Flag Bool
ghcOptCabal :: Flag Bool
  -- ^ Let GHC know that it is Cabal that's calling it.
  -- Modifies some of the GHC error messages.
  }
  deriving (Int -> GhcOptions -> [Char] -> [Char]
[GhcOptions] -> [Char] -> [Char]
GhcOptions -> [Char]
(Int -> GhcOptions -> [Char] -> [Char])
-> (GhcOptions -> [Char])
-> ([GhcOptions] -> [Char] -> [Char])
-> Show GhcOptions
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> GhcOptions -> [Char] -> [Char]
showsPrec :: Int -> GhcOptions -> [Char] -> [Char]
$cshow :: GhcOptions -> [Char]
show :: GhcOptions -> [Char]
$cshowList :: [GhcOptions] -> [Char] -> [Char]
showList :: [GhcOptions] -> [Char] -> [Char]
Show, (forall x. GhcOptions -> Rep GhcOptions x)
-> (forall x. Rep GhcOptions x -> GhcOptions) -> Generic GhcOptions
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
$cfrom :: forall x. GhcOptions -> Rep GhcOptions x
from :: forall x. GhcOptions -> Rep GhcOptions x
$cto :: forall x. Rep GhcOptions x -> GhcOptions
to :: forall x. Rep GhcOptions x -> GhcOptions
Generic)

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

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

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

data GhcObjectMode
  = -- | -fobject-code
    GhcObjectCode
  | -- | -fbyte-code
    GhcByteCode
  | -- | -fbyte-code-and-object-code
    GhcByteCodeAndObjectCode
  deriving (Int -> GhcObjectMode -> [Char] -> [Char]
[GhcObjectMode] -> [Char] -> [Char]
GhcObjectMode -> [Char]
(Int -> GhcObjectMode -> [Char] -> [Char])
-> (GhcObjectMode -> [Char])
-> ([GhcObjectMode] -> [Char] -> [Char])
-> Show GhcObjectMode
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> GhcObjectMode -> [Char] -> [Char]
showsPrec :: Int -> GhcObjectMode -> [Char] -> [Char]
$cshow :: GhcObjectMode -> [Char]
show :: GhcObjectMode -> [Char]
$cshowList :: [GhcObjectMode] -> [Char] -> [Char]
showList :: [GhcObjectMode] -> [Char] -> [Char]
Show, GhcObjectMode -> GhcObjectMode -> Bool
(GhcObjectMode -> GhcObjectMode -> Bool)
-> (GhcObjectMode -> GhcObjectMode -> Bool) -> Eq GhcObjectMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcObjectMode -> GhcObjectMode -> Bool
== :: GhcObjectMode -> GhcObjectMode -> Bool
$c/= :: GhcObjectMode -> GhcObjectMode -> Bool
/= :: GhcObjectMode -> GhcObjectMode -> Bool
Eq)

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

runGHC
  :: Verbosity
  -> ConfiguredProgram
  -> Compiler
  -> Platform
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> GhcOptions
  -> IO ()
runGHC :: Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir GhcOptions
opts = do
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity
    (ProgramInvocation -> IO ()) -> IO ProgramInvocation -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ProgramInvocation
ghcInvocation Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir GhcOptions
opts

runGHCWithResponseFile
  :: FilePath
  -> Maybe TextEncoding
  -> TempFileOptions
  -> Verbosity
  -> ConfiguredProgram
  -> Compiler
  -> Platform
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> GhcOptions
  -> IO ()
runGHCWithResponseFile :: [Char]
-> Maybe TextEncoding
-> TempFileOptions
-> Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ()
runGHCWithResponseFile [Char]
fileNameTemplate Maybe TextEncoding
encoding TempFileOptions
tempFileOptions Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
maybeWorkDir GhcOptions
opts = do
  invocation <- Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ProgramInvocation
ghcInvocation Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
maybeWorkDir GhcOptions
opts

  let compilerSupportsResponseFiles =
        case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
comp of
          -- GHC 9.4 is the first version which supports response files.
          Just Version
version -> Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9, Int
4]
          Maybe Version
Nothing -> Bool
False

      args = ProgramInvocation -> [[Char]]
progInvokeArgs ProgramInvocation
invocation

  if not compilerSupportsResponseFiles
    then runProgramInvocation verbosity invocation
    else do
      let (rtsArgs, otherArgs) = splitRTSArgs args

      withResponseFile
        verbosity
        tempFileOptions
        fileNameTemplate
        encoding
        otherArgs
        $ \[Char]
responseFile -> do
          let newInvocation :: ProgramInvocation
newInvocation =
                ProgramInvocation
invocation{progInvokeArgs = ('@' : responseFile) : rtsArgs}

          Verbosity -> [Char] -> IO ()
infoNoWrap Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"GHC response file arguments: "
              [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> case [[Char]]
otherArgs of
                [] -> [Char]
""
                [Char]
arg : [[Char]]
args' -> [Char] -> [[Char]] -> [Char]
Process.showCommandForUser [Char]
arg [[Char]]
args'

          Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
newInvocation

-- Start the repl.  Either use `ghc`, or the program specified by the --with-repl flag.
runReplProgram
  :: Maybe FilePath
  -- ^ --with-repl argument
  -> TempFileOptions
  -> Verbosity
  -> ConfiguredProgram
  -> Compiler
  -> Platform
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> GhcOptions
  -> IO ()
runReplProgram :: Maybe [Char]
-> TempFileOptions
-> Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ()
runReplProgram Maybe [Char]
withReplProg TempFileOptions
tempFileOptions Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir GhcOptions
ghcOpts =
  let replProg :: ConfiguredProgram
replProg = case Maybe [Char]
withReplProg of
        Just [Char]
path -> ConfiguredProgram
ghcProg{programLocation = FoundOnSystem path}
        Maybe [Char]
Nothing -> ConfiguredProgram
ghcProg
   in [Char]
-> Maybe TextEncoding
-> TempFileOptions
-> Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ()
runGHCWithResponseFile [Char]
"ghci.rsp" Maybe TextEncoding
forall a. Maybe a
Nothing TempFileOptions
tempFileOptions Verbosity
verbosity ConfiguredProgram
replProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir GhcOptions
ghcOpts

ghcInvocation
  :: Verbosity
  -> ConfiguredProgram
  -> Compiler
  -> Platform
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> GhcOptions
  -> IO ProgramInvocation
ghcInvocation :: Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ProgramInvocation
ghcInvocation Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir GhcOptions
opts = do
  -- NOTE: GHC is the only program whose path we modify with more values than
  -- the standard @extra-prog-path@, namely the folders of the executables in
  -- the components, see @componentGhcOptions@.
  let envOverrides :: [([Char], Maybe [Char])]
envOverrides = ConfiguredProgram -> [([Char], Maybe [Char])]
programOverrideEnv ConfiguredProgram
ghcProg
  extraPath <-
    Verbosity
-> [([Char], Maybe [Char])]
-> [[Char]]
-> IO [([Char], Maybe [Char])]
getExtraPathEnv Verbosity
verbosity [([Char], Maybe [Char])]
envOverrides ([[Char]] -> IO [([Char], Maybe [Char])])
-> [[Char]] -> IO [([Char], Maybe [Char])]
forall a b. (a -> b) -> a -> b
$
      (SymbolicPath Pkg ('Dir Build) -> [Char])
-> [SymbolicPath Pkg ('Dir Build)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg ('Dir Build) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath ([SymbolicPath Pkg ('Dir Build)] -> [[Char]])
-> [SymbolicPath Pkg ('Dir Build)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
        NubListR (SymbolicPath Pkg ('Dir Build))
-> [SymbolicPath Pkg ('Dir Build)]
forall a. NubListR a -> [a]
fromNubListR (NubListR (SymbolicPath Pkg ('Dir Build))
 -> [SymbolicPath Pkg ('Dir Build)])
-> NubListR (SymbolicPath Pkg ('Dir Build))
-> [SymbolicPath Pkg ('Dir Build)]
forall a b. (a -> b) -> a -> b
$
          GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Build))
ghcOptExtraPath GhcOptions
opts
  let ghcProg' = ConfiguredProgram
ghcProg{programOverrideEnv = envOverrides ++ extraPath}
  return $
    programInvocationCwd mbWorkDir ghcProg' $
      renderGhcOptions comp platform opts

-- TODO: use the -working-dir GHC flag instead of setting the process
-- working directory, as this improves error messages.

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

          GhcOptions -> [[Char]]
ghcOptExtraDefault GhcOptions
opts
        , [[Char]
"-no-link" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoLink]
        , [[Char]
"-flink-rts" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptLinkRts]
        , ---------------
          -- Misc flags

          [[Char]]
-> (VerbosityLevel -> [[Char]]) -> Maybe VerbosityLevel -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] VerbosityLevel -> [[Char]]
verbosityOpts (Flag VerbosityLevel -> Maybe VerbosityLevel
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag VerbosityLevel
ghcOptVerbosity GhcOptions
opts))
        , [[Char]
"-fbuilding-cabal-package" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptCabal]
        , ----------------
          -- Compilation

          case Flag GhcOptimisation -> Maybe GhcOptimisation
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag GhcOptimisation
ghcOptOptimisation GhcOptions
opts) of
            Maybe GhcOptimisation
Nothing -> []
            Just GhcOptimisation
GhcNoOptimisation -> [[Char]
"-O0"]
            Just GhcOptimisation
GhcNormalOptimisation -> [[Char]
"-O"]
            Just GhcOptimisation
GhcMaximumOptimisation -> [[Char]
"-O2"]
            Just (GhcSpecialOptimisation [Char]
s) -> [[Char]
"-O" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s] -- eg -Odph
        , case Flag DebugInfoLevel -> Maybe DebugInfoLevel
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag DebugInfoLevel
ghcOptDebugInfo GhcOptions
opts) of
            Maybe DebugInfoLevel
Nothing -> []
            Just DebugInfoLevel
NoDebugInfo -> []
            Just DebugInfoLevel
MinimalDebugInfo -> [[Char]
"-g1"]
            Just DebugInfoLevel
NormalDebugInfo -> [[Char]
"-g2"]
            Just DebugInfoLevel
MaximalDebugInfo -> [[Char]
"-g3"]
        , [[Char]
"-prof" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptProfilingMode]
        , case Flag GhcProfAuto -> Maybe GhcProfAuto
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 -> [[Char]
"-fprof-auto"]
            Just GhcProfAuto
GhcProfLate
              | GhcImplInfo -> Bool
flagProfLate GhcImplInfo
implInfo -> [[Char]
"-fprof-late"]
              | Bool
otherwise -> [[Char]
"-fprof-auto-top"] -- not the same, not very close, but what we have.
            Just GhcProfAuto
GhcProfAutoToplevel -> [[Char]
"-fprof-auto-top"]
            Just GhcProfAuto
GhcProfAutoExported -> [[Char]
"-fprof-auto-exported"]
        , [[Char]
"-split-sections" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSplitSections]
        , case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
comp of
            -- the -split-objs flag was removed in GHC 9.8
            Just Version
ver | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9, Int
8] -> []
            Maybe Version
_ -> [[Char]
"-split-objs" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSplitObjs]
        , case Flag (SymbolicPath Pkg ('Dir Mix))
-> Maybe (SymbolicPath Pkg ('Dir Mix))
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Mix))
ghcOptHPCDir GhcOptions
opts) of
            Maybe (SymbolicPath Pkg ('Dir Mix))
Nothing -> []
            Just SymbolicPath Pkg ('Dir Mix)
hpcdir -> [[Char]
"-fhpc", [Char]
"-hpcdir", SymbolicPath Pkg ('Dir Mix) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Mix)
hpcdir]
        , if Compiler -> Bool
parmakeSupported Compiler
comp
            then case GhcOptions -> Flag ParStrat
ghcOptNumJobs GhcOptions
opts of
              Flag ParStrat
NoFlag -> []
              Flag ParStrat
Serial -> []
              Flag (UseSem [Char]
name) -> [[Char]
"-jsem " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name | Compiler -> Bool
jsemSupported Compiler
comp]
              Flag (NumJobs Maybe Int
n) -> [[Char]
"-j" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show Maybe Int
n]
            else []
        , --------------------
          -- Creating libraries

          [[Char]
"-staticlib" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptStaticLib]
        , [[Char]
"-shared" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptShared]
        , [[Char]
"-bytecodelib" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptBytecodeLib]
        , case Flag GhcDynLinkMode -> Maybe GhcDynLinkMode
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag GhcDynLinkMode
ghcOptDynLinkMode GhcOptions
opts) of
            Maybe GhcDynLinkMode
Nothing -> []
            Just GhcDynLinkMode
GhcStaticOnly -> [[Char]
"-static"]
            Just GhcDynLinkMode
GhcDynamicOnly -> [[Char]
"-dynamic"]
            Just GhcDynLinkMode
GhcStaticAndDynamic -> [[Char]
"-static", [Char]
"-dynamic-too"]
        , case Flag GhcObjectMode -> Maybe GhcObjectMode
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag GhcObjectMode
ghcOptObjectMode GhcOptions
opts) of
            Maybe GhcObjectMode
Nothing -> []
            Just GhcObjectMode
GhcObjectCode -> [[Char]
"-fobject-code"]
            Just GhcObjectMode
GhcByteCode -> [[Char]
"-fbyte-code", [Char]
"-fwrite-interface", [Char]
"-fwrite-byte-code"]
            Just GhcObjectMode
GhcByteCodeAndObjectCode -> [[Char]
"-fbyte-code-and-object-code"]
        , [[Char]
"-fPIC" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptFPic]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-dylib-install-name", [Char]
libname] | [Char]
libname <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptDylibName]
        , ------------------------
          -- Redirecting outputs

          [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-osuf", [Char]
suf] | [Char]
suf <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptObjSuffix]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-hisuf", [Char]
suf] | [Char]
suf <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptHiSuffix]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-dynosuf", [Char]
suf] | [Char]
suf <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptDynObjSuffix]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-dynhisuf", [Char]
suf] | [Char]
suf <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptDynHiSuffix]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-outputdir", SymbolicPath Pkg ('Dir Artifacts) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Artifacts)
dir] | SymbolicPath Pkg ('Dir Artifacts)
dir <- (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts)))
-> [SymbolicPath Pkg ('Dir Artifacts)]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptOutputDir]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-odir", SymbolicPath Pkg ('Dir Artifacts) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Artifacts)
dir] | SymbolicPath Pkg ('Dir Artifacts)
dir <- (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts)))
-> [SymbolicPath Pkg ('Dir Artifacts)]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptObjDir]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-hidir", SymbolicPath Pkg ('Dir Artifacts) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Artifacts)
dir] | SymbolicPath Pkg ('Dir Artifacts)
dir <- (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts)))
-> [SymbolicPath Pkg ('Dir Artifacts)]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptHiDir]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-hiedir", SymbolicPath Pkg ('Dir Artifacts) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Artifacts)
dir] | SymbolicPath Pkg ('Dir Artifacts)
dir <- (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts)))
-> [SymbolicPath Pkg ('Dir Artifacts)]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptHieDir]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-gbcdir", SymbolicPath Pkg ('Dir Artifacts) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Artifacts)
dir] | Compiler -> Bool
bytecodeArtifactsSupported Compiler
comp, SymbolicPath Pkg ('Dir Artifacts)
dir <- (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts)))
-> [SymbolicPath Pkg ('Dir Artifacts)]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptBytecodeDir]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-stubdir", SymbolicPath Pkg ('Dir Artifacts) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Artifacts)
dir] | SymbolicPath Pkg ('Dir Artifacts)
dir <- (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts)))
-> [SymbolicPath Pkg ('Dir Artifacts)]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptStubDir]
        , -----------------------
          -- Source search path

          [[Char]
"-i" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSourcePathClear]
        , [[Char]
"-i" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPath Pkg ('Dir Source) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Source)
dir | SymbolicPath Pkg ('Dir Source)
dir <- (GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Source)))
-> [SymbolicPath Pkg ('Dir Source)]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Source))
ghcOptSourcePath]
        , --------------------

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

          [[Char]
"-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPath Pkg ('Dir Include) -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg ('Dir Include)
dir | SymbolicPath Pkg ('Dir Include)
dir <- (GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Include)))
-> [SymbolicPath Pkg ('Dir Include)]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR (SymbolicPath Pkg ('Dir Include))
ghcOptCppIncludePath]
        , [[Char]
"-optP" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- GhcOptions -> [[Char]]
ghcOptCppOptions GhcOptions
opts]
        , [[Char]
"-optJSP" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- GhcOptions -> [[Char]]
ghcOptJSppOptions GhcOptions
opts]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [[Char]
"-optP-include", [Char]
"-optP" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SymbolicPath Pkg 'File -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg 'File
inc]
            | SymbolicPath Pkg 'File
inc <- (GhcOptions -> NubListR (SymbolicPath Pkg 'File))
-> [SymbolicPath Pkg 'File]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR (SymbolicPath Pkg 'File)
ghcOptCppIncludes
            ]
        , [[Char]
"-optc" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- GhcOptions -> [[Char]]
ghcOptCcOptions GhcOptions
opts]
        , -- C++ compiler options: GHC >= 8.10 requires -optcxx, older requires -optc
          -- https://gitlab.haskell.org/ghc/ghc/-/issues/16477
          let cxxflag :: [Char]
cxxflag = case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
comp of
                Just Version
v | Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
10] -> [Char]
"-optcxx"
                Maybe Version
_ -> [Char]
"-optc"
           in [[Char]
cxxflag [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- GhcOptions -> [[Char]]
ghcOptCxxOptions GhcOptions
opts]
        , [[Char]
"-opta" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt | [Char]
opt <- GhcOptions -> [[Char]]
ghcOptAsmOptions GhcOptions
opts]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-pgmc", [Char]
cc] | [Char]
cc <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptCcProgram]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-pgmcxx", [Char]
cxx] | [Char]
cxx <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptGppProgram]
        , -----------------
          -- Linker stuff

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

          [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [ if
                    | Compiler -> Bool
unitIdSupported Compiler
comp -> [Char]
"-this-unit-id"
                    | Compiler -> Bool
packageKeySupported Compiler
comp -> [Char]
"-this-package-key"
                    | Bool
otherwise -> [Char]
"-package-name"
              , [Char]
this_arg
              ]
            | [Char]
this_arg <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptThisUnitId
            ]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [[Char]
"-this-component-id", ComponentId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow ComponentId
this_cid]
            | ComponentId
this_cid <- (GhcOptions -> Flag ComponentId) -> [ComponentId]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag ComponentId
ghcOptThisComponentId
            ]
        , if [(ModuleName, OpenModule)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GhcOptions -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith GhcOptions
opts)
            then []
            else
              [ [Char]
"-instantiated-with"
              , [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
                  [Char]
","
                  ( ((ModuleName, OpenModule) -> [Char])
-> [(ModuleName, OpenModule)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map
                      ( \(ModuleName
n, OpenModule
m) ->
                          ModuleName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow ModuleName
n
                            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"="
                            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ OpenModule -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow OpenModule
m
                      )
                      (GhcOptions -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith GhcOptions
opts)
                  )
              ]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-fno-code", [Char]
"-fwrite-interface"] | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoCode]
        , [[Char]
"-hide-all-packages" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptHideAllPackages]
        , [[Char]
"-Wmissing-home-modules" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptWarnMissingHomeModules]
        , [[Char]
"-no-auto-link-packages" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoAutoLinkPackages]
        , PackageDBStackCWD -> [[Char]]
packageDbArgsDb (Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack -> PackageDBStackCWD
interpretPackageDBStack Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Maybe a
Nothing (GhcOptions -> PackageDBStack
ghcOptPackageDBs GhcOptions
opts))
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
            let space :: [Char] -> [Char]
space [Char]
"" = [Char]
""
                space [Char]
xs = Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
xs
             in [ [[Char]
"-package-id", OpenUnitId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow OpenUnitId
ipkgid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
space (ModuleRenaming -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow ModuleRenaming
rns)]
                | (OpenUnitId
ipkgid, ModuleRenaming
rns) <- (GhcOptions -> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages
                ]
        , ----------------------------
          -- Language and extensions

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

          [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [[Char]
"-ghci-script", [Char]
script] | [Char]
script <- GhcOptions -> [[Char]]
ghcOptGHCiScripts GhcOptions
opts
            ]
        , ---------------
          -- 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`.
          (SymbolicPath Pkg 'File -> [Char])
-> [SymbolicPath Pkg 'File] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg 'File -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u ([SymbolicPath Pkg 'File] -> [[Char]])
-> [SymbolicPath Pkg 'File] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (GhcOptions -> NubListR (SymbolicPath Pkg 'File))
-> [SymbolicPath Pkg 'File]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR (SymbolicPath Pkg 'File)
ghcOptInputFiles
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-x", [Char]
"hs", SymbolicPath Pkg 'File -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg 'File
script] | SymbolicPath Pkg 'File
script <- (GhcOptions -> NubListR (SymbolicPath Pkg 'File))
-> [SymbolicPath Pkg 'File]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR (SymbolicPath Pkg 'File)
ghcOptInputScripts]
        , [ModuleName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow ModuleName
modu | ModuleName
modu <- (GhcOptions -> NubListR ModuleName) -> [ModuleName]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR ModuleName
ghcOptInputModules]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-o", SymbolicPath Pkg 'File -> [Char]
forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u SymbolicPath Pkg 'File
out] | SymbolicPath Pkg 'File
out <- (GhcOptions -> Flag (SymbolicPath Pkg 'File))
-> [SymbolicPath Pkg 'File]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag (SymbolicPath Pkg 'File)
ghcOptOutputFile]
        , [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-dyno", [Char]
out] | [Char]
out <- (GhcOptions -> Flag [Char]) -> [[Char]]
forall {a}. (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Flag [Char]
ghcOptOutputDynFile]
        , -- unit files
          [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]
"-unit", [Char]
"@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unit] | [Char]
unit <- GhcOptions -> [[Char]]
ghcOptUnitFiles GhcOptions
opts]
        , ---------------
          -- Extra

          GhcOptions -> [[Char]]
ghcOptExtra GhcOptions
opts
        ]
  where
    -- See Note [Symbolic paths] in Distribution.Utils.Path
    u :: SymbolicPath Pkg to -> FilePath
    u :: forall (to :: FileOrDir). SymbolicPath Pkg to -> [Char]
u = SymbolicPathX 'AllowAbsolute Pkg to -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPathCWD
    implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
    isOSX :: Bool
isOSX = OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSX
    flag :: (GhcOptions -> Last a) -> [a]
flag GhcOptions -> Last a
flg = Last a -> [a]
forall a. Flag a -> [a]
flagToList (GhcOptions -> Last a
flg GhcOptions
opts)
    flags :: (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR a
flg = NubListR a -> [a]
forall a. NubListR a -> [a]
fromNubListR (NubListR a -> [a])
-> (GhcOptions -> NubListR a) -> GhcOptions -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcOptions -> NubListR a
flg (GhcOptions -> [a]) -> GhcOptions -> [a]
forall a b. (a -> b) -> a -> b
$ GhcOptions
opts
    flagBool :: (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
flg = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (GhcOptions -> Flag Bool
flg GhcOptions
opts)

verbosityOpts :: VerbosityLevel -> [String]
verbosityOpts :: VerbosityLevel -> [[Char]]
verbosityOpts VerbosityLevel
verbosity
  | VerbosityLevel
verbosity VerbosityLevel -> VerbosityLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= VerbosityLevel
Deafening = [[Char]
"-v"]
  | VerbosityLevel
verbosity VerbosityLevel -> VerbosityLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= VerbosityLevel
Normal = []
  | Bool
otherwise = [[Char]
"-w", [Char]
"-v0"]

packageDbArgsDb :: PackageDBStackCWD -> [String]
-- special cases to make arguments prettier in common scenarios
packageDbArgsDb :: PackageDBStackCWD -> [[Char]]
packageDbArgsDb = \case
  (PackageDBX [Char]
GlobalPackageDB : PackageDBX [Char]
UserPackageDB : PackageDBStackCWD
dbs)
    | (PackageDBX [Char] -> Bool) -> PackageDBStackCWD -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDBX [Char] -> Bool
forall {fp}. PackageDBX fp -> Bool
isSpecific PackageDBStackCWD
dbs -> (PackageDBX [Char] -> [[Char]]) -> PackageDBStackCWD -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDBX [Char] -> [[Char]]
single PackageDBStackCWD
dbs
  (PackageDBX [Char]
GlobalPackageDB : PackageDBStackCWD
dbs)
    | (PackageDBX [Char] -> Bool) -> PackageDBStackCWD -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDBX [Char] -> Bool
forall {fp}. PackageDBX fp -> Bool
isSpecific PackageDBStackCWD
dbs ->
        [Char]
"-no-user-package-db"
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (PackageDBX [Char] -> [[Char]]) -> PackageDBStackCWD -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDBX [Char] -> [[Char]]
single PackageDBStackCWD
dbs
  PackageDBStackCWD
dbs ->
    [Char]
"-clear-package-db"
      [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (PackageDBX [Char] -> [[Char]]) -> PackageDBStackCWD -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDBX [Char] -> [[Char]]
single PackageDBStackCWD
dbs
  where
    single :: PackageDBX [Char] -> [[Char]]
single (SpecificPackageDB [Char]
db) = [[Char]
"-package-db", [Char]
db]
    single PackageDBX [Char]
GlobalPackageDB = [[Char]
"-global-package-db"]
    single PackageDBX [Char]
UserPackageDB = [[Char]
"-user-package-db"]
    isSpecific :: PackageDBX fp -> Bool
isSpecific (SpecificPackageDB fp
_) = Bool
True
    isSpecific PackageDBX fp
_ = Bool
False

-- | Split a list of command-line arguments into RTS arguments and non-RTS
-- arguments.
splitRTSArgs :: [String] -> ([String], [String])
splitRTSArgs :: [[Char]] -> ([[Char]], [[Char]])
splitRTSArgs [[Char]]
args =
  let addRTSArg :: a -> ([a], b) -> ([a], b)
addRTSArg a
arg ~([a]
rtsArgs, b
nonRTSArgs) = (a
arg a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rtsArgs, b
nonRTSArgs)
      addNonRTSArg :: a -> (a, [a]) -> (a, [a])
addNonRTSArg a
arg ~(a
rtsArgs, [a]
nonRTSArgs) = (a
rtsArgs, a
arg a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
nonRTSArgs)

      go :: Bool -> [[Char]] -> ([[Char]], [[Char]])
go Bool
_ [] = ([], [])
      go Bool
isRTSArg ([Char]
arg : [[Char]]
rest) =
        case [Char]
arg of
          [Char]
"+RTS" -> [Char] -> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall {a} {b}. a -> ([a], b) -> ([a], b)
addRTSArg [Char]
arg (([[Char]], [[Char]]) -> ([[Char]], [[Char]]))
-> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> ([[Char]], [[Char]])
go Bool
True [[Char]]
rest
          [Char]
"-RTS" -> [Char] -> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall {a} {b}. a -> ([a], b) -> ([a], b)
addRTSArg [Char]
arg (([[Char]], [[Char]]) -> ([[Char]], [[Char]]))
-> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> ([[Char]], [[Char]])
go Bool
False [[Char]]
rest
          [Char]
"--RTS" -> ([[Char]
arg], [[Char]]
rest)
          [Char]
"--" -> ([], [Char]
arg [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
rest)
          [Char]
_ ->
            if Bool
isRTSArg
              then [Char] -> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall {a} {b}. a -> ([a], b) -> ([a], b)
addRTSArg [Char]
arg (([[Char]], [[Char]]) -> ([[Char]], [[Char]]))
-> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> ([[Char]], [[Char]])
go Bool
isRTSArg [[Char]]
rest
              else [Char] -> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall {a} {a}. a -> (a, [a]) -> (a, [a])
addNonRTSArg [Char]
arg (([[Char]], [[Char]]) -> ([[Char]], [[Char]]))
-> ([[Char]], [[Char]]) -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> ([[Char]], [[Char]])
go Bool
isRTSArg [[Char]]
rest
   in Bool -> [[Char]] -> ([[Char]], [[Char]])
go Bool
False [[Char]]
args

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

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

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