{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Language.Haskell.Extension
-- Copyright   :  Isaac Jones 2003-2004
-- License     :  BSD3
--
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- Haskell language dialects and extensions
module Language.Haskell.Extension
  ( Language (..)
  , knownLanguages
  , classifyLanguage
  , Extension (..)
  , KnownExtension (..)
  , deprecatedExtensions
  , classifyExtension
  , knownExtensions
  ) where

import Distribution.Compat.Prelude

import Data.Array (Array, Ix (inRange), accumArray, bounds, (!))

import Distribution.Parsec
import Distribution.Pretty

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp

-- ------------------------------------------------------------

-- * Language

-- ------------------------------------------------------------

-- | This represents a Haskell language dialect.
--
-- Language 'Extension's are interpreted relative to one of these base
-- languages.
data Language
  = -- | The Haskell 98 language as defined by the Haskell 98 report.
    -- <http://haskell.org/onlinereport/>
    Haskell98
  | -- | The Haskell 2010 language as defined by the Haskell 2010 report.
    -- <http://www.haskell.org/onlinereport/haskell2010>
    Haskell2010
  | -- | The GHC2021 collection of language extensions.
    -- <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0380-ghc2021.rst>
    GHC2021
  | -- | An unknown language, identified by its name.
    UnknownLanguage String
  deriving ((forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Language -> Rep Language x
from :: forall x. Language -> Rep Language x
$cto :: forall x. Rep Language x -> Language
to :: forall x. Rep Language x -> Language
Generic, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> String
show :: Language -> String
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, ReadPrec [Language]
ReadPrec Language
Int -> ReadS Language
ReadS [Language]
(Int -> ReadS Language)
-> ReadS [Language]
-> ReadPrec Language
-> ReadPrec [Language]
-> Read Language
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Language
readsPrec :: Int -> ReadS Language
$creadList :: ReadS [Language]
readList :: ReadS [Language]
$creadPrec :: ReadPrec Language
readPrec :: ReadPrec Language
$creadListPrec :: ReadPrec [Language]
readListPrec :: ReadPrec [Language]
Read, Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, Eq Language
Eq Language =>
(Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
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 :: Language -> Language -> Ordering
compare :: Language -> Language -> Ordering
$c< :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
>= :: Language -> Language -> Bool
$cmax :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
min :: Language -> Language -> Language
Ord, Typeable, Typeable Language
Typeable Language =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Language -> c Language)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Language)
-> (Language -> Constr)
-> (Language -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Language))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language))
-> ((forall b. Data b => b -> b) -> Language -> Language)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Language -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Language -> r)
-> (forall u. (forall d. Data d => d -> u) -> Language -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Language -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Language -> m Language)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Language -> m Language)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Language -> m Language)
-> Data Language
Language -> Constr
Language -> DataType
(forall b. Data b => b -> b) -> Language -> Language
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) -> Language -> u
forall u. (forall d. Data d => d -> u) -> Language -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Language -> m Language
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Language)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language
$ctoConstr :: Language -> Constr
toConstr :: Language -> Constr
$cdataTypeOf :: Language -> DataType
dataTypeOf :: Language -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Language)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Language)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language)
$cgmapT :: (forall b. Data b => b -> b) -> Language -> Language
gmapT :: (forall b. Data b => b -> b) -> Language -> Language
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Language -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Language -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Language -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Language -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Language -> m Language
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Language -> m Language
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
Data)

instance Binary Language
instance Structured Language

instance NFData Language where rnf :: Language -> ()
rnf = Language -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | List of known (supported) languages for GHC, oldest first.
knownLanguages :: [Language]
knownLanguages :: [Language]
knownLanguages = [Language
Haskell98, Language
Haskell2010, Language
GHC2021]

instance Pretty Language where
  pretty :: Language -> Doc
pretty (UnknownLanguage String
other) = String -> Doc
Disp.text String
other
  pretty Language
other = String -> Doc
Disp.text (Language -> String
forall a. Show a => a -> String
show Language
other)

instance Parsec Language where
  parsec :: forall (m :: * -> *). CabalParsing m => m Language
parsec = String -> Language
classifyLanguage (String -> Language) -> m String -> m Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlphaNum

classifyLanguage :: String -> Language
classifyLanguage :: String -> Language
classifyLanguage = \String
str -> case String -> [(String, Language)] -> Maybe Language
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
str [(String, Language)]
langTable of
  Just Language
lang -> Language
lang
  Maybe Language
Nothing -> String -> Language
UnknownLanguage String
str
  where
    langTable :: [(String, Language)]
langTable =
      [ (Language -> String
forall a. Show a => a -> String
show Language
lang, Language
lang)
      | Language
lang <- [Language]
knownLanguages
      ]

-- ------------------------------------------------------------

-- * Extension

