module Distribution.Compiler (
CompilerFlavor(..),
buildCompilerId,
buildCompilerFlavor,
defaultCompilerFlavor,
parseCompilerFlavorCompat,
CompilerId(..),
CompilerInfo(..),
unknownCompilerInfo,
AbiTag(..), abiTagString
) where
import Data.Binary (Binary)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Maybe (fromMaybe)
import Distribution.Version (Version(..))
import GHC.Generics (Generic)
import Language.Haskell.Extension (Language, Extension)
import qualified System.Info (compilerName, compilerVersion)
import Distribution.Text (Text(..), display)
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>))
import qualified Data.Char as Char (toLower, isDigit, isAlphaNum)
import Control.Monad (when)
data CompilerFlavor = GHC | GHCJS | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC
| HaskellSuite String
| OtherCompiler String
deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
instance Binary CompilerFlavor
knownCompilerFlavors :: [CompilerFlavor]
knownCompilerFlavors = [GHC, GHCJS, NHC, YHC, Hugs, HBC, Helium, JHC, LHC, UHC]
instance Text CompilerFlavor where
disp (OtherCompiler name) = Disp.text name
disp (HaskellSuite name) = Disp.text name
disp NHC = Disp.text "nhc98"
disp other = Disp.text (lowercase (show other))
parse = do
comp <- Parse.munch1 Char.isAlphaNum
when (all Char.isDigit comp) Parse.pfail
return (classifyCompilerFlavor comp)
classifyCompilerFlavor :: String -> CompilerFlavor
classifyCompilerFlavor s =
fromMaybe (OtherCompiler s) $ lookup (lowercase s) compilerMap
where
compilerMap = [ (display compiler, compiler)
| compiler <- knownCompilerFlavors ]
parseCompilerFlavorCompat :: Parse.ReadP r CompilerFlavor
parseCompilerFlavorCompat = do
comp <- Parse.munch1 Char.isAlphaNum
when (all Char.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 = 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 Text CompilerId where
disp (CompilerId f (Version [] _)) = disp f
disp (CompilerId f v) = disp f <> Disp.char '-' <> disp v
parse = do
flavour <- parse
version <- (Parse.char '-' >> parse) Parse.<++ return (Version [] [])
return (CompilerId flavour version)
lowercase :: String -> String
lowercase = map Char.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 (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 -> Char.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