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

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

-- |
-- 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
  , CompilerFlag
  , languageToFlags
  , unsupportedLanguages
  , extensionsToFlags
  , unsupportedExtensions
  , parmakeSupported
  , reexportedModulesSupported
  , renamingPackageFlagsSupported
  , unifiedIPIDRequired
  , packageKeySupported
  , unitIdSupported
  , coverageSupported
  , profilingSupported
  , backpackSupported
  , arResponseFilesSupported
  , arDashLSupported
  , libraryDynDirSupported
  , libraryVisibilitySupported
  , jsemSupported

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

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

import Distribution.Compiler
import Distribution.Simple.Utils
import Distribution.Version
import Language.Haskell.Extension

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 -> 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, 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
$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 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]
-> 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 isolated 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
$c== :: PackageDB -> PackageDB -> Bool
== :: PackageDB -> PackageDB -> Bool
$c/= :: PackageDB -> PackageDB -> Bool
/= :: PackageDB -> PackageDB -> Bool
Eq, (forall x. PackageDB -> Rep PackageDB x)
-> (forall x. Rep PackageDB x -> PackageDB) -> Generic PackageDB
forall x. Rep PackageDB x -> PackageDB
forall x. PackageDB -> Rep PackageDB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PackageDB -> Rep PackageDB x
from :: forall x. PackageDB -> Rep PackageDB x
$cto :: forall x. Rep PackageDB x -> PackageDB
to :: forall x. Rep PackageDB x -> PackageDB
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
$ccompare :: PackageDB -> PackageDB -> Ordering
compare :: PackageDB -> PackageDB -> Ordering
$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
>= :: PackageDB -> PackageDB -> Bool
$cmax :: PackageDB -> PackageDB -> PackageDB
max :: PackageDB -> PackageDB -> PackageDB
$cmin :: PackageDB -> PackageDB -> PackageDB
min :: PackageDB -> PackageDB -> 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
$cshowsPrec :: Int -> PackageDB -> ShowS
showsPrec :: Int -> PackageDB -> ShowS
$cshow :: PackageDB -> String
show :: PackageDB -> String
$cshowList :: [PackageDB] -> ShowS
showList :: [PackageDB] -> ShowS
Show, ReadPrec [PackageDB]
ReadPrec PackageDB
Int -> ReadS PackageDB
ReadS [PackageDB]
(Int -> ReadS PackageDB)
-> ReadS [PackageDB]
-> ReadPrec PackageDB
-> ReadPrec [PackageDB]
-> Read PackageDB
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PackageDB
readsPrec :: Int -> ReadS PackageDB
$creadList :: ReadS [PackageDB]
readList :: ReadS [PackageDB]
$creadPrec :: ReadPrec PackageDB
readPrec :: ReadPrec PackageDB
$creadListPrec :: ReadPrec [PackageDB]
readListPrec :: ReadPrec [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 -> IO PackageDBStack
absolutePackageDBPaths :: [PackageDB] -> IO [PackageDB]
absolutePackageDBPaths = (PackageDB -> IO PackageDB) -> [PackageDB] -> IO [PackageDB]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse PackageDB -> IO PackageDB
absolutePackageDBPath

absolutePackageDBPath :: PackageDB -> IO PackageDB
absolutePackageDBPath :: PackageDB -> IO PackageDB
absolutePackageDBPath PackageDB
GlobalPackageDB = PackageDB -> IO PackageDB
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDB
GlobalPackageDB
absolutePackageDBPath PackageDB
UserPackageDB = PackageDB -> IO PackageDB
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDB
UserPackageDB
absolutePackageDBPath (SpecificPackageDB String
db) =
  String -> PackageDB
SpecificPackageDB (String -> PackageDB) -> IO String -> IO PackageDB
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> IO String
canonicalizePath String
db

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

-- * 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, Typeable)

instance Binary OptimisationLevel
instance Structured OptimisationLevel

flagToOptimisationLevel :: Maybe String -> OptimisationLevel
flagToOptimisationLevel :: Maybe String -> OptimisationLevel
flagToOptimisationLevel Maybe String
Nothing = OptimisationLevel
NormalOptimisation
flagToOptimisationLevel (Just String
s) = case ReadS Int
forall a. Read a => ReadS a
reads String
s of
  [(Int
i, String
"")]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= OptimisationLevel -> Int
forall a. Enum a => a -> Int
fromEnum (OptimisationLevel
forall a. Bounded a => a
minBound :: OptimisationLevel)
        Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= OptimisationLevel -> Int
forall a. Enum a => a -> Int
fromEnum (OptimisationLevel
forall a. Bounded a => a
maxBound :: OptimisationLevel) ->
        Int -> OptimisationLevel
