{-# LANGUAGE DeriveDataTypeable #-}
module Distribution.Compiler (
CompilerFlavor(..),
buildCompilerId,
buildCompilerFlavor,
defaultCompilerFlavor,
parseCompilerFlavorCompat,
CompilerId(..),
) where
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Maybe (fromMaybe)
import Distribution.Version (Version(..))
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 | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC
| OtherCompiler String
deriving (Show, Read, Eq, Ord, Typeable, Data)
knownCompilerFlavors :: [CompilerFlavor]
knownCompilerFlavors = [GHC, NHC, YHC, Hugs, HBC, Helium, JHC, LHC, UHC]
instance Text CompilerFlavor where
disp (OtherCompiler 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, Ord, Read, Show)
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