{-# Language DataKinds, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, TypeFamilies, TypeOperators #-}

-- | The module exports the set of recognized language extensions, mostly corresponding to GHC extensions
module Language.Haskell.Extensions (Extension(..), ExtensionSwitch(..),
                                    On, Off, on, off,
                                    allExtensions, byName, includedByDefault, implications, inverseImplications,
                                    languageVersions, partitionContradictory, switchesByName, withImplications) where

import Data.Bifunctor (first)
import Data.Bool (bool)
import Data.Data (Data, Typeable)
import qualified Data.Map.Lazy as Map
import qualified Data.Set as Set
import Data.Map (Map)
import Data.Function.Memoize (Memoizable (memoize))
import Data.Set (Set)
import Data.Semigroup.Union (UnionWith(..))
import Data.String (IsString)

-- | The enumeration of all language extensions
data Extension = AllowAmbiguousTypes
               | AlternativeLayoutRule
               | AlternativeLayoutRuleTransitional
               | ApplicativeDo
               | Arrows
               | AutoDeriveTypeable
               | BangDataFields -- | active but unnamed in GHC and Report
               | BangPatterns
               | BinaryLiterals
               | BlockArguments
               | CApiFFI
               | CUSKs
               | ConstrainedClassMethods
               | ConstraintsAreTypes -- | active but unnamed in GHC
               | ConstraintKinds
               | Cpp
               | DataKinds
               | DatatypeContexts
               | DeepSubsumption
               | DefaultSignatures
               | DeriveAnyClass
               | DeriveDataTypeable
               | DeriveFoldable
               | DeriveFunctor
               | DeriveGeneric
               | DeriveLift
               | DeriveTraversable
               | DerivingStrategies
               | DerivingVia
               | DisambiguateRecordFields
               | DoAndIfThenElse
               | DuplicateRecordFields
               | EmptyCase
               | EmptyDataDeclarations
               | EmptyDataDeriving
               | EqualityConstraints -- | unnamed in GHC
               | ExistentialQuantification
               | ExplicitForAll
               | ExplicitNamespaces
               | ExtendedDefaultRules
               | ExtendedLiterals
               | FieldSelectors
               | FlexibleContexts
               | FlexibleInstances
               | ForeignFunctionInterface
               | FunctionalDependencies
               | GADTSyntax
               | GADTs
               | GHC2021
               | GHC2024
               | GHCForeignImportPrim
               | GeneralizedNewtypeDeriving
               | Haskell2010
               | Haskell98
               | HexFloatLiterals
               | IdentifierSyntax -- | active but unnamed in GHC
               | ImplicitParameters
               | ImplicitPrelude
               | ImportQualifiedPost
               | ImpredicativeTypes
               | IncoherentInstances
               | InferredTypeVariables -- | unnamed in GHC
               | InstanceSigs
               | InterruptibleFFI
               | JavaScriptFFI
               | KindSignatures
               | LambdaCase
               | LexicalNegation
               | LiberalTypeSynonyms
               | LinearTypes
               | ListTuplePuns
               | MagicHash
               | MonadComprehensions
               | MonadFailDesugaring
               | MonoLocalBinds
               | MonoPatBinds
               | MonomorphismRestriction
               | MultiParamTypeClasses
               | MultiParameterConstraints -- | active unnamed in GHC
               | MultiWayIf
               | NPlusKPatterns
               | NamedDefaults
               | NamedFieldPuns
               | NamedWildCards
               | NegativeLiterals
               | NondecreasingIndentation
               | NullaryTypeClasses
               | NumDecimals
               | NumericUnderscores
               | OverlappingInstances
               | OverloadedLabels
               | OverloadedLists
               | OverloadedRecordDot
               | OverloadedRecordUpdate
               | OverloadedStrings
               | PackageImports
               | ParallelArrays
               | ParallelListComp
               | ParallelListComprehensions
               | ParenthesizedTypeOperators     -- | active but unnamed in GHC
               | GratuitouslyParenthesizedTypes -- | active but unnamed in GHC
               | PartialTypeSignatures
               | PatternGuards
               | PatternSynonyms
               | PolyKinds
               | PostfixOperators
               | QualifiedDo
               | QuantifiedConstraints
               | QuasiQuotes
               | RankNTypes
               | RebindableSyntax
               | RecordWildCards
               | RecursiveDo
               | RelaxedLayout
               | RelaxedPolyRec
               | RequiredTypeArguments
               | RoleAnnotations
               | Safe
               | SafeImports
               | ScopedTypeVariables
               | SpaceSensitiveOperators
               | StandaloneDeriving
               | StandaloneKindSignatures
               | StarIsType
               | StaticPointers
               | Strict
               | StrictData
               | TemplateHaskell
               | TemplateHaskellQuotes
               | TraditionalRecordSyntax
               | TransformListComp
               | Trustworthy
               | TupleSections
               | TypeAbstractions
               | TypeAbstractionsOrApplicationsInConstructorPatterns -- | nameless
               | TypeApplications
               | TypeData
               | TypeFamilies
               | TypeFamilyDependencies
               | TypeInType
               | TypeOperators
               | TypeSynonymInstances
               | TypeVariableConstraints -- | active but unnamed in GHC
               | UnboxedSums
               | UnboxedTuples
               | UndecidableInstances
               | UndecidableSuperClasses
               | UnicodeSyntax
               | UnliftedDatatypes
               | UnliftedFFITypes
               | UnliftedNewtypes
               | Unsafe
               | ViewPatterns
               | VisibleDependedentQuantification -- | nameless
               deriving (Extension
Extension -> Extension -> Bounded Extension
forall a. a -> a -> Bounded a
$cminBound :: Extension
minBound :: Extension
$cmaxBound :: Extension
maxBound :: Extension
Bounded, Typeable Extension
Typeable Extension =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Extension -> c Extension)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Extension)
-> (Extension -> Constr)
-> (Extension -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Extension))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extension))
-> ((forall b. Data b => b -> b) -> Extension -> Extension)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Extension -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Extension -> r)
-> (forall u. (forall d. Data d => d -> u) -> Extension -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Extension -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Extension -> m Extension)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extension -> m Extension)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extension -> m Extension)
-> Data Extension
Extension -> Constr
Extension -> DataType
(forall b. Data b => b -> b) -> Extension -> Extension
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) -> Extension -> u
forall u. (forall d. Data d => d -> u) -> Extension -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extension -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extension -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extension
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extension -> c Extension
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extension)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extension)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extension -> c Extension
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extension -> c Extension
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extension
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extension
$ctoConstr :: Extension -> Constr
toConstr :: Extension -> Constr
$cdataTypeOf :: Extension -> DataType
dataTypeOf :: Extension -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extension)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extension)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extension)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extension)
$cgmapT :: (forall b. Data b => b -> b) -> Extension -> Extension
gmapT :: (forall b. Data b => b -> b) -> Extension -> Extension
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extension -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extension -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extension -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extension -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Extension -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Extension -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Extension -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Extension -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extension -> m Extension
Data, Int -> Extension
Extension -> Int
Extension -> [Extension]
Extension -> Extension
Extension -> Extension -> [Extension]
Extension -> Extension -> Extension -> [Extension]
(Extension -> Extension)
-> (Extension -> Extension)
-> (Int -> Extension)
-> (Extension -> Int)
-> (Extension -> [Extension])
-> (Extension -> Extension -> [Extension])
-> (Extension -> Extension -> [Extension])
-> (Extension -> Extension -> Extension -> [Extension])
-> Enum Extension
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Extension -> Extension
succ :: Extension -> Extension
$cpred :: Extension -> Extension
pred :: Extension -> Extension
$ctoEnum :: Int -> Extension
toEnum :: Int -> Extension
$cfromEnum :: Extension -> Int
fromEnum :: Extension -> Int
$cenumFrom :: Extension -> [Extension]
enumFrom :: Extension -> [Extension]
$cenumFromThen :: Extension -> Extension -> [Extension]
enumFromThen :: Extension -> Extension -> [Extension]
$cenumFromTo :: Extension -> Extension -> [Extension]
enumFromTo :: Extension -> Extension -> [Extension]
$cenumFromThenTo :: Extension -> Extension -> Extension -> [Extension]
enumFromThenTo :: Extension -> Extension -> Extension -> [Extension]
Enum, Extension -> Extension -> Bool
(Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool) -> Eq Extension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Extension -> Extension -> Bool
== :: Extension -> Extension -> Bool
$c/= :: Extension -> Extension -> Bool
/= :: Extension -> Extension -> Bool
Eq, Eq Extension
Eq Extension =>
(Extension -> Extension -> Ordering)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool)
-> (Extension -> Extension -> Extension)
-> (Extension -> Extension -> Extension)
-> Ord Extension
Extension -> Extension -> Bool
Extension -> Extension -> Ordering
Extension -> Extension -> Extension
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 :: Extension -> Extension -> Ordering
compare :: Extension -> Extension -> Ordering
$c< :: Extension -> Extension -> Bool
< :: Extension -> Extension -> Bool
$c<= :: Extension -> Extension -> Bool
<= :: Extension -> Extension -> Bool
$c> :: Extension -> Extension -> Bool
> :: Extension -> Extension -> Bool
$c>= :: Extension -> Extension -> Bool
>= :: Extension -> Extension -> Bool
$cmax :: Extension -> Extension -> Extension
max :: Extension -> Extension -> Extension
$cmin :: Extension -> Extension -> Extension
min :: Extension -> Extension -> Extension
Ord, ReadPrec [Extension]
ReadPrec Extension
Int -> ReadS Extension
ReadS [Extension]
(Int -> ReadS Extension)
-> ReadS [Extension]
-> ReadPrec Extension
-> ReadPrec [Extension]
-> Read Extension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Extension
readsPrec :: Int -> ReadS Extension
$creadList :: ReadS [Extension]
readList :: ReadS [Extension]
$creadPrec :: ReadPrec Extension
readPrec :: ReadPrec Extension
$creadListPrec :: ReadPrec [Extension]
readListPrec :: ReadPrec [Extension]
Read, Int -> Extension -> ShowS
[Extension] -> ShowS
Extension -> String
(Int -> Extension -> ShowS)
-> (Extension -> String)
-> ([Extension] -> ShowS)
-> Show Extension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Extension -> ShowS
showsPrec :: Int -> Extension -> ShowS
$cshow :: Extension -> String
show :: Extension -> String
$cshowList :: [Extension] -> ShowS
showList :: [Extension] -> ShowS
Show)