-- ------------------------------------------------------------

-- Note: if you add a new 'KnownExtension':
--

-- * also add it to the Distribution.Simple.X.compilerExtensions lists

--   (where X is each compiler: GHC, UHC, HaskellSuite)
--

-- | This represents language extensions beyond a base 'Language' definition
-- (such as 'Haskell98') that are supported by some implementations, usually
-- in some special mode.
--
-- Where applicable, references are given to an implementation's
-- official documentation.
data Extension
  = -- | Enable a known extension
    EnableExtension KnownExtension
  | -- | Disable a known extension
    DisableExtension KnownExtension
  | -- | An unknown extension, identified by the name of its @LANGUAGE@
    -- pragma.
    UnknownExtension String
  deriving ((forall x. Extension -> Rep Extension x)
-> (forall x. Rep Extension x -> Extension) -> Generic Extension
forall x. Rep Extension x -> Extension
forall x. Extension -> Rep Extension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Extension -> Rep Extension x
from :: forall x. Extension -> Rep Extension x
$cto :: forall x. Rep Extension x -> Extension
to :: forall x. Rep Extension x -> Extension
Generic, 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, 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, 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, Typeable, 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)

instance Binary Extension
instance Structured Extension

instance NFData Extension where rnf :: Extension -> ()
rnf = Extension -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Known Haskell language extensions, including deprecated and undocumented
-- ones.
--
-- Check <https://downloads.haskell.org/~ghc/9.2.3/docs/html/users_guide/exts/table.html “Overview of all language extensions” in GHC User’s Guide>
-- for more information.
data KnownExtension
  = -- | Allow overlapping class instances, provided there is a unique
    -- most specific instance for each use.
    OverlappingInstances
  | -- | Ignore structural rules guaranteeing the termination of class
    -- instance resolution.  Termination is guaranteed by a fixed-depth
    -- recursion stack, and compilation may fail if this depth is
    -- exceeded.
    UndecidableInstances
  | -- | Implies 'OverlappingInstances'.  Allow the implementation to
    -- choose an instance even when it is possible that further
    -- instantiation of types will lead to a more specific instance
    -- being applicable.
    IncoherentInstances
  | -- | /(deprecated)/ Deprecated in favour of 'RecursiveDo'.
    --
    -- Old description: Allow recursive bindings in @do@ blocks, using
    -- the @rec@ keyword. See also 'RecursiveDo'.
    DoRec
  | -- | Allow recursive bindings in @do@ blocks, using the @rec@
    -- keyword, or @mdo@, a variant of @do@.
    RecursiveDo
  | -- | Provide syntax for writing list comprehensions which iterate
    -- over several lists together, like the 'zipWith' family of
    -- functions.
    ParallelListComp
  | -- | Allow multiple parameters in a type class.
    MultiParamTypeClasses
  | -- | Enable the dreaded monomorphism restriction.
    MonomorphismRestriction
  | -- | Enable deep subsumption, relaxing the simple subsumption rules,
    -- implicitly inserting eta-expansions when matching up function types
    -- with different quantification structures.
    DeepSubsumption
  | -- | Allow a specification attached to a multi-parameter type class
    -- which indicates that some parameters are entirely determined by
    -- others. The implementation will check that this property holds
    -- for the declared instances, and will use this property to reduce
    -- ambiguity in instance resolution.
    FunctionalDependencies
  | -- | /(deprecated)/ A synonym for 'RankNTypes'.
    --
    -- Old description: Like 'RankNTypes' but does not allow a
    -- higher-rank type to itself appear on the left of a function
    -- arrow.
    Rank2Types
  | -- | Allow a universally-quantified type to occur on the left of a
    -- function arrow.
    RankNTypes
  | -- | /(deprecated)/ A synonym for 'RankNTypes'.
    --
    -- Old description: Allow data constructors to have polymorphic
    -- arguments.  Unlike 'RankNTypes', does not allow this for ordinary
    -- functions.
    PolymorphicComponents
  | -- | Allow existentially-quantified data constructors.
    ExistentialQuantification
  | -- | Cause a type variable in a signature, which has an explicit
    -- @forall@ quantifier, to scope over the definition of the
    -- accompanying value declaration.
    ScopedTypeVariables
  | -- | Deprecated, use 'ScopedTypeVariables' instead.
    PatternSignatures
  | -- | Enable implicit function parameters with dynamic scope.
    ImplicitParams
  | -- | Relax some restrictions on the form of the context of a type
    -- signature.
    FlexibleContexts
  | -- | Relax some restrictions on the form of the context of an
    -- instance declaration.
    FlexibleInstances
  | -- | Allow data type declarations with no constructors.
    EmptyDataDecls
  | -- | Run the C preprocessor on Haskell source code.
    CPP
  | -- | Allow an explicit kind signature giving the kind of types over
    -- which a type variable ranges.
    KindSignatures
  | -- | Enable a form of pattern which forces evaluation before an
    -- attempted match, and a form of strict @let@/@where@ binding.
    BangPatterns
  | -- | Allow type synonyms in instance heads.
    TypeSynonymInstances
  | -- | Enable Template Haskell, a system for compile-time
    -- metaprogramming.
    TemplateHaskell
  | -- | Enable the Foreign Function Interface.  In GHC, implements the
    -- standard Haskell 98 Foreign Function Interface Addendum, plus
    -- some GHC-specific extensions.
    ForeignFunctionInterface
  | -- | Enable arrow notation.
    Arrows
  | -- | /(deprecated)/ Enable generic type classes, with default instances defined in
    -- terms of the algebraic structure of a type.
    Generics
  | -- | Enable the implicit importing of the module "Prelude".  When
    -- disabled, when desugaring certain built-in syntax into ordinary
    -- identifiers, use whatever is in scope rather than the "Prelude"
    -- -- version.
    ImplicitPrelude
  | -- | Enable syntax for implicitly binding local names corresponding
    -- to the field names of a record.  Puns bind specific names, unlike
    -- 'RecordWildCards'.
    NamedFieldPuns
  | -- | Enable a form of guard which matches a pattern and binds
    -- variables.
    PatternGuards
  | -- | Allow a type declared with @newtype@ to use @deriving@ for any
    -- class with an instance for the underlying type.
    GeneralizedNewtypeDeriving
  | -- Synonym for GeneralizedNewtypeDeriving added in GHC 8.6.1.
    GeneralisedNewtypeDeriving
  | -- | Enable the \"Trex\" extensible records system.
    ExtensibleRecords
  | -- | Enable type synonyms which are transparent in some definitions
    -- and opaque elsewhere, as a way of implementing abstract
    -- datatypes.
    RestrictedTypeSynonyms
  | -- | Enable an alternate syntax for string literals,
    -- with string templating.
    HereDocuments
  | -- | Allow the character @#@ as a postfix modifier on identifiers.
    -- Also enables literal syntax for unboxed values.
    MagicHash
  | -- | Allow data types and type synonyms which are indexed by types,
    -- i.e. ad-hoc polymorphism for types.
    TypeFamilies
  | -- | Allow a standalone declaration which invokes the type class
    -- @deriving@ mechanism.
    StandaloneDeriving
  | -- | Allow certain Unicode characters to stand for certain ASCII
    -- character sequences, e.g. keywords and punctuation.
    UnicodeSyntax
  | -- | Allow the use of unboxed types as foreign types, e.g. in
    -- @foreign import@ and @foreign export@.
    UnliftedFFITypes
  | -- | Enable interruptible FFI.
    InterruptibleFFI
  | -- | Allow use of CAPI FFI calling convention (@foreign import capi@).
    CApiFFI
  | -- | Defer validity checking of types until after expanding type
    -- synonyms, relaxing the constraints on how synonyms may be used.
    LiberalTypeSynonyms
  | -- | Allow the name of a type constructor, type class, or type
    -- variable to be an infix operator.
    TypeOperators
  | -- | Enable syntax for implicitly binding local names corresponding
    -- to the field names of a record.  A wildcard binds all unmentioned
    -- names, unlike 'NamedFieldPuns'.
    RecordWildCards
  | -- | Deprecated, use 'NamedFieldPuns' instead.
    RecordPuns
  | -- | Allow a record field name to be disambiguated by the type of
    -- the record it's in.
    DisambiguateRecordFields
  | -- | Enable traditional record syntax (as supported by Haskell 98)
    TraditionalRecordSyntax
  | -- | Enable overloading of string literals using a type class, much
    -- like integer literals.
    OverloadedStrings
  | -- | Enable generalized algebraic data types, in which type
    -- variables may be instantiated on a per-constructor basis. Implies
    -- 'GADTSyntax'.
    GADTs
  | -- | Enable GADT syntax for declaring ordinary algebraic datatypes.
    GADTSyntax
  | -- | /(deprecated)/ Has no effect.
    --
    -- Old description: Make pattern bindings monomorphic.
    MonoPatBinds
  | -- | Relax the requirements on mutually-recursive polymorphic
    -- functions.
    RelaxedPolyRec
  | -- | Allow default instantiation of polymorphic types in more
    -- situations.
    ExtendedDefaultRules
  | -- | Enable unboxed tuples.
    UnboxedTuples
  | -- | Enable @deriving@ for classes 'Data.Typeable.Typeable' and
    -- 'Data.Generics.Data'.
    DeriveDataTypeable
  | -- | Enable @deriving@ for 'GHC.Generics.Generic' and 'GHC.Generics.Generic1'.
    DeriveGeneric
  | -- | Enable support for default signatures.
    DefaultSignatures
  | -- | Allow type signatures to be specified in instance declarations.
    InstanceSigs
  | -- | Allow a class method's type to place additional constraints on
    -- a class type variable.
    ConstrainedClassMethods
  | -- | Allow imports to be qualified by the package name the module is
    -- intended to be imported from, e.g.
    --
    -- > import "network" Network.Socket
    PackageImports
  | -- | /(deprecated)/ Allow a type variable to be instantiated at a
    -- polymorphic type.
    ImpredicativeTypes
  | -- | /(deprecated)/ Change the syntax for qualified infix operators.
    NewQualifiedOperators
  | -- | Relax the interpretation of left operator sections to allow
    -- unary postfix operators.
    PostfixOperators
  | -- | Enable quasi-quotation, a mechanism for defining new concrete
    -- syntax for expressions and patterns.
    QuasiQuotes
  | -- | Enable generalized list comprehensions, supporting operations
    -- such as sorting and grouping.
    TransformListComp
  | -- | Enable monad comprehensions, which generalise the list
    -- comprehension syntax to work for any monad.
    MonadComprehensions
  | -- | Enable view patterns, which match a value by applying a
    -- function and matching on the result.
    ViewPatterns
  | -- | Allow concrete XML syntax to be used in expressions and patterns,
    -- as per the Haskell Server Pages extension language:
    -- <http://www.haskell.org/haskellwiki/HSP>. The ideas behind it are
    -- discussed in the paper \"Haskell Server Pages through Dynamic Loading\"
    -- by Niklas Broberg, from Haskell Workshop '05.
    XmlSyntax
  | -- | Allow regular pattern matching over lists, as discussed in the
    -- paper \"Regular Expression Patterns\" by Niklas Broberg, Andreas Farre
    -- and Josef Svenningsson, from ICFP '04.
    RegularPatterns
  | -- | Enable the use of tuple sections, e.g. @(, True)@ desugars into
    -- @\x -> (x, True)@.
    TupleSections
  | -- | Allow GHC primops, written in C--, to be imported into a Haskell
    -- file.
    GHCForeignImportPrim
  | -- | Support for patterns of the form @n + k@, where @k@ is an
    -- integer literal.
    NPlusKPatterns
  | -- | Improve the layout rule when @if@ expressions are used in a @do@
    -- block.
    DoAndIfThenElse
  | -- | Enable support for multi-way @if@-expressions.
    MultiWayIf
  | -- | Enable support lambda-@case@ expressions.
    LambdaCase
  | -- | Makes much of the Haskell sugar be desugared into calls to the
    -- function with a particular name that is in scope.
    RebindableSyntax
  | -- | Make @forall@ a keyword in types, which can be used to give the
    -- generalisation explicitly.
    ExplicitForAll
  | -- | Allow contexts to be put on datatypes, e.g. the @Eq a@ in
    -- @data Eq a => Set a = NilSet | ConsSet a (Set a)@.
    DatatypeContexts
  | -- | Local (@let@ and @where@) bindings are monomorphic.
    MonoLocalBinds
  | -- | Enable @deriving@ for the 'Data.Functor.Functor' class.
    DeriveFunctor
  | -- | Enable @deriving@ for the 'Data.Traversable.Traversable' class.
    DeriveTraversable
  | -- | Enable @deriving@ for the 'Data.Foldable.Foldable' class.
    DeriveFoldable
  | -- | Enable non-decreasing indentation for @do@ blocks.
    NondecreasingIndentation
  | -- | Allow imports to be qualified with a safe keyword that requires
    -- the imported module be trusted as according to the Safe Haskell
    -- definition of trust.
    --
    -- > import safe Network.Socket
    SafeImports
  | -- | Compile a module in the Safe, Safe Haskell mode -- a restricted
    -- form of the Haskell language to ensure type safety.
    Safe
  | -- | Compile a module in the Trustworthy, Safe Haskell mode -- no
    -- restrictions apply but the module is marked as trusted as long as
    -- the package the module resides in is trusted.
    Trustworthy
  | -- | Compile a module in the Unsafe, Safe Haskell mode so that
    -- modules compiled using Safe, Safe Haskell mode can't import it.
    Unsafe
  | -- | Allow type class/implicit parameter/equality constraints to be
    -- used as types with the special kind constraint.  Also generalise
    -- the @(ctxt => ty)@ syntax so that any type of kind constraint can
    -- occur before the arrow.
    ConstraintKinds
  | -- | Enable kind polymorphism.
    PolyKinds
  | -- | Enable datatype promotion.
    DataKinds
  | -- | Enable @type data@ declarations, defining constructors at the type level.
    TypeData
  | -- | Enable parallel arrays syntax (@[:@, @:]@) for /Data Parallel Haskell/.
    ParallelArrays
  | -- | Enable explicit role annotations, like in (@type role Foo representational representational@).
    RoleAnnotations
  | -- | Enable overloading of list literals, arithmetic sequences and
    -- list patterns using the 'IsList' type class.
    OverloadedLists
  | -- | Enable case expressions that have no alternatives. Also applies to lambda-case expressions if they are enabled.
    EmptyCase
  | -- | /(deprecated)/ Deprecated in favour of 'DeriveDataTypeable'.
    --
    -- Old description: Triggers the generation of derived 'Typeable'
    -- instances for every datatype and type class declaration.
    AutoDeriveTypeable
  | -- | Desugars negative literals directly (without using negate).
    NegativeLiterals
  | -- | Allow the use of binary integer literal syntax (e.g. @0b11001001@ to denote @201@).
    BinaryLiterals
  | -- | Allow the use of floating literal syntax for all instances of 'Num', including 'Int' and 'Integer'.
    NumDecimals
  | -- | Enable support for type classes with no type parameter.
    NullaryTypeClasses
  | -- | Enable explicit namespaces in module import/export lists.
    ExplicitNamespaces
  | -- | Allow the user to write ambiguous types, and the type inference engine to infer them.
    AllowAmbiguousTypes
  | -- | Enable @foreign import javascript@.
    JavaScriptFFI
  | -- | Allow giving names to and abstracting over patterns.
    PatternSynonyms
  | -- | Allow anonymous placeholders (underscore) inside type signatures.  The
    -- type inference engine will generate a message describing the type inferred
    -- at the hole's location.
    PartialTypeSignatures
  | -- | Allow named placeholders written with a leading underscore inside type
    -- signatures.  Wildcards with the same name unify to the same type.
    NamedWildCards
  | -- | Enable @deriving@ for any class.
    DeriveAnyClass
  | -- | Enable @deriving@ for the 'Language.Haskell.TH.Syntax.Lift' class.
    DeriveLift
  | -- | Enable support for 'static pointers' (and the @static@
    -- keyword) to refer to globally stable names, even across
    -- different programs.
    StaticPointers
  | -- | Switches data type declarations to be strict by default (as if
    -- they had a bang using @BangPatterns@), and allow opt-in field
    -- laziness using @~@.
    StrictData
  | -- | Switches all pattern bindings to be strict by default (as if
    -- they had a bang using @BangPatterns@), ordinary patterns are
    -- recovered using @~@. Implies @StrictData@.
    Strict
  | -- | Allows @do@-notation for types that are @'Applicative'@ as well
    -- as @'Monad'@. When enabled, desugaring @do@ notation tries to use
    -- @(<*>)@ and @'fmap'@ and @'join'@ as far as possible.
    ApplicativeDo
  | -- | Allow records to use duplicated field labels for accessors.
    DuplicateRecordFields
  | -- | Enable explicit type applications with the syntax @id \@Int@.
    TypeApplications
  | -- | Dissolve the distinction between types and kinds, allowing the compiler
    -- to reason about kind equality and therefore enabling GADTs to be promoted
    -- to the type-level.
    TypeInType
  | -- | Allow recursive (and therefore undecidable) super-class relationships.
    UndecidableSuperClasses
  | -- | A temporary extension to help library authors check if their
    -- code will compile with the new planned desugaring of fail.
    MonadFailDesugaring
  | -- | A subset of @TemplateHaskell@ including only quoting.
    TemplateHaskellQuotes
  | -- | Allows use of the @#label@ syntax.
    OverloadedLabels
  | -- | Allow functional dependency annotations on type families to declare them
    -- as injective.
    TypeFamilyDependencies
  | -- | Allow multiple @deriving@ clauses, each optionally qualified with a
    -- /strategy/.
    DerivingStrategies
  | -- | Enable deriving instances via types of the same runtime representation.
    -- Implies 'DerivingStrategies'.
    DerivingVia
  | -- | Enable the use of unboxed sum syntax.
    UnboxedSums
  | -- | Allow use of hexadecimal literal notation for floating-point values.
    HexFloatLiterals
  | -- | Allow @do@ blocks etc. in argument position.
    BlockArguments
  | -- | Allow use of underscores in numeric literals.
    NumericUnderscores
  | -- | Allow @forall@ in constraints.
    QuantifiedConstraints
  | -- | Have @*@ refer to @Type@.
    StarIsType
  | -- | Liberalises deriving to provide instances for empty data types.
    EmptyDataDeriving
  | -- | Enable detection of complete user-supplied kind signatures.
    CUSKs
  | -- | Allows the syntax @import M qualified@.
    ImportQualifiedPost
  | -- | Allow the use of standalone kind signatures.
    StandaloneKindSignatures
  | -- | Enable unlifted newtypes.
    UnliftedNewtypes
  | -- | Use whitespace to determine whether the minus sign stands for negation or subtraction.
    LexicalNegation
  | -- | Enable qualified do-notation desugaring.
    QualifiedDo
  | -- | Enable linear types.
    LinearTypes
  | -- | Allow the use of visible forall in types of terms.
    RequiredTypeArguments
  | -- | Enable the generation of selector functions corresponding to record fields.
    FieldSelectors
  | -- | Enable the use of record dot-accessor and updater syntax
    OverloadedRecordDot
  | -- | Provides record @.@ syntax in record updates, e.g. @x {foo.bar = 1}@.
    OverloadedRecordUpdate
  | -- | Enable data types for which an unlifted or levity-polymorphic result kind is inferred.
    UnliftedDatatypes
  | -- | Enable syntax for primitive numeric literals, e.g. @3#Int8@
    ExtendedLiterals
  | -- | Undocumented parsing-related extensions introduced in GHC 7.0.
    AlternativeLayoutRule
  | -- | Undocumented parsing-related extensions introduced in GHC 7.0.
    AlternativeLayoutRuleTransitional
  | -- | Undocumented parsing-related extensions introduced in GHC 7.2.
    RelaxedLayout
  | -- | Allow the use of type abstraction syntax.
    TypeAbstractions
  | -- | Allow the use of built-in syntax for list, tuple and sum type constructors
    -- rather than being exclusive to data constructors.
    ListTuplePuns
  deriving ((forall x. KnownExtension -> Rep KnownExtension x)
-> (forall x. Rep KnownExtension x -> KnownExtension)
-> Generic KnownExtension
forall x. Rep KnownExtension x -> KnownExtension
forall x. KnownExtension -> Rep KnownExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KnownExtension -> Rep KnownExtension x
from :: forall x. KnownExtension -> Rep KnownExtension x
$cto :: forall x. Rep KnownExtension x -> KnownExtension
to :: forall x. Rep KnownExtension x -> KnownExtension
Generic, Int -> KnownExtension -> ShowS
[KnownExtension] -> ShowS
KnownExtension -> String
(Int -> KnownExtension -> ShowS)
-> (KnownExtension -> String)
-> ([KnownExtension] -> ShowS)
-> Show KnownExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KnownExtension -> ShowS
showsPrec :: Int -> KnownExtension -> ShowS
$cshow :: KnownExtension -> String
show :: KnownExtension -> String
$cshowList :: [KnownExtension] -> ShowS
showList :: [KnownExtension] -> ShowS
Show, ReadPrec [KnownExtension]
ReadPrec KnownExtension
Int -> ReadS KnownExtension
ReadS [KnownExtension]
(Int -> ReadS KnownExtension)
-> ReadS [KnownExtension]
-> ReadPrec KnownExtension
-> ReadPrec [KnownExtension]
-> Read KnownExtension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS KnownExtension
readsPrec :: Int -> ReadS KnownExtension
$creadList :: ReadS [KnownExtension]
readList :: ReadS [KnownExtension]
$creadPrec :: ReadPrec KnownExtension
readPrec :: ReadPrec KnownExtension
$creadListPrec :: ReadPrec [KnownExtension]
readListPrec :: ReadPrec [KnownExtension]
Read, KnownExtension -> KnownExtension -> Bool
(KnownExtension -> KnownExtension -> Bool)
-> (KnownExtension -> KnownExtension -> Bool) -> Eq KnownExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KnownExtension -> KnownExtension -> Bool
== :: KnownExtension -> KnownExtension -> Bool
$c/= :: KnownExtension -> KnownExtension -> Bool
/= :: KnownExtension -> KnownExtension -> Bool
Eq, Eq KnownExtension
Eq KnownExtension =>
(KnownExtension -> KnownExtension -> Ordering)
-> (KnownExtension -> KnownExtension -> Bool)
-> (KnownExtension -> KnownExtension -> Bool)
-> (KnownExtension -> KnownExtension -> Bool)
-> (KnownExtension -> KnownExtension -> Bool)
-> (KnownExtension -> KnownExtension -> KnownExtension)
-> (KnownExtension -> KnownExtension -> KnownExtension)
-> Ord KnownExtension
KnownExtension -> KnownExtension -> Bool
KnownExtension -> KnownExtension -> Ordering
KnownExtension -> KnownExtension -> KnownExtension
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 :: KnownExtension -> KnownExtension -> Ordering
compare :: KnownExtension -> KnownExtension -> Ordering
$c< :: KnownExtension -> KnownExtension -> Bool
< :: KnownExtension -> KnownExtension -> Bool
$c<= :: KnownExtension -> KnownExtension -> Bool
<= :: KnownExtension -> KnownExtension -> Bool
$c> :: KnownExtension -> KnownExtension -> Bool
> :: KnownExtension -> KnownExtension -> Bool
$c>= :: KnownExtension -> KnownExtension -> Bool
>= :: KnownExtension -> KnownExtension -> Bool
$cmax :: KnownExtension -> KnownExtension -> KnownExtension
max :: KnownExtension -> KnownExtension -> KnownExtension
$cmin :: KnownExtension -> KnownExtension -> KnownExtension
min :: KnownExtension -> KnownExtension -> KnownExtension
Ord, Int -> KnownExtension
KnownExtension -> Int
KnownExtension -> [KnownExtension]
KnownExtension -> KnownExtension
KnownExtension -> KnownExtension -> [KnownExtension]
KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
(KnownExtension -> KnownExtension)
-> (KnownExtension -> KnownExtension)
-> (Int -> KnownExtension)
-> (KnownExtension -> Int)
-> (KnownExtension -> [KnownExtension])
-> (KnownExtension -> KnownExtension -> [KnownExtension])
-> (KnownExtension -> KnownExtension -> [KnownExtension])
-> (KnownExtension
    -> KnownExtension -> KnownExtension -> [KnownExtension])
-> Enum KnownExtension
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 :: KnownExtension -> KnownExtension
succ :: KnownExtension -> KnownExtension
$cpred :: KnownExtension -> KnownExtension
pred :: KnownExtension -> KnownExtension
$ctoEnum :: Int -> KnownExtension
toEnum :: Int -> KnownExtension
$cfromEnum :: KnownExtension -> Int
fromEnum :: KnownExtension -> Int
$cenumFrom :: KnownExtension -> [KnownExtension]
enumFrom :: KnownExtension -> [KnownExtension]
$cenumFromThen :: KnownExtension -> KnownExtension -> [KnownExtension]
enumFromThen :: KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromTo :: KnownExtension -> KnownExtension -> [KnownExtension]
enumFromTo :: KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromThenTo :: KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
enumFromThenTo :: KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
Enum, KnownExtension
KnownExtension -> KnownExtension -> Bounded KnownExtension
forall a. a -> a -> Bounded a
$cminBound :: KnownExtension
minBound :: KnownExtension
$cmaxBound :: KnownExtension
maxBound :: KnownExtension
Bounded, Typeable, Typeable KnownExtension
Typeable KnownExtension =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> KnownExtension -> c KnownExtension)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c KnownExtension)
-> (KnownExtension -> Constr)
-> (KnownExtension -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c KnownExtension))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c KnownExtension))
-> ((forall b. Data b => b -> b)
    -> KnownExtension -> KnownExtension)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> KnownExtension -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> KnownExtension -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> KnownExtension -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> KnownExtension -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> KnownExtension -> m KnownExtension)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> KnownExtension -> m KnownExtension)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> KnownExtension -> m KnownExtension)
