{-# 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. CompilerFlavor -> Rep CompilerFlavor x)
-> (forall x. Rep CompilerFlavor x -> CompilerFlavor)
-> Generic CompilerFlavor
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
$cfrom :: forall x. CompilerFlavor -> Rep CompilerFlavor x
from :: forall x. CompilerFlavor -> Rep CompilerFlavor x
$cto :: forall x. Rep CompilerFlavor x -> CompilerFlavor
to :: forall x. Rep CompilerFlavor x -> CompilerFlavor
Generic, Int -> CompilerFlavor -> ShowS
[CompilerFlavor] -> ShowS
CompilerFlavor -> String
(Int -> CompilerFlavor -> ShowS)
-> (CompilerFlavor -> String)
-> ([CompilerFlavor] -> ShowS)
-> Show CompilerFlavor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompilerFlavor -> ShowS
showsPrec :: Int -> CompilerFlavor -> ShowS
$cshow :: CompilerFlavor -> String
show :: CompilerFlavor -> String
$cshowList :: [CompilerFlavor] -> ShowS
showList :: [CompilerFlavor] -> ShowS
Show, ReadPrec [CompilerFlavor]
ReadPrec CompilerFlavor
Int -> ReadS CompilerFlavor
ReadS [CompilerFlavor]
(Int -> ReadS CompilerFlavor)
-> ReadS [CompilerFlavor]
-> ReadPrec CompilerFlavor
-> ReadPrec [CompilerFlavor]
-> Read CompilerFlavor
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompilerFlavor
readsPrec :: Int -> ReadS CompilerFlavor
$creadList :: ReadS [CompilerFlavor]
readList :: ReadS [CompilerFlavor]
$creadPrec :: ReadPrec CompilerFlavor
readPrec :: ReadPrec CompilerFlavor
$creadListPrec :: ReadPrec [CompilerFlavor]
readListPrec :: ReadPrec [CompilerFlavor]
Read, CompilerFlavor -> CompilerFlavor -> Bool
(CompilerFlavor -> CompilerFlavor -> Bool)
-> (CompilerFlavor -> CompilerFlavor -> Bool) -> Eq CompilerFlavor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompilerFlavor -> CompilerFlavor -> Bool
== :: CompilerFlavor -> CompilerFlavor -> Bool
$c/= :: CompilerFlavor -> CompilerFlavor -> Bool
/= :: CompilerFlavor -> CompilerFlavor -> Bool
Eq, Eq CompilerFlavor
Eq CompilerFlavor
-> (CompilerFlavor -> CompilerFlavor -> Ordering)
-> (CompilerFlavor -> CompilerFlavor -> Bool)
-> (CompilerFlavor -> CompilerFlavor -> Bool)
-> (CompilerFlavor -> CompilerFlavor -> Bool)
-> (CompilerFlavor -> CompilerFlavor -> Bool)
-> (CompilerFlavor -> CompilerFlavor -> CompilerFlavor)
-> (CompilerFlavor -> CompilerFlavor -> CompilerFlavor)
-> Ord 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
$ccompare :: CompilerFlavor -> CompilerFlavor -> Ordering
compare :: CompilerFlavor -> CompilerFlavor -> Ordering
$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
>= :: CompilerFlavor -> CompilerFlavor -> Bool
$cmax :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
max :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
$cmin :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
min :: CompilerFlavor -> CompilerFlavor -> CompilerFlavor
Ord, Typeable, Typeable CompilerFlavor
Typeable CompilerFlavor
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerFlavor -> c CompilerFlavor)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerFlavor)
-> (CompilerFlavor -> Constr)
-> (CompilerFlavor -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
-> CompilerFlavor -> CompilerFlavor)
-> (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 u.
(forall d. Data d => d -> u) -> CompilerFlavor -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CompilerFlavor -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor)
-> Data CompilerFlavor
CompilerFlavor -> Constr
CompilerFlavor -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerFlavor -> c CompilerFlavor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerFlavor -> c CompilerFlavor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerFlavor
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerFlavor
$ctoConstr :: CompilerFlavor -> Constr
toConstr :: CompilerFlavor -> Constr
$cdataTypeOf :: CompilerFlavor -> DataType
dataTypeOf :: CompilerFlavor -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerFlavor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerFlavor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerFlavor)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerFlavor)
$cgmapT :: (forall b. Data b => b -> b) -> CompilerFlavor -> CompilerFlavor
gmapT :: (forall b. Data b => b -> b) -> CompilerFlavor -> CompilerFlavor
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerFlavor -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CompilerFlavor -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompilerFlavor -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompilerFlavor -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompilerFlavor -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompilerFlavor -> m CompilerFlavor
Data)
instance Binary CompilerFlavor
instance Structured CompilerFlavor
instance NFData CompilerFlavor where rnf :: CompilerFlavor -> ()
rnf = CompilerFlavor -> ()
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 (CompilerFlavor -> String
forall a. Show a => a -> String
show CompilerFlavor
other))
instance Parsec CompilerFlavor where
parsec :: forall (m :: * -> *). CabalParsing m => m CompilerFlavor
parsec = String -> CompilerFlavor
classifyCompilerFlavor (String -> CompilerFlavor) -> m String -> m CompilerFlavor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
component
where
component :: m String
component = do
String
cs <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlphaNum
if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
cs then String -> m String
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"all digits compiler name" else String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
cs
classifyCompilerFlavor :: String -> CompilerFlavor
classifyCompilerFlavor :: String -> CompilerFlavor
classifyCompilerFlavor String
s =
CompilerFlavor -> Maybe CompilerFlavor -> CompilerFlavor
forall a. a -> Maybe a -> a
fromMaybe (String -> CompilerFlavor
OtherCompiler String
s) (Maybe CompilerFlavor -> CompilerFlavor)
-> Maybe CompilerFlavor -> CompilerFlavor
forall a b. (a -> b) -> a -> b
$ String -> [(String, CompilerFlavor)] -> Maybe CompilerFlavor
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 (CompilerFlavor -> String
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
_ -> Maybe CompilerFlavor
forall a. Maybe a
Nothing
CompilerFlavor
_ -> CompilerFlavor -> Maybe CompilerFlavor
forall a. a -> Maybe a
Just CompilerFlavor
buildCompilerFlavor
data PerCompilerFlavor v = PerCompilerFlavor v v
deriving ((forall x. PerCompilerFlavor v -> Rep (PerCompilerFlavor v) x)
-> (forall x. Rep (PerCompilerFlavor v) x -> PerCompilerFlavor v)
-> Generic (PerCompilerFlavor v)
forall x. Rep (PerCompilerFlavor v) x -> PerCompilerFlavor v
forall x. PerCompilerFlavor v -> Rep (PerCompilerFlavor v) x
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
$cfrom :: forall v x. PerCompilerFlavor v -> Rep (PerCompilerFlavor v) x
from :: forall x. PerCompilerFlavor v -> Rep (PerCompilerFlavor v) x
$cto :: forall v x. Rep (PerCompilerFlavor v) x -> PerCompilerFlavor v
to :: forall x. Rep (PerCompilerFlavor v) x -> PerCompilerFlavor v
Generic, Int -> PerCompilerFlavor v -> ShowS
[PerCompilerFlavor v] -> ShowS
PerCompilerFlavor v -> String
(Int -> PerCompilerFlavor v -> ShowS)
-> (PerCompilerFlavor v -> String)
-> ([PerCompilerFlavor v] -> ShowS)
-> Show (PerCompilerFlavor v)
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
$cshowsPrec :: forall v. Show v => Int -> PerCompilerFlavor v -> ShowS
showsPrec :: Int -> PerCompilerFlavor v -> ShowS
$cshow :: forall v. Show v => PerCompilerFlavor v -> String
show :: PerCompilerFlavor v -> String
$cshowList :: forall v. Show v => [PerCompilerFlavor v] -> ShowS
showList :: [PerCompilerFlavor v] -> ShowS
Show, ReadPrec [PerCompilerFlavor v]
ReadPrec (PerCompilerFlavor v)
Int -> ReadS (PerCompilerFlavor v)
ReadS [PerCompilerFlavor v]
(Int -> ReadS (PerCompilerFlavor v))
-> ReadS [PerCompilerFlavor v]
-> ReadPrec (PerCompilerFlavor v)
-> ReadPrec [PerCompilerFlavor v]
-> Read (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
$creadsPrec :: forall v. Read v => Int -> ReadS (PerCompilerFlavor v)
readsPrec :: Int -> ReadS (PerCompilerFlavor v)
$creadList :: forall v. Read v => ReadS [PerCompilerFlavor v]
readList :: ReadS [PerCompilerFlavor v]
$creadPrec :: forall v. Read v => ReadPrec (PerCompilerFlavor v)
readPrec :: ReadPrec (PerCompilerFlavor v)
$creadListPrec :: forall v. Read v => ReadPrec [PerCompilerFlavor v]
readListPrec :: ReadPrec [PerCompilerFlavor v]
Read, PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
(PerCompilerFlavor v -> PerCompilerFlavor v -> Bool)
-> (PerCompilerFlavor v -> PerCompilerFlavor v -> Bool)
-> Eq (PerCompilerFlavor v)
forall v.
Eq v =>
PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: PerCompilerFlavor v -> PerCompilerFlavor v -> Bool
Eq, Typeable, Typeable (PerCompilerFlavor v)
Typeable (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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PerCompilerFlavor v))
-> (PerCompilerFlavor v -> Constr)
-> (PerCompilerFlavor v -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (PerCompilerFlavor v)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PerCompilerFlavor v)))
-> ((forall b. Data b => b -> b)
-> PerCompilerFlavor v -> PerCompilerFlavor v)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r)
-> (forall u.
(forall d. Data d => d -> u) -> PerCompilerFlavor v -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PerCompilerFlavor v -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v))
-> Data (PerCompilerFlavor v)
PerCompilerFlavor v -> Constr
PerCompilerFlavor v -> DataType
(forall b. Data b => b -> b)
-> PerCompilerFlavor v -> PerCompilerFlavor v
forall {v}. Data v => Typeable (PerCompilerFlavor v)
forall v. Data v => PerCompilerFlavor v -> Constr
forall v. Data v => PerCompilerFlavor v -> DataType
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 u.
Int -> (forall d. Data d => d -> u) -> PerCompilerFlavor v -> u
forall u.
(forall d. Data d => d -> u) -> PerCompilerFlavor v -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PerCompilerFlavor v
-> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PerCompilerFlavor v)
$ctoConstr :: forall v. Data v => PerCompilerFlavor v -> Constr
toConstr :: PerCompilerFlavor v -> Constr
$cdataTypeOf :: forall v. Data v => PerCompilerFlavor v -> DataType
dataTypeOf :: PerCompilerFlavor v -> DataType
$cdataCast1 :: forall v (t :: * -> *) (c :: * -> *).
(Data v, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (PerCompilerFlavor v))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PerCompilerFlavor v))
$cgmapT :: forall v.
Data v =>
(forall b. Data b => b -> b)
-> PerCompilerFlavor v -> PerCompilerFlavor v
gmapT :: (forall b. Data b => b -> b)
-> PerCompilerFlavor v -> PerCompilerFlavor v
$cgmapQl :: 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
$cgmapQr :: forall v r r'.
Data v =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerCompilerFlavor v -> r
$cgmapQ :: forall v u.
Data v =>
(forall d. Data d => d -> u) -> PerCompilerFlavor v -> [u]
gmapQ :: forall u.
(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
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PerCompilerFlavor v -> u
$cgmapM :: forall v (m :: * -> *).
(Data v, Monad 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)
$cgmapMp :: 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)
$cgmapMo :: forall v (m :: * -> *).
(Data v, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PerCompilerFlavor v -> m (PerCompilerFlavor v)
Data, (forall a b.
(a -> b) -> PerCompilerFlavor a -> PerCompilerFlavor b)
-> (forall a b. a -> PerCompilerFlavor b -> PerCompilerFlavor a)
-> Functor PerCompilerFlavor
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
$cfmap :: forall a b. (a -> b) -> PerCompilerFlavor a -> PerCompilerFlavor b
fmap :: forall a b. (a -> b) -> PerCompilerFlavor a -> PerCompilerFlavor b
$c<$ :: forall a b. a -> PerCompilerFlavor b -> PerCompilerFlavor a
<$ :: forall a b. a -> PerCompilerFlavor b -> PerCompilerFlavor a
Functor, (forall m. Monoid m => PerCompilerFlavor m -> m)
-> (forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m)
-> (forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m)
-> (forall a b. (a -> b -> b) -> b -> PerCompilerFlavor a -> b)
-> (forall a b. (a -> b -> b) -> b -> PerCompilerFlavor a -> b)
-> (forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b)
-> (forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b)
-> (forall a. (a -> a -> a) -> PerCompilerFlavor a -> a)
-> (forall a. (a -> a -> a) -> PerCompilerFlavor a -> a)
-> (forall a. PerCompilerFlavor a -> [a])
-> (forall a. PerCompilerFlavor a -> Bool)
-> (forall a. PerCompilerFlavor a -> Int)
-> (forall a. Eq a => a -> PerCompilerFlavor a -> Bool)
-> (forall a. Ord a => PerCompilerFlavor a -> a)
-> (forall a. Ord a => PerCompilerFlavor a -> a)
-> (forall a. Num a => PerCompilerFlavor a -> a)
-> (forall a. Num a => PerCompilerFlavor a -> a)
-> Foldable PerCompilerFlavor
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
$cfold :: forall m. Monoid m => PerCompilerFlavor m -> m
fold :: forall m. Monoid m => PerCompilerFlavor m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> PerCompilerFlavor a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> PerCompilerFlavor a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
foldr1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
foldl1 :: forall a. (a -> a -> a) -> PerCompilerFlavor a -> a
$ctoList :: forall a. PerCompilerFlavor a -> [a]
toList :: forall a. PerCompilerFlavor a -> [a]
$cnull :: forall a. PerCompilerFlavor a -> Bool
null :: forall a. PerCompilerFlavor a -> Bool
$clength :: forall a. PerCompilerFlavor a -> Int
length :: forall a. PerCompilerFlavor a -> Int
$celem :: forall a. Eq a => a -> PerCompilerFlavor a -> Bool
elem :: forall a. Eq a => a -> PerCompilerFlavor a -> Bool
$cmaximum :: forall a. Ord a => PerCompilerFlavor a -> a
maximum :: forall a. Ord a => PerCompilerFlavor a -> a
$cminimum :: forall a. Ord a => PerCompilerFlavor a -> a
minimum :: forall a. Ord a => PerCompilerFlavor a -> a
$csum :: forall a. Num a => PerCompilerFlavor a -> a
sum :: forall a. Num a => PerCompilerFlavor a -> a
$cproduct :: forall a. Num a => PerCompilerFlavor a -> a
product :: forall a. Num a => PerCompilerFlavor a -> a
Foldable
, Functor PerCompilerFlavor
Foldable PerCompilerFlavor
Functor PerCompilerFlavor
-> Foldable PerCompilerFlavor
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PerCompilerFlavor a -> f (PerCompilerFlavor b))
-> (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 (m :: * -> *) a.
Monad m =>
PerCompilerFlavor (m a) -> m (PerCompilerFlavor a))
-> Traversable 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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PerCompilerFlavor a -> f (PerCompilerFlavor b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PerCompilerFlavor a -> f (PerCompilerFlavor b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PerCompilerFlavor (f a) -> f (PerCompilerFlavor a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PerCompilerFlavor (f a) -> f (PerCompilerFlavor a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PerCompilerFlavor a -> m (PerCompilerFlavor b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PerCompilerFlavor a -> m (PerCompilerFlavor b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PerCompilerFlavor (m a) -> m (PerCompilerFlavor a)
sequence :: forall (m :: * -> *) a.
Monad m =>
PerCompilerFlavor (m a) -> m (PerCompilerFlavor a)
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' = a -> a -> PerCompilerFlavor a
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor
(a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a') (a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b')
instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where
mempty :: PerCompilerFlavor a
mempty = a -> a -> PerCompilerFlavor a
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor a
forall a. Monoid a => a
mempty a
forall a. Monoid a => a
mempty
mappend :: PerCompilerFlavor a -> PerCompilerFlavor a -> PerCompilerFlavor a
mappend = PerCompilerFlavor a -> PerCompilerFlavor a -> PerCompilerFlavor a
forall a. Semigroup a => a -> a -> a
(<>)
data CompilerId = CompilerId CompilerFlavor Version
deriving (CompilerId -> CompilerId -> Bool
(CompilerId -> CompilerId -> Bool)
-> (CompilerId -> CompilerId -> Bool) -> Eq CompilerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompilerId -> CompilerId -> Bool
== :: CompilerId -> CompilerId -> Bool
$c/= :: CompilerId -> CompilerId -> Bool
/= :: CompilerId -> CompilerId -> Bool
Eq, (forall x. CompilerId -> Rep CompilerId x)
-> (forall x. Rep CompilerId x -> CompilerId) -> Generic CompilerId
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
$cfrom :: forall x. CompilerId -> Rep CompilerId x
from :: forall x. CompilerId -> Rep CompilerId x
$cto :: forall x. Rep CompilerId x -> CompilerId
to :: forall x. Rep CompilerId x -> CompilerId
Generic, Eq CompilerId
Eq CompilerId
-> (CompilerId -> CompilerId -> Ordering)
-> (CompilerId -> CompilerId -> Bool)
-> (CompilerId -> CompilerId -> Bool)
-> (CompilerId -> CompilerId -> Bool)
-> (CompilerId -> CompilerId -> Bool)
-> (CompilerId -> CompilerId -> CompilerId)
-> (CompilerId -> CompilerId -> CompilerId)
-> Ord 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
$ccompare :: CompilerId -> CompilerId -> Ordering
compare :: CompilerId -> CompilerId -> Ordering
$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
>= :: CompilerId -> CompilerId -> Bool
$cmax :: CompilerId -> CompilerId -> CompilerId
max :: CompilerId -> CompilerId -> CompilerId
$cmin :: CompilerId -> CompilerId -> CompilerId
min :: CompilerId -> CompilerId -> CompilerId
Ord, ReadPrec [CompilerId]
ReadPrec CompilerId
Int -> ReadS CompilerId
ReadS [CompilerId]
(Int -> ReadS CompilerId)
-> ReadS [CompilerId]
-> ReadPrec CompilerId
-> ReadPrec [CompilerId]
-> Read CompilerId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompilerId
readsPrec :: Int -> ReadS CompilerId
$creadList :: ReadS [CompilerId]
readList :: ReadS [CompilerId]
$creadPrec :: ReadPrec CompilerId
readPrec :: ReadPrec CompilerId
$creadListPrec :: ReadPrec [CompilerId]
readListPrec :: ReadPrec [CompilerId]
Read, Int -> CompilerId -> ShowS
[CompilerId] -> ShowS
CompilerId -> String
(Int -> CompilerId -> ShowS)
-> (CompilerId -> String)
-> ([CompilerId] -> ShowS)
-> Show CompilerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompilerId -> ShowS
showsPrec :: Int -> CompilerId -> ShowS
$cshow :: CompilerId -> String
show :: CompilerId -> String
$cshowList :: [CompilerId] -> ShowS
showList :: [CompilerId] -> ShowS
Show, Typeable)
instance Binary CompilerId
instance Structured CompilerId
instance NFData CompilerId where rnf :: CompilerId -> ()
rnf = CompilerId -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Pretty CompilerId where
pretty :: CompilerId -> Doc
pretty (CompilerId CompilerFlavor
f Version
v)
| Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
nullVersion = CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
pretty CompilerFlavor
f
| Bool
otherwise = CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
pretty CompilerFlavor
f Doc -> Doc -> Doc
<<>> Char -> Doc
Disp.char Char
'-' Doc -> Doc -> Doc
<<>> Version -> 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 <- m CompilerFlavor
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m CompilerFlavor
parsec
Version
version <- (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-' m Char -> m Version -> m Version
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Version
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Version
parsec) m Version -> m Version -> m Version
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Version -> m Version
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Version
nullVersion
CompilerId -> m CompilerId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
flavour Version
version)
lowercase :: String -> String
lowercase :: ShowS
lowercase = (Char -> Char) -> ShowS
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. CompilerInfo -> Rep CompilerInfo x)
-> (forall x. Rep CompilerInfo x -> CompilerInfo)
-> Generic CompilerInfo
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
$cfrom :: forall x. CompilerInfo -> Rep CompilerInfo x
from :: forall x. CompilerInfo -> Rep CompilerInfo x
$cto :: forall x. Rep CompilerInfo x -> CompilerInfo
to :: forall x. Rep CompilerInfo x -> CompilerInfo
Generic, Int -> CompilerInfo -> ShowS
[CompilerInfo] -> ShowS
CompilerInfo -> String
(Int -> CompilerInfo -> ShowS)
-> (CompilerInfo -> String)
-> ([CompilerInfo] -> ShowS)
-> Show CompilerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompilerInfo -> ShowS
showsPrec :: Int -> CompilerInfo -> ShowS
$cshow :: CompilerInfo -> String
show :: CompilerInfo -> String
$cshowList :: [CompilerInfo] -> ShowS
showList :: [CompilerInfo] -> ShowS
Show, ReadPrec [CompilerInfo]
ReadPrec CompilerInfo
Int -> ReadS CompilerInfo
ReadS [CompilerInfo]
(Int -> ReadS CompilerInfo)
-> ReadS [CompilerInfo]
-> ReadPrec CompilerInfo
-> ReadPrec [CompilerInfo]
-> Read CompilerInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompilerInfo
readsPrec :: Int -> ReadS CompilerInfo
$creadList :: ReadS [CompilerInfo]
readList :: ReadS [CompilerInfo]
$creadPrec :: ReadPrec CompilerInfo
readPrec :: ReadPrec CompilerInfo
$creadListPrec :: ReadPrec [CompilerInfo]
readListPrec :: ReadPrec [CompilerInfo]
Read)
instance Binary CompilerInfo
data AbiTag
= NoAbiTag
| AbiTag String
deriving (AbiTag -> AbiTag -> Bool
(AbiTag -> AbiTag -> Bool)
-> (AbiTag -> AbiTag -> Bool) -> Eq AbiTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbiTag -> AbiTag -> Bool
== :: AbiTag -> AbiTag -> Bool
$c/= :: AbiTag -> AbiTag -> Bool
/= :: AbiTag -> AbiTag -> Bool
Eq, (forall x. AbiTag -> Rep AbiTag x)
-> (forall x. Rep AbiTag x -> AbiTag) -> Generic AbiTag
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
$cfrom :: forall x. AbiTag -> Rep AbiTag x
from :: forall x. AbiTag -> Rep AbiTag x
$cto :: forall x. Rep AbiTag x -> AbiTag
to :: forall x. Rep AbiTag x -> AbiTag
Generic, Int -> AbiTag -> ShowS
[AbiTag] -> ShowS
AbiTag -> String
(Int -> AbiTag -> ShowS)
-> (AbiTag -> String) -> ([AbiTag] -> ShowS) -> Show AbiTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbiTag -> ShowS
showsPrec :: Int -> AbiTag -> ShowS
$cshow :: AbiTag -> String
show :: AbiTag -> String
$cshowList :: [AbiTag] -> ShowS
showList :: [AbiTag] -> ShowS
Show, ReadPrec [AbiTag]
ReadPrec AbiTag
Int -> ReadS AbiTag
ReadS [AbiTag]
(Int -> ReadS AbiTag)
-> ReadS [AbiTag]
-> ReadPrec AbiTag
-> ReadPrec [AbiTag]
-> Read AbiTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AbiTag
readsPrec :: Int -> ReadS AbiTag
$creadList :: ReadS [AbiTag]
readList :: ReadS [AbiTag]
$creadPrec :: ReadPrec AbiTag
readPrec :: ReadPrec AbiTag
$creadListPrec :: ReadPrec [AbiTag]
readListPrec :: ReadPrec [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 <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
tag then AbiTag -> m AbiTag
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return AbiTag
NoAbiTag else AbiTag -> m AbiTag
forall a. a -> m a
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 ([CompilerId] -> Maybe [CompilerId]
forall a. a -> Maybe a
Just []) Maybe [Language]
forall a. Maybe a
Nothing Maybe [Extension]
forall a. Maybe a
Nothing