{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Distribution.Simple.Compiler (
module Distribution.Compiler,
Compiler(..),
showCompilerId, showCompilerIdWithAbi,
compilerFlavor, compilerVersion,
compilerCompatFlavor,
compilerCompatVersion,
compilerInfo,
PackageDB(..),
PackageDBStack,
registrationPackageDB,
absolutePackageDBPaths,
absolutePackageDBPath,
OptimisationLevel(..),
flagToOptimisationLevel,
DebugInfoLevel(..),
flagToDebugInfoLevel,
CompilerFlag,
languageToFlags,
unsupportedLanguages,
extensionsToFlags,
unsupportedExtensions,
parmakeSupported,
reexportedModulesSupported,
renamingPackageFlagsSupported,
unifiedIPIDRequired,
packageKeySupported,
unitIdSupported,
coverageSupported,
profilingSupported,
backpackSupported,
arResponseFilesSupported,
libraryDynDirSupported,
libraryVisibilitySupported,
ProfDetailLevel(..),
knownProfDetailLevels,
flagToProfDetailLevel,
showProfDetailLevel,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Pretty
import Distribution.Compiler
import Distribution.Version
import Language.Haskell.Extension
import Distribution.Simple.Utils
import qualified Data.Map as Map (lookup)
import System.Directory (canonicalizePath)
data Compiler = Compiler {
Compiler -> CompilerId
compilerId :: CompilerId,
Compiler -> AbiTag
compilerAbiTag :: AbiTag,
Compiler -> [CompilerId]
compilerCompat :: [CompilerId],
Compiler -> [(Language, String)]
compilerLanguages :: [(Language, CompilerFlag)],
Compiler -> [(Extension, Maybe String)]
compilerExtensions :: [(Extension, Maybe CompilerFlag)],
Compiler -> Map String String
compilerProperties :: Map String String
}
deriving (Compiler -> Compiler -> Bool
(Compiler -> Compiler -> Bool)
-> (Compiler -> Compiler -> Bool) -> Eq Compiler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compiler -> Compiler -> Bool
$c/= :: Compiler -> Compiler -> Bool
== :: Compiler -> Compiler -> Bool
$c== :: Compiler -> Compiler -> Bool
Eq, (forall x. Compiler -> Rep Compiler x)
-> (forall x. Rep Compiler x -> Compiler) -> Generic Compiler
forall x. Rep Compiler x -> Compiler
forall x. Compiler -> Rep Compiler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Compiler x -> Compiler
$cfrom :: forall x. Compiler -> Rep Compiler x
Generic, Typeable, Int -> Compiler -> ShowS
[Compiler] -> ShowS
Compiler -> String
(Int -> Compiler -> ShowS)
-> (Compiler -> String) -> ([Compiler] -> ShowS) -> Show Compiler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compiler] -> ShowS
$cshowList :: [Compiler] -> ShowS
show :: Compiler -> String
$cshow :: Compiler -> String
showsPrec :: Int -> Compiler -> ShowS
$cshowsPrec :: Int -> Compiler -> ShowS
Show, ReadPrec [Compiler]
ReadPrec Compiler
Int -> ReadS Compiler
ReadS [Compiler]
(Int -> ReadS Compiler)
-> ReadS [Compiler]
-> ReadPrec Compiler
-> ReadPrec [Compiler]
-> Read Compiler
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Compiler]
$creadListPrec :: ReadPrec [Compiler]
readPrec :: ReadPrec Compiler
$creadPrec :: ReadPrec Compiler
readList :: ReadS [Compiler]
$creadList :: ReadS [Compiler]
readsPrec :: Int -> ReadS Compiler
$creadsPrec :: Int -> ReadS Compiler
Read)
instance Binary Compiler
instance Structured Compiler
showCompilerId :: Compiler -> String
showCompilerId :: Compiler -> String
showCompilerId = CompilerId -> String
forall a. Pretty a => a -> String
prettyShow (CompilerId -> String)
-> (Compiler -> CompilerId) -> Compiler -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> CompilerId
compilerId
showCompilerIdWithAbi :: Compiler -> String
showCompilerIdWithAbi :: Compiler -> String
showCompilerIdWithAbi Compiler
comp =
CompilerId -> String
forall a. Pretty a => a -> String
prettyShow (Compiler -> CompilerId
compilerId Compiler
comp) String -> ShowS
forall a. [a] -> [a] -> [a]
++
case Compiler -> AbiTag
compilerAbiTag Compiler
comp of
AbiTag
NoAbiTag -> []
AbiTag String
xs -> Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs
compilerFlavor :: Compiler -> CompilerFlavor
compilerFlavor :: Compiler -> CompilerFlavor
compilerFlavor = (\(CompilerId CompilerFlavor
f Version
_) -> CompilerFlavor
f) (CompilerId -> CompilerFlavor)
-> (Compiler -> CompilerId) -> Compiler -> CompilerFlavor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> CompilerId
compilerId
compilerVersion :: Compiler -> Version
compilerVersion :: Compiler -> Version
compilerVersion = (\(CompilerId CompilerFlavor
_ Version
v) -> Version
v) (CompilerId -> Version)
-> (Compiler -> CompilerId) -> Compiler -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> CompilerId
compilerId
compilerCompatFlavor :: CompilerFlavor -> Compiler -> Bool
compilerCompatFlavor :: CompilerFlavor -> Compiler -> Bool
compilerCompatFlavor CompilerFlavor
flavor Compiler
comp =
CompilerFlavor
flavor CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== Compiler -> CompilerFlavor
compilerFlavor Compiler
comp
Bool -> Bool -> Bool
|| CompilerFlavor
flavor CompilerFlavor -> [CompilerFlavor] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ CompilerFlavor
flavor' | CompilerId CompilerFlavor
flavor' Version
_ <- Compiler -> [CompilerId]
compilerCompat Compiler
comp ]
compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
flavor Compiler
comp
| Compiler -> CompilerFlavor
compilerFlavor Compiler
comp CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
flavor = Version -> Maybe Version
forall a. a -> Maybe a
Just (Compiler -> Version
compilerVersion Compiler
comp)
| Bool
otherwise =
[Version] -> Maybe Version
forall a. [a] -> Maybe a
listToMaybe [ Version
v | CompilerId CompilerFlavor
fl Version
v <- Compiler -> [CompilerId]
compilerCompat Compiler
comp, CompilerFlavor
fl CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
flavor ]
compilerInfo :: Compiler -> CompilerInfo
compilerInfo :: Compiler -> CompilerInfo
compilerInfo Compiler
c = CompilerId
-> AbiTag
-> Maybe [CompilerId]
-> Maybe [Language]
-> Maybe [Extension]
-> CompilerInfo
CompilerInfo (Compiler -> CompilerId
compilerId Compiler
c)
(Compiler -> AbiTag
compilerAbiTag Compiler
c)
([CompilerId] -> Maybe [CompilerId]
forall a. a -> Maybe a
Just ([CompilerId] -> Maybe [CompilerId])
-> (Compiler -> [CompilerId]) -> Compiler -> Maybe [CompilerId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> [CompilerId]
compilerCompat (Compiler -> Maybe [CompilerId]) -> Compiler -> Maybe [CompilerId]
forall a b. (a -> b) -> a -> b
$ Compiler
c)
([Language] -> Maybe [Language]
forall a. a -> Maybe a
Just ([Language] -> Maybe [Language])
-> (Compiler -> [Language]) -> Compiler -> Maybe [Language]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Language, String) -> Language)
-> [(Language, String)] -> [Language]
forall a b. (a -> b) -> [a] -> [b]
map (Language, String) -> Language
forall a b. (a, b) -> a
fst ([(Language, String)] -> [Language])
-> (Compiler -> [(Language, String)]) -> Compiler -> [Language]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> [(Language, String)]
compilerLanguages (Compiler -> Maybe [Language]) -> Compiler -> Maybe [Language]
forall a b. (a -> b) -> a -> b
$ Compiler
c)
([Extension] -> Maybe [Extension]
forall a. a -> Maybe a
Just ([Extension] -> Maybe [Extension])
-> (Compiler -> [Extension]) -> Compiler -> Maybe [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Extension, Maybe String) -> Extension)
-> [(Extension, Maybe String)] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map (Extension, Maybe String) -> Extension
forall a b. (a, b) -> a
fst ([(Extension, Maybe String)] -> [Extension])
-> (Compiler -> [(Extension, Maybe String)])
-> Compiler
-> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> [(Extension, Maybe String)]
compilerExtensions (Compiler -> Maybe [Extension]) -> Compiler -> Maybe [Extension]
forall a b. (a -> b) -> a -> b
$ Compiler
c)
data PackageDB = GlobalPackageDB
| UserPackageDB
| SpecificPackageDB FilePath
deriving (PackageDB -> PackageDB -> Bool
(PackageDB -> PackageDB -> Bool)
-> (PackageDB -> PackageDB -> Bool) -> Eq PackageDB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageDB -> PackageDB -> Bool
$c/= :: PackageDB -> PackageDB -> Bool
== :: PackageDB -> PackageDB -> Bool
$c== :: PackageDB -> PackageDB -> Bool
Eq, (forall x. PackageDB -> Rep PackageDB x)
-> (forall x. Rep PackageDB x -> PackageDB) -> Generic PackageDB
forall x. Rep PackageDB x -> PackageDB
forall x. PackageDB -> Rep PackageDB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageDB x -> PackageDB
$cfrom :: forall x. PackageDB -> Rep PackageDB x
Generic, Eq PackageDB
Eq PackageDB
-> (PackageDB -> PackageDB -> Ordering)
-> (PackageDB -> PackageDB -> Bool)
-> (PackageDB -> PackageDB -> Bool)
-> (PackageDB -> PackageDB -> Bool)
-> (PackageDB -> PackageDB -> Bool)
-> (PackageDB -> PackageDB -> PackageDB)
-> (PackageDB -> PackageDB -> PackageDB)
-> Ord PackageDB
PackageDB -> PackageDB -> Bool
PackageDB -> PackageDB -> Ordering
PackageDB -> PackageDB -> PackageDB
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageDB -> PackageDB -> PackageDB
$cmin :: PackageDB -> PackageDB -> PackageDB
max :: PackageDB -> PackageDB -> PackageDB
$cmax :: PackageDB -> PackageDB -> PackageDB
>= :: PackageDB -> PackageDB -> Bool
$c>= :: PackageDB -> PackageDB -> Bool
> :: PackageDB -> PackageDB -> Bool
$c> :: PackageDB -> PackageDB -> Bool
<= :: PackageDB -> PackageDB -> Bool
$c<= :: PackageDB -> PackageDB -> Bool
< :: PackageDB -> PackageDB -> Bool
$c< :: PackageDB -> PackageDB -> Bool
compare :: PackageDB -> PackageDB -> Ordering
$ccompare :: PackageDB -> PackageDB -> Ordering
Ord, Int -> PackageDB -> ShowS
[PackageDB] -> ShowS
PackageDB -> String
(Int -> PackageDB -> ShowS)
-> (PackageDB -> String)
-> ([PackageDB] -> ShowS)
-> Show PackageDB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageDB] -> ShowS
$cshowList :: [PackageDB] -> ShowS
show :: PackageDB -> String
$cshow :: PackageDB -> String
showsPrec :: Int -> PackageDB -> ShowS
$cshowsPrec :: Int -> PackageDB -> ShowS
Show, ReadPrec [PackageDB]
ReadPrec PackageDB
Int -> ReadS PackageDB
ReadS [PackageDB]
(Int -> ReadS PackageDB)
-> ReadS [PackageDB]
-> ReadPrec PackageDB
-> ReadPrec [PackageDB]
-> Read PackageDB
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackageDB]
$creadListPrec :: ReadPrec [PackageDB]
readPrec :: ReadPrec PackageDB
$creadPrec :: ReadPrec PackageDB
readList :: ReadS [PackageDB]
$creadList :: ReadS [PackageDB]
readsPrec :: Int -> ReadS PackageDB
$creadsPrec :: Int -> ReadS PackageDB
Read, Typeable)
instance Binary PackageDB
instance Structured PackageDB
type PackageDBStack = [PackageDB]
registrationPackageDB :: PackageDBStack -> PackageDB
registrationPackageDB :: [PackageDB] -> PackageDB
registrationPackageDB [PackageDB]
dbs = case [PackageDB] -> Maybe PackageDB
forall a. [a] -> Maybe a
safeLast [PackageDB]
dbs of
Maybe PackageDB
Nothing -> String -> PackageDB
forall a. HasCallStack => String -> a
error String
"internal error: empty package db set"
Just PackageDB
p -> PackageDB
p
absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack
absolutePackageDBPaths :: [PackageDB] -> IO [PackageDB]
absolutePackageDBPaths = (PackageDB -> IO PackageDB) -> [PackageDB] -> IO [PackageDB]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PackageDB -> IO PackageDB
absolutePackageDBPath
absolutePackageDBPath :: PackageDB -> IO PackageDB
absolutePackageDBPath :: PackageDB -> IO PackageDB
absolutePackageDBPath PackageDB
GlobalPackageDB = PackageDB -> IO PackageDB
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDB
GlobalPackageDB
absolutePackageDBPath PackageDB
UserPackageDB = PackageDB -> IO PackageDB
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDB
UserPackageDB
absolutePackageDBPath (SpecificPackageDB String
db) =
String -> PackageDB
SpecificPackageDB (String -> PackageDB) -> IO String -> IO PackageDB
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> IO String
canonicalizePath String
db
data OptimisationLevel = NoOptimisation
| NormalOptimisation
| MaximumOptimisation
deriving (OptimisationLevel
OptimisationLevel -> OptimisationLevel -> Bounded OptimisationLevel
forall a. a -> a -> Bounded a
maxBound :: OptimisationLevel
$cmaxBound :: OptimisationLevel
minBound :: OptimisationLevel
$cminBound :: OptimisationLevel
Bounded, Int -> OptimisationLevel
OptimisationLevel -> Int
OptimisationLevel -> [OptimisationLevel]
OptimisationLevel -> OptimisationLevel
OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
OptimisationLevel
-> OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
(OptimisationLevel -> OptimisationLevel)
-> (OptimisationLevel -> OptimisationLevel)
-> (Int -> OptimisationLevel)
-> (OptimisationLevel -> Int)
-> (OptimisationLevel -> [OptimisationLevel])
-> (OptimisationLevel -> OptimisationLevel -> [OptimisationLevel])
-> (OptimisationLevel -> OptimisationLevel -> [OptimisationLevel])
-> (OptimisationLevel
-> OptimisationLevel -> OptimisationLevel -> [OptimisationLevel])
-> Enum OptimisationLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OptimisationLevel
-> OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
$cenumFromThenTo :: OptimisationLevel
-> OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
enumFromTo :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
$cenumFromTo :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
enumFromThen :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
$cenumFromThen :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
enumFrom :: OptimisationLevel -> [OptimisationLevel]
$cenumFrom :: OptimisationLevel -> [OptimisationLevel]
fromEnum :: OptimisationLevel -> Int
$cfromEnum :: OptimisationLevel -> Int
toEnum :: Int -> OptimisationLevel
$ctoEnum :: Int -> OptimisationLevel
pred :: OptimisationLevel -> OptimisationLevel
$cpred :: OptimisationLevel -> OptimisationLevel
succ :: OptimisationLevel -> OptimisationLevel
$csucc :: OptimisationLevel -> OptimisationLevel
Enum, OptimisationLevel -> OptimisationLevel -> Bool
(OptimisationLevel -> OptimisationLevel -> Bool)
-> (OptimisationLevel -> OptimisationLevel -> Bool)
-> Eq OptimisationLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptimisationLevel -> OptimisationLevel -> Bool
$c/= :: OptimisationLevel -> OptimisationLevel -> Bool
== :: OptimisationLevel -> OptimisationLevel -> Bool
$c== :: OptimisationLevel -> OptimisationLevel -> Bool
Eq, (forall x. OptimisationLevel -> Rep OptimisationLevel x)
-> (forall x. Rep OptimisationLevel x -> OptimisationLevel)
-> Generic OptimisationLevel
forall x. Rep OptimisationLevel x -> OptimisationLevel
forall x. OptimisationLevel -> Rep OptimisationLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OptimisationLevel x -> OptimisationLevel
$cfrom :: forall x. OptimisationLevel -> Rep OptimisationLevel x
Generic, ReadPrec [OptimisationLevel]
ReadPrec OptimisationLevel
Int -> ReadS OptimisationLevel
ReadS [OptimisationLevel]
(Int -> ReadS OptimisationLevel)
-> ReadS [OptimisationLevel]
-> ReadPrec OptimisationLevel
-> ReadPrec [OptimisationLevel]
-> Read OptimisationLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptimisationLevel]
$creadListPrec :: ReadPrec [OptimisationLevel]
readPrec :: ReadPrec OptimisationLevel
$creadPrec :: ReadPrec OptimisationLevel
readList :: ReadS [OptimisationLevel]
$creadList :: ReadS [OptimisationLevel]
readsPrec :: Int -> ReadS OptimisationLevel
$creadsPrec :: Int -> ReadS OptimisationLevel
Read, Int -> OptimisationLevel -> ShowS
[OptimisationLevel] -> ShowS
OptimisationLevel -> String
(Int -> OptimisationLevel -> ShowS)
-> (OptimisationLevel -> String)
-> ([OptimisationLevel] -> ShowS)
-> Show OptimisationLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptimisationLevel] -> ShowS
$cshowList :: [OptimisationLevel] -> ShowS
show :: OptimisationLevel -> String
$cshow :: OptimisationLevel -> String
showsPrec :: Int -> OptimisationLevel -> ShowS
$cshowsPrec :: Int -> OptimisationLevel -> ShowS
Show, Typeable)
instance Binary OptimisationLevel
instance Structured OptimisationLevel
flagToOptimisationLevel :: Maybe String -> OptimisationLevel
flagToOptimisationLevel :: Maybe String -> OptimisationLevel
flagToOptimisationLevel Maybe String
Nothing = OptimisationLevel
NormalOptimisation
flagToOptimisationLevel (Just String
s) = case ReadS Int
forall a. Read a => ReadS a
reads String
s of
[(Int
i, String
"")]
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= OptimisationLevel -> Int
forall a. Enum a => a -> Int
fromEnum (OptimisationLevel
forall a. Bounded a => a
minBound :: OptimisationLevel)
Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= OptimisationLevel -> Int
forall a. Enum a => a -> Int
fromEnum (OptimisationLevel
forall a. Bounded a => a
maxBound :: OptimisationLevel)
-> Int -> OptimisationLevel
forall a. Enum a => Int -> a
toEnum Int
i
| Bool
otherwise -> String -> OptimisationLevel
forall a. HasCallStack => String -> a
error (String -> OptimisationLevel) -> String -> OptimisationLevel
forall a b. (a -> b) -> a -> b
$ String
"Bad optimisation level: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Valid values are 0..2"
[(Int, String)]
_ -> String -> OptimisationLevel
forall a. HasCallStack => String -> a
error (String -> OptimisationLevel) -> String -> OptimisationLevel
forall a b. (a -> b) -> a -> b
$ String
"Can't parse optimisation level " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
data DebugInfoLevel = NoDebugInfo
| MinimalDebugInfo
| NormalDebugInfo
| MaximalDebugInfo
deriving (DebugInfoLevel
DebugInfoLevel -> DebugInfoLevel -> Bounded DebugInfoLevel
forall a. a -> a -> Bounded a
maxBound :: DebugInfoLevel
$cmaxBound :: DebugInfoLevel
minBound :: DebugInfoLevel
$cminBound :: DebugInfoLevel
Bounded, Int -> DebugInfoLevel
DebugInfoLevel -> Int
DebugInfoLevel -> [DebugInfoLevel]
DebugInfoLevel -> DebugInfoLevel
DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
DebugInfoLevel
-> DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
(DebugInfoLevel -> DebugInfoLevel)
-> (DebugInfoLevel -> DebugInfoLevel)
-> (Int -> DebugInfoLevel)
-> (DebugInfoLevel -> Int)
-> (DebugInfoLevel -> [DebugInfoLevel])
-> (DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel])
-> (DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel])
-> (DebugInfoLevel
-> DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel])
-> Enum DebugInfoLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DebugInfoLevel
-> DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
$cenumFromThenTo :: DebugInfoLevel
-> DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
enumFromTo :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
$cenumFromTo :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
enumFromThen :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
$cenumFromThen :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
enumFrom :: DebugInfoLevel -> [DebugInfoLevel]
$cenumFrom :: DebugInfoLevel -> [DebugInfoLevel]
fromEnum :: DebugInfoLevel -> Int
$cfromEnum :: DebugInfoLevel -> Int
toEnum :: Int -> DebugInfoLevel
$ctoEnum :: Int -> DebugInfoLevel
pred :: DebugInfoLevel -> DebugInfoLevel
$cpred :: DebugInfoLevel -> DebugInfoLevel
succ :: DebugInfoLevel -> DebugInfoLevel
$csucc :: DebugInfoLevel -> DebugInfoLevel
Enum, DebugInfoLevel -> DebugInfoLevel -> Bool
(DebugInfoLevel -> DebugInfoLevel -> Bool)
-> (DebugInfoLevel -> DebugInfoLevel -> Bool) -> Eq DebugInfoLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugInfoLevel -> DebugInfoLevel -> Bool
$c/= :: DebugInfoLevel -> DebugInfoLevel -> Bool
== :: DebugInfoLevel -> DebugInfoLevel -> Bool
$c== :: DebugInfoLevel -> DebugInfoLevel -> Bool
Eq, (forall x. DebugInfoLevel -> Rep DebugInfoLevel x)
-> (forall x. Rep DebugInfoLevel x -> DebugInfoLevel)
-> Generic DebugInfoLevel
forall x. Rep DebugInfoLevel x -> DebugInfoLevel
forall x. DebugInfoLevel -> Rep DebugInfoLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DebugInfoLevel x -> DebugInfoLevel
$cfrom :: forall x. DebugInfoLevel -> Rep DebugInfoLevel x
Generic, ReadPrec [DebugInfoLevel]
ReadPrec DebugInfoLevel
Int -> ReadS DebugInfoLevel
ReadS [DebugInfoLevel]
(Int -> ReadS DebugInfoLevel)
-> ReadS [DebugInfoLevel]
-> ReadPrec DebugInfoLevel
-> ReadPrec [DebugInfoLevel]
-> Read DebugInfoLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DebugInfoLevel]
$creadListPrec :: ReadPrec [DebugInfoLevel]
readPrec :: ReadPrec DebugInfoLevel
$creadPrec :: ReadPrec DebugInfoLevel
readList :: ReadS [DebugInfoLevel]
$creadList :: ReadS [DebugInfoLevel]
readsPrec :: Int -> ReadS DebugInfoLevel
$creadsPrec :: Int -> ReadS DebugInfoLevel
Read, Int -> DebugInfoLevel -> ShowS
[DebugInfoLevel] -> ShowS
DebugInfoLevel -> String
(Int -> DebugInfoLevel -> ShowS)
-> (DebugInfoLevel -> String)
-> ([DebugInfoLevel] -> ShowS)
-> Show DebugInfoLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugInfoLevel] -> ShowS
$cshowList :: [DebugInfoLevel] -> ShowS
show :: DebugInfoLevel -> String
$cshow :: DebugInfoLevel -> String
showsPrec :: Int -> DebugInfoLevel -> ShowS
$cshowsPrec :: Int -> DebugInfoLevel -> ShowS
Show, Typeable)
instance Binary DebugInfoLevel
instance Structured DebugInfoLevel
flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
flagToDebugInfoLevel Maybe String
Nothing = DebugInfoLevel
NormalDebugInfo
flagToDebugInfoLevel (Just String
s) = case ReadS Int
forall a. Read a => ReadS a
reads String
s of
[(Int
i, String
"")]
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= DebugInfoLevel -> Int
forall a. Enum a => a -> Int
fromEnum (DebugInfoLevel
forall a. Bounded a => a
minBound :: DebugInfoLevel)
Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= DebugInfoLevel -> Int
forall a. Enum a => a -> Int
fromEnum (DebugInfoLevel
forall a. Bounded a => a
maxBound :: DebugInfoLevel)
-> Int -> DebugInfoLevel
forall a. Enum a => Int -> a
toEnum Int
i
| Bool
otherwise -> String -> DebugInfoLevel
forall a. HasCallStack => String -> a
error (String -> DebugInfoLevel) -> String -> DebugInfoLevel
forall a b. (a -> b) -> a -> b
$ String
"Bad debug info level: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Valid values are 0..3"
[(Int, String)]
_ -> String -> DebugInfoLevel
forall a. HasCallStack => String -> a
error (String -> DebugInfoLevel) -> String -> DebugInfoLevel
forall a b. (a -> b) -> a -> b
$ String
"Can't parse debug info level " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
unsupportedLanguages :: Compiler -> [Language] -> [Language]
unsupportedLanguages :: Compiler -> [Language] -> [Language]
unsupportedLanguages Compiler
comp [Language]
langs =
[ Language
lang | Language
lang <- [Language]
langs
, Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Compiler -> Language -> Maybe String
languageToFlag Compiler
comp Language
lang) ]
languageToFlags :: Compiler -> Maybe Language -> [CompilerFlag]
languageToFlags :: Compiler -> Maybe Language -> [String]
languageToFlags Compiler
comp = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
([String] -> [String])
-> (Maybe Language -> [String]) -> Maybe Language -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String])
-> (Maybe Language -> [Maybe String]) -> Maybe Language -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Language -> Maybe String) -> [Language] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (Compiler -> Language -> Maybe String
languageToFlag Compiler
comp)
([Language] -> [Maybe String])
-> (Maybe Language -> [Language])
-> Maybe Language
-> [Maybe String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Language]
-> (Language -> [Language]) -> Maybe Language -> [Language]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Language
Haskell98] (\Language
x->[Language
x])
languageToFlag :: Compiler -> Language -> Maybe CompilerFlag
languageToFlag :: Compiler -> Language -> Maybe String
languageToFlag Compiler
comp Language
ext = Language -> [(Language, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Language
ext (Compiler -> [(Language, String)]
compilerLanguages Compiler
comp)
unsupportedExtensions :: Compiler -> [Extension] -> [Extension]
unsupportedExtensions :: Compiler -> [Extension] -> [Extension]
unsupportedExtensions Compiler
comp [Extension]
exts =
[ Extension
ext | Extension
ext <- [Extension]
exts
, Maybe (Maybe String) -> Bool
forall a. Maybe a -> Bool
isNothing (Compiler -> Extension -> Maybe (Maybe String)
extensionToFlag' Compiler
comp Extension
ext) ]
type CompilerFlag = String
extensionsToFlags :: Compiler -> [Extension] -> [CompilerFlag]
extensionsToFlags :: Compiler -> [Extension] -> [String]
extensionsToFlags Compiler
comp = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([Extension] -> [String]) -> [Extension] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
([String] -> [String])
-> ([Extension] -> [String]) -> [Extension] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String])
-> ([Extension] -> [Maybe String]) -> [Extension] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension -> Maybe String) -> [Extension] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (Compiler -> Extension -> Maybe String
extensionToFlag Compiler
comp)
extensionToFlag :: Compiler -> Extension -> Maybe CompilerFlag
extensionToFlag :: Compiler -> Extension -> Maybe String
extensionToFlag Compiler
comp Extension
ext = Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Compiler -> Extension -> Maybe (Maybe String)
extensionToFlag' Compiler
comp Extension
ext)
extensionToFlag' :: Compiler -> Extension -> Maybe (Maybe CompilerFlag)
extensionToFlag' :: Compiler -> Extension -> Maybe (Maybe String)
extensionToFlag' Compiler
comp Extension
ext = Extension -> [(Extension, Maybe String)] -> Maybe (Maybe String)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Extension
ext (Compiler -> [(Extension, Maybe String)]
compilerExtensions Compiler
comp)
parmakeSupported :: Compiler -> Bool
parmakeSupported :: Compiler -> Bool
parmakeSupported = String -> Compiler -> Bool
ghcSupported String
"Support parallel --make"
reexportedModulesSupported :: Compiler -> Bool
reexportedModulesSupported :: Compiler -> Bool
reexportedModulesSupported = String -> Compiler -> Bool
ghcSupported String
"Support reexported-modules"
renamingPackageFlagsSupported :: Compiler -> Bool
renamingPackageFlagsSupported :: Compiler -> Bool
renamingPackageFlagsSupported = String -> Compiler -> Bool
ghcSupported
String
"Support thinning and renaming package flags"
unifiedIPIDRequired :: Compiler -> Bool
unifiedIPIDRequired :: Compiler -> Bool
unifiedIPIDRequired = String -> Compiler -> Bool
ghcSupported String
"Requires unified installed package IDs"
packageKeySupported :: Compiler -> Bool
packageKeySupported :: Compiler -> Bool
packageKeySupported = String -> Compiler -> Bool
ghcSupported String
"Uses package keys"
unitIdSupported :: Compiler -> Bool
unitIdSupported :: Compiler -> Bool
unitIdSupported = String -> Compiler -> Bool
ghcSupported String
"Uses unit IDs"
backpackSupported :: Compiler -> Bool
backpackSupported :: Compiler -> Bool
backpackSupported = String -> Compiler -> Bool
ghcSupported String
"Support Backpack"
libraryDynDirSupported :: Compiler -> Bool
libraryDynDirSupported :: Compiler -> Bool
libraryDynDirSupported Compiler
comp = case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
CompilerFlavor
GHC ->
((Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
0,Int
1,Int
20161022] Bool -> Bool -> Bool
&& Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
8,Int
1]) Bool -> Bool -> Bool
||
Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
1,Int
20161021])
CompilerFlavor
_ -> Bool
False
where
v :: Version
v = Compiler -> Version
compilerVersion Compiler
comp
arResponseFilesSupported :: Compiler -> Bool
arResponseFilesSupported :: Compiler -> Bool
arResponseFilesSupported = String -> Compiler -> Bool
ghcSupported String
"ar supports at file"
coverageSupported :: Compiler -> Bool
coverageSupported :: Compiler -> Bool
coverageSupported Compiler
comp =
case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
CompilerFlavor
GHC -> Bool
True
CompilerFlavor
GHCJS -> Bool
True
CompilerFlavor
_ -> Bool
False
profilingSupported :: Compiler -> Bool
profilingSupported :: Compiler -> Bool
profilingSupported Compiler
comp =
case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
CompilerFlavor
GHC -> Bool
True
CompilerFlavor
GHCJS -> Bool
True
CompilerFlavor
_ -> Bool
False
libraryVisibilitySupported :: Compiler -> Bool
libraryVisibilitySupported :: Compiler -> Bool
libraryVisibilitySupported Compiler
comp = case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
CompilerFlavor
GHC -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
8]
CompilerFlavor
_ -> Bool
False
where
v :: Version
v = Compiler -> Version
compilerVersion Compiler
comp
ghcSupported :: String -> Compiler -> Bool
ghcSupported :: String -> Compiler -> Bool
ghcSupported String
key Compiler
comp =
case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
CompilerFlavor
GHC -> Bool
checkProp
CompilerFlavor
GHCJS -> Bool
checkProp
CompilerFlavor
_ -> Bool
False
where checkProp :: Bool
checkProp =
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key (Compiler -> Map String String
compilerProperties Compiler
comp) of
Just String
"YES" -> Bool
True
Maybe String
_ -> Bool
False
data ProfDetailLevel = ProfDetailNone
| ProfDetailDefault
| ProfDetailExportedFunctions
| ProfDetailToplevelFunctions
| ProfDetailAllFunctions
| ProfDetailOther String
deriving (ProfDetailLevel -> ProfDetailLevel -> Bool
(ProfDetailLevel -> ProfDetailLevel -> Bool)
-> (ProfDetailLevel -> ProfDetailLevel -> Bool)
-> Eq ProfDetailLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfDetailLevel -> ProfDetailLevel -> Bool
$c/= :: ProfDetailLevel -> ProfDetailLevel -> Bool
== :: ProfDetailLevel -> ProfDetailLevel -> Bool
$c== :: ProfDetailLevel -> ProfDetailLevel -> Bool
Eq, (forall x. ProfDetailLevel -> Rep ProfDetailLevel x)
-> (forall x. Rep ProfDetailLevel x -> ProfDetailLevel)
-> Generic ProfDetailLevel
forall x. Rep ProfDetailLevel x -> ProfDetailLevel
forall x. ProfDetailLevel -> Rep ProfDetailLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProfDetailLevel x -> ProfDetailLevel
$cfrom :: forall x. ProfDetailLevel -> Rep ProfDetailLevel x
Generic, ReadPrec [ProfDetailLevel]
ReadPrec ProfDetailLevel
Int -> ReadS ProfDetailLevel
ReadS [ProfDetailLevel]
(Int -> ReadS ProfDetailLevel)
-> ReadS [ProfDetailLevel]
-> ReadPrec ProfDetailLevel
-> ReadPrec [ProfDetailLevel]
-> Read ProfDetailLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProfDetailLevel]
$creadListPrec :: ReadPrec [ProfDetailLevel]
readPrec :: ReadPrec ProfDetailLevel
$creadPrec :: ReadPrec ProfDetailLevel
readList :: ReadS [ProfDetailLevel]
$creadList :: ReadS [ProfDetailLevel]
readsPrec :: Int -> ReadS ProfDetailLevel
$creadsPrec :: Int -> ReadS ProfDetailLevel
Read, Int -> ProfDetailLevel -> ShowS
[ProfDetailLevel] -> ShowS
ProfDetailLevel -> String
(Int -> ProfDetailLevel -> ShowS)
-> (ProfDetailLevel -> String)
-> ([ProfDetailLevel] -> ShowS)
-> Show ProfDetailLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfDetailLevel] -> ShowS
$cshowList :: [ProfDetailLevel] -> ShowS
show :: ProfDetailLevel -> String
$cshow :: ProfDetailLevel -> String
showsPrec :: Int -> ProfDetailLevel -> ShowS
$cshowsPrec :: Int -> ProfDetailLevel -> ShowS
Show, Typeable)
instance Binary ProfDetailLevel
instance Structured ProfDetailLevel
flagToProfDetailLevel :: String -> ProfDetailLevel
flagToProfDetailLevel :: String -> ProfDetailLevel
flagToProfDetailLevel String
"" = ProfDetailLevel
ProfDetailDefault
flagToProfDetailLevel String
s =
case String -> [(String, ProfDetailLevel)] -> Maybe ProfDetailLevel
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ShowS
lowercase String
s)
[ (String
name, ProfDetailLevel
value)
| (String
primary, [String]
aliases, ProfDetailLevel
value) <- [(String, [String], ProfDetailLevel)]
knownProfDetailLevels
, String
name <- String
primary String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
aliases ]
of Just ProfDetailLevel
value -> ProfDetailLevel
value
Maybe ProfDetailLevel
Nothing -> String -> ProfDetailLevel
ProfDetailOther String
s
knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
knownProfDetailLevels =
[ (String
"default", [], ProfDetailLevel
ProfDetailDefault)
, (String
"none", [], ProfDetailLevel
ProfDetailNone)
, (String
"exported-functions", [String
"exported"], ProfDetailLevel
ProfDetailExportedFunctions)
, (String
"toplevel-functions", [String
"toplevel", String
"top"], ProfDetailLevel
ProfDetailToplevelFunctions)
, (String
"all-functions", [String
"all"], ProfDetailLevel
ProfDetailAllFunctions)
]
showProfDetailLevel :: ProfDetailLevel -> String
showProfDetailLevel :: ProfDetailLevel -> String
showProfDetailLevel ProfDetailLevel
dl = case ProfDetailLevel
dl of
ProfDetailLevel
ProfDetailNone -> String
"none"
ProfDetailLevel
ProfDetailDefault -> String
"default"
ProfDetailLevel
ProfDetailExportedFunctions -> String
"exported-functions"
ProfDetailLevel
ProfDetailToplevelFunctions -> String
"toplevel-functions"
ProfDetailLevel
ProfDetailAllFunctions -> String
"all-functions"
ProfDetailOther String
other -> String
other