-- | An extension together with an on/off boolean
newtype ExtensionSwitch = ExtensionSwitch (Extension, Bool)
                          deriving (Typeable ExtensionSwitch
Typeable ExtensionSwitch =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ExtensionSwitch -> c ExtensionSwitch)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ExtensionSwitch)
-> (ExtensionSwitch -> Constr)
-> (ExtensionSwitch -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ExtensionSwitch))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ExtensionSwitch))
-> ((forall b. Data b => b -> b)
    -> ExtensionSwitch -> ExtensionSwitch)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ExtensionSwitch -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ExtensionSwitch -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ExtensionSwitch -> m ExtensionSwitch)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExtensionSwitch -> m ExtensionSwitch)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExtensionSwitch -> m ExtensionSwitch)
-> Data ExtensionSwitch
ExtensionSwitch -> Constr
ExtensionSwitch -> DataType
(forall b. Data b => b -> b) -> ExtensionSwitch -> ExtensionSwitch
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) -> ExtensionSwitch -> u
forall u. (forall d. Data d => d -> u) -> ExtensionSwitch -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtensionSwitch
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtensionSwitch -> c ExtensionSwitch
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtensionSwitch)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExtensionSwitch)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtensionSwitch -> c ExtensionSwitch
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtensionSwitch -> c ExtensionSwitch
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtensionSwitch
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtensionSwitch
$ctoConstr :: ExtensionSwitch -> Constr
toConstr :: ExtensionSwitch -> Constr
$cdataTypeOf :: ExtensionSwitch -> DataType
dataTypeOf :: ExtensionSwitch -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtensionSwitch)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtensionSwitch)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExtensionSwitch)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExtensionSwitch)
$cgmapT :: (forall b. Data b => b -> b) -> ExtensionSwitch -> ExtensionSwitch
gmapT :: (forall b. Data b => b -> b) -> ExtensionSwitch -> ExtensionSwitch
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtensionSwitch -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExtensionSwitch -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExtensionSwitch -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ExtensionSwitch -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ExtensionSwitch -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExtensionSwitch -> m ExtensionSwitch
Data, ExtensionSwitch -> ExtensionSwitch -> Bool
(ExtensionSwitch -> ExtensionSwitch -> Bool)
-> (ExtensionSwitch -> ExtensionSwitch -> Bool)
-> Eq ExtensionSwitch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtensionSwitch -> ExtensionSwitch -> Bool
== :: ExtensionSwitch -> ExtensionSwitch -> Bool
$c/= :: ExtensionSwitch -> ExtensionSwitch -> Bool
/= :: ExtensionSwitch -> ExtensionSwitch -> Bool
Eq, Eq ExtensionSwitch
Eq ExtensionSwitch =>
(ExtensionSwitch -> ExtensionSwitch -> Ordering)
-> (ExtensionSwitch -> ExtensionSwitch -> Bool)
-> (ExtensionSwitch -> ExtensionSwitch -> Bool)
-> (ExtensionSwitch -> ExtensionSwitch -> Bool)
-> (ExtensionSwitch -> ExtensionSwitch -> Bool)
-> (ExtensionSwitch -> ExtensionSwitch -> ExtensionSwitch)
-> (ExtensionSwitch -> ExtensionSwitch -> ExtensionSwitch)
-> Ord ExtensionSwitch
ExtensionSwitch -> ExtensionSwitch -> Bool
ExtensionSwitch -> ExtensionSwitch -> Ordering
ExtensionSwitch -> ExtensionSwitch -> ExtensionSwitch
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 :: ExtensionSwitch -> ExtensionSwitch -> Ordering
compare :: ExtensionSwitch -> ExtensionSwitch -> Ordering
$c< :: ExtensionSwitch -> ExtensionSwitch -> Bool
< :: ExtensionSwitch -> ExtensionSwitch -> Bool
$c<= :: ExtensionSwitch -> ExtensionSwitch -> Bool
<= :: ExtensionSwitch -> ExtensionSwitch -> Bool
$c> :: ExtensionSwitch -> ExtensionSwitch -> Bool
> :: ExtensionSwitch -> ExtensionSwitch -> Bool
$c>= :: ExtensionSwitch -> ExtensionSwitch -> Bool
>= :: ExtensionSwitch -> ExtensionSwitch -> Bool
$cmax :: ExtensionSwitch -> ExtensionSwitch -> ExtensionSwitch
max :: ExtensionSwitch -> ExtensionSwitch -> ExtensionSwitch
$cmin :: ExtensionSwitch -> ExtensionSwitch -> ExtensionSwitch
min :: ExtensionSwitch -> ExtensionSwitch -> ExtensionSwitch
Ord, Int -> ExtensionSwitch -> ShowS
[ExtensionSwitch] -> ShowS
ExtensionSwitch -> String
(Int -> ExtensionSwitch -> ShowS)
-> (ExtensionSwitch -> String)
-> ([ExtensionSwitch] -> ShowS)
-> Show ExtensionSwitch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionSwitch -> ShowS
showsPrec :: Int -> ExtensionSwitch -> ShowS
$cshow :: ExtensionSwitch -> String
show :: ExtensionSwitch -> String
$cshowList :: [ExtensionSwitch] -> ShowS
showList :: [ExtensionSwitch] -> ShowS
Show)

