module Distribution.Simple.GHC.ImplInfo (
GhcImplInfo(..), getImplInfo,
ghcVersionImplInfo, ghcjsVersionImplInfo
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Simple.Compiler
import Distribution.Version
data GhcImplInfo = GhcImplInfo
{ supportsHaskell2010 :: Bool
, reportsNoExt :: Bool
, alwaysNondecIndent :: Bool
, flagGhciScript :: Bool
, flagProfAuto :: Bool
, flagPackageConf :: Bool
, flagDebugInfo :: Bool
, supportsDebugLevels :: Bool
, supportsPkgEnvFiles :: Bool
, flagWarnMissingHomeModules :: Bool
}
getImplInfo :: Compiler -> GhcImplInfo
getImplInfo comp =
case compilerFlavor comp of
GHC -> ghcVersionImplInfo (compilerVersion comp)
GHCJS -> case compilerCompatVersion GHC comp of
Just ghcVer -> ghcjsVersionImplInfo (compilerVersion comp) ghcVer
_ -> error ("Distribution.Simple.GHC.Props.getImplProps: " ++
"could not find GHC version for GHCJS compiler")
x -> error ("Distribution.Simple.GHC.Props.getImplProps only works" ++
"for GHC-like compilers (GHC, GHCJS)" ++
", but found " ++ show x)
ghcVersionImplInfo :: Version -> GhcImplInfo
ghcVersionImplInfo ver = GhcImplInfo
{ supportsHaskell2010 = v >= [7]
, reportsNoExt = v >= [7]
, alwaysNondecIndent = v < [7,1]
, flagGhciScript = v >= [7,2]
, flagProfAuto = v >= [7,4]
, flagPackageConf = v < [7,5]
, flagDebugInfo = v >= [7,10]
, supportsDebugLevels = v >= [8,0]
, supportsPkgEnvFiles = v >= [8,0,1,20160901]
, flagWarnMissingHomeModules = v >= [8,2]
}
where
v = versionNumbers ver
ghcjsVersionImplInfo :: Version
-> Version
-> GhcImplInfo
ghcjsVersionImplInfo _ghcjsver ghcver = GhcImplInfo
{ supportsHaskell2010 = True
, reportsNoExt = True
, alwaysNondecIndent = False
, flagGhciScript = True
, flagProfAuto = True
, flagPackageConf = False
, flagDebugInfo = False
, supportsDebugLevels = ghcv >= [8,0]
, supportsPkgEnvFiles = ghcv >= [8,0,2]
, flagWarnMissingHomeModules = ghcv >= [8,2]
}
where
ghcv = versionNumbers ghcver