{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}

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

-- |
-- 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
  , PackageDBCWD
  , PackageDBStackCWD
  , PackageDBX (..)
  , PackageDBStackX
  , PackageDBS
  , PackageDBStackS
  , registrationPackageDB
  , absolutePackageDBPaths
  , absolutePackageDBPath
  , interpretPackageDB
  , interpretPackageDBStack
  , coercePackageDB
  , coercePackageDBStack
  , readPackageDb

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

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

    -- * Support for language extensions
  , CompilerFlag
  , languageToFlags
  , unsupportedLanguages
  , extensionsToFlags
  , unsupportedExtensions
  , parmakeSupported
  , reexportedModulesSupported
  , renamingPackageFlagsSupported
  , unifiedIPIDRequired
  , packageKeySupported
  , unitIdSupported
  , coverageSupported
  , profilingSupported
  , profilingDynamicSupported
  , profilingDynamicSupportedOrUnknown
  , profilingVanillaSupported
  , profilingVanillaSupportedOrUnknown
  , dynamicSupported
  , bytecodeArtifactsSupported
  , backpackSupported
  , arResponseFilesSupported
  , arDashLSupported
  , libraryDynDirSupported
  , libraryVisibilitySupported
  , jsemSupported
  , jsemVersion
  , reexportedAsSupported

    -- * Support for profiling detail levels
  , ProfDetailLevel (..)
  , knownProfDetailLevels
  , flagToProfDetailLevel
  , showProfDetailLevel
  ) where

import Distribution.Compat.CharParsing
import Distribution.Compat.Prelude
import Distribution.Parsec
import Distribution.Pretty
import Prelude ()

import Distribution.Compiler
import Distribution.Package (PackageName)
import Distribution.Simple.Utils
import Distribution.Types.UnitId (UnitId)
import Distribution.Utils.Path
import Distribution.Version

import Language.Haskell.Extension

import Data.Bool (bool)
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, CompilerFlag)]
  -- ^ Supported language standards.
  , Compiler -> [(Extension, Maybe String)]
compilerExtensions :: [(Extension, Maybe CompilerFlag)]
  -- ^ Supported extensions.
  , Compiler -> Maybe [(PackageName, UnitId)]
compilerWiredInUnitIds :: Maybe [(PackageName, UnitId)]
  -- ^ 'UnitId's that the compiler doesn't support reinstalling.
  -- For instance, when using GHC plugins, one wants to use the exact same
  -- version of the `ghc` package as the one the compiler was linked against.
  -- 'Nothing' indicates that the compiler hasn't supplied this
  -- information and that we should act pessimistically.
  , 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
$c== :: Compiler -> Compiler -> Bool
== :: Compiler -> Compiler -> Bool
$c/= :: Compiler -> Compiler -> Bool
/= :: 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
$cfrom :: forall x. Compiler -> Rep Compiler x
from :: forall x. Compiler -> Rep Compiler x
$cto :: forall x. Rep Compiler x -> Compiler
to :: forall x. Rep Compiler x -> Compiler
Generic, 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
$cshowsPrec :: Int -> Compiler -> ShowS
showsPrec :: Int -> Compiler -> ShowS
$cshow :: Compiler -> String
show :: Compiler -> String
$cshowList :: [Compiler] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Compiler
readsPrec :: Int -> ReadS Compiler
$creadList :: ReadS [Compiler]
readList :: ReadS [Compiler]
$creadPrec :: ReadPrec Compiler
readPrec :: ReadPrec Compiler
$creadListPrec :: ReadPrec [Compiler]
readListPrec :: ReadPrec [Compiler]
Read)

instance Binary Compiler
instance NFData 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

-- | 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
== Compiler -> CompilerFlavor
compilerFlavor Compiler
comp
    Bool -> Bool -> Bool
