{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.Compiler
-- Copyright   :  Isaac Jones 2003-2004
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This should be a much more sophisticated abstraction than it is. Currently
-- it's just a bit of data about the compiler, like its flavour and name and
-- version. The reason it's just data is because currently it has to be in
-- 'Read' and 'Show' so it can be saved along with the 'LocalBuildInfo'. The
-- only interesting bit of info it contains is a mapping between language
-- extensions and compiler command line flags. This module also defines a
-- 'PackageDB' type which is used to refer to package databases. Most compilers
-- only know about a single global package collection but GHC has a global and
-- per-user one and it lets you create arbitrary other package databases. We do
-- not yet fully support this latter feature.

module Distribution.Simple.Compiler (
        -- * Haskell implementations
        module Distribution.Compiler,
        Compiler(..),
        showCompilerId, showCompilerIdWithAbi,
        compilerFlavor, compilerVersion,
        compilerCompatFlavor,
        compilerCompatVersion,
        compilerInfo,

        -- * Support for package databases
        PackageDB(..),
        PackageDBStack,
        registrationPackageDB,
        absolutePackageDBPaths,
        absolutePackageDBPath,

        -- * Support for optimisation levels
        OptimisationLevel(..),
        flagToOptimisationLevel,

        -- * Support for debug info levels
        DebugInfoLevel(..),
        flagToDebugInfoLevel,

        -- * Support for language extensions
        Flag,
        languageToFlags,
        unsupportedLanguages,
        extensionsToFlags,
        unsupportedExtensions,
        parmakeSupported,
        reexportedModulesSupported,
        renamingPackageFlagsSupported,
        unifiedIPIDRequired,
        packageKeySupported,
        unitIdSupported,
        coverageSupported,
        profilingSupported,
        backpackSupported,
        arResponseFilesSupported,
        libraryDynDirSupported,

        -- * Support for profiling detail levels
        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 Control.Monad (join)
import qualified Data.Map as Map (lookup)
import System.Directory (canonicalizePath)

data Compiler = Compiler {
        Compiler -> CompilerId
compilerId              :: CompilerId,
        -- ^ Compiler flavour and version.
        Compiler -> AbiTag
compilerAbiTag          :: AbiTag,
        -- ^ Tag for distinguishing incompatible ABI's on the same
        -- architecture/os.
        Compiler -> [CompilerId]
compilerCompat          :: [CompilerId],
        -- ^ Other implementations that this compiler claims to be
        -- compatible with.
        Compiler -> [(Language, String)]
compilerLanguages       :: [(Language, Flag)],
        -- ^ Supported language standards.
        Compiler -> [(Extension, Maybe String)]
compilerExtensions      :: [(Extension, Maybe Flag)],
        -- ^ Supported extensions.
        Compiler -> Map String String
compilerProperties      :: Map String String
        -- ^ A key-value map for properties not covered by the above fields.
    }
    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
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type forall k a. (Eq k, Eq a) => Eq (Map k a)
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq Extension
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq Language
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Eq AbiTag
External instance of the constraint type Eq CompilerId
External instance of the constraint type Eq CompilerId
External instance of the constraint type Eq Language
External instance of the constraint type Eq Extension
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
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
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type Show Extension
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Extension
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type Show Language
External instance of the constraint type Show Language
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall k a. (Show k, Show a) => Show (Map k a)
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show Extension
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show Language
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show AbiTag
External instance of the constraint type Show CompilerId
External instance of the constraint type Show CompilerId
External instance of the constraint type Ord Int
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
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type Read Extension
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Read Extension
External instance of the constraint type Read Char
External instance of the constraint type Read Char
External instance of the constraint type Read Language
External instance of the constraint type Read Language
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
External instance of the constraint type forall k e. (Ord k, Read k, Read e) => Read (Map k e)
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read Extension
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read Language
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read AbiTag
External instance of the constraint type Read CompilerId
External instance of the constraint type Read CompilerId
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read Compiler
Read)

instance Binary Compiler
instance Structured Compiler

showCompilerId :: Compiler -> String
showCompilerId :: Compiler -> String
showCompilerId = CompilerId -> String
forall a. Pretty a => a -> String
External instance of the constraint type Pretty CompilerId
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
External instance of the constraint type Pretty CompilerId
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


-- | Is this compiler compatible with the compiler flavour we're interested in?
--
-- For example this checks if the compiler is actually GHC or is another
-- compiler that claims to be compatible with some version of GHC, e.g. GHCJS.
--
-- > if compilerCompatFlavor GHC compiler then ... else ...
--
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
External instance of the constraint type Eq CompilerFlavor
== Compiler -> CompilerFlavor
compilerFlavor Compiler
comp
 Bool -> Bool -> Bool
|| CompilerFlavor
flavor CompilerFlavor -> [CompilerFlavor] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq CompilerFlavor
External instance of the constraint type Foldable []
`elem` [ CompilerFlavor
flavor' | CompilerId CompilerFlavor
flavor' Version
_ <- Compiler -> [CompilerId]
compilerCompat Compiler
comp ]


-- | Is this compiler compatible with the compiler flavour we're interested in,
-- and if so what version does it claim to be compatible with.
--
-- For example this checks if the compiler is actually GHC-7.x or is another
-- compiler that claims to be compatible with some GHC-7.x version.
--
-- > case compilerCompatVersion GHC compiler of
-- >   Just (Version (7:_)) -> ...
-- >   _                    -> ...
--
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
External instance of the constraint type Eq CompilerFlavor
== 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
External instance of the constraint type Eq CompilerFlavor
== 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)