-> Data KnownExtension
KnownExtension -> Constr
KnownExtension -> DataType
(forall b. Data b => b -> b) -> KnownExtension -> KnownExtension
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) -> KnownExtension -> u
forall u. (forall d. Data d => d -> u) -> KnownExtension -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KnownExtension -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KnownExtension -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KnownExtension
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KnownExtension -> c KnownExtension
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KnownExtension)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c KnownExtension)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KnownExtension -> c KnownExtension
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KnownExtension -> c KnownExtension
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KnownExtension
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KnownExtension
$ctoConstr :: KnownExtension -> Constr
toConstr :: KnownExtension -> Constr
$cdataTypeOf :: KnownExtension -> DataType
dataTypeOf :: KnownExtension -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KnownExtension)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KnownExtension)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c KnownExtension)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c KnownExtension)
$cgmapT :: (forall b. Data b => b -> b) -> KnownExtension -> KnownExtension
gmapT :: (forall b. Data b => b -> b) -> KnownExtension -> KnownExtension
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KnownExtension -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KnownExtension -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KnownExtension -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KnownExtension -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> KnownExtension -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> KnownExtension -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> KnownExtension -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> KnownExtension -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> KnownExtension -> m KnownExtension
Data)

instance Binary KnownExtension
instance Structured KnownExtension

