module Distribution.Compiler (
CompilerFlavor(..),
buildCompilerId,
buildCompilerFlavor,
defaultCompilerFlavor,
parseCompilerFlavorCompat,
classifyCompilerFlavor,
knownCompilerFlavors,
CompilerId(..),
CompilerInfo(..),
unknownCompilerInfo,
AbiTag(..), abiTagString
) where
import Prelude ()
import Distribution.Compat.Prelude
import Language.Haskell.Extension
import Distribution.Version (Version, mkVersion', nullVersion)
import qualified System.Info (compilerName, compilerVersion)
import Distribution.Parsec.Class (Parsec (..))
import Distribution.Pretty (Pretty (..))
import Distribution.Text (Text(..), display)
import qualified Distribution.Compat.ReadP as Parse
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
data CompilerFlavor =
GHC | GHCJS | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC | Eta
| HaskellSuite String
| OtherCompiler String
deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
instance Binary CompilerFlavor
instance NFData CompilerFlavor where rnf = genericRnf
knownCompilerFlavors :: [CompilerFlavor]
knownCompilerFlavors =
[GHC, GHCJS, NHC, YHC, Hugs, HBC, Helium, JHC, LHC, UHC, Eta]
instance Pretty CompilerFlavor where
pretty (OtherCompiler name) = Disp.text name
pretty (HaskellSuite name) = Disp.text name
pretty NHC = Disp.text "nhc98"
pretty other = Disp.text (lowercase (show other))
instance Parsec CompilerFlavor where
parsec = classifyCompilerFlavor <$> component
where
component = do
cs <- P.munch1 isAlphaNum
if all isDigit cs then fail "all digits compiler name" else return cs
instance Text CompilerFlavor where
parse = do
comp <- Parse.munch1 isAlphaNum
when (all isDigit comp) Parse.pfail
return (classifyCompilerFlavor comp)
classifyCompilerFlavor :: String -> CompilerFlavor
classifyCompilerFlavor s =
fromMaybe (OtherCompiler s) $ lookup (lowercase s) compilerMap
where
compilerMap = [ (lowercase (display compiler), compiler)
| compiler <- knownCompilerFlavors ]
parseCompilerFlavorCompat :: Parse.ReadP r CompilerFlavor
parseCompilerFlavorCompat = do
comp <- Parse.munch1 isAlphaNum
when (all isDigit comp) Parse.pfail
case lookup comp compilerMap of
Just compiler -> return compiler
Nothing -> return (OtherCompiler comp)
where
compilerMap = [ (show compiler, compiler)
| compiler <- knownCompilerFlavors
, compiler /= YHC ]
buildCompilerFlavor :: CompilerFlavor
buildCompilerFlavor = classifyCompilerFlavor System.Info.compilerName
buildCompilerVersion :: Version
buildCompilerVersion = mkVersion' System.Info.compilerVersion
buildCompilerId :: CompilerId
buildCompilerId = CompilerId buildCompilerFlavor buildCompilerVersion
defaultCompilerFlavor :: Maybe CompilerFlavor
defaultCompilerFlavor = case buildCompilerFlavor of
OtherCompiler _ -> Nothing
_ -> Just buildCompilerFlavor
data CompilerId = CompilerId CompilerFlavor Version
deriving (Eq, Generic, Ord, Read, Show)
instance Binary CompilerId
instance NFData CompilerId where rnf = genericRnf
instance Text CompilerId where
disp (CompilerId f v)
| v == nullVersion = disp f
| otherwise = disp f <<>> Disp.char '-' <<>> disp v
parse = do
flavour <- parse
version <- (Parse.char '-' >> parse) Parse.<++ return nullVersion
return (CompilerId flavour version)
lowercase :: String -> String
lowercase = map toLower
data CompilerInfo = CompilerInfo {
compilerInfoId :: CompilerId,
compilerInfoAbiTag :: AbiTag,
compilerInfoCompat :: Maybe [CompilerId],
compilerInfoLanguages :: Maybe [Language],
compilerInfoExtensions :: Maybe [Extension]
}
deriving (Generic, Show, Read)
instance Binary CompilerInfo
data AbiTag
= NoAbiTag
| AbiTag String
deriving (Eq, Generic, Show, Read)
instance Binary AbiTag
instance Text AbiTag where
disp NoAbiTag = Disp.empty
disp (AbiTag tag) = Disp.text tag
parse = do
tag <- Parse.munch (\c -> isAlphaNum c || c == '_')
if null tag then return NoAbiTag else return (AbiTag tag)
abiTagString :: AbiTag -> String
abiTagString NoAbiTag = ""
abiTagString (AbiTag tag) = tag
unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo compilerId abiTag =
CompilerInfo compilerId abiTag (Just []) Nothing Nothing