-- ------------------------------------------------------------
-- * Package databases
-- ------------------------------------------------------------

-- |Some compilers have a notion of a database of available packages.
-- For some there is just one global db of packages, other compilers
-- support a per-user or an arbitrary db specified at some location in
-- the file system. This can be used to build isloated environments of
-- packages, for example to build a collection of related packages
-- without installing them globally.
--
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
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
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
External instance of the constraint type Ord Char
External instance of the constraint type Ord Char
Instance of class: Eq of the constraint type Eq PackageDB
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Ord of the constraint type Ord PackageDB
Instance of class: Eq of the constraint type Eq PackageDB
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
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
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
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read PackageDB
Read, Typeable)

instance Binary PackageDB
instance Structured PackageDB

-- | We typically get packages from several databases, and stack them
-- together. This type lets us be explicit about that stacking. For example
-- typical stacks include:
--
-- > [GlobalPackageDB]
-- > [GlobalPackageDB, UserPackageDB]
-- > [GlobalPackageDB, SpecificPackageDB "package.conf.inplace"]
--
-- Note that the 'GlobalPackageDB' is invariably at the bottom since it
-- contains the rts, base and other special compiler-specific packages.
--
-- We are not restricted to using just the above combinations. In particular
-- we can use several custom package dbs and the user package db together.
--
-- When it comes to writing, the top most (last) package is used.
--
type PackageDBStack = [PackageDB]

-- | Return the package that we should register into. This is the package db at
-- the top of the stack.
--
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

-- | Make package paths absolute


absolutePackageDBPaths :: PackageDBStack -> NoCallStackIO PackageDBStack
absolutePackageDBPaths :: [PackageDB] -> NoCallStackIO [PackageDB]
absolutePackageDBPaths = (PackageDB -> IO PackageDB)
-> [PackageDB] -> NoCallStackIO [PackageDB]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
traverse PackageDB -> IO PackageDB
absolutePackageDBPath

absolutePackageDBPath :: PackageDB -> NoCallStackIO PackageDB
absolutePackageDBPath :: PackageDB -> IO PackageDB
absolutePackageDBPath PackageDB
GlobalPackageDB        = PackageDB -> IO PackageDB
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return PackageDB
GlobalPackageDB
absolutePackageDBPath PackageDB
UserPackageDB          = PackageDB -> IO PackageDB
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
`liftM` String -> IO String
canonicalizePath String
db

-- ------------------------------------------------------------
-- * Optimisation levels
-- ------------------------------------------------------------

