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