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

-- |
-- Module      :  Distribution.Simple.GHC.ImplInfo
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module contains the data structure describing invocation
-- details for a GHC or GHC-derived compiler, such as supported flags
-- and workarounds for bugs.
module Distribution.Simple.GHC.ImplInfo
  ( GhcImplInfo (..)
  , getImplInfo
  , ghcVersionImplInfo
  , ghcjsVersionImplInfo
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Simple.Compiler
import Distribution.Version

-- |
--      Information about features and quirks of a GHC-based implementation.
--
--      Compiler flavors based on GHC behave similarly enough that some of
--      the support code for them is shared. Every implementation has its
--      own peculiarities, that may or may not be a direct result of the
--      underlying GHC version. This record keeps track of these differences.
--
--      All shared code (i.e. everything not in the Distribution.Simple.FLAVOR
--      module) should use implementation info rather than version numbers
--      to test for supported features.
data GhcImplInfo = GhcImplInfo
  { GhcImplInfo -> Bool
supportsHaskell2010 :: Bool
  -- ^ -XHaskell2010 and -XHaskell98 flags
  , GhcImplInfo -> Bool
supportsGHC2021 :: Bool
  -- ^ -XGHC2021 flag
  , GhcImplInfo -> Bool
reportsNoExt :: Bool
  -- ^ --supported-languages gives Ext and NoExt
  , GhcImplInfo -> Bool
alwaysNondecIndent :: Bool
  -- ^ NondecreasingIndentation is always on
  , GhcImplInfo -> Bool
flagGhciScript :: Bool
  -- ^ -ghci-script flag supported
  , GhcImplInfo -> Bool
flagProfAuto :: Bool
  -- ^ new style -fprof-auto* flags
  , GhcImplInfo -> Bool
flagProfLate :: Bool
  -- ^ fprof-late flag
  , GhcImplInfo -> Bool
flagPackageConf :: Bool
  -- ^ use package-conf instead of package-db
  , GhcImplInfo -> Bool
flagDebugInfo :: Bool
  -- ^ -g flag supported
  , GhcImplInfo -> Bool
flagHie :: Bool
  -- ^ -hiedir flag supported
  , GhcImplInfo -> Bool
supportsDebugLevels :: Bool
  -- ^ supports numeric @-g@ levels
  , GhcImplInfo -> Bool
supportsPkgEnvFiles :: Bool
  -- ^ picks up @.ghc.environment@ files
  , GhcImplInfo -> Bool
flagWarnMissingHomeModules :: Bool
  -- ^ -Wmissing-home-modules is supported
  , GhcImplInfo -> Bool
unitIdForExes :: Bool
  -- ^ Pass -this-unit-id flag when building executables
  }

getImplInfo :: Compiler -> GhcImplInfo
getImplInfo :: Compiler -> GhcImplInfo
getImplInfo Compiler
comp =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> Version -> GhcImplInfo
ghcVersionImplInfo (Compiler -> Version
compilerVersion Compiler
comp)
    CompilerFlavor
GHCJS -> case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
comp of
      Just Version
ghcVer -> Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo (Compiler -> Version
compilerVersion Compiler
comp) Version
ghcVer
      Maybe Version
_ ->
        [Char] -> GhcImplInfo
forall a. HasCallStack => [Char] -> a
error
          ( [Char]
"Distribution.Simple.GHC.Props.getImplProps: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not find GHC version for GHCJS compiler"
          )
    CompilerFlavor
x ->
      [Char] -> GhcImplInfo
forall a. HasCallStack => [Char] -> a
error
        ( [Char]
"Distribution.Simple.GHC.Props.getImplProps only works"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"for GHC-like compilers (GHC, GHCJS)"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", but found "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CompilerFlavor -> [Char]
forall a. Show a => a -> [Char]
show CompilerFlavor
x
        )

ghcVersionImplInfo :: Version -> GhcImplInfo
ghcVersionImplInfo :: Version -> GhcImplInfo
ghcVersionImplInfo Version
ver =
  GhcImplInfo
    { supportsHaskell2010 :: Bool
supportsHaskell2010 = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
7]
    , supportsGHC2021 :: Bool
supportsGHC2021 = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
9, Int
1]
    , reportsNoExt :: Bool
reportsNoExt = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
7]
    , alwaysNondecIndent :: Bool
alwaysNondecIndent = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
7, Int
1]
    , flagGhciScript :: Bool
flagGhciScript = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
7, Int
2]
    , flagProfAuto :: Bool
flagProfAuto = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
7, Int
4]
    , flagProfLate :: Bool
flagProfLate = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
9, Int
4]
    , flagPackageConf :: Bool
flagPackageConf = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
7, Int
5]
    , flagDebugInfo :: Bool
flagDebugInfo = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
7, Int
10]
    , flagHie :: Bool
flagHie = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
8]
    , supportsDebugLevels :: Bool
supportsDebugLevels = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
0]
    , supportsPkgEnvFiles :: Bool
supportsPkgEnvFiles = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
0, Int
1, Int
20160901] -- broken in 8.0.1, fixed in 8.0.2
    , flagWarnMissingHomeModules :: Bool
flagWarnMissingHomeModules = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
2]
    , unitIdForExes :: Bool
unitIdForExes = [Int]
v [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
9, Int
2]
    }
  where
    v :: [Int]
v = Version -> [Int]
versionNumbers Version
ver

ghcjsVersionImplInfo
  :: Version
  -- ^ The GHCJS version
  -> Version
  -- ^ The GHC version
  -> GhcImplInfo
ghcjsVersionImplInfo :: Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo Version
_ghcjsver Version
ghcver =
  GhcImplInfo
    { supportsHaskell2010 :: Bool
supportsHaskell2010 = Bool
True
    , supportsGHC2021 :: Bool
supportsGHC2021 = Bool
True
    , reportsNoExt :: Bool
reportsNoExt = Bool
True
    , alwaysNondecIndent :: Bool
alwaysNondecIndent = Bool
False
    , flagGhciScript :: Bool
flagGhciScript = Bool
True
    , flagProfAuto :: Bool
flagProfAuto = Bool
True
    , flagProfLate :: Bool
flagProfLate = Bool
True
    , flagPackageConf :: Bool
flagPackageConf = Bool
False
    , flagDebugInfo :: Bool
flagDebugInfo = Bool
False
    , flagHie :: Bool
flagHie = [Int]
ghcv [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
8]
    , supportsDebugLevels :: Bool
supportsDebugLevels = [Int]
ghcv [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
0]
    , supportsPkgEnvFiles :: Bool
supportsPkgEnvFiles = [Int]
ghcv [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
0, Int
2] -- TODO: check this works in ghcjs
    , flagWarnMissingHomeModules :: Bool
flagWarnMissingHomeModules = [Int]
ghcv [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
8, Int
2]
    , unitIdForExes :: Bool
unitIdForExes = [Int]
ghcv [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
9, Int
2]
    }
  where
    ghcv :: [Int]
ghcv = Version -> [Int]
versionNumbers Version
ghcver