instance NFData KnownExtension where rnf :: KnownExtension -> ()
rnf = KnownExtension -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Extensions that have been deprecated, possibly paired with another
-- extension that replaces it.
deprecatedExtensions :: [(Extension, Maybe Extension)]
deprecatedExtensions :: [(Extension, Maybe Extension)]
deprecatedExtensions =
  [ (KnownExtension -> Extension
EnableExtension KnownExtension
RecordPuns, Extension -> Maybe Extension
forall a. a -> Maybe a
Just (KnownExtension -> Extension
EnableExtension KnownExtension
NamedFieldPuns))
  , (KnownExtension -> Extension
EnableExtension KnownExtension
PatternSignatures, Extension -> Maybe Extension
forall a. a -> Maybe a
Just (KnownExtension -> Extension
EnableExtension KnownExtension
ScopedTypeVariables))
  ]

-- NOTE: when adding deprecated extensions that have new alternatives
-- we must be careful to make sure that the deprecation messages are
-- valid. We must not recommend aliases that cannot be used with older
-- compilers, perhaps by adding support in Cabal to translate the new
-- name to the old one for older compilers. Otherwise we are in danger
-- of the scenario in ticket #689.

instance Pretty Extension where
  pretty :: Extension -> Doc
pretty (UnknownExtension String
other) = String -> Doc
Disp.text String
other
  pretty (EnableExtension KnownExtension
ke) = String -> Doc
Disp.text (KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
ke)
  pretty (DisableExtension KnownExtension
ke) = String -> Doc
Disp.text (String
"No" String -> ShowS
forall a. [a] -> [a] -> [a]
++ KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
ke)