forall a. Enum a => Int -> a
toEnum Int
i
    | Bool
otherwise ->
        String -> OptimisationLevel
forall a. HasCallStack => String -> a
error (String -> OptimisationLevel) -> String -> OptimisationLevel
forall a b. (a -> b) -> a -> b
$
          String
"Bad optimisation level: "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Valid values are 0..2"
  [(Int, String)]
_ -> String -> OptimisationLevel
forall a. HasCallStack => String -> a
error (String -> OptimisationLevel) -> String -> OptimisationLevel
forall a b. (a -> b) -> a -> b
$ String
"Can't parse optimisation level " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

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

-- * 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, Typeable)

instance Binary DebugInfoLevel
instance Structured DebugInfoLevel

flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
flagToDebugInfoLevel Maybe String
Nothing = DebugInfoLevel
NormalDebugInfo
flagToDebugInfoLevel (Just String
s) = case ReadS Int
forall a. Read a => ReadS a
reads String
s of
  [(Int
i, String
"")]
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= DebugInfoLevel -> Int
forall a. Enum a => a -> Int
fromEnum (DebugInfoLevel
forall a. Bounded a => a
minBound :: DebugInfoLevel)
        Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= DebugInfoLevel -> Int
forall a. Enum a => a -> Int
fromEnum (DebugInfoLevel
forall a. Bounded a => a
maxBound :: DebugInfoLevel) ->
        Int -> DebugInfoLevel
forall a. Enum a => Int -> a
toEnum Int
i
    | Bool
otherwise ->
        String -> DebugInfoLevel
forall a. HasCallStack => String -> a
error (String -> DebugInfoLevel) -> String -> DebugInfoLevel
forall a b. (a -> b) -> a -> b
$
          String
"Bad debug info level: "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Valid values are 0..3"
  [(Int, String)]
_ -> String -> DebugInfoLevel
forall a. HasCallStack => String -> a
error (String -> DebugInfoLevel) -> String -> DebugInfoLevel
forall a b. (a -> b) -> a -> b
$ String
"Can't parse debug info level " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

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

-- * 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
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe String] -> [String])
-> (Maybe Language -> [Maybe String]) -> Maybe Language -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Language -> Maybe String) -> [Language] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (Compiler -> Language -> Maybe String
languageToFlag Compiler
comp)
    ([Language] -> [Maybe String])
-> (Maybe Language -> [Language])
-> Maybe Language
-> [Maybe String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Language]
-> (Language -> [Language]) -> Maybe Language -> [Language]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Language
Haskell98] (\Language
x -> [Language
x])

languageToFlag :: Compiler -> Language -> Maybe CompilerFlag
languageToFlag :: Compiler -> Language -> Maybe String
languageToFlag Compiler
comp Language
ext = Language -> [(Language, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Language
ext (Compiler -> [(Language, String)]
compilerLanguages Compiler
comp)

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

-- | 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
>= [Int] -> Version
mkVersion [Int
8, Int
0, Int
1, Int
20161022] Bool -> Bool -> Bool
&& Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
8, Int
1])
        Bool -> Bool -> Bool
|| Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
1, Int
20161021]
    )
  CompilerFlavor
_ -> Bool
False
  where
    v :: Version
v = Compiler -> Version
compilerVersion Compiler
comp

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

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

instance Binary ProfDetailLevel
instance Structured ProfDetailLevel

flagToProfDetailLevel :: String -> ProfDetailLevel
flagToProfDetailLevel :: String -> ProfDetailLevel
flagToProfDetailLevel String
"" = ProfDetailLevel
ProfDetailDefault
flagToProfDetailLevel String
s =
  case String -> [(String, ProfDetailLevel)] -> Maybe ProfDetailLevel
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup
    (ShowS
lowercase String
s)
    [ (String
name, ProfDetailLevel
value)
    | (String
primary, [String]
aliases, ProfDetailLevel
value) <- [(String, [String], ProfDetailLevel)]
knownProfDetailLevels
    , String
name <- String
primary String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
aliases
    ] of
    Just ProfDetailLevel
value -> ProfDetailLevel
value
    Maybe ProfDetailLevel
Nothing -> String -> ProfDetailLevel
ProfDetailOther String
s

knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
knownProfDetailLevels =
  [ (String
"default", [], ProfDetailLevel
ProfDetailDefault)
  , (String
"none", [], ProfDetailLevel
ProfDetailNone)
  , (String
"exported-functions", [String
"exported"], ProfDetailLevel
ProfDetailExportedFunctions)
  , (String
"toplevel-functions", [String
"toplevel", String
"top"], ProfDetailLevel
ProfDetailToplevelFunctions)
  , (String
"all-functions", [String
"all"], ProfDetailLevel
ProfDetailAllFunctions)
  , (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