|| CompilerFlavor
flavor CompilerFlavor -> [CompilerFlavor] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`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
== 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]
-> Maybe [(PackageName, UnitId)]
-> 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)
    (Compiler -> Maybe [(PackageName, UnitId)]
compilerWiredInUnitIds 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 isolated environments of
--  packages, for example to build a collection of related packages
--  without installing them globally.
--
--  Abstracted over
data PackageDBX fp
  = GlobalPackageDB
  | UserPackageDB
  | -- | NB: the path might be relative or it might be absolute
    SpecificPackageDB fp
  deriving (PackageDBX fp -> PackageDBX fp -> Bool
(PackageDBX fp -> PackageDBX fp -> Bool)
-> (PackageDBX fp -> PackageDBX fp -> Bool) -> Eq (PackageDBX fp)
forall fp. Eq fp => PackageDBX fp -> PackageDBX fp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall fp. Eq fp => PackageDBX fp -> PackageDBX fp -> Bool
== :: PackageDBX fp -> PackageDBX fp -> Bool
$c/= :: forall fp. Eq fp => PackageDBX fp -> PackageDBX fp -> Bool
/= :: PackageDBX fp -> PackageDBX fp -> Bool
Eq, (forall x. PackageDBX fp -> Rep (PackageDBX fp) x)
-> (forall x. Rep (PackageDBX fp) x -> PackageDBX fp)
-> Generic (PackageDBX fp)
forall x. Rep (PackageDBX fp) x -> PackageDBX fp
forall x. PackageDBX fp -> Rep (PackageDBX fp) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall fp x. Rep (PackageDBX fp) x -> PackageDBX fp
forall fp x. PackageDBX fp -> Rep (PackageDBX fp) x
$cfrom :: forall fp x. PackageDBX fp -> Rep (PackageDBX fp) x
from :: forall x. PackageDBX fp -> Rep (PackageDBX fp) x
$cto :: forall fp x. Rep (PackageDBX fp) x -> PackageDBX fp
to :: forall x. Rep (PackageDBX fp) x -> PackageDBX fp
Generic, Eq (PackageDBX fp)
Eq (PackageDBX fp) =>
(PackageDBX fp -> PackageDBX fp -> Ordering)
-> (PackageDBX fp -> PackageDBX fp -> Bool)
-> (PackageDBX fp -> PackageDBX fp -> Bool)
-> (PackageDBX fp -> PackageDBX fp -> Bool)
-> (PackageDBX fp -> PackageDBX fp -> Bool)
-> (PackageDBX fp -> PackageDBX fp -> PackageDBX fp)
-> (PackageDBX fp -> PackageDBX fp -> PackageDBX fp)
-> Ord (PackageDBX fp)
PackageDBX fp -> PackageDBX fp -> Bool
PackageDBX fp -> PackageDBX fp -> Ordering
PackageDBX fp -> PackageDBX fp -> PackageDBX fp
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
forall fp. Ord fp => Eq (PackageDBX fp)
forall fp. Ord fp => PackageDBX fp -> PackageDBX fp -> Bool
forall fp. Ord fp => PackageDBX fp -> PackageDBX fp -> Ordering
forall fp.
Ord fp =>
PackageDBX fp -> PackageDBX fp -> PackageDBX fp
$ccompare :: forall fp. Ord fp => PackageDBX fp -> PackageDBX fp -> Ordering
compare :: PackageDBX fp -> PackageDBX fp -> Ordering
$c< :: forall fp. Ord fp => PackageDBX fp -> PackageDBX fp -> Bool
< :: PackageDBX fp -> PackageDBX fp -> Bool
$c<= :: forall fp. Ord fp => PackageDBX fp -> PackageDBX fp -> Bool
<= :: PackageDBX fp -> PackageDBX fp -> Bool
$c> :: forall fp. Ord fp => PackageDBX fp -> PackageDBX fp -> Bool
> :: PackageDBX fp -> PackageDBX fp -> Bool
$c>= :: forall fp. Ord fp => PackageDBX fp -> PackageDBX fp -> Bool
>= :: PackageDBX fp -> PackageDBX fp -> Bool
$cmax :: forall fp.
Ord fp =>
PackageDBX fp -> PackageDBX fp -> PackageDBX fp
max :: PackageDBX fp -> PackageDBX fp -> PackageDBX fp
$cmin :: forall fp.
Ord fp =>
PackageDBX fp -> PackageDBX fp -> PackageDBX fp
min :: PackageDBX fp -> PackageDBX fp -> PackageDBX fp
Ord, Int -> PackageDBX fp -> ShowS
[PackageDBX fp] -> ShowS
PackageDBX fp -> String
(Int -> PackageDBX fp -> ShowS)
-> (PackageDBX fp -> String)
-> ([PackageDBX fp] -> ShowS)
-> Show (PackageDBX fp)
forall fp. Show fp => Int -> PackageDBX fp -> ShowS
forall fp. Show fp => [PackageDBX fp] -> ShowS
forall fp. Show fp => PackageDBX fp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall fp. Show fp => Int -> PackageDBX fp -> ShowS
showsPrec :: Int -> PackageDBX fp -> ShowS
$cshow :: forall fp. Show fp => PackageDBX fp -> String
show :: PackageDBX fp -> String
$cshowList :: forall fp. Show fp => [PackageDBX fp] -> ShowS
showList :: [PackageDBX fp] -> ShowS
Show, ReadPrec [PackageDBX fp]
ReadPrec (PackageDBX fp)
Int -> ReadS (PackageDBX fp)
ReadS [PackageDBX fp]
(Int -> ReadS (PackageDBX fp))
-> ReadS [PackageDBX fp]
-> ReadPrec (PackageDBX fp)
-> ReadPrec [PackageDBX fp]
-> Read (PackageDBX fp)
forall fp. Read fp => ReadPrec [PackageDBX fp]
forall fp. Read fp => ReadPrec (PackageDBX fp)
forall fp. Read fp => Int -> ReadS (PackageDBX fp)
forall fp. Read fp => ReadS [PackageDBX fp]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall fp. Read fp => Int -> ReadS (PackageDBX fp)
readsPrec :: Int -> ReadS (PackageDBX fp)
$creadList :: forall fp. Read fp => ReadS [PackageDBX fp]
readList :: ReadS [PackageDBX fp]
$creadPrec :: forall fp. Read fp => ReadPrec (PackageDBX fp)
readPrec :: ReadPrec (PackageDBX fp)
$creadListPrec :: forall fp. Read fp => ReadPrec [PackageDBX fp]
readListPrec :: ReadPrec [PackageDBX fp]
Read, (forall a b. (a -> b) -> PackageDBX a -> PackageDBX b)
-> (forall a b. a -> PackageDBX b -> PackageDBX a)
-> Functor PackageDBX
forall a b. a -> PackageDBX b -> PackageDBX a
forall a b. (a -> b) -> PackageDBX a -> PackageDBX b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PackageDBX a -> PackageDBX b
fmap :: forall a b. (a -> b) -> PackageDBX a -> PackageDBX b
$c<$ :: forall a b. a -> PackageDBX b -> PackageDBX a
<$ :: forall a b. a -> PackageDBX b -> PackageDBX a
Functor, (forall m. Monoid m => PackageDBX m -> m)
-> (forall m a. Monoid m => (a -> m) -> PackageDBX a -> m)
-> (forall m a. Monoid m => (a -> m) -> PackageDBX a -> m)
-> (forall a b. (a -> b -> b) -> b -> PackageDBX a -> b)
-> (forall a b. (a -> b -> b) -> b -> PackageDBX a -> b)
-> (forall b a. (b -> a -> b) -> b -> PackageDBX a -> b)
-> (forall b a. (b -> a -> b) -> b -> PackageDBX a -> b)
-> (forall a. (a -> a -> a) -> PackageDBX a -> a)
-> (forall a. (a -> a -> a) -> PackageDBX a -> a)
-> (forall a. PackageDBX a -> [a])
-> (forall a. PackageDBX a -> Bool)
-> (forall a. PackageDBX a -> Int)
-> (forall a. Eq a => a -> PackageDBX a -> Bool)
-> (forall a. Ord a => PackageDBX a -> a)
-> (forall a. Ord a => PackageDBX a -> a)
-> (forall a. Num a => PackageDBX a -> a)
-> (forall a. Num a => PackageDBX a -> a)
-> Foldable PackageDBX
forall a. Eq a => a -> PackageDBX a -> Bool
forall a. Num a => PackageDBX a -> a
forall a. Ord a => PackageDBX a -> a
forall m. Monoid m => PackageDBX m -> m
forall a. PackageDBX a -> Bool
forall a. PackageDBX a -> Int
forall a. PackageDBX a -> [a]
forall a. (a -> a -> a) -> PackageDBX a -> a
forall m a. Monoid m => (a -> m) -> PackageDBX a -> m
forall b a. (b -> a -> b) -> b -> PackageDBX a -> b
forall a b. (a -> b -> b) -> b -> PackageDBX a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => PackageDBX m -> m
fold :: forall m. Monoid m => PackageDBX m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PackageDBX a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PackageDBX a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PackageDBX a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> PackageDBX a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> PackageDBX a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PackageDBX a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PackageDBX a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PackageDBX a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PackageDBX a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PackageDBX a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PackageDBX a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> PackageDBX a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> PackageDBX a -> a
foldr1 :: forall a. (a -> a -> a) -> PackageDBX a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PackageDBX a -> a
foldl1 :: forall a. (a -> a -> a) -> PackageDBX a -> a
$ctoList :: forall a. PackageDBX a -> [a]
toList :: forall a. PackageDBX a -> [a]
$cnull :: forall a. PackageDBX a -> Bool
null :: forall a. PackageDBX a -> Bool
$clength :: forall a. PackageDBX a -> Int
length :: forall a. PackageDBX a -> Int
$celem :: forall a. Eq a => a -> PackageDBX a -> Bool
elem :: forall a. Eq a => a -> PackageDBX a -> Bool
$cmaximum :: forall a. Ord a => PackageDBX a -> a
maximum :: forall a. Ord a => PackageDBX a -> a
$cminimum :: forall a. Ord a => PackageDBX a -> a
minimum :: forall a. Ord a => PackageDBX a -> a
$csum :: forall a. Num a => PackageDBX a -> a
sum :: forall a. Num a => PackageDBX a -> a
$cproduct :: forall a. Num a => PackageDBX a -> a
product :: forall a. Num a => PackageDBX a -> a
Foldable, Functor PackageDBX
Foldable PackageDBX
(Functor PackageDBX, Foldable PackageDBX) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> PackageDBX a -> f (PackageDBX b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PackageDBX (f a) -> f (PackageDBX a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PackageDBX a -> m (PackageDBX b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PackageDBX (m a) -> m (PackageDBX a))
-> Traversable PackageDBX
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PackageDBX (m a) -> m (PackageDBX a)
forall (f :: * -> *) a.
Applicative f =>
PackageDBX (f a) -> f (PackageDBX a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PackageDBX a -> m (PackageDBX b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PackageDBX a -> f (PackageDBX b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PackageDBX a -> f (PackageDBX b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PackageDBX a -> f (PackageDBX b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PackageDBX (f a) -> f (PackageDBX a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PackageDBX (f a) -> f (PackageDBX a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PackageDBX a -> m (PackageDBX b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PackageDBX a -> m (PackageDBX b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PackageDBX (m a) -> m (PackageDBX a)
sequence :: forall (m :: * -> *) a.
Monad m =>
PackageDBX (m a) -> m (PackageDBX a)
Traversable)

instance Binary fp => Binary (PackageDBX fp)
instance NFData fp => NFData (PackageDBX fp)
instance Structured fp => Structured (PackageDBX fp)

-- | Parse a PackageDB stack entry
--
-- @since 3.7.0.0
readPackageDb :: String -> Maybe PackageDB
readPackageDb :: String -> Maybe PackageDB
readPackageDb String
"clear" = Maybe PackageDB
forall a. Maybe a
Nothing
readPackageDb String
"global" = PackageDB -> Maybe PackageDB
forall a. a -> Maybe a
Just PackageDB
forall fp. PackageDBX fp
GlobalPackageDB
readPackageDb String
"user" = PackageDB -> Maybe PackageDB
forall a. a -> Maybe a
Just PackageDB
forall fp. PackageDBX fp
UserPackageDB
readPackageDb String
other = PackageDB -> Maybe PackageDB
forall a. a -> Maybe a
Just (SymbolicPath Pkg ('Dir PkgDB) -> PackageDB
forall fp. fp -> PackageDBX fp
SpecificPackageDB (String -> SymbolicPath Pkg ('Dir PkgDB)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath String
other))

-- | 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 PackageDBStackX from = [PackageDBX from]

type PackageDB = PackageDBX (SymbolicPath Pkg (Dir PkgDB))
type PackageDBStack = PackageDBStackX (SymbolicPath Pkg (Dir PkgDB))

type PackageDBS from = PackageDBX (SymbolicPath from (Dir PkgDB))
type PackageDBStackS from = PackageDBStackX (SymbolicPath from (Dir PkgDB))

type PackageDBCWD = PackageDBX FilePath
type PackageDBStackCWD = PackageDBStackX FilePath

-- | Return the package that we should register into. This is the package db at
-- the top of the stack.
registrationPackageDB :: PackageDBStackX from -> PackageDBX from
registrationPackageDB :: forall from. PackageDBStackX from -> PackageDBX from
registrationPackageDB PackageDBStackX from
dbs = case PackageDBStackX from -> Maybe (PackageDBX from)
forall a. [a] -> Maybe a
safeLast PackageDBStackX from
dbs of
  Maybe (PackageDBX from)
Nothing -> String -> PackageDBX from
forall a. HasCallStack => String -> a
error String
"internal error: empty package db set"
  Just PackageDBX from
p -> PackageDBX from
p

-- | Make package paths absolute
absolutePackageDBPaths
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -> PackageDBStack
  -> IO PackageDBStack
absolutePackageDBPaths :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack -> IO PackageDBStack
absolutePackageDBPaths Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = (PackageDB -> IO PackageDB) -> PackageDBStack -> IO PackageDBStack
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((PackageDB -> IO PackageDB)
 -> PackageDBStack -> IO PackageDBStack)
-> (PackageDB -> IO PackageDB)
-> PackageDBStack
-> IO PackageDBStack
forall a b. (a -> b) -> a -> b
$ Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> IO PackageDB
absolutePackageDBPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir

absolutePackageDBPath
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -> PackageDB
  -> IO PackageDB
absolutePackageDBPath :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> IO PackageDB
absolutePackageDBPath Maybe (SymbolicPath CWD ('Dir Pkg))
_ PackageDB
GlobalPackageDB = PackageDB -> IO PackageDB
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDB
forall fp. PackageDBX fp
GlobalPackageDB
absolutePackageDBPath Maybe (SymbolicPath CWD ('Dir Pkg))
_ PackageDB
UserPackageDB = PackageDB -> IO PackageDB
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDB
forall fp. PackageDBX fp
UserPackageDB
absolutePackageDBPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir (SpecificPackageDB SymbolicPath Pkg ('Dir PkgDB)
db) = do
  let db' :: String
db' =
        case SymbolicPath Pkg ('Dir PkgDB)
-> Maybe (RelativePath Pkg ('Dir PkgDB))
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe SymbolicPath Pkg ('Dir PkgDB)
db of
          Maybe (RelativePath Pkg ('Dir PkgDB))
Nothing -> SymbolicPath Pkg ('Dir PkgDB) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath Pkg ('Dir PkgDB)
db
          Just RelativePath Pkg ('Dir PkgDB)
rel_path -> Maybe (SymbolicPath CWD ('Dir Pkg))
-> RelativePath Pkg ('Dir PkgDB) -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir RelativePath Pkg ('Dir PkgDB)
rel_path
  SymbolicPath Pkg ('Dir PkgDB) -> PackageDB
forall fp. fp -> PackageDBX fp
SpecificPackageDB (SymbolicPath Pkg ('Dir PkgDB) -> PackageDB)
-> (String -> SymbolicPath Pkg ('Dir PkgDB)) -> String -> PackageDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SymbolicPath Pkg ('Dir PkgDB)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath (String -> PackageDB) -> IO String -> IO PackageDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
canonicalizePath String
db'

interpretPackageDB :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageDBCWD
interpretPackageDB :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> PackageDBCWD
interpretPackageDB Maybe (SymbolicPath CWD ('Dir Pkg))
_ PackageDB
GlobalPackageDB = PackageDBCWD
forall fp. PackageDBX fp
GlobalPackageDB
interpretPackageDB Maybe (SymbolicPath CWD ('Dir Pkg))
_ PackageDB
UserPackageDB = PackageDBCWD
forall fp. PackageDBX fp
UserPackageDB
interpretPackageDB Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir (SpecificPackageDB SymbolicPath Pkg ('Dir PkgDB)
db) =
  String -> PackageDBCWD
forall fp. fp -> PackageDBX fp
SpecificPackageDB (Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir PkgDB) -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir PkgDB)
db)

interpretPackageDBStack :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> PackageDBStackCWD
interpretPackageDBStack :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack -> PackageDBStackCWD
interpretPackageDBStack Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = (PackageDB -> PackageDBCWD) -> PackageDBStack -> PackageDBStackCWD
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> PackageDBCWD
interpretPackageDB Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir)

-- | Transform a package db using a FilePath into one using symbolic paths.
coercePackageDB :: PackageDBCWD -> PackageDBX (SymbolicPath CWD (Dir PkgDB))
coercePackageDB :: PackageDBCWD -> PackageDBX (SymbolicPath CWD ('Dir PkgDB))
coercePackageDB PackageDBCWD
GlobalPackageDB = PackageDBX (SymbolicPath CWD ('Dir PkgDB))
forall fp. PackageDBX fp
GlobalPackageDB
coercePackageDB PackageDBCWD
UserPackageDB = PackageDBX (SymbolicPath CWD ('Dir PkgDB))
forall fp. PackageDBX fp
UserPackageDB
coercePackageDB (SpecificPackageDB String
db) = SymbolicPath CWD ('Dir PkgDB)
-> PackageDBX (SymbolicPath CWD ('Dir PkgDB))
forall fp. fp -> PackageDBX fp
SpecificPackageDB (String -> SymbolicPath CWD ('Dir PkgDB)
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath String
db)

coercePackageDBStack
  :: [PackageDBCWD]
  -> [PackageDBX (SymbolicPath CWD (Dir PkgDB))]
coercePackageDBStack :: PackageDBStackCWD -> [PackageDBX (SymbolicPath CWD ('Dir PkgDB))]
coercePackageDBStack = (PackageDBCWD -> PackageDBX (SymbolicPath CWD ('Dir PkgDB)))
-> PackageDBStackCWD
-> [PackageDBX (SymbolicPath CWD ('Dir PkgDB))]
forall a b. (a -> b) -> [a] -> [b]
map PackageDBCWD -> PackageDBX (SymbolicPath CWD ('Dir PkgDB))
coercePackageDB

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

-- * 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
$cminBound :: OptimisationLevel
minBound :: OptimisationLevel
$cmaxBound :: OptimisationLevel
maxBound :: 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
$csucc :: OptimisationLevel -> OptimisationLevel
succ :: OptimisationLevel -> OptimisationLevel
$cpred :: OptimisationLevel -> OptimisationLevel
pred :: OptimisationLevel -> OptimisationLevel
$ctoEnum :: Int -> OptimisationLevel
toEnum :: Int -> OptimisationLevel
$cfromEnum :: OptimisationLevel -> Int
fromEnum :: OptimisationLevel -> Int
$cenumFrom :: OptimisationLevel -> [OptimisationLevel]
enumFrom :: OptimisationLevel -> [OptimisationLevel]
$cenumFromThen :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
enumFromThen :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
$cenumFromTo :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
enumFromTo :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
$cenumFromThenTo :: OptimisationLevel
-> OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
enumFromThenTo :: OptimisationLevel
-> OptimisationLevel -> OptimisationLevel -> [OptimisationLevel]
Enum, OptimisationLevel -> OptimisationLevel -> Bool
(OptimisationLevel -> OptimisationLevel -> Bool)
-> (OptimisationLevel -> OptimisationLevel -> Bool)
-> Eq OptimisationLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptimisationLevel -> OptimisationLevel -> Bool
== :: OptimisationLevel -> OptimisationLevel -> Bool
$c/= :: OptimisationLevel -> OptimisationLevel -> Bool
/= :: 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
$cfrom :: forall x. OptimisationLevel -> Rep OptimisationLevel x
from :: forall x. OptimisationLevel -> Rep OptimisationLevel x
$cto :: forall x. Rep OptimisationLevel x -> OptimisationLevel
to :: forall x. Rep OptimisationLevel x -> OptimisationLevel
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
$creadsPrec :: Int -> ReadS OptimisationLevel
readsPrec :: Int -> ReadS OptimisationLevel
$creadList :: ReadS [OptimisationLevel]
readList :: ReadS [OptimisationLevel]
$creadPrec :: ReadPrec OptimisationLevel
readPrec :: ReadPrec OptimisationLevel
$creadListPrec :: ReadPrec [OptimisationLevel]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> OptimisationLevel -> ShowS
showsPrec :: Int -> OptimisationLevel -> ShowS
$cshow :: OptimisationLevel -> String
show :: OptimisationLevel -> String
$cshowList :: [OptimisationLevel] -> ShowS
showList :: [OptimisationLevel] -> ShowS
Show)

instance Binary OptimisationLevel
instance NFData OptimisationLevel
instance Structured OptimisationLevel

instance Parsec OptimisationLevel where
  parsec :: forall (m :: * -> *). CabalParsing m => m OptimisationLevel
parsec = m OptimisationLevel
forall (m :: * -> *). CabalParsing m => m OptimisationLevel
parsecOptimisationLevel

parsecOptimisationLevel :: CabalParsing m => m OptimisationLevel
parsecOptimisationLevel :: forall (m :: * -> *). CabalParsing m => m OptimisationLevel
parsecOptimisationLevel = m OptimisationLevel
boolParser m OptimisationLevel -> m OptimisationLevel -> m OptimisationLevel
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m OptimisationLevel
intParser
  where
    boolParser :: m OptimisationLevel
boolParser = OptimisationLevel -> OptimisationLevel -> Bool -> OptimisationLevel
forall a. a -> a -> Bool -> a
bool OptimisationLevel
NoOptimisation OptimisationLevel
NormalOptimisation (Bool -> OptimisationLevel) -> m Bool -> m OptimisationLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Bool
parsec
    intParser :: m OptimisationLevel
intParser = Int -> OptimisationLevel
intToOptimisationLevel (Int -> OptimisationLevel) -> m Int -> m OptimisationLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
integral

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 -> OptimisationLevel
intToOptimisationLevel Int
i
  [(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

intToOptimisationLevel :: Int -> OptimisationLevel
intToOptimisationLevel :: Int -> OptimisationLevel
intToOptimisationLevel Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minLevel Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLevel = 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 "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minLevel
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".."
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxLevel
  where
    minLevel :: Int
minLevel = OptimisationLevel -> Int
forall a. Enum a => a -> Int
fromEnum (OptimisationLevel
forall a. Bounded a => a
minBound :: OptimisationLevel)
    maxLevel :: Int
maxLevel = OptimisationLevel -> Int
forall a. Enum a => a -> Int
fromEnum (OptimisationLevel
forall a. Bounded a => a
maxBound :: OptimisationLevel)

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

-- * 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
$cminBound :: DebugInfoLevel
minBound :: DebugInfoLevel
$cmaxBound :: DebugInfoLevel
maxBound :: 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
$csucc :: DebugInfoLevel -> DebugInfoLevel
succ :: DebugInfoLevel -> DebugInfoLevel
$cpred :: DebugInfoLevel -> DebugInfoLevel
pred :: DebugInfoLevel -> DebugInfoLevel
$ctoEnum :: Int -> DebugInfoLevel
toEnum :: Int -> DebugInfoLevel
$cfromEnum :: DebugInfoLevel -> Int
fromEnum :: DebugInfoLevel -> Int
$cenumFrom :: DebugInfoLevel -> [DebugInfoLevel]
enumFrom :: DebugInfoLevel -> [DebugInfoLevel]
$cenumFromThen :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
enumFromThen :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
$cenumFromTo :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
enumFromTo :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
$cenumFromThenTo :: DebugInfoLevel
-> DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
enumFromThenTo :: DebugInfoLevel
-> DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel]
Enum, DebugInfoLevel -> DebugInfoLevel -> Bool
(DebugInfoLevel -> DebugInfoLevel -> Bool)
-> (DebugInfoLevel -> DebugInfoLevel -> Bool) -> Eq DebugInfoLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DebugInfoLevel -> DebugInfoLevel -> Bool
== :: DebugInfoLevel -> DebugInfoLevel -> Bool
$c/= :: DebugInfoLevel -> DebugInfoLevel -> Bool
/= :: 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
$cfrom :: forall x. DebugInfoLevel -> Rep DebugInfoLevel x
from :: forall x. DebugInfoLevel -> Rep DebugInfoLevel x
$cto :: forall x. Rep DebugInfoLevel x -> DebugInfoLevel
to :: forall x. Rep DebugInfoLevel x -> DebugInfoLevel
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
$creadsPrec :: Int -> ReadS DebugInfoLevel
readsPrec :: Int -> ReadS DebugInfoLevel
$creadList :: ReadS [DebugInfoLevel]
readList :: ReadS [DebugInfoLevel]
$creadPrec :: ReadPrec DebugInfoLevel
readPrec :: ReadPrec DebugInfoLevel
$creadListPrec :: ReadPrec [DebugInfoLevel]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> DebugInfoLevel -> ShowS
showsPrec :: Int -> DebugInfoLevel -> ShowS
$cshow :: DebugInfoLevel -> String
show :: DebugInfoLevel -> String
$cshowList :: [DebugInfoLevel] -> ShowS
showList :: [DebugInfoLevel] -> ShowS
Show)

instance Binary DebugInfoLevel
instance NFData DebugInfoLevel
instance Structured DebugInfoLevel

instance Parsec DebugInfoLevel where
  parsec :: forall (m :: * -> *). CabalParsing m => m DebugInfoLevel
parsec = m DebugInfoLevel
forall (m :: * -> *). CabalParsing m => m DebugInfoLevel
parsecDebugInfoLevel

parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel
parsecDebugInfoLevel :: forall (m :: * -> *). CabalParsing m => m DebugInfoLevel
parsecDebugInfoLevel = Maybe String -> DebugInfoLevel
flagToDebugInfoLevel (Maybe String -> DebugInfoLevel)
-> (String -> Maybe String) -> String -> DebugInfoLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> DebugInfoLevel) -> m String -> m DebugInfoLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
parsecToken

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

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

-- * 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 -> [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 a. [a] -> 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
. (Language -> Maybe String) -> [Language] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Compiler -> Language -> Maybe String
languageToFlag Compiler
comp)
    ([Language] -> [String])
-> (Maybe Language -> [Language]) -> Maybe Language -> [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)

-- | 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 CompilerFlag = String

-- | For the given compiler, return the flags for the supported extensions.
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 a. [a] -> 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
. (Extension -> Maybe String) -> [Extension] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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 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)

-- | 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 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)

-- | 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 the -jsem option?
jsemSupported :: Compiler -> Bool
jsemSupported :: Compiler -> Bool
jsemSupported 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
9, Int
7]
  CompilerFlavor
_ -> Bool
False
  where
    v :: Version
v = Compiler -> Version
compilerVersion Compiler
comp

-- | What semaphore protocol version does this compiler use?
--
-- Returns @Nothing@ for compilers that don't report a "Semaphore version"
-- field in @ghc --info@ (i.e. GHC 9.8–9.14, which use v1).
jsemVersion :: Compiler -> Maybe Int
jsemVersion :: Compiler -> Maybe Int
jsemVersion Compiler
comp = case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
  CompilerFlavor
GHC -> String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"Semaphore version" (Compiler -> Map String String
compilerProperties Compiler
comp) Maybe String -> (String -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe
  CompilerFlavor
_ -> Maybe Int
forall a. Maybe a
Nothing

-- | Does the compiler support the -reexported-modules "A as B" syntax
reexportedAsSupported :: Compiler -> Bool
reexportedAsSupported :: Compiler -> Bool
reexportedAsSupported 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
9, Int
12]
  CompilerFlavor
_ -> Bool
False
  where
    v :: Version
v = Compiler -> Version
compilerVersion Compiler
comp

-- | 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 -> Bool
True
  CompilerFlavor
_ -> Bool
False

-- | 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's "ar" command support llvm-ar's -L flag,
-- which compels the archiver to add an input archive's members
-- rather than adding the archive itself.
arDashLSupported :: Compiler -> Bool
arDashLSupported :: Compiler -> Bool
arDashLSupported = String -> Compiler -> Bool
ghcSupported String
"ar supports -L"

-- | 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

-- | Returns Just if we can certainly determine whether a way is supported
-- if we don't know, return Nothing
waySupported :: String -> Compiler -> Maybe Bool
waySupported :: String -> Compiler -> Maybe Bool
waySupported String
way Compiler
comp =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC ->
      -- Information about compiler ways is only accurately reported after
      -- 9.10.1. Which is useful as this is before profiling dynamic support
      -- was introduced. (See GHC #24881)
      if Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9, Int
10, Int
1]
        then case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"RTS ways" (Compiler -> Map String String
compilerProperties Compiler
comp) of
          Just String
ways -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (String
way String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
words String
ways)
          Maybe String
Nothing -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
        else Maybe Bool
forall a. Maybe a
Nothing
    CompilerFlavor
_ -> Maybe Bool
forall a. Maybe a
Nothing

-- | Either profiling is definitely supported or we don't know (so assume
-- it is)
profilingVanillaSupportedOrUnknown :: Compiler -> Bool
profilingVanillaSupportedOrUnknown :: Compiler -> Bool
profilingVanillaSupportedOrUnknown Compiler
comp = Compiler -> Maybe Bool
profilingVanillaSupported Compiler
comp Maybe Bool -> [Maybe Bool] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True, Maybe Bool
forall a. Maybe a
Nothing]

-- | Is the compiler distributed with profiling libraries
profilingVanillaSupported :: Compiler -> Maybe Bool
profilingVanillaSupported :: Compiler -> Maybe Bool
profilingVanillaSupported Compiler
comp = String -> Compiler -> Maybe Bool
waySupported String
"p" Compiler
comp

-- | Is the compiler distributed with profiling dynamic libraries
profilingDynamicSupported :: Compiler -> Maybe Bool
profilingDynamicSupported :: Compiler -> Maybe Bool
profilingDynamicSupported Compiler
comp
  | CompilerFlavor
GHC <- Compiler -> CompilerFlavor
compilerFlavor Compiler
comp
  , -- Certainly not before 9.11, as prof+dyn was not implemented yet.
    Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= [Int] -> Version
mkVersion [Int
9, Int
11, Int
0] =
      Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  | Bool
otherwise =
      String -> Compiler -> Maybe Bool
waySupported String
"p_dyn" Compiler
comp

-- | Either profiling dynamic is definitely supported or we don't know (so assume
-- it is)
profilingDynamicSupportedOrUnknown :: Compiler -> Bool
profilingDynamicSupportedOrUnknown :: Compiler -> Bool
profilingDynamicSupportedOrUnknown Compiler
comp =
  Compiler -> Maybe Bool
profilingDynamicSupported Compiler
comp Maybe Bool -> [Maybe Bool] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True, Maybe Bool
forall a. Maybe a
Nothing]

-- | Is the compiler distributed with dynamic libraries
dynamicSupported :: Compiler -> Maybe Bool
dynamicSupported :: Compiler -> Maybe Bool
dynamicSupported Compiler
comp = String -> Compiler -> Maybe Bool
waySupported String
"dyn" Compiler
comp

-- | Does the compiler support producing bytecode objects and bytecode libraries?
bytecodeArtifactsSupported :: Compiler -> Bool
bytecodeArtifactsSupported :: Compiler -> Bool
bytecodeArtifactsSupported Compiler
comp
  | CompilerFlavor
GHC <- Compiler -> CompilerFlavor
compilerFlavor Compiler
comp
  , Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
9, Int
15, Int
0] =
      Bool
True
  | Bool
otherwise = Bool
False

-- | Does this compiler support a package database entry with:
-- "visibility"?
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

-- | 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
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
  | ProfDetailTopLate
  | ProfDetailOther String
  deriving (ProfDetailLevel -> ProfDetailLevel -> Bool
(ProfDetailLevel -> ProfDetailLevel -> Bool)
-> (ProfDetailLevel -> ProfDetailLevel -> Bool)
-> Eq ProfDetailLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfDetailLevel -> ProfDetailLevel -> Bool
== :: ProfDetailLevel -> ProfDetailLevel -> Bool
$c/= :: ProfDetailLevel -> ProfDetailLevel -> Bool
/= :: 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
$cfrom :: forall x. ProfDetailLevel -> Rep ProfDetailLevel x
from :: forall x. ProfDetailLevel -> Rep ProfDetailLevel x
$cto :: forall x. Rep ProfDetailLevel x -> ProfDetailLevel
to :: forall x. Rep ProfDetailLevel x -> ProfDetailLevel
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
$creadsPrec :: Int -> ReadS ProfDetailLevel
readsPrec :: Int -> ReadS ProfDetailLevel
$creadList :: ReadS [ProfDetailLevel]
readList :: ReadS [ProfDetailLevel]
$creadPrec :: ReadPrec ProfDetailLevel
readPrec :: ReadPrec ProfDetailLevel
$creadListPrec :: ReadPrec [ProfDetailLevel]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> ProfDetailLevel -> ShowS
showsPrec :: Int -> ProfDetailLevel -> ShowS
$cshow :: ProfDetailLevel -> String
show :: ProfDetailLevel -> String
$cshowList :: [ProfDetailLevel] -> ShowS
showList :: [ProfDetailLevel] -> ShowS
Show)

instance Binary ProfDetailLevel
instance NFData ProfDetailLevel
instance Structured ProfDetailLevel

instance Parsec ProfDetailLevel where
  parsec :: forall (m :: * -> *). CabalParsing m => m ProfDetailLevel
parsec = m ProfDetailLevel
forall (m :: * -> *). CabalParsing m => m ProfDetailLevel
parsecProfDetailLevel

parsecProfDetailLevel :: CabalParsing m => m ProfDetailLevel
parsecProfDetailLevel :: forall (m :: * -> *). CabalParsing m => m ProfDetailLevel
parsecProfDetailLevel = String -> ProfDetailLevel
flagToProfDetailLevel (String -> ProfDetailLevel) -> m String -> m ProfDetailLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
parsecToken

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)
  , (String
"late-toplevel", [String
"late"], ProfDetailLevel
ProfDetailTopLate)
  ]

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"
  ProfDetailLevel
ProfDetailTopLate -> String
"late-toplevel"
  ProfDetailOther String
other -> String
other