instance Parsec Extension where
  parsec :: forall (m :: * -> *). CabalParsing m => m Extension
parsec = String -> Extension
classifyExtension (String -> Extension) -> m String -> m Extension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAlphaNum

instance Pretty KnownExtension where
  pretty :: KnownExtension -> Doc
pretty KnownExtension
ke = String -> Doc
Disp.text (KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
ke)

classifyExtension :: String -> Extension
classifyExtension :: String -> Extension
classifyExtension String
string =
  case String -> Maybe KnownExtension
classifyKnownExtension String
string of
    Just KnownExtension
ext -> KnownExtension -> Extension
EnableExtension KnownExtension
ext
    Maybe KnownExtension
Nothing ->
      case String
string of
        Char
'N' : Char
'o' : String
string' ->
          case String -> Maybe KnownExtension
classifyKnownExtension String
string' of
            Just KnownExtension
ext -> KnownExtension -> Extension
DisableExtension KnownExtension
ext
            Maybe KnownExtension
Nothing -> String -> Extension
UnknownExtension String
string
        String
_ -> String -> Extension
UnknownExtension String
string

-- | 'read' for 'KnownExtension's is really really slow so for the Text
-- instance
-- what we do is make a simple table indexed off the first letter in the
-- extension name. The extension names actually cover the range @'A'-'Z'@
-- pretty densely and the biggest bucket is 7 so it's not too bad. We just do
-- a linear search within each bucket.
--
-- This gives an order of magnitude improvement in parsing speed, and it'll
-- also allow us to do case insensitive matches in future if we prefer.
classifyKnownExtension :: String -> Maybe KnownExtension
classifyKnownExtension :: String -> Maybe KnownExtension
classifyKnownExtension String
"" = Maybe KnownExtension
forall a. Maybe a
Nothing
classifyKnownExtension string :: String
string@(Char
c : String
_)
  | (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Char [(String, KnownExtension)] -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char [(String, KnownExtension)]
knownExtensionTable) Char
c =
      String -> [(String, KnownExtension)] -> Maybe KnownExtension
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
string (Array Char [(String, KnownExtension)]
knownExtensionTable Array Char [(String, KnownExtension)]
-> Char -> [(String, KnownExtension)]
forall i e. Ix i => Array i e -> i -> e
! Char
c)
  | Bool