-- | Some compilers support optimising. Some have different levels.
-- For compilers that do not the level is just capped to the level
-- they do support.
--
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
External instance of the constraint type Enum Int
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
External instance of the constraint type Show Int
External instance of the constraint type Ord Int
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
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read 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
External instance of the constraint type Read Int
reads String
s of
  [(Int
i, String
"")]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= OptimisationLevel -> Int
forall a. Enum a => a -> Int
Instance of class: Enum of the constraint type Enum OptimisationLevel
fromEnum (OptimisationLevel
forall a. Bounded a => a
Instance of class: Bounded of the constraint type Bounded OptimisationLevel
minBound :: OptimisationLevel)
   Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= OptimisationLevel -> Int
forall a. Enum a => a -> Int
Instance of class: Enum of the constraint type Enum OptimisationLevel
fromEnum (OptimisationLevel
forall a. Bounded a => a
Instance of class: Bounded of the constraint type Bounded OptimisationLevel
maxBound :: OptimisationLevel)
                -> Int -> OptimisationLevel
forall a. Enum a => Int -> a
Instance of class: Enum of the constraint type Enum OptimisationLevel
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
External instance of the constraint type Show Int
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

-- ------------------------------------------------------------
-- * Debug info levels
-- ------------------------------------------------------------

-- | Some compilers support emitting debug info. Some have different
-- levels.  For compilers that do not the level is just capped to the
-- level they do support.
--
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
External instance of the constraint type Enum Int
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
External instance of the constraint type Show Int
External instance of the constraint type Ord Int
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
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read 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
External instance of the constraint type Read Int
reads String
s of
  [(Int
i, String
"")]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= DebugInfoLevel -> Int
forall a. Enum a => a -> Int
Instance of class: Enum of the constraint type Enum DebugInfoLevel
fromEnum (DebugInfoLevel
forall a. Bounded a => a
Instance of class: Bounded of the constraint type Bounded DebugInfoLevel
minBound :: DebugInfoLevel)
   Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= DebugInfoLevel -> Int
forall a. Enum a => a -> Int
Instance of class: Enum of the constraint type Enum DebugInfoLevel
fromEnum (DebugInfoLevel
forall a. Bounded a => a
Instance of class: Bounded of the constraint type Bounded DebugInfoLevel
maxBound :: DebugInfoLevel)
                -> Int -> DebugInfoLevel
forall a. Enum a => Int -> a
Instance of class: Enum of the constraint type Enum DebugInfoLevel
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
External instance of the constraint type Show Int
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

-- ------------------------------------------------------------
-- * Languages and Extensions
-- ------------------------------------------------------------

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 -> [Flag]
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
External instance of the constraint type Foldable []
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 Flag
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
External instance of the constraint type Eq Language
lookup Language
ext (Compiler -> [(Language, String)]
compilerLanguages Compiler
comp)


-- |For the given compiler, return the extensions it does not support.
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 Flag = String

-- |For the given compiler, return the flags for the supported extensions.
extensionsToFlags :: Compiler -> [Extension] -> [Flag]
extensionsToFlags :: Compiler -> [Extension] -> [String]
extensionsToFlags Compiler
comp = [String] -> [String]
forall a. Eq a => [a] -> [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
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
External instance of the constraint type Foldable []
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)

-- | Looks up the flag for a given extension, for a given compiler.
-- Ignores the subtlety of extensions which lack associated flags.
extensionToFlag :: Compiler -> Extension -> Maybe Flag
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
External instance of the constraint type Monad Maybe
join (Compiler -> Extension -> Maybe (Maybe String)
extensionToFlag' Compiler
comp Extension
ext)

-- | Looks up the flag for a given extension, for a given compiler.
-- However, the extension may be valid for the compiler but not have a flag.
-- For example, NondecreasingIndentation is enabled by default on GHC 7.0.4,
-- hence it is considered a supported extension but not an accepted flag.
--
-- The outer layer of Maybe indicates whether the extensions is supported, while
-- the inner layer indicates whether it has a flag.
-- When building strings, it is often more convenient to use 'extensionToFlag',
-- which ignores the difference.
extensionToFlag' :: Compiler -> Extension -> Maybe (Maybe Flag)
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
External instance of the constraint type Eq Extension
lookup Extension
ext (Compiler -> [(Extension, Maybe String)]
compilerExtensions Compiler
comp)

