try Apple AArch64 again
[cabal.git] / Cabal-syntax / src / Language / Haskell / Extension.hs
blobdce345605864d0914d39d6ad9a57a78d607a542b
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE DeriveGeneric #-}
3 {-# LANGUAGE OverloadedStrings #-}
5 -----------------------------------------------------------------------------
7 -- |
8 -- Module : Language.Haskell.Extension
9 -- Copyright : Isaac Jones 2003-2004
10 -- License : BSD3
12 -- Maintainer : libraries@haskell.org
13 -- Portability : portable
15 -- Haskell language dialects and extensions
16 module Language.Haskell.Extension
17 ( Language (..)
18 , knownLanguages
19 , classifyLanguage
20 , Extension (..)
21 , KnownExtension (..)
22 , deprecatedExtensions
23 , classifyExtension
24 , knownExtensions
25 ) where
27 import Distribution.Compat.Prelude
29 import Data.Array (Array, Ix (inRange), accumArray, bounds, (!))
31 import Distribution.Parsec
32 import Distribution.Pretty
34 import qualified Distribution.Compat.CharParsing as P
35 import qualified Text.PrettyPrint as Disp
37 -- ------------------------------------------------------------
39 -- * Language
41 -- ------------------------------------------------------------
43 -- | This represents a Haskell language dialect.
45 -- Language 'Extension's are interpreted relative to one of these base
46 -- languages.
47 data Language
48 = -- | The Haskell 98 language as defined by the Haskell 98 report.
49 -- <http://haskell.org/onlinereport/>
50 Haskell98
51 | -- | The Haskell 2010 language as defined by the Haskell 2010 report.
52 -- <http://www.haskell.org/onlinereport/haskell2010>
53 Haskell2010
54 | -- | The GHC2021 collection of language extensions.
55 -- <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0380-ghc2021.rst>
56 GHC2021
57 | -- | The GHC2024 collection of language extensions.
58 -- <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0613-ghc2024.rst>
59 GHC2024
60 | -- | An unknown language, identified by its name.
61 UnknownLanguage String
62 deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
64 instance Binary Language
65 instance Structured Language
67 instance NFData Language where rnf = genericRnf
69 -- | List of known (supported) languages for GHC, oldest first.
70 knownLanguages :: [Language]
71 knownLanguages = [Haskell98, Haskell2010, GHC2021, GHC2024]
73 instance Pretty Language where
74 pretty (UnknownLanguage other) = Disp.text other
75 pretty other = Disp.text (show other)
77 instance Parsec Language where
78 parsec = classifyLanguage <$> P.munch1 isAlphaNum
80 classifyLanguage :: String -> Language
81 classifyLanguage = \str -> case lookup str langTable of
82 Just lang -> lang
83 Nothing -> UnknownLanguage str
84 where
85 langTable =
86 [ (show lang, lang)
87 | lang <- knownLanguages
90 -- ------------------------------------------------------------
92 -- * Extension
94 -- ------------------------------------------------------------
96 -- Note: if you add a new 'KnownExtension':
99 -- * also add it to the Distribution.Simple.X.compilerExtensions lists
101 -- (where X is each compiler: GHC, UHC, HaskellSuite)
104 -- | This represents language extensions beyond a base 'Language' definition
105 -- (such as 'Haskell98') that are supported by some implementations, usually
106 -- in some special mode.
108 -- Where applicable, references are given to an implementation's
109 -- official documentation.
110 data Extension
111 = -- | Enable a known extension
112 EnableExtension KnownExtension
113 | -- | Disable a known extension
114 DisableExtension KnownExtension
115 | -- | An unknown extension, identified by the name of its @LANGUAGE@
116 -- pragma.
117 UnknownExtension String
118 deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)
120 instance Binary Extension
121 instance Structured Extension
123 instance NFData Extension where rnf = genericRnf
125 -- | Known Haskell language extensions, including deprecated and undocumented
126 -- ones.
128 -- 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>
129 -- for more information.
130 data KnownExtension
131 = -- | Allow overlapping class instances, provided there is a unique
132 -- most specific instance for each use.
133 OverlappingInstances
134 | -- | Ignore structural rules guaranteeing the termination of class
135 -- instance resolution. Termination is guaranteed by a fixed-depth
136 -- recursion stack, and compilation may fail if this depth is
137 -- exceeded.
138 UndecidableInstances
139 | -- | Implies 'OverlappingInstances'. Allow the implementation to
140 -- choose an instance even when it is possible that further
141 -- instantiation of types will lead to a more specific instance
142 -- being applicable.
143 IncoherentInstances
144 | -- | /(deprecated)/ Deprecated in favour of 'RecursiveDo'.
146 -- Old description: Allow recursive bindings in @do@ blocks, using
147 -- the @rec@ keyword. See also 'RecursiveDo'.
148 DoRec
149 | -- | Allow recursive bindings in @do@ blocks, using the @rec@
150 -- keyword, or @mdo@, a variant of @do@.
151 RecursiveDo
152 | -- | Provide syntax for writing list comprehensions which iterate
153 -- over several lists together, like the 'zipWith' family of
154 -- functions.
155 ParallelListComp
156 | -- | Allow multiple parameters in a type class.
157 MultiParamTypeClasses
158 | -- | Enable the dreaded monomorphism restriction.
159 MonomorphismRestriction
160 | -- | Enable deep subsumption, relaxing the simple subsumption rules,
161 -- implicitly inserting eta-expansions when matching up function types
162 -- with different quantification structures.
163 DeepSubsumption
164 | -- | Allow a specification attached to a multi-parameter type class
165 -- which indicates that some parameters are entirely determined by
166 -- others. The implementation will check that this property holds
167 -- for the declared instances, and will use this property to reduce
168 -- ambiguity in instance resolution.
169 FunctionalDependencies
170 | -- | /(deprecated)/ A synonym for 'RankNTypes'.
172 -- Old description: Like 'RankNTypes' but does not allow a
173 -- higher-rank type to itself appear on the left of a function
174 -- arrow.
175 Rank2Types
176 | -- | Allow a universally-quantified type to occur on the left of a
177 -- function arrow.
178 RankNTypes
179 | -- | /(deprecated)/ A synonym for 'RankNTypes'.
181 -- Old description: Allow data constructors to have polymorphic
182 -- arguments. Unlike 'RankNTypes', does not allow this for ordinary
183 -- functions.
184 PolymorphicComponents
185 | -- | Allow existentially-quantified data constructors.
186 ExistentialQuantification
187 | -- | Cause a type variable in a signature, which has an explicit
188 -- @forall@ quantifier, to scope over the definition of the
189 -- accompanying value declaration.
190 ScopedTypeVariables
191 | -- | Deprecated, use 'ScopedTypeVariables' instead.
192 PatternSignatures
193 | -- | Enable implicit function parameters with dynamic scope.
194 ImplicitParams
195 | -- | Relax some restrictions on the form of the context of a type
196 -- signature.
197 FlexibleContexts
198 | -- | Relax some restrictions on the form of the context of an
199 -- instance declaration.
200 FlexibleInstances
201 | -- | Allow data type declarations with no constructors.
202 EmptyDataDecls
203 | -- | Run the C preprocessor on Haskell source code.
205 | -- | Allow an explicit kind signature giving the kind of types over
206 -- which a type variable ranges.
207 KindSignatures
208 | -- | Enable a form of pattern which forces evaluation before an
209 -- attempted match, and a form of strict @let@/@where@ binding.
210 BangPatterns
211 | -- | Allow type synonyms in instance heads.
212 TypeSynonymInstances
213 | -- | Enable Template Haskell, a system for compile-time
214 -- metaprogramming.
215 TemplateHaskell
216 | -- | Enable the Foreign Function Interface. In GHC, implements the
217 -- standard Haskell 98 Foreign Function Interface Addendum, plus
218 -- some GHC-specific extensions.
219 ForeignFunctionInterface
220 | -- | Enable arrow notation.
221 Arrows
222 | -- | /(deprecated)/ Enable generic type classes, with default instances defined in
223 -- terms of the algebraic structure of a type.
224 Generics
225 | -- | Enable the implicit importing of the module "Prelude". When
226 -- disabled, when desugaring certain built-in syntax into ordinary
227 -- identifiers, use whatever is in scope rather than the "Prelude"
228 -- -- version.
229 ImplicitPrelude
230 | -- | Enable syntax for implicitly binding local names corresponding
231 -- to the field names of a record. Puns bind specific names, unlike
232 -- 'RecordWildCards'.
233 NamedFieldPuns
234 | -- | Enable a form of guard which matches a pattern and binds
235 -- variables.
236 PatternGuards
237 | -- | Allow a type declared with @newtype@ to use @deriving@ for any
238 -- class with an instance for the underlying type.
239 GeneralizedNewtypeDeriving
240 | -- Synonym for GeneralizedNewtypeDeriving added in GHC 8.6.1.
241 GeneralisedNewtypeDeriving
242 | -- | Enable the \"Trex\" extensible records system.
243 ExtensibleRecords
244 | -- | Enable type synonyms which are transparent in some definitions
245 -- and opaque elsewhere, as a way of implementing abstract
246 -- datatypes.
247 RestrictedTypeSynonyms
248 | -- | Enable an alternate syntax for string literals,
249 -- with string templating.
250 HereDocuments
251 | -- | Allow the character @#@ as a postfix modifier on identifiers.
252 -- Also enables literal syntax for unboxed values.
253 MagicHash
254 | -- | Allow data types and type synonyms which are indexed by types,
255 -- i.e. ad-hoc polymorphism for types.
256 TypeFamilies
257 | -- | Allow a standalone declaration which invokes the type class
258 -- @deriving@ mechanism.
259 StandaloneDeriving
260 | -- | Allow certain Unicode characters to stand for certain ASCII
261 -- character sequences, e.g. keywords and punctuation.
262 UnicodeSyntax
263 | -- | Allow the use of unboxed types as foreign types, e.g. in
264 -- @foreign import@ and @foreign export@.
265 UnliftedFFITypes
266 | -- | Enable interruptible FFI.
267 InterruptibleFFI
268 | -- | Allow use of CAPI FFI calling convention (@foreign import capi@).
269 CApiFFI
270 | -- | Defer validity checking of types until after expanding type
271 -- synonyms, relaxing the constraints on how synonyms may be used.
272 LiberalTypeSynonyms
273 | -- | Allow the name of a type constructor, type class, or type
274 -- variable to be an infix operator.
275 TypeOperators
276 | -- | Enable syntax for implicitly binding local names corresponding
277 -- to the field names of a record. A wildcard binds all unmentioned
278 -- names, unlike 'NamedFieldPuns'.
279 RecordWildCards
280 | -- | Deprecated, use 'NamedFieldPuns' instead.
281 RecordPuns
282 | -- | Allow a record field name to be disambiguated by the type of
283 -- the record it's in.
284 DisambiguateRecordFields
285 | -- | Enable traditional record syntax (as supported by Haskell 98)
286 TraditionalRecordSyntax
287 | -- | Enable overloading of string literals using a type class, much
288 -- like integer literals.
289 OverloadedStrings
290 | -- | Enable generalized algebraic data types, in which type
291 -- variables may be instantiated on a per-constructor basis. Implies
292 -- 'GADTSyntax'.
293 GADTs
294 | -- | Enable GADT syntax for declaring ordinary algebraic datatypes.
295 GADTSyntax
296 | -- | /(deprecated)/ Has no effect.
298 -- Old description: Make pattern bindings monomorphic.
299 MonoPatBinds
300 | -- | Relax the requirements on mutually-recursive polymorphic
301 -- functions.
302 RelaxedPolyRec
303 | -- | Allow default instantiation of polymorphic types in more
304 -- situations.
305 ExtendedDefaultRules
306 | -- | Allow @default@ declarations to explicitly name the class and
307 -- be exported.
308 NamedDefaults
309 | -- | Enable unboxed tuples.
310 UnboxedTuples
311 | -- | Enable @deriving@ for classes 'Data.Typeable.Typeable' and
312 -- 'Data.Generics.Data'.
313 DeriveDataTypeable
314 | -- | Enable @deriving@ for 'GHC.Generics.Generic' and 'GHC.Generics.Generic1'.
315 DeriveGeneric
316 | -- | Enable support for default signatures.
317 DefaultSignatures
318 | -- | Allow type signatures to be specified in instance declarations.
319 InstanceSigs
320 | -- | Allow a class method's type to place additional constraints on
321 -- a class type variable.
322 ConstrainedClassMethods
323 | -- | Allow imports to be qualified by the package name the module is
324 -- intended to be imported from, e.g.
326 -- > import "network" Network.Socket
327 PackageImports
328 | -- | /(deprecated)/ Allow a type variable to be instantiated at a
329 -- polymorphic type.
330 ImpredicativeTypes
331 | -- | /(deprecated)/ Change the syntax for qualified infix operators.
332 NewQualifiedOperators
333 | -- | Relax the interpretation of left operator sections to allow
334 -- unary postfix operators.
335 PostfixOperators
336 | -- | Enable quasi-quotation, a mechanism for defining new concrete
337 -- syntax for expressions and patterns.
338 QuasiQuotes
339 | -- | Enable generalized list comprehensions, supporting operations
340 -- such as sorting and grouping.
341 TransformListComp
342 | -- | Enable monad comprehensions, which generalise the list
343 -- comprehension syntax to work for any monad.
344 MonadComprehensions
345 | -- | Enable view patterns, which match a value by applying a
346 -- function and matching on the result.
347 ViewPatterns
348 | -- | Allow concrete XML syntax to be used in expressions and patterns,
349 -- as per the Haskell Server Pages extension language:
350 -- <http://www.haskell.org/haskellwiki/HSP>. The ideas behind it are
351 -- discussed in the paper \"Haskell Server Pages through Dynamic Loading\"
352 -- by Niklas Broberg, from Haskell Workshop '05.
353 XmlSyntax
354 | -- | Allow regular pattern matching over lists, as discussed in the
355 -- paper \"Regular Expression Patterns\" by Niklas Broberg, Andreas Farre
356 -- and Josef Svenningsson, from ICFP '04.
357 RegularPatterns
358 | -- | Enable the use of tuple sections, e.g. @(, True)@ desugars into
359 -- @\x -> (x, True)@.
360 TupleSections
361 | -- | Allow GHC primops, written in C--, to be imported into a Haskell
362 -- file.
363 GHCForeignImportPrim
364 | -- | Support for patterns of the form @n + k@, where @k@ is an
365 -- integer literal.
366 NPlusKPatterns
367 | -- | Improve the layout rule when @if@ expressions are used in a @do@
368 -- block.
369 DoAndIfThenElse
370 | -- | Enable support for multi-way @if@-expressions.
371 MultiWayIf
372 | -- | Enable support lambda-@case@ expressions.
373 LambdaCase
374 | -- | Makes much of the Haskell sugar be desugared into calls to the
375 -- function with a particular name that is in scope.
376 RebindableSyntax
377 | -- | Make @forall@ a keyword in types, which can be used to give the
378 -- generalisation explicitly.
379 ExplicitForAll
380 | -- | Allow contexts to be put on datatypes, e.g. the @Eq a@ in
381 -- @data Eq a => Set a = NilSet | ConsSet a (Set a)@.
382 DatatypeContexts
383 | -- | Local (@let@ and @where@) bindings are monomorphic.
384 MonoLocalBinds
385 | -- | Enable @deriving@ for the 'Data.Functor.Functor' class.
386 DeriveFunctor
387 | -- | Enable @deriving@ for the 'Data.Traversable.Traversable' class.
388 DeriveTraversable
389 | -- | Enable @deriving@ for the 'Data.Foldable.Foldable' class.
390 DeriveFoldable
391 | -- | Enable non-decreasing indentation for @do@ blocks.
392 NondecreasingIndentation
393 | -- | Allow imports to be qualified with a safe keyword that requires
394 -- the imported module be trusted as according to the Safe Haskell
395 -- definition of trust.
397 -- > import safe Network.Socket
398 SafeImports
399 | -- | Compile a module in the Safe, Safe Haskell mode -- a restricted
400 -- form of the Haskell language to ensure type safety.
401 Safe
402 | -- | Compile a module in the Trustworthy, Safe Haskell mode -- no
403 -- restrictions apply but the module is marked as trusted as long as
404 -- the package the module resides in is trusted.
405 Trustworthy
406 | -- | Compile a module in the Unsafe, Safe Haskell mode so that
407 -- modules compiled using Safe, Safe Haskell mode can't import it.
408 Unsafe
409 | -- | Allow type class/implicit parameter/equality constraints to be
410 -- used as types with the special kind constraint. Also generalise
411 -- the @(ctxt => ty)@ syntax so that any type of kind constraint can
412 -- occur before the arrow.
413 ConstraintKinds
414 | -- | Enable kind polymorphism.
415 PolyKinds
416 | -- | Enable datatype promotion.
417 DataKinds
418 | -- | Enable @type data@ declarations, defining constructors at the type level.
419 TypeData
420 | -- | Enable parallel arrays syntax (@[:@, @:]@) for /Data Parallel Haskell/.
421 ParallelArrays
422 | -- | Enable explicit role annotations, like in (@type role Foo representational representational@).
423 RoleAnnotations
424 | -- | Enable overloading of list literals, arithmetic sequences and
425 -- list patterns using the 'IsList' type class.
426 OverloadedLists
427 | -- | Enable case expressions that have no alternatives. Also applies to lambda-case expressions if they are enabled.
428 EmptyCase
429 | -- | /(deprecated)/ Deprecated in favour of 'DeriveDataTypeable'.
431 -- Old description: Triggers the generation of derived 'Typeable'
432 -- instances for every datatype and type class declaration.
433 AutoDeriveTypeable
434 | -- | Desugars negative literals directly (without using negate).
435 NegativeLiterals
436 | -- | Allow the use of binary integer literal syntax (e.g. @0b11001001@ to denote @201@).
437 BinaryLiterals
438 | -- | Allow the use of floating literal syntax for all instances of 'Num', including 'Int' and 'Integer'.
439 NumDecimals
440 | -- | Enable support for type classes with no type parameter.
441 NullaryTypeClasses
442 | -- | Enable explicit namespaces in module import/export lists.
443 ExplicitNamespaces
444 | -- | Allow the user to write ambiguous types, and the type inference engine to infer them.
445 AllowAmbiguousTypes
446 | -- | Enable @foreign import javascript@.
447 JavaScriptFFI
448 | -- | Allow giving names to and abstracting over patterns.
449 PatternSynonyms
450 | -- | Allow anonymous placeholders (underscore) inside type signatures. The
451 -- type inference engine will generate a message describing the type inferred
452 -- at the hole's location.
453 PartialTypeSignatures
454 | -- | Allow named placeholders written with a leading underscore inside type
455 -- signatures. Wildcards with the same name unify to the same type.
456 NamedWildCards
457 | -- | Enable @deriving@ for any class.
458 DeriveAnyClass
459 | -- | Enable @deriving@ for the 'Language.Haskell.TH.Syntax.Lift' class.
460 DeriveLift
461 | -- | Enable support for 'static pointers' (and the @static@
462 -- keyword) to refer to globally stable names, even across
463 -- different programs.
464 StaticPointers
465 | -- | Switches data type declarations to be strict by default (as if
466 -- they had a bang using @BangPatterns@), and allow opt-in field
467 -- laziness using @~@.
468 StrictData
469 | -- | Switches all pattern bindings to be strict by default (as if
470 -- they had a bang using @BangPatterns@), ordinary patterns are
471 -- recovered using @~@. Implies @StrictData@.
472 Strict
473 | -- | Allows @do@-notation for types that are @'Applicative'@ as well
474 -- as @'Monad'@. When enabled, desugaring @do@ notation tries to use
475 -- @(<*>)@ and @'fmap'@ and @'join'@ as far as possible.
476 ApplicativeDo
477 | -- | Allow records to use duplicated field labels for accessors.
478 DuplicateRecordFields
479 | -- | Enable explicit type applications with the syntax @id \@Int@.
480 TypeApplications
481 | -- | Dissolve the distinction between types and kinds, allowing the compiler
482 -- to reason about kind equality and therefore enabling GADTs to be promoted
483 -- to the type-level.
484 TypeInType
485 | -- | Allow recursive (and therefore undecidable) super-class relationships.
486 UndecidableSuperClasses
487 | -- | A temporary extension to help library authors check if their
488 -- code will compile with the new planned desugaring of fail.
489 MonadFailDesugaring
490 | -- | A subset of @TemplateHaskell@ including only quoting.
491 TemplateHaskellQuotes
492 | -- | Allows use of the @#label@ syntax.
493 OverloadedLabels
494 | -- | Allow functional dependency annotations on type families to declare them
495 -- as injective.
496 TypeFamilyDependencies
497 | -- | Allow multiple @deriving@ clauses, each optionally qualified with a
498 -- /strategy/.
499 DerivingStrategies
500 | -- | Enable deriving instances via types of the same runtime representation.
501 -- Implies 'DerivingStrategies'.
502 DerivingVia
503 | -- | Enable the use of unboxed sum syntax.
504 UnboxedSums
505 | -- | Allow use of hexadecimal literal notation for floating-point values.
506 HexFloatLiterals
507 | -- | Allow @do@ blocks etc. in argument position.
508 BlockArguments
509 | -- | Allow use of underscores in numeric literals.
510 NumericUnderscores
511 | -- | Allow @forall@ in constraints.
512 QuantifiedConstraints
513 | -- | Have @*@ refer to @Type@.
514 StarIsType
515 | -- | Liberalises deriving to provide instances for empty data types.
516 EmptyDataDeriving
517 | -- | Enable detection of complete user-supplied kind signatures.
518 CUSKs
519 | -- | Allows the syntax @import M qualified@.
520 ImportQualifiedPost
521 | -- | Allow the use of standalone kind signatures.
522 StandaloneKindSignatures
523 | -- | Enable unlifted newtypes.
524 UnliftedNewtypes
525 | -- | Use whitespace to determine whether the minus sign stands for negation or subtraction.
526 LexicalNegation
527 | -- | Enable qualified do-notation desugaring.
528 QualifiedDo
529 | -- | Enable linear types.
530 LinearTypes
531 | -- | Allow the use of visible forall in types of terms.
532 RequiredTypeArguments
533 | -- | Enable the generation of selector functions corresponding to record fields.
534 FieldSelectors
535 | -- | Enable the use of record dot-accessor and updater syntax
536 OverloadedRecordDot
537 | -- | Provides record @.@ syntax in record updates, e.g. @x {foo.bar = 1}@.
538 OverloadedRecordUpdate
539 | -- | Enable data types for which an unlifted or levity-polymorphic result kind is inferred.
540 UnliftedDatatypes
541 | -- | Enable syntax for primitive numeric literals, e.g. @3#Int8@
542 ExtendedLiterals
543 | -- | Undocumented parsing-related extensions introduced in GHC 7.0.
544 AlternativeLayoutRule
545 | -- | Undocumented parsing-related extensions introduced in GHC 7.0.
546 AlternativeLayoutRuleTransitional
547 | -- | Undocumented parsing-related extensions introduced in GHC 7.2.
548 RelaxedLayout
549 | -- | Allow the use of type abstraction syntax.
550 TypeAbstractions
551 | -- | Allow the use of built-in syntax for list, tuple and sum type constructors
552 -- rather than being exclusive to data constructors.
553 ListTuplePuns
554 | -- | Support multiline strings.
555 MultilineStrings
556 | -- | Allow use of or-pattern syntax, condensing multiple patterns
557 -- into a single one.
558 OrPatterns
559 deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded, Typeable, Data)
561 instance Binary KnownExtension
562 instance Structured KnownExtension
564 instance NFData KnownExtension where rnf = genericRnf
566 -- | Extensions that have been deprecated, possibly paired with another
567 -- extension that replaces it.
568 deprecatedExtensions :: [(Extension, Maybe Extension)]
569 deprecatedExtensions =
570 [ (EnableExtension RecordPuns, Just (EnableExtension NamedFieldPuns))
571 , (EnableExtension PatternSignatures, Just (EnableExtension ScopedTypeVariables))
574 -- NOTE: when adding deprecated extensions that have new alternatives
575 -- we must be careful to make sure that the deprecation messages are
576 -- valid. We must not recommend aliases that cannot be used with older
577 -- compilers, perhaps by adding support in Cabal to translate the new
578 -- name to the old one for older compilers. Otherwise we are in danger
579 -- of the scenario in ticket #689.
581 instance Pretty Extension where
582 pretty (UnknownExtension other) = Disp.text other
583 pretty (EnableExtension ke) = Disp.text (show ke)
584 pretty (DisableExtension ke) = Disp.text ("No" ++ show ke)
586 instance Parsec Extension where
587 parsec = classifyExtension <$> P.munch1 isAlphaNum
589 instance Pretty KnownExtension where
590 pretty ke = Disp.text (show ke)
592 classifyExtension :: String -> Extension
593 classifyExtension string =
594 case classifyKnownExtension string of
595 Just ext -> EnableExtension ext
596 Nothing ->
597 case string of
598 'N' : 'o' : string' ->
599 case classifyKnownExtension string' of
600 Just ext -> DisableExtension ext
601 Nothing -> UnknownExtension string
602 _ -> UnknownExtension string
604 -- | 'read' for 'KnownExtension's is really really slow so for the Text
605 -- instance
606 -- what we do is make a simple table indexed off the first letter in the
607 -- extension name. The extension names actually cover the range @'A'-'Z'@
608 -- pretty densely and the biggest bucket is 7 so it's not too bad. We just do
609 -- a linear search within each bucket.
611 -- This gives an order of magnitude improvement in parsing speed, and it'll
612 -- also allow us to do case insensitive matches in future if we prefer.
613 classifyKnownExtension :: String -> Maybe KnownExtension
614 classifyKnownExtension "" = Nothing
615 classifyKnownExtension string@(c : _)
616 | inRange (bounds knownExtensionTable) c =
617 lookup string (knownExtensionTable ! c)
618 | otherwise = Nothing
620 knownExtensionTable :: Array Char [(String, KnownExtension)]
621 knownExtensionTable =
622 accumArray
623 (flip (:))
625 ('A', 'Z')
626 [ (hd, (str, extension)) -- assume KnownExtension's Show returns a non-empty string
627 | (extension, str@(hd : _)) <- map (\e -> (e, show e)) [toEnum 0 ..]
630 knownExtensions :: [KnownExtension]
631 knownExtensions = [minBound .. maxBound]