{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Simple.Program.GHC
( GhcOptions (..)
, GhcMode (..)
, GhcOptimisation (..)
, GhcDynLinkMode (..)
, GhcProfAuto (..)
, ghcInvocation
, renderGhcOptions
, runGHC
, packageDbArgsDb
, normaliseGhcArgs
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Backpack
import Distribution.Compat.Semigroup (First' (..), Last' (..), Option' (..))
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.Run
import Distribution.Simple.Program.Types
import Distribution.System
import Distribution.Types.ComponentId
import Distribution.Utils.NubList
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Data.Monoid (All (..), Any (..), Endo (..))
import qualified Data.Set as Set
normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
normaliseGhcArgs (Just Version
ghcVersion) PackageDescription{String
[String]
[(String, String)]
[(CompilerFlavor, VersionRange)]
[SymbolicPath PackageDir LicenseFile]
[SourceRepo]
[TestSuite]
[Library]
[ForeignLib]
[Executable]
[Benchmark]
Maybe BuildType
Maybe SetupBuildInfo
Maybe Library
Either License License
ShortText
CabalSpecVersion
PackageIdentifier
specVersion :: CabalSpecVersion
package :: PackageIdentifier
licenseRaw :: Either License License
licenseFiles :: [SymbolicPath PackageDir LicenseFile]
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 :: [(String, String)]
buildTypeRaw :: Maybe BuildType
setupBuildInfo :: Maybe SetupBuildInfo
library :: Maybe Library
subLibraries :: [Library]
executables :: [Executable]
foreignLibs :: [ForeignLib]
testSuites :: [TestSuite]
benchmarks :: [Benchmark]
dataFiles :: [String]
dataDir :: String
extraSrcFiles :: [String]
extraTmpFiles :: [String]
extraDocFiles :: [String]
extraDocFiles :: PackageDescription -> [String]
extraTmpFiles :: PackageDescription -> [String]
extraSrcFiles :: PackageDescription -> [String]
dataDir :: PackageDescription -> String
dataFiles :: PackageDescription -> [String]
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 -> [(String, String)]
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 -> [SymbolicPath PackageDir LicenseFile]
licenseRaw :: PackageDescription -> Either License License
package :: PackageDescription -> PackageIdentifier
specVersion :: PackageDescription -> CabalSpecVersion
..} [String]
ghcArgs
| Version
ghcVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
supportedGHCVersions =
[String] -> [String]
argumentFilters ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
simpleFilters ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
filterRtsOpts ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
ghcArgs
where
supportedGHCVersions :: VersionRange
supportedGHCVersions :: VersionRange
supportedGHCVersions = Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
8, Int
0])
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 => ([String] -> m) -> m
checkGhcFlags [String] -> m
fun =
[m] -> m
forall a. Monoid a => [a] -> a
mconcat
[ [String] -> m
fun [String]
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 = ([String] -> m) -> [[String]] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [String] -> m
fun ([[String]] -> m) -> (BuildInfo -> [[String]]) -> BuildInfo -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CompilerFlavor, [String])] -> [[String]]
filterGhcOptions ([(CompilerFlavor, [String])] -> [[String]])
-> (BuildInfo -> [(CompilerFlavor, [String])])
-> BuildInfo
-> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [(CompilerFlavor, [String])]
allGhcOptions
allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])]
allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])]
allGhcOptions =
((BuildInfo -> PerCompilerFlavor [String])
-> BuildInfo -> [(CompilerFlavor, [String])])
-> [BuildInfo -> PerCompilerFlavor [String]]
-> BuildInfo
-> [(CompilerFlavor, [String])]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(PerCompilerFlavor [String] -> [(CompilerFlavor, [String])]
forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor [String] -> [(CompilerFlavor, [String])])
-> (BuildInfo -> PerCompilerFlavor [String])
-> BuildInfo
-> [(CompilerFlavor, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
[BuildInfo -> PerCompilerFlavor [String]
options, BuildInfo -> PerCompilerFlavor [String]
profOptions, BuildInfo -> PerCompilerFlavor [String]
sharedOptions, BuildInfo -> PerCompilerFlavor [String]
staticOptions]
filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]]
filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]]
filterGhcOptions [(CompilerFlavor, [String])]
l = [[String]
opts | (CompilerFlavor
GHC, [String]
opts) <- [(CompilerFlavor, [String])]
l]
safeToFilterWarnings :: Bool
safeToFilterWarnings :: Bool
safeToFilterWarnings = All -> Bool
getAll (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ ([String] -> All) -> All
forall m. Monoid m => ([String] -> m) -> m
checkGhcFlags [String] -> All
checkWarnings
where
checkWarnings :: [String] -> All
checkWarnings :: [String] -> All
checkWarnings = Bool -> All
All (Bool -> All) -> ([String] -> Bool) -> [String] -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String -> Bool
forall a. Set a -> Bool
Set.null (Set String -> Bool)
-> ([String] -> Set String) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Set String -> Set String)
-> Set String -> [String] -> Set String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Set String -> Set String
alter Set String
forall a. Set a
Set.empty
alter :: String -> Set String -> Set String
alter :: String -> Set String -> Set String
alter String
flag =
Endo (Set String) -> Set String -> Set String
forall a. Endo a -> a -> a
appEndo (Endo (Set String) -> Set String -> Set String)
-> Endo (Set String) -> Set String -> Set String
forall a b. (a -> b) -> a -> b
$
[String -> Endo (Set String)] -> String -> Endo (Set String)
forall a. Monoid a => [a] -> a
mconcat
[ \String
s -> (Set String -> Set String) -> Endo (Set String)
forall a. (a -> a) -> Endo a
Endo ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String) -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$ if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-Werror" then String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
s else Set String -> Set String
forall a. a -> a
id
, \String
s -> (Set String -> Set String) -> Endo (Set String)
forall a. (a -> a) -> Endo a
Endo ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String) -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$ if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-Wwarn" then Set String -> Set String -> Set String
forall a b. a -> b -> a
const Set String
forall a. Set a
Set.empty else Set String -> Set String
forall a. a -> a
id
, \String
s ->
[Int] -> Endo (Set String) -> Endo (Set String)
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
6] (Endo (Set String) -> Endo (Set String))
-> ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String)
-> Endo (Set String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set String -> Set String) -> Endo (Set String)
forall a. (a -> a) -> Endo a
Endo ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String) -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$
if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-Werror=compat"
then Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set String
compatWarningSet
else Set String -> Set String
forall a. a -> a
id
, \String
s ->
[Int] -> Endo (Set String) -> Endo (Set String)
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
6] (Endo (Set String) -> Endo (Set String))
-> ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String)
-> Endo (Set String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set String -> Set String) -> Endo (Set String)
forall a. (a -> a) -> Endo a
Endo ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String) -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$
if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-Wno-error=compat"
then (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set String
compatWarningSet)
else Set String -> Set String
forall a. a -> a
id
, \String
s ->
[Int] -> Endo (Set String) -> Endo (Set String)
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
6] (Endo (Set String) -> Endo (Set String))
-> ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String)
-> Endo (Set String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set String -> Set String) -> Endo (Set String)
forall a. (a -> a) -> Endo a
Endo ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String) -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$
if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-Wwarn=compat"
then (Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set String
compatWarningSet)
else Set String -> Set String
forall a. a -> a
id
, [Int]
-> (String -> Endo (Set String)) -> String -> Endo (Set String)
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] ((String -> Endo (Set String)) -> String -> Endo (Set String))
-> (String -> Endo (Set String)) -> String -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$ String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
"-Werror=" String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert
, [Int]
-> (String -> Endo (Set String)) -> String -> Endo (Set String)
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] ((String -> Endo (Set String)) -> String -> Endo (Set String))
-> (String -> Endo (Set String)) -> String -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$ String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
"-Wwarn=" String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.delete
, [Int]
-> (String -> Endo (Set String)) -> String -> Endo (Set String)
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] ((String -> Endo (Set String)) -> String -> Endo (Set String))
-> (String -> Endo (Set String)) -> String -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$ String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
"-Wno-error=" String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.delete
]
String
flag
markFlag
:: String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag :: String
-> (String -> Set String -> Set String)
-> String
-> Endo (Set String)
markFlag String
name String -> Set String -> Set String
update String
flag = (Set String -> Set String) -> Endo (Set String)
forall a. (a -> a) -> Endo a
Endo ((Set String -> Set String) -> Endo (Set String))
-> (Set String -> Set String) -> Endo (Set String)
forall a b. (a -> b) -> a -> b
$ case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
name String
flag of
Just String
rest | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) Bool -> Bool -> Bool
&& String
rest String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"compat" -> String -> Set String -> Set String
update String
rest
Maybe String
_ -> Set String -> Set String
forall a. a -> a
id
flagArgumentFilter :: [String] -> [String] -> [String]
flagArgumentFilter :: [String] -> [String] -> [String]
flagArgumentFilter [String]
flags = [String] -> [String]
go
where
makeFilter :: String -> String -> Option' (First' ([String] -> [String]))
makeFilter :: String -> String -> Option' (First' ([String] -> [String]))
makeFilter String
flag String
arg = Maybe (First' ([String] -> [String]))
-> Option' (First' ([String] -> [String]))
forall a. Maybe a -> Option' a
Option' (Maybe (First' ([String] -> [String]))
-> Option' (First' ([String] -> [String])))
-> Maybe (First' ([String] -> [String]))
-> Option' (First' ([String] -> [String]))
forall a b. (a -> b) -> a -> b
$ ([String] -> [String]) -> First' ([String] -> [String])
forall a. a -> First' a
First' (([String] -> [String]) -> First' ([String] -> [String]))
-> (String -> [String] -> [String])
-> String
-> First' ([String] -> [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall {a}. String -> [a] -> [a]
filterRest (String -> First' ([String] -> [String]))
-> Maybe String -> Maybe (First' ([String] -> [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
flag String
arg
where
filterRest :: String -> [a] -> [a]
filterRest String
leftOver = case String -> String
dropEq String
leftOver of
[] -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1
String
_ -> [a] -> [a]
forall a. a -> a
id
checkFilter :: String -> Maybe ([String] -> [String])
checkFilter :: String -> Maybe ([String] -> [String])
checkFilter = (First' ([String] -> [String]) -> [String] -> [String])
-> Maybe (First' ([String] -> [String]))
-> Maybe ([String] -> [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap First' ([String] -> [String]) -> [String] -> [String]
forall a. First' a -> a
getFirst' (Maybe (First' ([String] -> [String]))
-> Maybe ([String] -> [String]))
-> (String -> Maybe (First' ([String] -> [String])))
-> String
-> Maybe ([String] -> [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option' (First' ([String] -> [String]))
-> Maybe (First' ([String] -> [String]))
forall a. Option' a -> Maybe a
getOption' (Option' (First' ([String] -> [String]))
-> Maybe (First' ([String] -> [String])))
-> (String -> Option' (First' ([String] -> [String])))
-> String
-> Maybe (First' ([String] -> [String]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Option' (First' ([String] -> [String])))
-> [String] -> String -> Option' (First' ([String] -> [String]))
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> String -> Option' (First' ([String] -> [String]))
makeFilter [String]
flags
go :: [String] -> [String]
go :: [String] -> [String]
go [] = []
go (String
arg : [String]
args) = case String -> Maybe ([String] -> [String])
checkFilter String
arg of
Just [String] -> [String]
f -> [String] -> [String]
go ([String] -> [String]
f [String]
args)
Maybe ([String] -> [String])
Nothing -> String
arg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
go [String]
args
argumentFilters :: [String] -> [String]
argumentFilters :: [String] -> [String]
argumentFilters =
[String] -> [String] -> [String]
flagArgumentFilter
[String
"-ghci-script", String
"-H", String
"-interactive-print"]
filterRtsOpts :: [String] -> [String]
filterRtsOpts :: [String] -> [String]
filterRtsOpts = Bool -> [String] -> [String]
go Bool
False
where
go :: Bool -> [String] -> [String]
go :: Bool -> [String] -> [String]
go Bool
_ [] = []
go Bool
_ (String
"+RTS" : [String]
opts) = Bool -> [String] -> [String]
go Bool
True [String]
opts
go Bool
_ (String
"-RTS" : [String]
opts) = Bool -> [String] -> [String]
go Bool
False [String]
opts
go Bool
isRTSopts (String
opt : [String]
opts) = [String] -> [String]
addOpt ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> [String]
go Bool
isRTSopts [String]
opts
where
addOpt :: [String] -> [String]
addOpt
| Bool
isRTSopts = [String] -> [String]
forall a. a -> a
id
| Bool
otherwise = (String
opt String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
simpleFilters :: String -> Bool
simpleFilters :: String -> Bool
simpleFilters =
Bool -> Bool
not
(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Bool
getAny
(Any -> Bool) -> (String -> Any) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String -> Any] -> String -> Any
forall a. Monoid a => [a] -> a
mconcat
[ Set String -> String -> Any
flagIn Set String
simpleFlags
, Bool -> Any
Any (Bool -> Any) -> (String -> Bool) -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"-ddump-"
, Bool -> Any
Any (Bool -> Any) -> (String -> Bool) -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"-dsuppress-"
, Bool -> Any
Any (Bool -> Any) -> (String -> Bool) -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"-dno-suppress-"
, Set String -> String -> Any
flagIn (Set String -> String -> Any) -> Set String -> String -> Any
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Set String
invertibleFlagSet String
"-" [String
"ignore-dot-ghci"]
, Set String -> String -> Any
flagIn (Set String -> String -> Any)
-> ([[String]] -> Set String) -> [[String]] -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Set String
invertibleFlagSet String
"-f" ([String] -> Set String)
-> ([[String]] -> [String]) -> [[String]] -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat ([[String]] -> String -> Any) -> [[String]] -> String -> Any
forall a b. (a -> b) -> a -> b
$
[
[ String
"reverse-errors"
, String
"warn-unused-binds"
, String
"break-on-error"
, String
"break-on-exception"
, String
"print-bind-result"
, String
"print-bind-contents"
, String
"print-evld-with-show"
, String
"implicit-import-qualified"
, String
"error-spans"
]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from
[Int
7, Int
8]
[ String
"print-explicit-foralls"
, String
"print-explicit-kinds"
]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from
[Int
8, Int
0]
[ String
"print-explicit-coercions"
, String
"print-explicit-runtime-reps"
, String
"print-equality-relations"
, String
"print-unicode-syntax"
, String
"print-expanded-synonyms"
, String
"print-potential-instances"
, String
"print-typechecker-elaboration"
]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from
[Int
8, Int
2]
[ String
"diagnostics-show-caret"
, String
"local-ghci-history"
, String
"show-warning-groups"
, String
"hide-source-paths"
, String
"show-hole-constraints"
]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] [String
"show-loaded-modules"]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
6] [String
"ghci-leak-check", String
"no-it"]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from
[Int
8, Int
10]
[ String
"defer-diagnostics"
, String
"keep-going"
, String
"print-axiom-incomps"
]
]
, Set String -> String -> Any
flagIn (Set String -> String -> Any)
-> ([String] -> Set String) -> [String] -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Set String
invertibleFlagSet String
"-d" ([String] -> String -> Any) -> [String] -> String -> Any
forall a b. (a -> b) -> a -> b
$ [String
"ppr-case-as-let", String
"ppr-ticks"]
, String -> Any
isOptIntFlag
, String -> Any
isIntFlag
, if Bool
safeToFilterWarnings
then String -> Any
isWarning (String -> Any) -> (String -> Any) -> String -> Any
forall a. Semigroup a => a -> a -> a
<> (Bool -> Any
Any (Bool -> Any) -> (String -> Bool) -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-w" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==))
else String -> Any
forall a. Monoid a => a
mempty
, [Int] -> (String -> Any) -> String -> Any
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
6] ((String -> Any) -> String -> Any)
-> (String -> Any) -> String -> Any
forall a b. (a -> b) -> a -> b
$
if Bool
safeToFilterHoles
then String -> Any
isTypedHoleFlag
else String -> Any
forall a. Monoid a => a
mempty
]
flagIn :: Set String -> String -> Any
flagIn :: Set String -> String -> Any
flagIn Set String
set String
flag = Bool -> Any
Any (Bool -> Any) -> Bool -> Any
forall a b. (a -> b) -> a -> b
$ String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
flag Set String
set
isWarning :: String -> Any
isWarning :: String -> Any
isWarning =
[String -> Any] -> String -> Any
forall a. Monoid a => [a] -> a
mconcat ([String -> Any] -> String -> Any)
-> [String -> Any] -> String -> Any
forall a b. (a -> b) -> a -> b
$
(String -> String -> Any) -> [String] -> [String -> Any]
forall a b. (a -> b) -> [a] -> [b]
map
((Bool -> Any
Any (Bool -> Any) -> (String -> Bool) -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((String -> Bool) -> String -> Any)
-> (String -> String -> Bool) -> String -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf)
[String
"-fwarn-", String
"-fno-warn-", String
"-W", String
"-Wno-"]
simpleFlags :: Set String
simpleFlags :: Set String
simpleFlags =
[String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String)
-> ([[String]] -> [String]) -> [[String]] -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat ([[String]] -> Set String) -> [[String]] -> Set String
forall a b. (a -> b) -> a -> b
$
[
[ String
"-n"
, String
"-#include"
, String
"-Rghc-timing"
, String
"-dstg-stats"
, String
"-dth-dec-file"
, String
"-dsource-stats"
, String
"-dverbose-core2core"
, String
"-dverbose-stg2stg"
, String
"-dcore-lint"
, String
"-dstg-lint"
, String
"-dcmm-lint"
, String
"-dasm-lint"
, String
"-dannot-lint"
, String
"-dshow-passes"
, String
"-dfaststring-stats"
, String
"-fno-max-relevant-binds"
, String
"-recomp"
, String
"-no-recomp"
, String
"-fforce-recomp"
, String
"-fno-force-recomp"
]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from
[Int
8, Int
2]
[ String
"-fno-max-errors"
, String
"-fdiagnostics-color=auto"
, String
"-fdiagnostics-color=always"
, String
"-fdiagnostics-color=never"
, String
"-dppr-debug"
, String
"-dno-debug-output"
]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] [String
"-ddebug-output"]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
to [Int
8, Int
6] [String
"-fno-max-valid-substitutions"]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
6] [String
"-dhex-word-literals"]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
8] [String
"-fshow-docs-of-hole-fits", String
"-fno-show-docs-of-hole-fits"]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
9, Int
0] [String
"-dlinear-core-lint"]
]
isOptIntFlag :: String -> Any
isOptIntFlag :: String -> Any
isOptIntFlag = [String -> Any] -> String -> Any
forall a. Monoid a => [a] -> a
mconcat ([String -> Any] -> String -> Any)
-> ([String] -> [String -> Any]) -> [String] -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Any) -> [String] -> [String -> Any]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> String -> Any
dropIntFlag Bool
True) ([String] -> String -> Any) -> [String] -> String -> Any
forall a b. (a -> b) -> a -> b
$ [String
"-v", String
"-j"]
isIntFlag :: String -> Any
isIntFlag :: String -> Any
isIntFlag =
[String -> Any] -> String -> Any
forall a. Monoid a => [a] -> a
mconcat ([String -> Any] -> String -> Any)
-> ([[String]] -> [String -> Any]) -> [[String]] -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Any) -> [String] -> [String -> Any]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> String -> Any
dropIntFlag Bool
False) ([String] -> [String -> Any])
-> ([[String]] -> [String]) -> [[String]] -> [String -> Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat ([[String]] -> String -> Any) -> [[String]] -> String -> Any
forall a b. (a -> b) -> a -> b
$
[
[ String
"-fmax-relevant-binds"
, String
"-ddpr-user-length"
, String
"-ddpr-cols"
, String
"-dtrace-level"
, String
"-fghci-hist-size"
]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
2] [String
"-fmax-uncovered-patterns", String
"-fmax-errors"]
, [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from [Int
8, Int
4] ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
to [Int
8, Int
6] [String
"-fmax-valid-substitutions"]
]
dropIntFlag :: Bool -> String -> String -> Any
dropIntFlag :: Bool -> String -> String -> Any
dropIntFlag Bool
isOpt String
flag String
input = Bool -> Any
Any (Bool -> Any) -> Bool -> Any
forall a b. (a -> b) -> a -> b
$ case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
flag String
input of
Maybe String
Nothing -> Bool
False
Just String
rest
| Bool
isOpt Bool -> Bool -> Bool
&& String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest -> Bool
True
| Bool
otherwise -> case String -> Maybe Int
parseInt String
rest of
Just Int
_ -> Bool
True
Maybe Int
Nothing -> Bool
False
where
parseInt :: String -> Maybe Int
parseInt :: String -> Maybe Int
parseInt = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (String -> String) -> String -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropEq
dropEq :: String -> String
dropEq :: String -> String
dropEq (Char
'=' : String
s) = String
s
dropEq String
s = String
s
invertibleFlagSet :: String -> [String] -> Set String
invertibleFlagSet :: String -> [String] -> Set String
invertibleFlagSet String
prefix [String]
flagNames =
[String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String) -> [String] -> [String -> String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
prefix, String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"no-"] [String -> String] -> [String] -> [String]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String]
flagNames
compatWarningSet :: Set String
compatWarningSet :: Set String
compatWarningSet =
[String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$
[[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
[ [Int] -> [String] -> [String]
forall m. Monoid m => [Int] -> m -> m
from
[Int
8, Int
6]
[ String
"missing-monadfail-instances"
, String
"semigroup"
, String
"noncanonical-monoid-instances"
, String
"implicit-kind-vars"
]
]
safeToFilterHoles :: Bool
safeToFilterHoles :: Bool
safeToFilterHoles =
All -> Bool
getAll (All -> Bool)
-> (([String] -> All) -> All) -> ([String] -> All) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> All) -> All
forall m. Monoid m => ([String] -> m) -> m
checkGhcFlags (([String] -> All) -> Bool) -> ([String] -> All) -> Bool
forall a b. (a -> b) -> a -> b
$
Bool -> All
All (Bool -> All) -> ([String] -> Bool) -> [String] -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool)
-> ([String] -> Maybe Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Last' Bool -> Bool) -> Maybe (Last' Bool) -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Last' Bool -> Bool
forall a. Last' a -> a
getLast' (Maybe (Last' Bool) -> Maybe Bool)
-> ([String] -> Maybe (Last' Bool)) -> [String] -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option' (Last' Bool) -> Maybe (Last' Bool)
forall a. Option' a -> Maybe a
getOption' (Option' (Last' Bool) -> Maybe (Last' Bool))
-> ([String] -> Option' (Last' Bool))
-> [String]
-> Maybe (Last' Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Option' (Last' Bool))
-> [String] -> Option' (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 String -> Option' (Last' Bool)
notDeferred
where
notDeferred :: String -> Option' (Last' Bool)
notDeferred :: String -> Option' (Last' Bool)
notDeferred String
"-fdefer-typed-holes" = Maybe (Last' Bool) -> Option' (Last' Bool)
forall a. Maybe a -> Option' a
Option' (Maybe (Last' Bool) -> Option' (Last' Bool))
-> (Bool -> Maybe (Last' Bool)) -> Bool -> Option' (Last' Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a. a -> Last' a
Last' (Bool -> Option' (Last' Bool)) -> Bool -> Option' (Last' Bool)
forall a b. (a -> b) -> a -> b
$ Bool
False
notDeferred String
"-fno-defer-typed-holes" = Maybe (Last' Bool) -> Option' (Last' Bool)
forall a. Maybe a -> Option' a
Option' (Maybe (Last' Bool) -> Option' (Last' Bool))
-> (Bool -> Maybe (Last' Bool)) -> Bool -> Option' (Last' Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a. a -> Last' a
Last' (Bool -> Option' (Last' Bool)) -> Bool -> Option' (Last' Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
notDeferred String
_ = Maybe (Last' Bool) -> Option' (Last' Bool)
forall a. Maybe a -> Option' a
Option' Maybe (Last' Bool)
forall a. Maybe a
Nothing
isTypedHoleFlag :: String -> Any
isTypedHoleFlag :: String -> Any
isTypedHoleFlag =
[String -> Any] -> String -> Any
forall a. Monoid a => [a] -> a
mconcat
[ Set String -> String -> Any
flagIn (Set String -> String -> Any)
-> ([String] -> Set String) -> [String] -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Set String
invertibleFlagSet String
"-f" ([String] -> String -> Any) -> [String] -> String -> Any
forall a b. (a -> b) -> a -> b
$
[ String
"show-hole-constraints"
, String
"show-valid-substitutions"
, String
"show-valid-hole-fits"
, String
"sort-valid-hole-fits"
, String
"sort-by-size-hole-fits"
, String
"sort-by-subsumption-hole-fits"
, String
"abstract-refinement-hole-fits"
, String
"show-provenance-of-hole-fits"
, String
"show-hole-matches-of-hole-fits"
, String
"show-type-of-hole-fits"
, String
"show-type-app-of-hole-fits"
, String
"show-type-app-vars-of-hole-fits"
, String
"unclutter-valid-hole-fits"
]
, Set String -> String -> Any
flagIn (Set String -> String -> Any)
-> ([String] -> Set String) -> [String] -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> String -> Any) -> [String] -> String -> Any
forall a b. (a -> b) -> a -> b
$
[ String
"-fno-max-valid-hole-fits"
, String
"-fno-max-refinement-hole-fits"
, String
"-fno-refinement-level-hole-fits"
]
, [String -> Any] -> String -> Any
forall a. Monoid a => [a] -> a
mconcat ([String -> Any] -> String -> Any)
-> ([String] -> [String -> Any]) -> [String] -> String -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Any) -> [String] -> [String -> Any]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> String -> Any
dropIntFlag Bool
False) ([String] -> String -> Any) -> [String] -> String -> Any
forall a b. (a -> b) -> a -> b
$
[ String
"-fmax-valid-hole-fits"
, String
"-fmax-refinement-hole-fits"
, String
"-frefinement-level-hole-fits"
]
]
normaliseGhcArgs Maybe Version
_ PackageDescription
_ [String]
args = [String]
args
data GhcOptions = GhcOptions
{ GhcOptions -> Flag GhcMode
ghcOptMode :: Flag GhcMode
, :: [String]
, :: [String]
,
GhcOptions -> NubListR String
ghcOptInputFiles :: NubListR FilePath
, GhcOptions -> NubListR String
ghcOptInputScripts :: NubListR FilePath
, GhcOptions -> NubListR ModuleName
ghcOptInputModules :: NubListR ModuleName
, GhcOptions -> Flag String
ghcOptOutputFile :: Flag FilePath
, GhcOptions -> Flag String
ghcOptOutputDynFile :: Flag FilePath
, GhcOptions -> Flag Bool
ghcOptSourcePathClear :: Flag Bool
, GhcOptions -> NubListR String
ghcOptSourcePath :: NubListR FilePath
,
GhcOptions -> Flag String
ghcOptThisUnitId :: Flag String
, GhcOptions -> Flag ComponentId
ghcOptThisComponentId :: Flag ComponentId
, GhcOptions -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith :: [(ModuleName, OpenModule)]
, GhcOptions -> Flag Bool
ghcOptNoCode :: Flag Bool
, GhcOptions -> PackageDBStack
ghcOptPackageDBs :: PackageDBStack
, GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages
:: NubListR (OpenUnitId, ModuleRenaming)
, GhcOptions -> Flag Bool
ghcOptHideAllPackages :: Flag Bool
, GhcOptions -> Flag Bool
ghcOptWarnMissingHomeModules :: Flag Bool
, GhcOptions -> Flag Bool
ghcOptNoAutoLinkPackages :: Flag Bool
,
GhcOptions -> [String]
ghcOptLinkLibs :: [FilePath]
, GhcOptions -> NubListR String
ghcOptLinkLibPath :: NubListR FilePath
, GhcOptions -> [String]
ghcOptLinkOptions :: [String]
, GhcOptions -> NubListR String
ghcOptLinkFrameworks :: NubListR String
, GhcOptions -> NubListR String
ghcOptLinkFrameworkDirs :: NubListR String
, GhcOptions -> Flag Bool
ghcOptLinkRts :: Flag Bool
, GhcOptions -> Flag Bool
ghcOptNoLink :: Flag Bool
, GhcOptions -> Flag Bool
ghcOptLinkNoHsMain :: Flag Bool
, GhcOptions -> NubListR String
ghcOptLinkModDefFiles :: NubListR FilePath
,
GhcOptions -> [String]
ghcOptCcOptions :: [String]
, GhcOptions -> [String]
ghcOptCxxOptions :: [String]
, GhcOptions -> [String]
ghcOptAsmOptions :: [String]
, GhcOptions -> [String]
ghcOptCppOptions :: [String]
, GhcOptions -> NubListR String
ghcOptCppIncludePath :: NubListR FilePath
, GhcOptions -> NubListR String
ghcOptCppIncludes :: NubListR FilePath
, GhcOptions -> NubListR String
ghcOptFfiIncludes :: NubListR FilePath
, GhcOptions -> Flag String
ghcOptCcProgram :: Flag FilePath
,
GhcOptions -> Flag Language
ghcOptLanguage :: Flag Language
, GhcOptions -> NubListR Extension
ghcOptExtensions :: NubListR Extension
, GhcOptions -> Map Extension (Maybe String)
ghcOptExtensionMap :: Map Extension (Maybe CompilerFlag)
,
GhcOptions -> Flag GhcOptimisation
ghcOptOptimisation :: Flag GhcOptimisation
, GhcOptions -> Flag DebugInfoLevel
ghcOptDebugInfo :: Flag DebugInfoLevel
, GhcOptions -> Flag Bool
ghcOptProfilingMode :: Flag Bool
, GhcOptions -> Flag GhcProfAuto
ghcOptProfilingAuto :: Flag GhcProfAuto
, GhcOptions -> Flag Bool
ghcOptSplitSections :: Flag Bool
, GhcOptions -> Flag Bool
ghcOptSplitObjs :: Flag Bool
, GhcOptions -> Flag (Maybe Int)
ghcOptNumJobs :: Flag (Maybe Int)
, GhcOptions -> Flag String
ghcOptHPCDir :: Flag FilePath
,
GhcOptions -> [String]
ghcOptGHCiScripts :: [FilePath]
,
GhcOptions -> Flag String
ghcOptHiSuffix :: Flag String
, GhcOptions -> Flag String
ghcOptObjSuffix :: Flag String
, GhcOptions -> Flag String
ghcOptDynHiSuffix :: Flag String
, GhcOptions -> Flag String
ghcOptDynObjSuffix :: Flag String
, GhcOptions -> Flag String
ghcOptHiDir :: Flag FilePath
, GhcOptions -> Flag String
ghcOptObjDir :: Flag FilePath
, GhcOptions -> Flag String
ghcOptOutputDir :: Flag FilePath
, GhcOptions -> Flag String
ghcOptStubDir :: Flag FilePath
,
GhcOptions -> Flag GhcDynLinkMode
ghcOptDynLinkMode :: Flag GhcDynLinkMode
, GhcOptions -> Flag Bool
ghcOptStaticLib :: Flag Bool
, GhcOptions -> Flag Bool
ghcOptShared :: Flag Bool
, GhcOptions -> Flag Bool
ghcOptFPic :: Flag Bool
, GhcOptions -> Flag String
ghcOptDylibName :: Flag String
, GhcOptions -> NubListR String
ghcOptRPaths :: NubListR FilePath
,
GhcOptions -> Flag Verbosity
ghcOptVerbosity :: Flag Verbosity
, :: NubListR FilePath
, GhcOptions -> Flag Bool
ghcOptCabal :: Flag Bool
}
deriving (Int -> GhcOptions -> String -> String
[GhcOptions] -> String -> String
GhcOptions -> String
(Int -> GhcOptions -> String -> String)
-> (GhcOptions -> String)
-> ([GhcOptions] -> String -> String)
-> Show GhcOptions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GhcOptions -> String -> String
showsPrec :: Int -> GhcOptions -> String -> String
$cshow :: GhcOptions -> String
show :: GhcOptions -> String
$cshowList :: [GhcOptions] -> String -> String
showList :: [GhcOptions] -> String -> String
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
=
GhcModeCompile
|
GhcModeLink
|
GhcModeMake
|
GhcModeInteractive
|
GhcModeAbiHash
deriving (Int -> GhcMode -> String -> String
[GhcMode] -> String -> String
GhcMode -> String
(Int -> GhcMode -> String -> String)
-> (GhcMode -> String)
-> ([GhcMode] -> String -> String)
-> Show GhcMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GhcMode -> String -> String
showsPrec :: Int -> GhcMode -> String -> String
$cshow :: GhcMode -> String
show :: GhcMode -> String
$cshowList :: [GhcMode] -> String -> String
showList :: [GhcMode] -> String -> String
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
=
GhcNoOptimisation
|
GhcNormalOptimisation
|
GhcMaximumOptimisation
|
GhcSpecialOptimisation String
deriving (Int -> GhcOptimisation -> String -> String
[GhcOptimisation] -> String -> String
GhcOptimisation -> String
(Int -> GhcOptimisation -> String -> String)
-> (GhcOptimisation -> String)
-> ([GhcOptimisation] -> String -> String)
-> Show GhcOptimisation
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GhcOptimisation -> String -> String
showsPrec :: Int -> GhcOptimisation -> String -> String
$cshow :: GhcOptimisation -> String
show :: GhcOptimisation -> String
$cshowList :: [GhcOptimisation] -> String -> String
showList :: [GhcOptimisation] -> String -> String
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
=
GhcStaticOnly
|
GhcDynamicOnly
|
GhcStaticAndDynamic
deriving (Int -> GhcDynLinkMode -> String -> String
[GhcDynLinkMode] -> String -> String
GhcDynLinkMode -> String
(Int -> GhcDynLinkMode -> String -> String)
-> (GhcDynLinkMode -> String)
-> ([GhcDynLinkMode] -> String -> String)
-> Show GhcDynLinkMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GhcDynLinkMode -> String -> String
showsPrec :: Int -> GhcDynLinkMode -> String -> String
$cshow :: GhcDynLinkMode -> String
show :: GhcDynLinkMode -> String
$cshowList :: [GhcDynLinkMode] -> String -> String
showList :: [GhcDynLinkMode] -> String -> String
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 GhcProfAuto
=
GhcProfAutoAll
|
GhcProfAutoToplevel
|
GhcProfAutoExported
|
GhcProfLate
deriving (Int -> GhcProfAuto -> String -> String
[GhcProfAuto] -> String -> String
GhcProfAuto -> String
(Int -> GhcProfAuto -> String -> String)
-> (GhcProfAuto -> String)
-> ([GhcProfAuto] -> String -> String)
-> Show GhcProfAuto
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GhcProfAuto -> String -> String
showsPrec :: Int -> GhcProfAuto -> String -> String
$cshow :: GhcProfAuto -> String
show :: GhcProfAuto -> String
$cshowList :: [GhcProfAuto] -> String -> String
showList :: [GhcProfAuto] -> String -> String
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
-> GhcOptions
-> IO ()
runGHC :: Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform GhcOptions
opts = do
Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
ghcProg Compiler
comp Platform
platform GhcOptions
opts)
ghcInvocation
:: ConfiguredProgram
-> Compiler
-> Platform
-> GhcOptions
-> ProgramInvocation
ghcInvocation :: ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
prog Compiler
comp Platform
platform GhcOptions
opts =
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
prog (Compiler -> Platform -> GhcOptions -> [String]
renderGhcOptions Compiler
comp Platform
platform GhcOptions
opts))
{ progInvokePathEnv = fromNubListR (ghcOptExtraPath opts)
}
renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
renderGhcOptions Compiler
comp _platform :: Platform
_platform@(Platform Arch
_arch OS
os) GhcOptions
opts
| Compiler -> CompilerFlavor
compilerFlavor Compiler
comp CompilerFlavor -> [CompilerFlavor] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CompilerFlavor
GHC, CompilerFlavor
GHCJS] =
String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
String
"Distribution.Simple.Program.GHC.renderGhcOptions: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"compiler flavor must be 'GHC' or 'GHCJS'!"
| Bool
otherwise =
[[String]] -> [String]
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 -> [String
"-c"]
Just GhcMode
GhcModeLink -> []
Just GhcMode
GhcModeMake -> [String
"--make"]
Just GhcMode
GhcModeInteractive -> [String
"--interactive"]
Just GhcMode
GhcModeAbiHash -> [String
"--abi-hash"]
,
GhcOptions -> [String]
ghcOptExtraDefault GhcOptions
opts
, [String
"-no-link" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoLink]
, [String
"-flink-rts" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptLinkRts]
,
[String] -> (Verbosity -> [String]) -> Maybe Verbosity -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Verbosity -> [String]
verbosityOpts (Flag Verbosity -> Maybe Verbosity
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag Verbosity
ghcOptVerbosity GhcOptions
opts))
, [String
"-fbuilding-cabal-package" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptCabal]
,
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 -> [String
"-O0"]
Just GhcOptimisation
GhcNormalOptimisation -> [String
"-O"]
Just GhcOptimisation
GhcMaximumOptimisation -> [String
"-O2"]
Just (GhcSpecialOptimisation String
s) -> [String
"-O" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s]
, 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 -> [String
"-g1"]
Just DebugInfoLevel
NormalDebugInfo -> [String
"-g2"]
Just DebugInfoLevel
MaximalDebugInfo -> [String
"-g3"]
, [String
"-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
| GhcImplInfo -> Bool
flagProfAuto GhcImplInfo
implInfo -> [String
"-fprof-auto"]
| Bool
otherwise -> [String
"-auto-all"]
Just GhcProfAuto
GhcProfLate
| GhcImplInfo -> Bool
flagProfLate GhcImplInfo
implInfo -> [String
"-fprof-late"]
| Bool
otherwise -> [String
"-fprof-auto-top"]
Just GhcProfAuto
GhcProfAutoToplevel
| GhcImplInfo -> Bool
flagProfAuto GhcImplInfo
implInfo -> [String
"-fprof-auto-top"]
| Bool
otherwise -> [String
"-auto-all"]
Just GhcProfAuto
GhcProfAutoExported
| GhcImplInfo -> Bool
flagProfAuto GhcImplInfo
implInfo -> [String
"-fprof-auto-exported"]
| Bool
otherwise -> [String
"-auto"]
, [String
"-split-sections" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSplitSections]
, [String
"-split-objs" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSplitObjs]
, case Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe (GhcOptions -> Flag String
ghcOptHPCDir GhcOptions
opts) of
Maybe String
Nothing -> []
Just String
hpcdir -> [String
"-fhpc", String
"-hpcdir", String
hpcdir]
, if Compiler -> Bool
parmakeSupported Compiler
comp
then case GhcOptions -> Flag (Maybe Int)
ghcOptNumJobs GhcOptions
opts of
Flag (Maybe Int)
NoFlag -> []
Flag Maybe Int
n -> [String
"-j" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Int -> String
forall a. Show a => a -> String
show Maybe Int
n]
else []
,
[String
"-staticlib" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptStaticLib]
, [String
"-shared" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptShared]
, 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 -> [String
"-static"]
Just GhcDynLinkMode
GhcDynamicOnly -> [String
"-dynamic"]
Just GhcDynLinkMode
GhcStaticAndDynamic -> [String
"-static", String
"-dynamic-too"]
, [String
"-fPIC" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptFPic]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-dylib-install-name", String
libname] | String
libname <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptDylibName]
,
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-osuf", String
suf] | String
suf <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptObjSuffix]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-hisuf", String
suf] | String
suf <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptHiSuffix]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-dynosuf", String
suf] | String
suf <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptDynObjSuffix]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-dynhisuf", String
suf] | String
suf <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptDynHiSuffix]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-outputdir", String
dir] | String
dir <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptOutputDir]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-odir", String
dir] | String
dir <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptObjDir]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-hidir", String
dir] | String
dir <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptHiDir]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-stubdir", String
dir] | String
dir <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptStubDir]
,
[String
"-i" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptSourcePathClear]
, [String
"-i" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptSourcePath]
,
[String
"-I" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptCppIncludePath]
, [String
"-optP" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptCppOptions GhcOptions
opts]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [String
"-optP-include", String
"-optP" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inc]
| String
inc <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptCppIncludes
]
, [String
"-optc" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptCcOptions GhcOptions
opts]
,
let cxxflag :: String
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] -> String
"-optcxx"
Maybe Version
_ -> String
"-optc"
in [String
cxxflag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptCxxOptions GhcOptions
opts]
, [String
"-opta" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptAsmOptions GhcOptions
opts]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-pgmc", String
cc] | String
cc <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptCcProgram]
,
[String
"-optl" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt | String
opt <- GhcOptions -> [String]
ghcOptLinkOptions GhcOptions
opts]
, [String
"-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lib | String
lib <- GhcOptions -> [String]
ghcOptLinkLibs GhcOptions
opts]
, [String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir | String
dir <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkLibPath]
, if Bool
isOSX
then
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [String
"-framework", String
fmwk]
| String
fmwk <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkFrameworks
]
else []
, if Bool
isOSX
then
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [String
"-framework-path", String
path]
| String
path <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkFrameworkDirs
]
else []
, [String
"-no-hs-main" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptLinkNoHsMain]
, [String
"-dynload deploy" | Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptRPaths))]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [String
"-optl-Wl,-rpath," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir]
| String
dir <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptRPaths
]
, [String
modDefFile | String
modDefFile <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptLinkModDefFiles]
,
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ case () of
()
_
| Compiler -> Bool
unitIdSupported Compiler
comp -> String
"-this-unit-id"
| Compiler -> Bool
packageKeySupported Compiler
comp -> String
"-this-package-key"
| Bool
otherwise -> String
"-package-name"
, String
this_arg
]
| String
this_arg <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptThisUnitId
]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [String
"-this-component-id", ComponentId -> String
forall a. Pretty a => a -> String
prettyShow ComponentId
this_cid]
| ComponentId
this_cid <- (GhcOptions -> Flag ComponentId) -> [ComponentId]
forall {a}. (GhcOptions -> Flag 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
String
"-instantiated-with"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
String
","
( ((ModuleName, OpenModule) -> String)
-> [(ModuleName, OpenModule)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
( \(ModuleName
n, OpenModule
m) ->
ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
n
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"="
String -> String -> String
forall a. [a] -> [a] -> [a]
++ OpenModule -> String
forall a. Pretty a => a -> String
prettyShow OpenModule
m
)
(GhcOptions -> [(ModuleName, OpenModule)]
ghcOptInstantiatedWith GhcOptions
opts)
)
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-fno-code", String
"-fwrite-interface"] | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoCode]
, [String
"-hide-all-packages" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptHideAllPackages]
, [String
"-Wmissing-home-modules" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptWarnMissingHomeModules]
, [String
"-no-auto-link-packages" | (GhcOptions -> Flag Bool) -> Bool
flagBool GhcOptions -> Flag Bool
ghcOptNoAutoLinkPackages]
, GhcImplInfo -> PackageDBStack -> [String]
packageDbArgs GhcImplInfo
implInfo (GhcOptions -> PackageDBStack
ghcOptPackageDBs GhcOptions
opts)
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$
let space :: String -> String
space String
"" = String
""
space String
xs = Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
in [ [String
"-package-id", OpenUnitId -> String
forall a. Pretty a => a -> String
prettyShow OpenUnitId
ipkgid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
space (ModuleRenaming -> String
forall a. Pretty a => a -> String
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
]
,
if GhcImplInfo -> Bool
supportsHaskell2010 GhcImplInfo
implInfo
then [String
"-X" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Language -> String
forall a. Pretty a => a -> String
prettyShow Language
lang | Language
lang <- (GhcOptions -> Flag Language) -> [Language]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag Language
ghcOptLanguage]
else []
, [ String
ext'
| Extension
ext <- (GhcOptions -> NubListR Extension) -> [Extension]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR Extension
ghcOptExtensions
, String
ext' <- case Extension -> Map Extension (Maybe String) -> Maybe (Maybe String)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Extension
ext (GhcOptions -> Map Extension (Maybe String)
ghcOptExtensionMap GhcOptions
opts) of
Just (Just String
arg) -> [String
arg]
Just Maybe String
Nothing -> []
Maybe (Maybe String)
Nothing ->
String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
String
"Distribution.Simple.Program.GHC.renderGhcOptions: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
ext
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not present in ghcOptExtensionMap."
]
,
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [String
"-ghci-script", String
script] | String
script <- GhcOptions -> [String]
ghcOptGHCiScripts GhcOptions
opts, GhcImplInfo -> Bool
flagGhciScript GhcImplInfo
implInfo
]
,
(GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptInputFiles
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-x", String
"hs", String
script] | String
script <- (GhcOptions -> NubListR String) -> [String]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR String
ghcOptInputScripts]
, [ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
modu | ModuleName
modu <- (GhcOptions -> NubListR ModuleName) -> [ModuleName]
forall {a}. (GhcOptions -> NubListR a) -> [a]
flags GhcOptions -> NubListR ModuleName
ghcOptInputModules]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-o", String
out] | String
out <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptOutputFile]
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-dyno", String
out] | String
out <- (GhcOptions -> Flag String) -> [String]
forall {a}. (GhcOptions -> Flag a) -> [a]
flag GhcOptions -> Flag String
ghcOptOutputDynFile]
,
GhcOptions -> [String]
ghcOptExtra GhcOptions
opts
]
where
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 -> Flag a) -> [a]
flag GhcOptions -> Flag a
flg = Flag a -> [a]
forall a. Flag a -> [a]
flagToList (GhcOptions -> Flag 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 :: Verbosity -> [String]
verbosityOpts :: Verbosity -> [String]
verbosityOpts Verbosity
verbosity
| Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening = [String
"-v"]
| Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
normal = []
| Bool
otherwise = [String
"-w", String
"-v0"]
packageDbArgsConf :: PackageDBStack -> [String]
packageDbArgsConf :: PackageDBStack -> [String]
packageDbArgsConf PackageDBStack
dbstack = case PackageDBStack
dbstack of
(PackageDB
GlobalPackageDB : PackageDB
UserPackageDB : PackageDBStack
dbs) -> (PackageDB -> [String]) -> PackageDBStack -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
specific PackageDBStack
dbs
(PackageDB
GlobalPackageDB : PackageDBStack
dbs) ->
(String
"-no-user-package-conf")
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (PackageDB -> [String]) -> PackageDBStack -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
specific PackageDBStack
dbs
PackageDBStack
_ -> [String]
forall {a}. a
ierror
where
specific :: PackageDB -> [String]
specific (SpecificPackageDB String
db) = [String
"-package-conf", String
db]
specific PackageDB
_ = [String]
forall {a}. a
ierror
ierror :: a
ierror =
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
String
"internal error: unexpected package db stack: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageDBStack -> String
forall a. Show a => a -> String
show PackageDBStack
dbstack
packageDbArgsDb :: PackageDBStack -> [String]
packageDbArgsDb :: PackageDBStack -> [String]
packageDbArgsDb PackageDBStack
dbstack = case PackageDBStack
dbstack of
(PackageDB
GlobalPackageDB : PackageDB
UserPackageDB : PackageDBStack
dbs)
| (PackageDB -> Bool) -> PackageDBStack -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDB -> Bool
isSpecific PackageDBStack
dbs -> (PackageDB -> [String]) -> PackageDBStack -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single PackageDBStack
dbs
(PackageDB
GlobalPackageDB : PackageDBStack
dbs)
| (PackageDB -> Bool) -> PackageDBStack -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDB -> Bool
isSpecific PackageDBStack
dbs ->
String
"-no-user-package-db"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (PackageDB -> [String]) -> PackageDBStack -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single PackageDBStack
dbs
PackageDBStack
dbs ->
String
"-clear-package-db"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (PackageDB -> [String]) -> PackageDBStack -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single PackageDBStack
dbs
where
single :: PackageDB -> [String]
single (SpecificPackageDB String
db) = [String
"-package-db", String
db]
single PackageDB
GlobalPackageDB = [String
"-global-package-db"]
single PackageDB
UserPackageDB = [String
"-user-package-db"]
isSpecific :: PackageDB -> Bool
isSpecific (SpecificPackageDB String
_) = Bool
True
isSpecific PackageDB
_ = Bool
False
packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String]
packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String]
packageDbArgs GhcImplInfo
implInfo
| GhcImplInfo -> Bool
flagPackageConf GhcImplInfo
implInfo = PackageDBStack -> [String]
packageDbArgsConf
| Bool
otherwise = PackageDBStack -> [String]
packageDbArgsDb
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