instance Memoizable (Set Extension) where
   memoize :: forall v. (Set Extension -> v) -> Set Extension -> v
memoize Set Extension -> v
f Set Extension
s = ([Bool] -> v) -> [Bool] -> v
forall a v. Memoizable a => (a -> v) -> a -> v
forall v. ([Bool] -> v) -> [Bool] -> v
memoize (Set Extension -> v
f (Set Extension -> v) -> ([Bool] -> Set Extension) -> [Bool] -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Set Extension
setFromBits) [Extension -> Set Extension -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Extension
e Set Extension
s | Extension
e <- [Extension
forall a. Bounded a => a
minBound .. Extension
forall a. Bounded a => a
maxBound]]

setFromBits :: [Bool] -> Set Extension
setFromBits :: [Bool] -> Set Extension
setFromBits = [Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList ([Extension] -> Set Extension)
-> ([Bool] -> [Extension]) -> [Bool] -> Set Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Extension, Bool) -> Extension)
-> [(Extension, Bool)] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map (Extension, Bool) -> Extension
forall a b. (a, b) -> a
fst ([(Extension, Bool)] -> [Extension])
-> ([Bool] -> [(Extension, Bool)]) -> [Bool] -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Extension, Bool) -> Bool)
-> [(Extension, Bool)] -> [(Extension, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(Extension, Bool)] -> [(Extension, Bool)])
-> ([Bool] -> [(Extension, Bool)]) -> [Bool] -> [(Extension, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> [Bool] -> [(Extension, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Extension
forall a. Bounded a => a
minBound .. Extension
forall a. Bounded a => a
maxBound]

off, on :: Extension -> ExtensionSwitch
-- | The off-switch for an extension
off :: Extension -> ExtensionSwitch
off Extension
x = (Extension, Bool) -> ExtensionSwitch
ExtensionSwitch (Extension
x, Bool
False)
-- | The on-switch for an extension
on :: Extension -> ExtensionSwitch
on Extension
x = (Extension, Bool) -> ExtensionSwitch
ExtensionSwitch (Extension
x, Bool
True)

type On (e :: Extension) = 'ExtensionSwitch '( e, 'True) :: ExtensionSwitch
type Off (e :: Extension) = 'ExtensionSwitch '( e, 'False) :: ExtensionSwitch

-- | Set of all extensions
allExtensions :: Set Extension
allExtensions :: Set Extension
allExtensions = [Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList [Extension
forall a. Bounded a => a
minBound .. Extension
forall a. Bounded a => a
maxBound]

-- | Set of extensions that are on by default
includedByDefault :: Set Extension
includedByDefault :: Set Extension
includedByDefault = [Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList [Extension
BangDataFields, Extension
ConstraintsAreTypes,
                                  Extension
DatatypeContexts, Extension
DoAndIfThenElse, Extension
EmptyDataDeclarations, Extension
EqualityConstraints,
                                  Extension
FieldSelectors, Extension
ForeignFunctionInterface,
                                  Extension
GratuitouslyParenthesizedTypes, Extension
IdentifierSyntax, Extension
ListTuplePuns,
                                  Extension
MultiParameterConstraints, Extension
ParenthesizedTypeOperators, Extension
PatternGuards,
                                  Extension
RelaxedPolyRec, Extension
SpaceSensitiveOperators, Extension
StarIsType,
                                  Extension
TraditionalRecordSyntax, Extension
TypeVariableConstraints]

-- | Set of language version extensions, such as 'Haskell2010'
languageVersions :: Set Extension
languageVersions :: Set Extension
languageVersions = [Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList [Extension
Haskell98, Extension
Haskell2010]

-- | Map of all extension implications, including 'directImplications' but adding transitive implications
implications :: Map Extension (Map Extension Bool)
implications :: Map Extension (Map Extension Bool)
implications = Map Extension (Map Extension Bool)
-> Map Extension (Map Extension Bool)
-> Map Extension (Map Extension Bool)
forall {k}.
Ord k =>
Map k (Map k Bool) -> Map k (Map k Bool) -> Map k (Map k Bool)
transitiveClosure Map Extension (Map Extension Bool)
directImplications Map Extension (Map Extension Bool)
directImplications
  where transitiveClosure :: Map k (Map k Bool) -> Map k (Map k Bool) -> Map k (Map k Bool)
transitiveClosure Map k (Map k Bool)
margin Map k (Map k Bool)
c
           | (Map k Bool -> Bool) -> Map k (Map k Bool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Map k Bool -> Bool
forall k a. Map k a -> Bool
Map.null Map k (Map k Bool)
margin' = Map k (Map k Bool)
c
           | Bool
otherwise = Map k (Map k Bool) -> Map k (Map k Bool) -> Map k (Map k Bool)
transitiveClosure Map k (Map k Bool)
margin' ((Map k Bool -> Map k Bool -> Map k Bool)
-> Map k (Map k Bool) -> Map k (Map k Bool) -> Map k (Map k Bool)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map k Bool -> Map k Bool -> Map k Bool
forall a. Semigroup a => a -> a -> a
(<>) Map k (Map k Bool)
c Map k (Map k Bool)
margin')
           where margin' :: Map k (Map k Bool)
margin' = (k -> Map k Bool -> Map k Bool)
-> Map k (Map k Bool) -> Map k (Map k Bool)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey ((k -> Bool -> Map k Bool) -> Map k Bool -> Map k Bool
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey ((k -> Bool -> Map k Bool) -> Map k Bool -> Map k Bool)
-> (k -> k -> Bool -> Map k Bool) -> k -> Map k Bool -> Map k Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> k -> Bool -> Map k Bool
marginOf) Map k (Map k Bool)
margin
                 marginOf :: k -> k -> Bool -> Map k Bool
marginOf k
k1 k
k2 Bool
True = Map k Bool -> k -> Map k (Map k Bool) -> Map k Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map k Bool
forall a. Monoid a => a
mempty k
k2 Map k (Map k Bool)
c Map k Bool -> Map k Bool -> Map k Bool
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map k Bool -> k -> Map k (Map k Bool) -> Map k Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map k Bool
forall a. Monoid a => a
mempty k
k1 Map k (Map k Bool)
c
                 marginOf k
_ k
_ Bool
False = Map k Bool
forall a. Monoid a => a
mempty

-- | Map of direct extension implications
directImplications :: Map Extension (Map Extension Bool)
directImplications :: Map Extension (Map Extension Bool)
directImplications = [(Extension, Bool)] -> Map Extension Bool
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Extension, Bool)] -> Map Extension Bool)
-> Map Extension [(Extension, Bool)]
-> Map Extension (Map Extension Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Extension, [(Extension, Bool)])]
-> Map Extension [(Extension, Bool)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
  (Extension
AutoDeriveTypeable, [(Extension
DeriveDataTypeable, Bool
True)]),
  (Extension
DeriveTraversable, [(Extension
DeriveFoldable, Bool
True), (Extension
DeriveFunctor, Bool
True)]),
  (Extension
DerivingVia, [(Extension
DerivingStrategies, Bool
True)]),
  (Extension
DuplicateRecordFields, [(Extension
DisambiguateRecordFields, Bool
True)]),
  (Extension
ExistentialQuantification, [(Extension
ExplicitForAll, Bool
True)]),
  (Extension
ExplicitForAll, [(Extension
InferredTypeVariables, Bool
True)]),
  (Extension
FlexibleInstances, [(Extension
TypeSynonymInstances, Bool
True)]),
  (Extension
FunctionalDependencies, [(Extension
MultiParamTypeClasses, Bool
True)]),
  (Extension
GADTs, [(Extension
EqualityConstraints, Bool
True), (Extension
ExistentialQuantification, Bool
True), (Extension
GADTSyntax, Bool
True), (Extension
MonoLocalBinds, Bool
True)]),
  (Extension
GHC2021, [(Extension
BangPatterns, Bool
True), (Extension
BinaryLiterals, Bool
True),
             (Extension
ConstrainedClassMethods, Bool
True), (Extension
ConstraintKinds, Bool
True),
             (Extension
DeriveDataTypeable, Bool
True), (Extension
DeriveFoldable, Bool
True), (Extension
DeriveFunctor, Bool
True),
             (Extension
DeriveGeneric, Bool
True), (Extension
DeriveLift, Bool
True), (Extension
DeriveTraversable, Bool
True), (Extension
DoAndIfThenElse, Bool
True),
             (Extension
EmptyCase, Bool
True), (Extension
EmptyDataDeclarations, Bool
True), (Extension
EmptyDataDeriving, Bool
True),
             (Extension
ExistentialQuantification, Bool
True), (Extension
ExplicitForAll, Bool
True),
             (Extension
FieldSelectors, Bool
True), (Extension
FlexibleContexts, Bool
True),
             (Extension
FlexibleInstances, Bool
True), (Extension
ForeignFunctionInterface, Bool
True),
             (Extension
GADTSyntax, Bool
True), (Extension
GeneralizedNewtypeDeriving, Bool
True),
             (Extension
HexFloatLiterals, Bool
True),
             (Extension
ImplicitPrelude, Bool
True), (Extension
ImportQualifiedPost, Bool
True), (Extension
InstanceSigs, Bool
True),
             (Extension
KindSignatures, Bool
True),
             (Extension
MonomorphismRestriction, Bool
True), (Extension
MultiParamTypeClasses, Bool
True),
             (Extension
NamedFieldPuns, Bool
True), (Extension
NamedWildCards, Bool
True), (Extension
NumericUnderscores, Bool
True),
             (Extension
PatternGuards, Bool
True), (Extension
PolyKinds, Bool
True), (Extension
PostfixOperators, Bool
True),
             (Extension
RankNTypes, Bool
True), (Extension
RelaxedPolyRec, Bool
True),
             (Extension
ScopedTypeVariables, Bool
True), (Extension
StandaloneDeriving, Bool
True),
             (Extension
StandaloneKindSignatures, Bool
True), (Extension
StarIsType, Bool
True),
             (Extension
TraditionalRecordSyntax, Bool
True), (Extension
TupleSections, Bool
True),
             (Extension
TypeApplications, Bool
True), (Extension
TypeOperators, Bool
True), (Extension
TypeSynonymInstances, Bool
True),
             (Extension
ExplicitNamespaces, Bool
False)]),
  (Extension
GHC2024, [(Extension
GHC2021, Bool
True), (Extension
DataKinds, Bool
True), (Extension
DerivingStrategies, Bool
True), (Extension
DisambiguateRecordFields, Bool
True),
             (Extension
ExplicitNamespaces, Bool
True), (Extension
GADTs, Bool
True), (Extension
LambdaCase, Bool
True),
             (Extension
MonoLocalBinds, Bool
True), (Extension
RoleAnnotations, Bool
True)]),
  (Extension
Haskell98, [(Extension
NPlusKPatterns, Bool
True), (Extension
NondecreasingIndentation, Bool
True),
               (Extension
DoAndIfThenElse, Bool
False), (Extension
EmptyDataDeclarations, Bool
False),
               (Extension
ForeignFunctionInterface, Bool
False), (Extension
PatternGuards, Bool
False), (Extension
RelaxedPolyRec, Bool
False)]),
  (Extension
ImpredicativeTypes, [(Extension
ExplicitForAll, Bool
True), (Extension
RankNTypes, Bool
True)]),
  (Extension
IncoherentInstances, [(Extension
OverlappingInstances, Bool
True)]),
  (Extension
JavaScriptFFI, [(Extension
InterruptibleFFI, Bool
True)]),
  (Extension
KindSignatures, [(Extension
GratuitouslyParenthesizedTypes, Bool
True)]),
  (Extension
LiberalTypeSynonyms, [(Extension
ExplicitForAll, Bool
True)]),
  (Extension
LinearTypes, [(Extension
SpaceSensitiveOperators, Bool
True)]),
  (Extension
MultiParamTypeClasses, [(Extension
ConstrainedClassMethods, Bool
True), (Extension
MultiParameterConstraints, Bool
True)]),
  (Extension
ParallelArrays, [(Extension
ParallelListComprehensions, Bool
True)]),
  (Extension
ParallelListComp, [(Extension
ParallelListComprehensions, Bool
True)]),
  (Extension
PolyKinds, [(Extension
KindSignatures, Bool
True), (Extension
VisibleDependedentQuantification, Bool
True)]),
  (Extension
QuantifiedConstraints, [(Extension
ExplicitForAll, Bool
True)]),
  (Extension
RankNTypes, [(Extension
ExplicitForAll, Bool
True)]),
  (Extension
RebindableSyntax, [(Extension
ImplicitPrelude, Bool
False)]),
  (Extension
RecordWildCards, [(Extension
DisambiguateRecordFields, Bool
True)]),
  (Extension
RequiredTypeArguments, [(Extension
VisibleDependedentQuantification, Bool
True)]),
  (Extension
Safe, [(Extension
SafeImports, Bool
True)]),
  (Extension
ScopedTypeVariables, [(Extension
ExplicitForAll, Bool
True)]),
  (Extension
StandaloneKindSignatures, [(Extension
CUSKs, Bool
False)]),
  (Extension
Strict, [(Extension
StrictData, Bool
True)]),
  (Extension
TemplateHaskell, [(Extension
TemplateHaskellQuotes, Bool
True)]),
  (Extension
Trustworthy, [(Extension
SafeImports, Bool
True)]),
  (Extension
TypeAbstractions, [(Extension
TypeAbstractionsOrApplicationsInConstructorPatterns, Bool
True)]),
  (Extension
TypeApplications, [(Extension
InferredTypeVariables, Bool
True), (Extension
TypeAbstractionsOrApplicationsInConstructorPatterns, Bool
True)]),
  (Extension
TypeFamilies, [(Extension
EqualityConstraints, Bool
True), (Extension
ExplicitNamespaces, Bool
True),
                  (Extension
KindSignatures, Bool
True), (Extension
MonoLocalBinds, Bool
True)]),
  (Extension
TypeFamilyDependencies, [(Extension
TypeFamilies, Bool
True)]),
  (Extension
TypeInType, [(Extension
PolyKinds, Bool
True), (Extension
DataKinds, Bool
True), (Extension
KindSignatures, Bool
True)]),
  (Extension
TypeOperators, [(Extension
ExplicitNamespaces, Bool
True), (Extension
ParenthesizedTypeOperators, Bool
True)]),
  (Extension
UnboxedTuples, [(Extension
UnboxedSums, Bool
True)]),
  (Extension
UnliftedDatatypes, [(Extension
DataKinds, Bool
True), (Extension
StandaloneKindSignatures, Bool
True)]),
  (Extension
Unsafe, [(Extension
SafeImports, Bool
True)])]

-- | Inverse of the 'implications' map
inverseImplications :: Map Extension (Set Extension)
inverseImplications :: Map Extension (Set Extension)
inverseImplications = UnionWith (Map Extension) (Set Extension)
-> Map Extension (Set Extension)
forall (f :: * -> *) m. UnionWith f m -> f m
getUnionWith (UnionWith (Map Extension) (Set Extension)
 -> Map Extension (Set Extension))
-> UnionWith (Map Extension) (Set Extension)
-> Map Extension (Set Extension)
forall a b. (a -> b) -> a -> b
$ (Extension
 -> Map Extension Bool -> UnionWith (Map Extension) (Set Extension))
-> Map Extension (Map Extension Bool)
-> UnionWith (Map Extension) (Set Extension)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Extension
-> Map Extension Bool -> UnionWith (Map Extension) (Set Extension)
forall {a} {k}. a -> Map k Bool -> UnionWith (Map k) (Set a)
inverse Map Extension (Map Extension Bool)
implications 
   where inverse :: a -> Map k Bool -> UnionWith (Map k) (Set a)
inverse a
parent = Map k (Set a) -> UnionWith (Map k) (Set a)
forall (f :: * -> *) m. f m -> UnionWith f m
UnionWith (Map k (Set a) -> UnionWith (Map k) (Set a))
-> (Map k Bool -> Map k (Set a))
-> Map k Bool
-> UnionWith (Map k) (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Maybe (Set a)) -> Map k Bool -> Map k (Set a)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (Maybe (Set a) -> Maybe (Set a) -> Bool -> Maybe (Set a)
forall a. a -> a -> Bool -> a
bool Maybe (Set a)
forall a. Maybe a
Nothing (Maybe (Set a) -> Bool -> Maybe (Set a))
-> Maybe (Set a) -> Bool -> Maybe (Set a)
forall a b. (a -> b) -> a -> b
$ Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just (Set a -> Maybe (Set a)) -> Set a -> Maybe (Set a)
forall a b. (a -> b) -> a -> b
$ a -> Set a
forall a. a -> Set a
Set.singleton a
parent)
      
-- | Given a set of extension switches, provides a 'Map' of extensions to their 'on'/'off' state an a 'Set' of
-- contradictory extensions.
partitionContradictory :: Set ExtensionSwitch -> (Set ExtensionSwitch, Map Extension Bool)
partitionContradictory :: Set ExtensionSwitch -> (Set ExtensionSwitch, Map Extension Bool)
partitionContradictory Set ExtensionSwitch
switches = (Map ExtensionSwitch Bool -> Set ExtensionSwitch
forall k a. Map k a -> Set k
Map.keysSet Map ExtensionSwitch Bool
contradictions, (ExtensionSwitch -> Extension)
-> Map ExtensionSwitch Bool -> Map Extension Bool
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys ExtensionSwitch -> Extension
getExtension Map ExtensionSwitch Bool
consistents)
   where (Map ExtensionSwitch Bool
contradictions, Map ExtensionSwitch Bool
consistents) = (ExtensionSwitch -> Bool -> Bool)
-> Map ExtensionSwitch Bool
-> (Map ExtensionSwitch Bool, Map ExtensionSwitch Bool)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey ExtensionSwitch -> Bool -> Bool
isContradicted Map ExtensionSwitch Bool
extensionMap
         extensionMap :: Map ExtensionSwitch Bool
         extensionMap :: Map ExtensionSwitch Bool
extensionMap = (ExtensionSwitch -> Bool)
-> Set ExtensionSwitch -> Map ExtensionSwitch Bool
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet ExtensionSwitch -> Bool
getSwitch Set ExtensionSwitch
switches
         isContradicted :: ExtensionSwitch -> Bool -> Bool
isContradicted (ExtensionSwitch (Extension
x, Bool
s)) Bool
_ = (Extension, Bool) -> ExtensionSwitch
ExtensionSwitch (Extension
x, Bool -> Bool
not Bool
s) ExtensionSwitch -> Set ExtensionSwitch -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ExtensionSwitch
switches
         getExtension :: ExtensionSwitch -> Extension
getExtension (ExtensionSwitch (Extension
x, Bool
_)) = Extension
x
         getSwitch :: ExtensionSwitch -> Bool
getSwitch (ExtensionSwitch (Extension
_, Bool
s)) = Bool
s

-- | Adds the implied extensions to the given set of extension switches
withImplications :: Map Extension Bool -> Map Extension Bool
withImplications :: Map Extension Bool -> Map Extension Bool
withImplications Map Extension Bool
extensions = Map Extension Bool
extensions Map Extension Bool -> Map Extension Bool -> Map Extension Bool
forall a. Semigroup a => a -> a -> a
<> Map Extension (Map Extension Bool) -> Map Extension Bool
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (Map Extension (Map Extension Bool)
implications Map Extension (Map Extension Bool)
-> Map Extension Bool -> Map Extension (Map Extension Bool)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` (Bool -> Bool) -> Map Extension Bool -> Map Extension Bool
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Bool -> Bool
forall a. a -> a
id Map Extension Bool
extensions)

-- | Map from valid extension switch strings (such as "EmptyCase" or "NoArrows") to the corresponding
-- extension switches
switchesByName :: (IsString t, Ord t, Semigroup t) => Map t ExtensionSwitch
switchesByName :: forall t. (IsString t, Ord t, Semigroup t) => Map t ExtensionSwitch
switchesByName = (Extension, Bool) -> ExtensionSwitch
ExtensionSwitch ((Extension, Bool) -> ExtensionSwitch)
-> Map t (Extension, Bool) -> Map t ExtensionSwitch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Extension -> Bool -> (Extension, Bool))
-> Bool -> Extension -> (Extension, Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Bool
True (Extension -> (Extension, Bool))
-> Map t Extension -> Map t (Extension, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map t Extension
forall t. (IsString t, Ord t) => Map t Extension
byName)
                                      Map t (Extension, Bool)
-> Map t (Extension, Bool) -> Map t (Extension, Bool)
forall a. Semigroup a => a -> a -> a
<> ((Extension -> Bool -> (Extension, Bool))
-> Bool -> Extension -> (Extension, Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Bool
False (Extension -> (Extension, Bool))
-> Map t Extension -> Map t (Extension, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> t) -> Map t Extension -> Map t Extension
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic (t
"No" t -> t -> t
forall a. Semigroup a => a -> a -> a
<>) Map t Extension
forall t. (IsString t, Ord t) => Map t Extension
byName))

byName :: (IsString t, Ord t) => Map t Extension
byName :: forall t. (IsString t, Ord t) => Map t Extension
byName = [(t, Extension)] -> Map t Extension
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
  (t
"AllowAmbiguousTypes", Extension
AllowAmbiguousTypes),
  (t
"AlternativeLayoutRule", Extension
AlternativeLayoutRule),
  (t
"AlternativeLayoutRuleTransitional", Extension
AlternativeLayoutRuleTransitional),
  (t
"ApplicativeDo", Extension
ApplicativeDo),
  (t
"Arrows", Extension
Arrows),
  (t
"AutoDeriveTypeable", Extension
AutoDeriveTypeable),
  (t
"BangDataFields", Extension
BangDataFields),
  (t
"BangPatterns", Extension
BangPatterns),
  (t
"BinaryLiterals", Extension
BinaryLiterals),
  (t
"BlockArguments", Extension
BlockArguments),
  (t
"CApiFFI", Extension
CApiFFI),
  (t
"CUSKs", Extension
CUSKs),
  (t
"ConstrainedClassMethods", Extension
ConstrainedClassMethods),
  (t
"ConstraintKinds", Extension
ConstraintKinds),
  (t
"Cpp", Extension
Cpp),
  (t
"DataKinds", Extension
DataKinds),
  (t
"DatatypeContexts", Extension
DatatypeContexts),
  (t
"DeepSubsumption", Extension
DeepSubsumption),
  (t
"DefaultSignatures", Extension
DefaultSignatures),
  (t
"DeriveAnyClass", Extension
DeriveAnyClass),
  (t
"DeriveDataTypeable", Extension
DeriveDataTypeable),
  (t
"DeriveFoldable", Extension
DeriveFoldable),
  (t
"DeriveFunctor", Extension
DeriveFunctor),
  (t
"DeriveGeneric", Extension
DeriveGeneric),
  (t
"DeriveLift", Extension
DeriveLift),
  (t
"DeriveTraversable", Extension
DeriveTraversable),
  (t
"DerivingStrategies", Extension
DerivingStrategies),
  (t
"DerivingVia", Extension
DerivingVia),
  (t
"DisambiguateRecordFields", Extension
DisambiguateRecordFields),
  (t
"DoAndIfThenElse", Extension
DoAndIfThenElse),
  (t
"DuplicateRecordFields", Extension
DuplicateRecordFields),
  (t
"EmptyCase", Extension
EmptyCase),
  (t
"EmptyDataDeclarations", Extension
EmptyDataDeclarations),
  (t
"EmptyDataDecls", Extension
EmptyDataDeclarations),
  (t
"EmptyDataDeriving", Extension
EmptyDataDeriving),
  (t
"EqualityConstraints", Extension
EqualityConstraints), 
  (t
"ExistentialQuantification", Extension
ExistentialQuantification),
  (t
"ExplicitForAll", Extension
ExplicitForAll),
  (t
"ExplicitNamespaces", Extension
ExplicitNamespaces),
  (t
"ExtendedDefaultRules", Extension
ExtendedDefaultRules),
  (t
"ExtendedLiterals", Extension
ExtendedLiterals),
  (t
"FieldSelectors", Extension
FieldSelectors),
  (t
"FlexibleContexts", Extension
FlexibleContexts),
  (t
"FlexibleInstances", Extension
FlexibleInstances),
  (t
"ForeignFunctionInterface", Extension
ForeignFunctionInterface),
  (t
"FunctionalDependencies", Extension
FunctionalDependencies),
  (t
"GADTSyntax", Extension
GADTSyntax),
  (t
"GADTs", Extension
GADTs),
  (t
"GHC2021", Extension
GHC2021),
  (t
"GHC2024", Extension
GHC2024),
  (t
"GHCForeignImportPrim", Extension
GHCForeignImportPrim),
  (t
"GeneralisedNewtypeDeriving", Extension
GeneralizedNewtypeDeriving),
  (t
"GeneralizedNewtypeDeriving", Extension
GeneralizedNewtypeDeriving),
  (t
"Haskell2010", Extension
Haskell2010),
  (t
"Haskell98", Extension
Haskell98),
  (t
"HexFloatLiterals", Extension
HexFloatLiterals),
  (t
"IdentifierSyntax", Extension
IdentifierSyntax),
  (t
"ImplicitParameters", Extension
ImplicitParameters),
  (t
"ImplicitParams", Extension
ImplicitParameters),
  (t
"ImplicitPrelude", Extension
ImplicitPrelude),
  (t
"ImportQualifiedPost", Extension
ImportQualifiedPost),
  (t
"ImpredicativeTypes", Extension
ImpredicativeTypes),
  (t
"IncoherentInstances", Extension
IncoherentInstances),
  (t
"InferredTypeVariables", Extension
InferredTypeVariables),
  (t
"InstanceSigs", Extension
InstanceSigs),
  (t
"InterruptibleFFI", Extension
InterruptibleFFI),
  (t
"JavaScriptFFI", Extension
JavaScriptFFI),
  (t
"KindSignatures", Extension
KindSignatures),
  (t
"LambdaCase", Extension
LambdaCase),
  (t
"LexicalNegation", Extension
LexicalNegation),
  (t
"LiberalTypeSynonyms", Extension
LiberalTypeSynonyms),
  (t
"LinearTypes", Extension
LinearTypes),
  (t
"ListTuplePuns", Extension
ListTuplePuns),
  (t
"MagicHash", Extension
MagicHash),
  (t
"MonadComprehensions", Extension
MonadComprehensions),
  (t
"MonadFailDesugaring", Extension
MonadFailDesugaring),
  (t
"MonoLocalBinds", Extension
MonoLocalBinds),
  (t
"MonoPatBinds", Extension
MonoPatBinds),
  (t
"MonomorphismRestriction", Extension
MonomorphismRestriction),
  (t
"MultiParameterConstraints", Extension
MultiParameterConstraints),
  (t
"MultiParamTypeClasses", Extension
MultiParamTypeClasses),
  (t
"MultiWayIf", Extension
MultiWayIf),
  (t
"NPlusKPatterns", Extension
NPlusKPatterns),
  (t
"NamedDefaults", Extension
NamedDefaults),
  (t
"NamedFieldPuns", Extension
NamedFieldPuns),
  (t
"NamedWildCards", Extension
NamedWildCards),
  (t
"NegativeLiterals", Extension
NegativeLiterals),
  (t
"NondecreasingIndentation", Extension
NondecreasingIndentation),
  (t
"NullaryTypeClasses", Extension
NullaryTypeClasses),
  (t
"NumDecimals", Extension
NumDecimals),
  (t
"NumericUnderscores", Extension
NumericUnderscores),
  (t
"OverlappingInstances", Extension
OverlappingInstances),
  (t
"OverloadedLabels", Extension
OverloadedLabels),
  (t
"OverloadedLists", Extension
OverloadedLists),
  (t
"OverloadedRecordDot", Extension
OverloadedRecordDot),
  (t
"OverloadedRecordUpdate", Extension
OverloadedRecordUpdate),
  (t
"OverloadedStrings", Extension
OverloadedStrings),
  (t
"PackageImports", Extension
PackageImports),
  (t
"ParallelArrays", Extension
ParallelArrays),
  (t
"ParallelListComp", Extension
ParallelListComp),
  (t
"ParallelListComp", Extension
ParallelListComprehensions),
  (t
"ParallelListComprehensions", Extension
ParallelListComprehensions),
  (t
"GratuitouslyParenthesizedTypes", Extension
GratuitouslyParenthesizedTypes),
  (t
"ParenthesizedTypeOperators", Extension
ParenthesizedTypeOperators),
  (t
"PartialTypeSignatures", Extension
PartialTypeSignatures),
  (t
"PatternGuards", Extension
PatternGuards),
  (t
"PatternSynonyms", Extension
PatternSynonyms),
  (t
"PolyKinds", Extension
PolyKinds),
  (t
"PostfixOperators", Extension
PostfixOperators),
  (t
"QualifiedDo", Extension
QualifiedDo),
  (t
"QuantifiedConstraints", Extension
QuantifiedConstraints),
  (t
"QuasiQuotes", Extension
QuasiQuotes),
  (t
"Rank2Types", Extension
RankNTypes),
  (t
"RankNTypes", Extension
RankNTypes),
  (t
"RebindableSyntax", Extension
RebindableSyntax),
  (t
"RecordWildCards", Extension
RecordWildCards),
  (t
"RecursiveDo", Extension
RecursiveDo),
  (t
"RelaxedLayout", Extension
RelaxedLayout),
  (t
"RelaxedPolyRec", Extension
RelaxedPolyRec),
  (t
"RequiredTypeArguments", Extension
RequiredTypeArguments),
  (t
"RoleAnnotations", Extension
RoleAnnotations),
  (t
"Safe", Extension
Safe),
  (t
"ScopedTypeVariables", Extension
ScopedTypeVariables),
  (t
"SpaceSensitiveOperators", Extension
SpaceSensitiveOperators),
  (t
"StandaloneDeriving", Extension
StandaloneDeriving),
  (t
"StandaloneKindSignatures", Extension
StandaloneKindSignatures),
  (t
"StarIsType", Extension
StarIsType),
  (t
"StaticPointers", Extension
StaticPointers),
  (t
"Strict", Extension
Strict),
  (t
"StrictData", Extension
StrictData),
  (t
"TemplateHaskell", Extension
TemplateHaskell),
  (t
"TemplateHaskellQuotes", Extension
TemplateHaskellQuotes),
  (t
"TraditionalRecordSyntax", Extension
TraditionalRecordSyntax),
  (t
"TransformListComp", Extension
TransformListComp),
  (t
"Trustworthy", Extension
Trustworthy),
  (t
"TupleSections", Extension
TupleSections),
  (t
"TypeAbstractions", Extension
TypeAbstractions),
  (t
"TypeApplications", Extension
TypeApplications),
  (t
"TypeData", Extension
TypeData),
  (t
"TypeFamilies", Extension
TypeFamilies),
  (t
"TypeFamilyDependencies", Extension
TypeFamilyDependencies),
  (t
"TypeInType", Extension
TypeInType),
  (t
"TypeOperators", Extension
TypeOperators),
  (t
"TypeSynonymInstances", Extension
TypeSynonymInstances),
  (t
"UnboxedSums", Extension
UnboxedSums),
  (t
"UnboxedTuples", Extension
UnboxedTuples),
  (t
"UndecidableInstances", Extension
UndecidableInstances),
  (t
"UndecidableSuperClasses", Extension
UndecidableSuperClasses),
  (t
"UnicodeSyntax", Extension
UnicodeSyntax),
  (t
"UnliftedDatatypes", Extension
UnliftedDatatypes),
  (t
"UnliftedFFITypes", Extension
UnliftedFFITypes),
  (t
"UnliftedNewtypes", Extension
UnliftedNewtypes),
  (t
"Unsafe", Extension
Unsafe),
  (t
"ViewPatterns", Extension
ViewPatterns)]