Cabal-syntax/src/Distribution/Compiler.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveFoldable #-}
   3 {-# LANGUAGE DeriveFunctor #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 {-# LANGUAGE DeriveTraversable #-}
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Compiler
  11 -- Copyright   :  Isaac Jones 2003-2004
  12 -- License     :  BSD3
  13 --
  14 -- Maintainer  :  cabal-devel@haskell.org
  15 -- Portability :  portable
  16 --
  17 -- This has an enumeration of the various compilers that Cabal knows about. It
  18 -- also specifies the default compiler. Sadly you'll often see code that does
  19 -- case analysis on this compiler flavour enumeration like:
  20 --
  21 -- > case compilerFlavor comp of
  22 -- >   GHC -> GHC.getInstalledPackages verbosity packageDb progdb
  23 --
  24 -- Obviously it would be better to use the proper 'Compiler' abstraction
  25 -- because that would keep all the compiler-specific code together.
  26 -- Unfortunately we cannot make this change yet without breaking the
  27 -- 'UserHooks' api, which would break all custom @Setup.hs@ files, so for the
  28 -- moment we just have to live with this deficiency. If you're interested, see
  29 -- ticket #57.
  30 module Distribution.Compiler
  31   ( -- * Compiler flavor
  32     CompilerFlavor (..)
  33   , buildCompilerId
  34   , buildCompilerFlavor
  35   , defaultCompilerFlavor
  36   , classifyCompilerFlavor
  37   , knownCompilerFlavors
  38
  39     -- * Per compiler flavor
  40   , PerCompilerFlavor (..)
  41   , perCompilerFlavorToList
  42
  43     -- * Compiler id
  44   , CompilerId (..)
  45
  46     -- * Compiler info
  47   , CompilerInfo (..)
  48   , unknownCompilerInfo
  49   , AbiTag (..)
  50   , abiTagString
  51   ) where
  52
  53 import Distribution.Compat.Prelude
  54 import Prelude ()
  55
  56 import Language.Haskell.Extension
  57
  58 import Distribution.Version (Version, mkVersion', nullVersion)
  59
  60 import qualified Distribution.Compat.CharParsing as P
  61 import Distribution.Parsec (Parsec (..))
  62 import Distribution.Pretty (Pretty (..), prettyShow)
  63 import qualified System.Info (compilerName, compilerVersion)
  64 import qualified Text.PrettyPrint as Disp
  65
  66 data CompilerFlavor
  67   = GHC
  68   | GHCJS
  69   | NHC
  70   | YHC
  71   | Hugs
  72   | HBC
  73   | Helium
  74   | JHC
  75   | LHC
  76   | UHC
  77   | Eta
  78   | MHS -- MicroHS, see https://github.com/augustss/MicroHs
  79   | HaskellSuite String -- string is the id of the actual compiler
  80   | OtherCompiler String
  81   deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
  82
  83 instance Binary CompilerFlavor
  84 instance Structured CompilerFlavor
  85 instance NFData CompilerFlavor where rnf = genericRnf
  86
  87 knownCompilerFlavors :: [CompilerFlavor]
  88 knownCompilerFlavors =
  89   [GHC, GHCJS, NHC, YHC, Hugs, HBC, Helium, JHC, LHC, UHC, Eta, MHS]
  90
  91 instance Pretty CompilerFlavor where
  92   pretty (OtherCompiler name) = Disp.text name
  93   pretty (HaskellSuite name) = Disp.text name
  94   pretty NHC = Disp.text "nhc98"
  95   pretty other = Disp.text (lowercase (show other))
  96
  97 instance Parsec CompilerFlavor where
  98   parsec = classifyCompilerFlavor <$> component
  99     where
 100       component = do
 101         cs <- P.munch1 isAlphaNum
 102         if all isDigit cs then fail "all digits compiler name" else return cs
 103
 104 classifyCompilerFlavor :: String -> CompilerFlavor
 105 classifyCompilerFlavor s =
 106   fromMaybe (OtherCompiler s) $ lookup (lowercase s) compilerMap
 107   where
 108     compilerMap =
 109       [ (lowercase (prettyShow compiler), compiler)
 110       | compiler <- knownCompilerFlavors
 111       ]
 112
 113 buildCompilerFlavor :: CompilerFlavor
 114 buildCompilerFlavor = classifyCompilerFlavor System.Info.compilerName
 115
 116 buildCompilerVersion :: Version
 117 buildCompilerVersion = mkVersion' System.Info.compilerVersion
 118
 119 buildCompilerId :: CompilerId
 120 buildCompilerId = CompilerId buildCompilerFlavor buildCompilerVersion
 121
 122 -- | The default compiler flavour to pick when compiling stuff. This defaults
 123 -- to the compiler used to build the Cabal lib.
 124 --
 125 -- However if it's not a recognised compiler then it's 'Nothing' and the user
 126 -- will have to specify which compiler they want.
 127 defaultCompilerFlavor :: Maybe CompilerFlavor
 128 defaultCompilerFlavor = case buildCompilerFlavor of
 129   OtherCompiler _ -> Nothing
 130   _ -> Just buildCompilerFlavor
 131
 132 -------------------------------------------------------------------------------
 133 -- Per compiler data
 134 -------------------------------------------------------------------------------
 135
 136 -- | 'PerCompilerFlavor' carries only info per GHC and GHCJS
 137 --
 138 -- Cabal parses only @ghc-options@ and @ghcjs-options@, others are omitted.
 139 data PerCompilerFlavor v = PerCompilerFlavor v v
 140   deriving
 141     ( Generic
 142     , Show
 143     , Read
 144     , Eq
 145     , Ord
 146     , Typeable
 147     , Data
 148     , Functor
 149     , Foldable
 150     , Traversable
 151     )
 152
 153 instance Binary a => Binary (PerCompilerFlavor a)
 154 instance Structured a => Structured (PerCompilerFlavor a)
 155 instance NFData a => NFData (PerCompilerFlavor a)
 156
 157 perCompilerFlavorToList :: PerCompilerFlavor v -> [(CompilerFlavor, v)]
 158 perCompilerFlavorToList (PerCompilerFlavor a b) = [(GHC, a), (GHCJS, b)]
 159
 160 instance Semigroup a => Semigroup (PerCompilerFlavor a) where
 161   PerCompilerFlavor a b <> PerCompilerFlavor a' b' =
 162     PerCompilerFlavor
 163       (a <> a')
 164       (b <> b')
 165
 166 instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
 167   mempty = PerCompilerFlavor mempty mempty
 168   mappend = (<>)
 169
 170 -- ------------------------------------------------------------
 171
 172 -- * Compiler Id
 173
 174 -- ------------------------------------------------------------
 175
 176 data CompilerId = CompilerId CompilerFlavor Version
 177   deriving (Eq, Generic, Ord, Read, Show, Typeable)
 178
 179 instance Binary CompilerId
 180 instance Structured CompilerId
 181 instance NFData CompilerId where rnf = genericRnf
 182
 183 instance Pretty CompilerId where
 184   pretty (CompilerId f v)
 185     | v == nullVersion = pretty f
 186     | otherwise = pretty f <<>> Disp.char '-' <<>> pretty v
 187
 188 instance Parsec CompilerId where
 189   parsec = do
 190     flavour <- parsec
 191     version <- (P.char '-' >> parsec) <|> return nullVersion
 192     return (CompilerId flavour version)
 193
 194 lowercase :: String -> String
 195 lowercase = map toLower
 196
 197 -- ------------------------------------------------------------
 198
 199 -- * Compiler Info
 200
 201 -- ------------------------------------------------------------
 202
 203 -- | Compiler information used for resolving configurations. Some
 204 --   fields can be set to Nothing to indicate that the information is
 205 --   unknown.
 206 data CompilerInfo = CompilerInfo
 207   { compilerInfoId :: CompilerId
 208   -- ^ Compiler flavour and version.
 209   , compilerInfoAbiTag :: AbiTag
 210   -- ^ Tag for distinguishing incompatible ABI's on the same
 211   -- architecture/os.
 212   , compilerInfoCompat :: Maybe [CompilerId]
 213   -- ^ Other implementations that this compiler claims to be
 214   -- compatible with, if known.
 215   , compilerInfoLanguages :: Maybe [Language]
 216   -- ^ Supported language standards, if known.
 217   , compilerInfoExtensions :: Maybe [Extension]
 218   -- ^ Supported extensions, if known.
 219   }
 220   deriving (Generic, Show, Read)
 221
 222 instance Binary CompilerInfo
 223
 224 data AbiTag
 225   = NoAbiTag
 226   | AbiTag String
 227   deriving (Eq, Generic, Show, Read, Typeable)
 228
 229 instance Binary AbiTag
 230 instance Structured AbiTag
 231
 232 instance Pretty AbiTag where
 233   pretty NoAbiTag = Disp.empty
 234   pretty (AbiTag tag) = Disp.text tag
 235
 236 instance Parsec AbiTag where
 237   parsec = do
 238     tag <- P.munch (\c -> isAlphaNum c || c == '_')
 239     if null tag then return NoAbiTag else return (AbiTag tag)
 240
 241 abiTagString :: AbiTag -> String
 242 abiTagString NoAbiTag = ""
 243 abiTagString (AbiTag tag) = tag
 244
 245 -- | Make a CompilerInfo of which only the known information is its CompilerId,
 246 --   its AbiTag and that it does not claim to be compatible with other
 247 --   compiler id's.
 248 unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo
 249 unknownCompilerInfo compilerId abiTag =
 250   CompilerInfo compilerId abiTag (Just []) Nothing Nothing