Copyright | Isaac Jones 2003-2004 |
---|---|
License | BSD3 |
Maintainer | cabal-devel@haskell.org |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
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.
Synopsis
- module Distribution.Compiler
- data Compiler = Compiler {}
- showCompilerId :: Compiler -> String
- showCompilerIdWithAbi :: Compiler -> String
- compilerFlavor :: Compiler -> CompilerFlavor
- compilerVersion :: Compiler -> Version
- compilerCompatFlavor :: CompilerFlavor -> Compiler -> Bool
- compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version
- compilerInfo :: Compiler -> CompilerInfo
- type PackageDB = PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
- type PackageDBStack = PackageDBStackX (SymbolicPath Pkg ('Dir PkgDB))
- type PackageDBCWD = PackageDBX FilePath
- type PackageDBStackCWD = PackageDBStackX FilePath
- data PackageDBX fp
- type PackageDBStackX from = [PackageDBX from]
- type PackageDBS from = PackageDBX (SymbolicPath from ('Dir PkgDB))
- type PackageDBStackS from = PackageDBStackX (SymbolicPath from ('Dir PkgDB))
- registrationPackageDB :: PackageDBStackX from -> PackageDBX from
- absolutePackageDBPaths :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDBStack -> IO PackageDBStack
- absolutePackageDBPath :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> IO PackageDB
- interpretPackageDB :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> PackageDBCWD
- interpretPackageDBStack :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDBStack -> PackageDBStackCWD
- coercePackageDB :: PackageDBCWD -> PackageDBX (SymbolicPath CWD ('Dir PkgDB))
- coercePackageDBStack :: [PackageDBCWD] -> [PackageDBX (SymbolicPath CWD ('Dir PkgDB))]
- data OptimisationLevel
- flagToOptimisationLevel :: Maybe String -> OptimisationLevel
- data DebugInfoLevel
- flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
- type CompilerFlag = String
- languageToFlags :: Compiler -> Maybe Language -> [CompilerFlag]
- unsupportedLanguages :: Compiler -> [Language] -> [Language]
- extensionsToFlags :: Compiler -> [Extension] -> [CompilerFlag]
- unsupportedExtensions :: Compiler -> [Extension] -> [Extension]
- parmakeSupported :: Compiler -> Bool
- reexportedModulesSupported :: Compiler -> Bool
- renamingPackageFlagsSupported :: Compiler -> Bool
- unifiedIPIDRequired :: Compiler -> Bool
- packageKeySupported :: Compiler -> Bool
- unitIdSupported :: Compiler -> Bool
- coverageSupported :: Compiler -> Bool
- profilingSupported :: Compiler -> Bool
- profilingDynamicSupported :: Compiler -> Maybe Bool
- profilingDynamicSupportedOrUnknown :: Compiler -> Bool
- profilingVanillaSupported :: Compiler -> Maybe Bool
- profilingVanillaSupportedOrUnknown :: Compiler -> Bool
- dynamicSupported :: Compiler -> Maybe Bool
- backpackSupported :: Compiler -> Bool
- arResponseFilesSupported :: Compiler -> Bool
- arDashLSupported :: Compiler -> Bool
- libraryDynDirSupported :: Compiler -> Bool
- libraryVisibilitySupported :: Compiler -> Bool
- jsemSupported :: Compiler -> Bool
- data ProfDetailLevel
- knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
- flagToProfDetailLevel :: String -> ProfDetailLevel
- showProfDetailLevel :: ProfDetailLevel -> String
Haskell implementations
module Distribution.Compiler
Compiler | |
|
Instances
showCompilerId :: Compiler -> String Source #
compilerVersion :: Compiler -> Version Source #
compilerCompatFlavor :: CompilerFlavor -> Compiler -> Bool Source #
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 ...
compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version Source #
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:_)) -> ... _ -> ...
compilerInfo :: Compiler -> CompilerInfo Source #
Support for package databases
type PackageDB = PackageDBX (SymbolicPath Pkg ('Dir PkgDB)) Source #
type PackageDBStack = PackageDBStackX (SymbolicPath Pkg ('Dir PkgDB)) Source #
type PackageDBCWD = PackageDBX FilePath Source #
data PackageDBX fp Source #
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
GlobalPackageDB | |
UserPackageDB | |
SpecificPackageDB fp | NB: the path might be relative or it might be absolute |
Instances
Functor PackageDBX Source # | |||||
Defined in Distribution.Simple.Compiler fmap :: (a -> b) -> PackageDBX a -> PackageDBX b # (<$) :: a -> PackageDBX b -> PackageDBX a # | |||||
Foldable PackageDBX Source # | |||||
Defined in Distribution.Simple.Compiler fold :: Monoid m => PackageDBX m -> m # foldMap :: Monoid m => (a -> m) -> PackageDBX a -> m # foldMap' :: Monoid m => (a -> m) -> PackageDBX a -> m # foldr :: (a -> b -> b) -> b -> PackageDBX a -> b # foldr' :: (a -> b -> b) -> b -> PackageDBX a -> b # foldl :: (b -> a -> b) -> b -> PackageDBX a -> b # foldl' :: (b -> a -> b) -> b -> PackageDBX a -> b # foldr1 :: (a -> a -> a) -> PackageDBX a -> a # foldl1 :: (a -> a -> a) -> PackageDBX a -> a # toList :: PackageDBX a -> [a] # null :: PackageDBX a -> Bool # length :: PackageDBX a -> Int # elem :: Eq a => a -> PackageDBX a -> Bool # maximum :: Ord a => PackageDBX a -> a # minimum :: Ord a => PackageDBX a -> a # sum :: Num a => PackageDBX a -> a # product :: Num a => PackageDBX a -> a # | |||||
Traversable PackageDBX Source # | |||||
Defined in Distribution.Simple.Compiler traverse :: Applicative f => (a -> f b) -> PackageDBX a -> f (PackageDBX b) # sequenceA :: Applicative f => PackageDBX (f a) -> f (PackageDBX a) # mapM :: Monad m => (a -> m b) -> PackageDBX a -> m (PackageDBX b) # sequence :: Monad m => PackageDBX (m a) -> m (PackageDBX a) # | |||||
Structured fp => Structured (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler structure :: Proxy (PackageDBX fp) -> Structure Source # structureHash' :: Tagged (PackageDBX fp) MD5 | |||||
Binary fp => Binary (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler | |||||
Generic (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler
from :: PackageDBX fp -> Rep (PackageDBX fp) x # to :: Rep (PackageDBX fp) x -> PackageDBX fp # | |||||
Read fp => Read (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler readsPrec :: Int -> ReadS (PackageDBX fp) # readList :: ReadS [PackageDBX fp] # readPrec :: ReadPrec (PackageDBX fp) # readListPrec :: ReadPrec [PackageDBX fp] # | |||||
Show fp => Show (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler showsPrec :: Int -> PackageDBX fp -> ShowS # show :: PackageDBX fp -> String # showList :: [PackageDBX fp] -> ShowS # | |||||
Eq fp => Eq (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler (==) :: PackageDBX fp -> PackageDBX fp -> Bool # (/=) :: PackageDBX fp -> PackageDBX fp -> Bool # | |||||
Ord fp => Ord (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler compare :: 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 # max :: PackageDBX fp -> PackageDBX fp -> PackageDBX fp # min :: PackageDBX fp -> PackageDBX fp -> PackageDBX fp # | |||||
type Rep (PackageDBX fp) Source # | |||||
Defined in Distribution.Simple.Compiler type Rep (PackageDBX fp) = D1 ('MetaData "PackageDBX" "Distribution.Simple.Compiler" "Cabal-3.14.0.0-be97" 'False) (C1 ('MetaCons "GlobalPackageDB" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "UserPackageDB" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SpecificPackageDB" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 fp)))) |
type PackageDBStackX from = [PackageDBX from] Source #
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 PackageDBS from = PackageDBX (SymbolicPath from ('Dir PkgDB)) Source #
type PackageDBStackS from = PackageDBStackX (SymbolicPath from ('Dir PkgDB)) Source #
registrationPackageDB :: PackageDBStackX from -> PackageDBX from Source #
Return the package that we should register into. This is the package db at the top of the stack.
absolutePackageDBPaths :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDBStack -> IO PackageDBStack Source #
Make package paths absolute
interpretPackageDB :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDB -> PackageDBCWD Source #
interpretPackageDBStack :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> PackageDBStack -> PackageDBStackCWD Source #
coercePackageDB :: PackageDBCWD -> PackageDBX (SymbolicPath CWD ('Dir PkgDB)) Source #
Transform a package db using a FilePath into one using symbolic paths.
coercePackageDBStack :: [PackageDBCWD] -> [PackageDBX (SymbolicPath CWD ('Dir PkgDB))] Source #
Support for optimisation levels
data OptimisationLevel Source #
Some compilers support optimising. Some have different levels. For compilers that do not the level is just capped to the level they do support.
Instances
Structured OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler structure :: Proxy OptimisationLevel -> Structure Source # structureHash' :: Tagged OptimisationLevel MD5 | |||||
Binary OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler put :: OptimisationLevel -> Put # get :: Get OptimisationLevel # putList :: [OptimisationLevel] -> Put # | |||||
Bounded OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler | |||||
Enum OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler succ :: OptimisationLevel -> OptimisationLevel # pred :: OptimisationLevel -> OptimisationLevel # toEnum :: Int -> OptimisationLevel # fromEnum :: OptimisationLevel -> Int # enumFrom :: OptimisationLevel -> [OptimisationLevel] # enumFromThen :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel] # enumFromTo :: OptimisationLevel -> OptimisationLevel -> [OptimisationLevel] # enumFromThenTo :: OptimisationLevel -> OptimisationLevel -> OptimisationLevel -> [OptimisationLevel] # | |||||
Generic OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler
from :: OptimisationLevel -> Rep OptimisationLevel x # to :: Rep OptimisationLevel x -> OptimisationLevel # | |||||
Read OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler | |||||
Show OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler showsPrec :: Int -> OptimisationLevel -> ShowS # show :: OptimisationLevel -> String # showList :: [OptimisationLevel] -> ShowS # | |||||
Eq OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler (==) :: OptimisationLevel -> OptimisationLevel -> Bool # (/=) :: OptimisationLevel -> OptimisationLevel -> Bool # | |||||
type Rep OptimisationLevel Source # | |||||
Defined in Distribution.Simple.Compiler type Rep OptimisationLevel = D1 ('MetaData "OptimisationLevel" "Distribution.Simple.Compiler" "Cabal-3.14.0.0-be97" 'False) (C1 ('MetaCons "NoOptimisation" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NormalOptimisation" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MaximumOptimisation" 'PrefixI 'False) (U1 :: Type -> Type))) |
Support for debug info levels
data DebugInfoLevel Source #
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.
Instances
Structured DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler structure :: Proxy DebugInfoLevel -> Structure Source # structureHash' :: Tagged DebugInfoLevel MD5 | |||||
Binary DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler | |||||
Bounded DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler | |||||
Enum DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler succ :: DebugInfoLevel -> DebugInfoLevel # pred :: DebugInfoLevel -> DebugInfoLevel # toEnum :: Int -> DebugInfoLevel # fromEnum :: DebugInfoLevel -> Int # enumFrom :: DebugInfoLevel -> [DebugInfoLevel] # enumFromThen :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel] # enumFromTo :: DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel] # enumFromThenTo :: DebugInfoLevel -> DebugInfoLevel -> DebugInfoLevel -> [DebugInfoLevel] # | |||||
Generic DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler
from :: DebugInfoLevel -> Rep DebugInfoLevel x # to :: Rep DebugInfoLevel x -> DebugInfoLevel # | |||||
Read DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler readsPrec :: Int -> ReadS DebugInfoLevel # readList :: ReadS [DebugInfoLevel] # | |||||
Show DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler showsPrec :: Int -> DebugInfoLevel -> ShowS # show :: DebugInfoLevel -> String # showList :: [DebugInfoLevel] -> ShowS # | |||||
Eq DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler (==) :: DebugInfoLevel -> DebugInfoLevel -> Bool # (/=) :: DebugInfoLevel -> DebugInfoLevel -> Bool # | |||||
type Rep DebugInfoLevel Source # | |||||
Defined in Distribution.Simple.Compiler type Rep DebugInfoLevel = D1 ('MetaData "DebugInfoLevel" "Distribution.Simple.Compiler" "Cabal-3.14.0.0-be97" 'False) ((C1 ('MetaCons "NoDebugInfo" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MinimalDebugInfo" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NormalDebugInfo" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MaximalDebugInfo" 'PrefixI 'False) (U1 :: Type -> Type))) |
Support for language extensions
type CompilerFlag = String Source #
languageToFlags :: Compiler -> Maybe Language -> [CompilerFlag] Source #
extensionsToFlags :: Compiler -> [Extension] -> [CompilerFlag] Source #
For the given compiler, return the flags for the supported extensions.
unsupportedExtensions :: Compiler -> [Extension] -> [Extension] Source #
For the given compiler, return the extensions it does not support.
parmakeSupported :: Compiler -> Bool Source #
Does this compiler support parallel --make mode?
reexportedModulesSupported :: Compiler -> Bool Source #
Does this compiler support reexported-modules?
renamingPackageFlagsSupported :: Compiler -> Bool Source #
Does this compiler support thinning/renaming on package flags?
unifiedIPIDRequired :: Compiler -> Bool Source #
Does this compiler have unified IPIDs (so no package keys)
packageKeySupported :: Compiler -> Bool Source #
Does this compiler support package keys?
unitIdSupported :: Compiler -> Bool Source #
Does this compiler support unit IDs?
coverageSupported :: Compiler -> Bool Source #
Does this compiler support Haskell program coverage?
profilingSupported :: Compiler -> Bool Source #
Does this compiler support profiling?
profilingDynamicSupported :: Compiler -> Maybe Bool Source #
Is the compiler distributed with profiling dynamic libraries
profilingDynamicSupportedOrUnknown :: Compiler -> Bool Source #
Either profiling dynamic is definitely supported or we don't know (so assume it is)
profilingVanillaSupported :: Compiler -> Maybe Bool Source #
Is the compiler distributed with profiling libraries
profilingVanillaSupportedOrUnknown :: Compiler -> Bool Source #
Either profiling is definitely supported or we don't know (so assume it is)
dynamicSupported :: Compiler -> Maybe Bool Source #
Is the compiler distributed with dynamic libraries
backpackSupported :: Compiler -> Bool Source #
Does this compiler support Backpack?
arResponseFilesSupported :: Compiler -> Bool Source #
Does this compiler's "ar" command supports response file arguments (i.e. @file-style arguments).
arDashLSupported :: Compiler -> Bool Source #
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.
libraryDynDirSupported :: Compiler -> Bool Source #
Does this compiler support a package database entry with: "dynamic-library-dirs"?
libraryVisibilitySupported :: Compiler -> Bool Source #
Does this compiler support a package database entry with: "visibility"?
jsemSupported :: Compiler -> Bool Source #
Does this compiler support the -jsem option?
Support for profiling detail levels
data ProfDetailLevel Source #
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.
ProfDetailNone | |
ProfDetailDefault | |
ProfDetailExportedFunctions | |
ProfDetailToplevelFunctions | |
ProfDetailAllFunctions | |
ProfDetailTopLate | |
ProfDetailOther String |
Instances
Structured ProfDetailLevel Source # | |||||
Defined in Distribution.Simple.Compiler structure :: Proxy ProfDetailLevel -> Structure Source # structureHash' :: Tagged ProfDetailLevel MD5 | |||||
Binary ProfDetailLevel Source # | |||||
Defined in Distribution.Simple.Compiler | |||||
Generic ProfDetailLevel Source # | |||||
Defined in Distribution.Simple.Compiler
from :: ProfDetailLevel -> Rep ProfDetailLevel x # to :: Rep ProfDetailLevel x -> ProfDetailLevel # | |||||
Read ProfDetailLevel Source # | |||||
Defined in Distribution.Simple.Compiler | |||||
Show ProfDetailLevel Source # | |||||
Defined in Distribution.Simple.Compiler showsPrec :: Int -> ProfDetailLevel -> ShowS # show :: ProfDetailLevel -> String # showList :: [ProfDetailLevel] -> ShowS # | |||||
Eq ProfDetailLevel Source # | |||||
Defined in Distribution.Simple.Compiler (==) :: ProfDetailLevel -> ProfDetailLevel -> Bool # (/=) :: ProfDetailLevel -> ProfDetailLevel -> Bool # | |||||
type Rep ProfDetailLevel Source # | |||||
Defined in Distribution.Simple.Compiler type Rep ProfDetailLevel = D1 ('MetaData "ProfDetailLevel" "Distribution.Simple.Compiler" "Cabal-3.14.0.0-be97" 'False) ((C1 ('MetaCons "ProfDetailNone" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ProfDetailDefault" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ProfDetailExportedFunctions" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "ProfDetailToplevelFunctions" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ProfDetailAllFunctions" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ProfDetailTopLate" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ProfDetailOther" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))))) |
knownProfDetailLevels :: [(String, [String], ProfDetailLevel)] Source #