module Distribution.Compiler (
CompilerFlavor(..),
buildCompilerId,
buildCompilerFlavor,
defaultCompilerFlavor,
classifyCompilerFlavor,
knownCompilerFlavors,
PerCompilerFlavor (..),
perCompilerFlavorToList,
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 (Parsec (..))
import Distribution.Pretty (Pretty (..), prettyShow)
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 Structured 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
classifyCompilerFlavor :: String -> CompilerFlavor
classifyCompilerFlavor s =
fromMaybe (OtherCompiler s) $ lookup (lowercase s) compilerMap
where
compilerMap = [ (lowercase (prettyShow compiler), compiler)
| compiler <- knownCompilerFlavors ]
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 PerCompilerFlavor v = PerCompilerFlavor v v
deriving (Generic, Show, Read, Eq, Typeable, Data, Functor, Foldable
, Traversable)
instance Binary a => Binary (PerCompilerFlavor a)
instance Structured a => Structured (PerCompilerFlavor a)
instance NFData a => NFData (PerCompilerFlavor a)
perCompilerFlavorToList :: PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor a b) = [(GHC, a), (GHCJS, b)]
instance Semigroup a => Semigroup (PerCompilerFlavor a) where
PerCompilerFlavor a b <> PerCompilerFlavor a' b' = PerCompilerFlavor
(a <> a') (b <> b')
instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
mempty = PerCompilerFlavor mempty mempty
mappend = (<>)
data CompilerId = CompilerId CompilerFlavor Version
deriving (Eq, Generic, Ord, Read, Show, Typeable)
instance Binary CompilerId
instance Structured CompilerId
instance NFData CompilerId where rnf = genericRnf
instance Pretty CompilerId where
pretty (CompilerId f v)
| v == nullVersion = pretty f
| otherwise = pretty f <<>> Disp.char '-' <<>> pretty v
instance Parsec CompilerId where
parsec = do
flavour <- parsec
version <- (P.char '-' >> parsec) <|> 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, Typeable)
instance Binary AbiTag
instance Structured AbiTag
instance Pretty AbiTag where
pretty NoAbiTag = Disp.empty
pretty (AbiTag tag) = Disp.text tag
instance Parsec AbiTag where
parsec = do
tag <- P.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