-- | Does this compiler support parallel --make mode?
parmakeSupported :: Compiler -> Bool
parmakeSupported :: Compiler -> Bool
parmakeSupported = String -> Compiler -> Bool
ghcSupported String
"Support parallel --make"

-- | Does this compiler support reexported-modules?
reexportedModulesSupported :: Compiler -> Bool
reexportedModulesSupported :: Compiler -> Bool
reexportedModulesSupported = String -> Compiler -> Bool
ghcSupported String
"Support reexported-modules"

-- | Does this compiler support thinning/renaming on package flags?
renamingPackageFlagsSupported :: Compiler -> Bool
renamingPackageFlagsSupported :: Compiler -> Bool
renamingPackageFlagsSupported = String -> Compiler -> Bool
ghcSupported
  String
"Support thinning and renaming package flags"

-- | Does this compiler have unified IPIDs (so no package keys)
unifiedIPIDRequired :: Compiler -> Bool
unifiedIPIDRequired :: Compiler -> Bool
unifiedIPIDRequired = String -> Compiler -> Bool
ghcSupported String
"Requires unified installed package IDs"

-- | Does this compiler support package keys?
packageKeySupported :: Compiler -> Bool
packageKeySupported :: Compiler -> Bool
packageKeySupported = String -> Compiler -> Bool
ghcSupported String
"Uses package keys"

-- | Does this compiler support unit IDs?
unitIdSupported :: Compiler -> Bool
unitIdSupported :: Compiler -> Bool
unitIdSupported = String -> Compiler -> Bool
ghcSupported String
"Uses unit IDs"

-- | Does this compiler support Backpack?
backpackSupported :: Compiler -> Bool
backpackSupported :: Compiler -> Bool
backpackSupported = String -> Compiler -> Bool
ghcSupported String
"Support Backpack"

-- | Does this compiler support a package database entry with:
-- "dynamic-library-dirs"?
libraryDynDirSupported :: Compiler -> Bool
libraryDynDirSupported :: Compiler -> Bool
libraryDynDirSupported Compiler
comp = case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
  CompilerFlavor
GHC ->
      -- Not just v >= mkVersion [8,0,1,20161022], as there
      -- are many GHC 8.1 nightlies which don't support this.
    ((Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Version
>= [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
External instance of the constraint type Ord Version
< [Int] -> Version
mkVersion [Int
8,Int
1]) Bool -> Bool -> Bool
||
      Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Version
>= [Int] -> Version
mkVersion [Int
8,Int
1,Int
20161021])
  CompilerFlavor
_   -> Bool
False
 where
  v :: Version
v = Compiler -> Version
compilerVersion Compiler
comp

-- | Does this compiler's "ar" command supports response file
-- arguments (i.e. @file-style arguments).
arResponseFilesSupported :: Compiler -> Bool
arResponseFilesSupported :: Compiler -> Bool
arResponseFilesSupported = String -> Compiler -> Bool
ghcSupported String
"ar supports at file"

-- | Does this compiler support Haskell program coverage?
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

-- | Does this compiler support profiling?
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

-- | Utility function for GHC only features
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
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.lookup String
key (Compiler -> Map String String
compilerProperties Compiler
comp) of
            Just String
"YES" -> Bool
True
            Maybe String
_          -> Bool
False

-- ------------------------------------------------------------
-- * Profiling detail level
-- ------------------------------------------------------------

-- | Some compilers (notably GHC) support profiling and can instrument
-- programs so the system can account costs to different functions. There are
-- different levels of detail that can be used for this accounting.
-- For compilers that do not support this notion or the particular detail
-- levels, this is either ignored or just capped to some similar level
-- they do support.
--
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
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
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
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read 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
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
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
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
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