{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
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 (forall x. Rep CompilerFlavor x -> CompilerFlavor
forall x. CompilerFlavor -> Rep CompilerFlavor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompilerFlavor x -> CompilerFlavor
$cfrom :: forall x. CompilerFlavor -> Rep CompilerFlavor x
Generic, Int -> CompilerFlavor -> ShowS
[CompilerFlavor] -> ShowS
CompilerFlavor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerFlavor] -> ShowS
$cshowList :: [CompilerFlavor] -> ShowS
show :: CompilerFlavor -> String
$cshow :: CompilerFlavor -> String
showsPrec :: Int -> CompilerFlavor -> ShowS
$cshowsPrec :: Int -> CompilerFlavor -> ShowS
Show, ReadPrec [CompilerFlavor]
ReadPrec CompilerFlavor
Int -> ReadS CompilerFlavor
ReadS [CompilerFlavor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompilerFlavor]
$creadListPrec :: ReadPrec [CompilerFlavor]
readPrec :: ReadPrec CompilerFlavor
$creadPrec :: ReadPrec CompilerFlavor
readList :: ReadS [CompilerFlavor]
$creadList :: ReadS [CompilerFlavor]
readsPrec :: Int -> ReadS CompilerFlavor
$creadsPrec :: Int -> ReadS CompilerFlavor
Read, CompilerFlavor -> CompilerFlavor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerFlavor -> CompilerFlavor -> Bool
$c/= :: CompilerFlavor -> CompilerFlavor -> Bool
== :: CompilerFlavor -> CompilerFlavor -> Bool
$c== :: CompilerFlavor -> CompilerFlavor -> Bool
Eq, Eq CompilerFlavor
CompilerFlavor -> CompilerFlavor -> Bool
CompilerFlavor -> CompilerFlavor -> Ordering
CompilerFlavor -> CompilerFlavor -> CompilerFlavor
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
$cmin :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
max :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
$cmax :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
>= :: CompilerFlavor -> CompilerFlavor -> Bool
$c>= :: CompilerFlavor -> CompilerFlavor -> Bool
> :: CompilerFlavor -> CompilerFlavor -> Bool
$c> :: CompilerFlavor -> CompilerFlavor -> Bool
<= :: CompilerFlavor -> CompilerFlavor -> Bool
$c<= :: CompilerFlavor -> CompilerFlavor -> Bool
< :: CompilerFlavor -> CompilerFlavor -> Bool
$c< :: CompilerFlavor -> CompilerFlavor -> Bool
compare :: CompilerFlavor -> CompilerFlavor -> Ordering
$ccompare :: CompilerFlavor -> CompilerFlavor -> Ordering
Ord, Typeable, Typeable CompilerFlavor
CompilerFlavor -> DataType
CompilerFlavor -> Constr
(forall b. Data b => b -> b) -> CompilerFlavor -> CompilerFlavor
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CompilerFlavor -> u
forall u. (forall d. Data d => d -> u) -> CompilerFlavor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerFlavor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerFlavor -> c CompilerFlavor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerFlavor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerFlavor)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompilerFlavor -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompilerFlavor -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompilerFlavor -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CompilerFlavor -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
gmapT :: (forall b. Data b => b -> b) -> CompilerFlavor -> CompilerFlavor
$cgmapT :: (forall b. Data b => b -> b) -> CompilerFlavor -> CompilerFlavor
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerFlavor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerFlavor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerFlavor)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerFlavor)
dataTypeOf :: CompilerFlavor -> DataType
$cdataTypeOf :: CompilerFlavor -> DataType
toConstr :: CompilerFlavor -> Constr
$ctoConstr :: CompilerFlavor -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerFlavor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerFlavor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerFlavor -> c CompilerFlavor
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerFlavor -> c CompilerFlavor
Data)
instance Binary CompilerFlavor
instance Structured CompilerFlavor
instance NFData CompilerFlavor where rnf :: CompilerFlavor -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
knownCompilerFlavors :: [CompilerFlavor]
knownCompilerFlavors :: [CompilerFlavor]
knownCompilerFlavors =
[CompilerFlavor
GHC, CompilerFlavor
GHCJS, CompilerFlavor
NHC, CompilerFlavor
YHC, CompilerFlavor
Hugs, CompilerFlavor
HBC, CompilerFlavor
Helium, CompilerFlavor
JHC, CompilerFlavor
LHC, CompilerFlavor
UHC, CompilerFlavor
Eta]
instance Pretty CompilerFlavor where
pretty :: CompilerFlavor -> Doc
pretty (OtherCompiler String
name) = String -> Doc
Disp.text String
name
pretty (HaskellSuite String
name) = String -> Doc
Disp.text String
name
pretty CompilerFlavor
NHC = String -> Doc
Disp.text String
"nhc98"
pretty CompilerFlavor
other = String -> Doc
Disp.text (ShowS
lowercase (forall a. Show a => a -> String
show CompilerFlavor
other))
instance Parsec CompilerFlavor where
parsec :: forall (m :: * -> *). CabalParsing m => m CompilerFlavor
parsec = String -> CompilerFlavor
classifyCompilerFlavor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
component
where
component :: m String
component = do
String
cs <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlphaNum
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
cs then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"all digits compiler name" else forall (m :: * -> *) a. Monad m => a -> m a
return String
cs
classifyCompilerFlavor :: String -> CompilerFlavor
classifyCompilerFlavor :: String -> CompilerFlavor
classifyCompilerFlavor String
s =
forall a. a -> Maybe a -> a
fromMaybe (String -> CompilerFlavor
OtherCompiler String
s) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ShowS
lowercase String
s) [(String, CompilerFlavor)]
compilerMap
where
compilerMap :: [(String, CompilerFlavor)]
compilerMap = [ (ShowS
lowercase (forall a. Pretty a => a -> String
prettyShow CompilerFlavor
compiler), CompilerFlavor
compiler)
| CompilerFlavor
compiler <- [CompilerFlavor]
knownCompilerFlavors ]
buildCompilerFlavor :: CompilerFlavor
buildCompilerFlavor :: CompilerFlavor
buildCompilerFlavor = String -> CompilerFlavor
classifyCompilerFlavor String
System.Info.compilerName
buildCompilerVersion :: Version
buildCompilerVersion :: Version
buildCompilerVersion = Version -> Version
mkVersion' Version
System.Info.compilerVersion
buildCompilerId :: CompilerId
buildCompilerId :: CompilerId
buildCompilerId = CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
buildCompilerFlavor Version
buildCompilerVersion
defaultCompilerFlavor :: Maybe CompilerFlavor
defaultCompilerFlavor :: Maybe CompilerFlavor
defaultCompilerFlavor = case CompilerFlavor
buildCompilerFlavor of
OtherCompiler String
_ -> forall a. Maybe a
Nothing
CompilerFlavor
_ -> forall a. a -> Maybe a
Just CompilerFlavor
buildCompilerFlavor
data PerCompilerFlavor v = PerCompilerFlavor v v
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (PerCompilerFlavor v) x -> PerCompilerFlavor v
forall v x. PerCompilerFlavor v -> Rep (PerCompilerFlavor v) x
$cto :: forall v x. Rep (PerCompilerFlavor v) x -> PerCompilerFlavor v
$cfrom :: forall v x. PerCompilerFlavor v -> Rep (PerCompilerFlavor v) x
Generic, Int -> PerCompilerFlavor v -> ShowS
forall v. Show v => Int -> PerCompilerFlavor v -> ShowS
forall v. Show v => [PerCompilerFlavor v] -> ShowS
forall v. Show v => PerCompilerFlavor v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerCompilerFlavor v] -> ShowS
$cshowList :: forall v. Show v => [PerCompilerFlavor v] -> ShowS
show :: PerCompilerFlavor v -> String
$cshow :: forall v. Show v => PerCompilerFlavor v -> String
showsPrec :: Int -> PerCompilerFlavor v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> PerCompilerFlavor v -> ShowS
Show, ReadPrec [PerCompilerFlavor v]
ReadPrec (PerCompilerFlavor v)
ReadS [PerCompilerFlavor v]
forall v. Read v => ReadPrec [PerCompilerFlavor v]
forall v. Read v => ReadPrec (PerCompilerFlavor v)
forall v. Read v => Int -> ReadS (PerCompilerFlavor v)
forall v. Read v => ReadS [PerCompilerFlavor v]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PerCompilerFlavor v]
$creadListPrec :: forall v. Read v => ReadPrec [PerCompilerFlavor v]
readPrec :: ReadPrec (PerCompilerFlavor v)
$creadPrec :: forall v. Read v => ReadPrec (PerCompilerFlavor v)
readList :: ReadS [PerCompilerFlavor v]
$creadList :: forall v. Read v => ReadS [PerCompilerFlavor v]
readsPrec :: Int -> ReadS (PerCompilerFlavor v)
$creadsPrec :: forall v. Read v => Int -> ReadS (PerCompilerFlavor v)
Read, PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
forall v.
Eq v =>
PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
$c/= :: forall v.
Eq v =>
PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
== :: PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
$c== :: forall v.
Eq v =>
PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
Eq, Typeable, PerCompilerFlavor v -> DataType
PerCompilerFlavor v -> Constr
forall {v}. Data v => Typeable (PerCompilerFlavor v)
forall v. Data v => PerCompilerFlavor v -> DataType
forall v. Data v => PerCompilerFlavor v -> Constr
forall v.
Data v =>
(forall b. Data b => b -> b)
-> PerCompilerFlavor v -> PerCompilerFlavor v
forall v u.
Data v =>
Int -> (forall d. Data d => d -> u) -> PerCompilerFlavor v -> u
forall v u.
Data v =>
(forall d. Data d => d -> u) -> PerCompilerFlavor v -> [u]
forall v r r'.
Data v =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
forall v r r'.
Data v =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
forall v (m :: * -> *).
(Data v, Monad m) =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
forall v (m :: * -> *).
(Data v, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
forall v (c :: * -> *).
Data v =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PerCompilerFlavor v)
forall v (c :: * -> *).
Data v =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PerCompilerFlavor v
-> c (PerCompilerFlavor v)
forall v (t :: * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (PerCompilerFlavor v))
forall v (t :: * -> * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PerCompilerFlavor v))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PerCompilerFlavor v)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PerCompilerFlavor v
-> c (PerCompilerFlavor v)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (PerCompilerFlavor v))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
$cgmapMo :: forall v (m :: * -> *).
(Data v, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
$cgmapMp :: forall v (m :: * -> *).
(Data v, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
$cgmapM :: forall v (m :: * -> *).
(Data v, Monad m) =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PerCompilerFlavor v -> u
$cgmapQi :: forall v u.
Data v =>
Int -> (forall d. Data d => d -> u) -> PerCompilerFlavor v -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> PerCompilerFlavor v -> [u]
$cgmapQ :: forall v u.
Data v =>
(forall d. Data d => d -> u) -> PerCompilerFlavor v -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
$cgmapQr :: forall v r r'.
Data v =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
$cgmapQl :: forall v r r'.
Data v =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
gmapT :: (forall b. Data b => b -> b)
-> PerCompilerFlavor v -> PerCompilerFlavor v
$cgmapT :: forall v.
Data v =>
(forall b. Data b => b -> b)
-> PerCompilerFlavor v -> PerCompilerFlavor v
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PerCompilerFlavor v))
$cdataCast2 :: forall v (t :: * -> * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PerCompilerFlavor v))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (PerCompilerFlavor v))
$cdataCast1 :: forall v (t :: * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (PerCompilerFlavor v))
dataTypeOf :: PerCompilerFlavor v -> DataType
$cdataTypeOf :: forall v. Data v => PerCompilerFlavor v -> DataType
toConstr :: PerCompilerFlavor v -> Constr
$ctoConstr :: forall v. Data v => PerCompilerFlavor v -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PerCompilerFlavor v)
$cgunfold :: forall v (c :: * -> *).
Data v =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PerCompilerFlavor v)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PerCompilerFlavor v
-> c (PerCompilerFlavor v)
$cgfoldl :: forall v (c :: * -> *).
Data v =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PerCompilerFlavor v
-> c (PerCompilerFlavor v)
Data, forall a b. a -> PerCompilerFlavor b -> PerCompilerFlavor a
forall a b. (a -> b) -> PerCompilerFlavor a -> PerCompilerFlavor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PerCompilerFlavor b -> PerCompilerFlavor a
$c<$ :: forall a b. a -> PerCompilerFlavor b -> PerCompilerFlavor a
fmap :: forall a b. (a -> b) -> PerCompilerFlavor a -> PerCompilerFlavor b
$cfmap :: forall a b. (a -> b) -> PerCompilerFlavor a -> PerCompilerFlavor b
Functor, forall a. Eq a => a -> PerCompilerFlavor a -> Bool
forall a. Num a => PerCompilerFlavor a -> a
forall a. Ord a => PerCompilerFlavor a -> a
forall m. Monoid m => PerCompilerFlavor m -> m
forall a. PerCompilerFlavor a -> Bool
forall a. PerCompilerFlavor a -> Int
forall a. PerCompilerFlavor a -> [a]
forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m
forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b
forall a b. (a -> b -> b) -> b -> PerCompilerFlavor a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => PerCompilerFlavor a -> a
$cproduct :: forall a. Num a => PerCompilerFlavor a -> a
sum :: forall a. Num a => PerCompilerFlavor a -> a
$csum :: forall a. Num a => PerCompilerFlavor a -> a
minimum :: forall a. Ord a => PerCompilerFlavor a -> a
$cminimum :: forall a. Ord a => PerCompilerFlavor a -> a
maximum :: forall a. Ord a => PerCompilerFlavor a -> a
$cmaximum :: forall a. Ord a => PerCompilerFlavor a -> a
elem :: forall a. Eq a => a -> PerCompilerFlavor a -> Bool
$celem :: forall a. Eq a => a -> PerCompilerFlavor a -> Bool
length :: forall a. PerCompilerFlavor a -> Int
$clength :: forall a. PerCompilerFlavor a -> Int
null :: forall a. PerCompilerFlavor a -> Bool
$cnull :: forall a. PerCompilerFlavor a -> Bool
toList :: forall a. PerCompilerFlavor a -> [a]
$ctoList :: forall a. PerCompilerFlavor a -> [a]
foldl1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
foldr1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PerCompilerFlavor a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PerCompilerFlavor a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PerCompilerFlavor a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PerCompilerFlavor a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m
fold :: forall m. Monoid m => PerCompilerFlavor m -> m
$cfold :: forall m. Monoid m => PerCompilerFlavor m -> m
Foldable
, Functor PerCompilerFlavor
Foldable PerCompilerFlavor
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PerCompilerFlavor (m a) -> m (PerCompilerFlavor a)
forall (f :: * -> *) a.
Applicative f =>
PerCompilerFlavor (f a) -> f (PerCompilerFlavor a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PerCompilerFlavor a -> m (PerCompilerFlavor b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PerCompilerFlavor a -> f (PerCompilerFlavor b)
sequence :: forall (m :: * -> *) a.
Monad m =>
PerCompilerFlavor (m a) -> m (PerCompilerFlavor a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PerCompilerFlavor (m a) -> m (PerCompilerFlavor a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PerCompilerFlavor a -> m (PerCompilerFlavor b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PerCompilerFlavor a -> m (PerCompilerFlavor b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PerCompilerFlavor (f a) -> f (PerCompilerFlavor a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PerCompilerFlavor (f a) -> f (PerCompilerFlavor a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PerCompilerFlavor a -> f (PerCompilerFlavor b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PerCompilerFlavor a -> f (PerCompilerFlavor b)
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 :: forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor v
a v
b) = [(CompilerFlavor
GHC, v
a), (CompilerFlavor
GHCJS, v
b)]
instance Semigroup a => Semigroup (PerCompilerFlavor a) where
PerCompilerFlavor a
a a
b <> :: PerCompilerFlavor a -> PerCompilerFlavor a -> PerCompilerFlavor a
<> PerCompilerFlavor a
a' a
b' = forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
(a
a forall a. Semigroup a => a -> a -> a
<> a
a') (a
b forall a. Semigroup a => a -> a -> a
<> a
b')
instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
mempty :: PerCompilerFlavor a
mempty = forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
mappend :: PerCompilerFlavor a -> PerCompilerFlavor a -> PerCompilerFlavor a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
data CompilerId = CompilerId CompilerFlavor Version
deriving (CompilerId -> CompilerId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerId -> CompilerId -> Bool
$c/= :: CompilerId -> CompilerId -> Bool
== :: CompilerId -> CompilerId -> Bool
$c== :: CompilerId -> CompilerId -> Bool
Eq, forall x. Rep CompilerId x -> CompilerId
forall x. CompilerId -> Rep CompilerId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompilerId x -> CompilerId
$cfrom :: forall x. CompilerId -> Rep CompilerId x
Generic, Eq CompilerId
CompilerId -> CompilerId -> Bool
CompilerId -> CompilerId -> Ordering
CompilerId -> CompilerId -> CompilerId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompilerId -> CompilerId -> CompilerId
$cmin :: CompilerId -> CompilerId -> CompilerId
max :: CompilerId -> CompilerId -> CompilerId
$cmax :: CompilerId -> CompilerId -> CompilerId
>= :: CompilerId -> CompilerId -> Bool
$c>= :: CompilerId -> CompilerId -> Bool
> :: CompilerId -> CompilerId -> Bool
$c> :: CompilerId -> CompilerId -> Bool
<= :: CompilerId -> CompilerId -> Bool
$c<= :: CompilerId -> CompilerId -> Bool
< :: CompilerId -> CompilerId -> Bool
$c< :: CompilerId -> CompilerId -> Bool
compare :: CompilerId -> CompilerId -> Ordering
$ccompare :: CompilerId -> CompilerId -> Ordering
Ord, ReadPrec [CompilerId]
ReadPrec CompilerId
Int -> ReadS CompilerId
ReadS [CompilerId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompilerId]
$creadListPrec :: ReadPrec [CompilerId]
readPrec :: ReadPrec CompilerId
$creadPrec :: ReadPrec CompilerId
readList :: ReadS [CompilerId]
$creadList :: ReadS [CompilerId]
readsPrec :: Int -> ReadS CompilerId
$creadsPrec :: Int -> ReadS CompilerId
Read, Int -> CompilerId -> ShowS
[CompilerId] -> ShowS
CompilerId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerId] -> ShowS
$cshowList :: [CompilerId] -> ShowS
show :: CompilerId -> String
$cshow :: CompilerId -> String
showsPrec :: Int -> CompilerId -> ShowS
$cshowsPrec :: Int -> CompilerId -> ShowS
Show, Typeable)
instance Binary CompilerId
instance Structured CompilerId
instance NFData CompilerId where rnf :: CompilerId -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Pretty CompilerId where
pretty :: CompilerId -> Doc
pretty (CompilerId CompilerFlavor
f Version
v)
| Version
v forall a. Eq a => a -> a -> Bool
== Version
nullVersion = forall a. Pretty a => a -> Doc
pretty CompilerFlavor
f
| Bool
otherwise = forall a. Pretty a => a -> Doc
pretty CompilerFlavor
f Doc -> Doc -> Doc
<<>> Char -> Doc
Disp.char Char
'-' Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty Version
v
instance Parsec CompilerId where
parsec :: forall (m :: * -> *). CabalParsing m => m CompilerId
parsec = do
CompilerFlavor
flavour <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
Version
version <- (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Version
nullVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
flavour Version
version)
lowercase :: String -> String
lowercase :: ShowS
lowercase = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
data CompilerInfo = CompilerInfo {
CompilerInfo -> CompilerId
compilerInfoId :: CompilerId,
CompilerInfo -> AbiTag
compilerInfoAbiTag :: AbiTag,
CompilerInfo -> Maybe [CompilerId]
compilerInfoCompat :: Maybe [CompilerId],
CompilerInfo -> Maybe [Language]
compilerInfoLanguages :: Maybe [Language],
CompilerInfo -> Maybe [Extension]
compilerInfoExtensions :: Maybe [Extension]
}
deriving (forall x. Rep CompilerInfo x -> CompilerInfo
forall x. CompilerInfo -> Rep CompilerInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompilerInfo x -> CompilerInfo
$cfrom :: forall x. CompilerInfo -> Rep CompilerInfo x
Generic, Int -> CompilerInfo -> ShowS
[CompilerInfo] -> ShowS
CompilerInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerInfo] -> ShowS
$cshowList :: [CompilerInfo] -> ShowS
show :: CompilerInfo -> String
$cshow :: CompilerInfo -> String
showsPrec :: Int -> CompilerInfo -> ShowS
$cshowsPrec :: Int -> CompilerInfo -> ShowS
Show, ReadPrec [CompilerInfo]
ReadPrec CompilerInfo
Int -> ReadS CompilerInfo
ReadS [CompilerInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompilerInfo]
$creadListPrec :: ReadPrec [CompilerInfo]
readPrec :: ReadPrec CompilerInfo
$creadPrec :: ReadPrec CompilerInfo
readList :: ReadS [CompilerInfo]
$creadList :: ReadS [CompilerInfo]
readsPrec :: Int -> ReadS CompilerInfo
$creadsPrec :: Int -> ReadS CompilerInfo
Read)
instance Binary CompilerInfo
data AbiTag
= NoAbiTag
| AbiTag String
deriving (AbiTag -> AbiTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbiTag -> AbiTag -> Bool
$c/= :: AbiTag -> AbiTag -> Bool
== :: AbiTag -> AbiTag -> Bool
$c== :: AbiTag -> AbiTag -> Bool
Eq, forall x. Rep AbiTag x -> AbiTag
forall x. AbiTag -> Rep AbiTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbiTag x -> AbiTag
$cfrom :: forall x. AbiTag -> Rep AbiTag x
Generic, Int -> AbiTag -> ShowS
[AbiTag] -> ShowS
AbiTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbiTag] -> ShowS
$cshowList :: [AbiTag] -> ShowS
show :: AbiTag -> String
$cshow :: AbiTag -> String
showsPrec :: Int -> AbiTag -> ShowS
$cshowsPrec :: Int -> AbiTag -> ShowS
Show, ReadPrec [AbiTag]
ReadPrec AbiTag
Int -> ReadS AbiTag
ReadS [AbiTag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AbiTag]
$creadListPrec :: ReadPrec [AbiTag]
readPrec :: ReadPrec AbiTag
$creadPrec :: ReadPrec AbiTag
readList :: ReadS [AbiTag]
$creadList :: ReadS [AbiTag]
readsPrec :: Int -> ReadS AbiTag
$creadsPrec :: Int -> ReadS AbiTag
Read, Typeable)
instance Binary AbiTag
instance Structured AbiTag
instance Pretty AbiTag where
pretty :: AbiTag -> Doc
pretty AbiTag
NoAbiTag = Doc
Disp.empty
pretty (AbiTag String
tag) = String -> Doc
Disp.text String
tag
instance Parsec AbiTag where
parsec :: forall (m :: * -> *). CabalParsing m => m AbiTag
parsec = do
String
tag <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_')
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
tag then forall (m :: * -> *) a. Monad m => a -> m a
return AbiTag
NoAbiTag else forall (m :: * -> *) a. Monad m => a -> m a
return (String -> AbiTag
AbiTag String
tag)
abiTagString :: AbiTag -> String
abiTagString :: AbiTag -> String
abiTagString AbiTag
NoAbiTag = String
""
abiTagString (AbiTag String
tag) = String
tag
unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo CompilerId
compilerId AbiTag
abiTag =
CompilerId
-> AbiTag
-> Maybe [CompilerId]
-> Maybe [Language]
-> Maybe [Extension]
-> CompilerInfo
CompilerInfo CompilerId
compilerId AbiTag
abiTag (forall a. a -> Maybe a
Just []) forall a. Maybe a
Nothing forall a. Maybe a
Nothing