otherwise = Maybe KnownExtension
forall a. Maybe a
Nothing

knownExtensionTable :: Array Char [(String, KnownExtension)]
knownExtensionTable :: Array Char [(String, KnownExtension)]
knownExtensionTable =
  ([(String, KnownExtension)]
 -> (String, KnownExtension) -> [(String, KnownExtension)])
-> [(String, KnownExtension)]
-> (Char, Char)
-> [(Char, (String, KnownExtension))]
-> Array Char [(String, KnownExtension)]
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray
    (((String, KnownExtension)
 -> [(String, KnownExtension)] -> [(String, KnownExtension)])
-> [(String, KnownExtension)]
-> (String, KnownExtension)
-> [(String, KnownExtension)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:))
    []
    (Char
'A', Char
'Z')
    [ (Char
hd, (String
str, KnownExtension
extension)) -- assume KnownExtension's Show returns a non-empty string
    | (KnownExtension
extension, str :: String
str@(Char
hd : String
_)) <- (KnownExtension -> (KnownExtension, String))
-> [KnownExtension] -> [(KnownExtension, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\KnownExtension
e -> (KnownExtension
e, KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
e)) [Int -> KnownExtension
forall a. Enum a => Int -> a
toEnum Int
0 ..]
    ]

knownExtensions :: [KnownExtension]
knownExtensions :: [KnownExtension]
knownExtensions = [KnownExtension
forall a. Bounded a => a
minBound .. KnownExtension
forall a. Bounded a => a
maxBound]