← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/Cabal/Language/Haskell/Extension.hs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libraries/Cabal/Language/Haskell/Extension.hs
 
1
-----------------------------------------------------------------------------
 
2
-- |
 
3
-- Module      :  Language.Haskell.Extension
 
4
-- Copyright   :  Isaac Jones 2003-2004
 
5
--
 
6
-- Maintainer  :  libraries@haskell.org
 
7
-- Portability :  portable
 
8
--
 
9
-- Haskell language dialects and extensions
 
10
 
 
11
{- All rights reserved.
 
12
 
 
13
Redistribution and use in source and binary forms, with or without
 
14
modification, are permitted provided that the following conditions are
 
15
met:
 
16
 
 
17
    * Redistributions of source code must retain the above copyright
 
18
      notice, this list of conditions and the following disclaimer.
 
19
 
 
20
    * Redistributions in binary form must reproduce the above
 
21
      copyright notice, this list of conditions and the following
 
22
      disclaimer in the documentation and/or other materials provided
 
23
      with the distribution.
 
24
 
 
25
    * Neither the name of Isaac Jones nor the names of other
 
26
      contributors may be used to endorse or promote products derived
 
27
      from this software without specific prior written permission.
 
28
 
 
29
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 
30
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 
31
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 
32
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 
33
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 
34
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 
35
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 
36
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 
37
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 
38
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 
39
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
 
40
 
 
41
module Language.Haskell.Extension (
 
42
        Language(..),
 
43
        knownLanguages,
 
44
 
 
45
        Extension(..),
 
46
        knownExtensions,
 
47
        deprecatedExtensions
 
48
  ) where
 
49
 
 
50
import Distribution.Text (Text(..))
 
51
import qualified Distribution.Compat.ReadP as Parse
 
52
import qualified Text.PrettyPrint as Disp
 
53
import qualified Data.Char as Char (isAlphaNum)
 
54
import Data.Array (Array, accumArray, bounds, Ix(inRange), (!))
 
55
 
 
56
-- ------------------------------------------------------------
 
57
-- * Language
 
58
-- ------------------------------------------------------------
 
59
 
 
60
-- | This represents a Haskell language dialect.
 
61
--
 
62
-- Language 'Extension's are interpreted relative to one of these base
 
63
-- languages.
 
64
--
 
65
data Language =
 
66
 
 
67
  -- | The Haskell 98 language as defined by the Haskell 98 report.
 
68
  -- <http://haskell.org/onlinereport/>
 
69
     Haskell98
 
70
 
 
71
  -- | The Haskell 2010 language as defined by the Haskell 2010 report.
 
72
  -- <http://www.haskell.org/onlinereport/haskell2010>
 
73
  | Haskell2010
 
74
 
 
75
  -- | An unknown language, identified by its name.
 
76
  | UnknownLanguage String
 
77
  deriving (Show, Read, Eq)
 
78
 
 
79
knownLanguages :: [Language]
 
80
knownLanguages = [Haskell98, Haskell2010]
 
81
 
 
82
instance Text Language where
 
83
  disp (UnknownLanguage other) = Disp.text other
 
84
  disp other                   = Disp.text (show other)
 
85
 
 
86
  parse = do
 
87
    lang <- Parse.munch1 Char.isAlphaNum
 
88
    return (classifyLanguage lang)
 
89
 
 
90
classifyLanguage :: String -> Language
 
91
classifyLanguage = \str -> case lookup str langTable of
 
92
    Just lang -> lang
 
93
    Nothing   -> UnknownLanguage str
 
94
  where
 
95
    langTable = [ (show lang, lang)
 
96
                | lang <- knownLanguages ]
 
97
 
 
98
-- ------------------------------------------------------------
 
99
-- * Extension
 
100
-- ------------------------------------------------------------
 
101
 
 
102
-- Note: if you add a new 'Extension':
 
103
--
 
104
-- * also add it to the Distribution.Simple.X.languageExtensions lists
 
105
--   (where X is each compiler: GHC, JHC, Hugs, NHC)
 
106
--
 
107
-- * also to the 'knownExtensions' list below.
 
108
 
 
109
-- | This represents language extensions beyond a base 'Language' definition
 
110
-- (such as 'Haskell98') that are supported by some implementations, usually
 
111
-- in some special mode.
 
112
--
 
113
-- Where applicable, references are given to an implementation's
 
114
-- official documentation, e.g. \"GHC &#xa7; 7.2.1\" for an extension
 
115
-- documented in section 7.2.1 of the GHC User's Guide.
 
116
 
 
117
data Extension =
 
118
 
 
119
  -- | [GHC &#xa7; 7.6.3.4] Allow overlapping class instances,
 
120
  -- provided there is a unique most specific instance for each use.
 
121
    OverlappingInstances
 
122
 
 
123
  -- | [GHC &#xa7; 7.6.3.3] Ignore structural rules guaranteeing the
 
124
  -- termination of class instance resolution.  Termination is
 
125
  -- guaranteed by a fixed-depth recursion stack, and compilation
 
126
  -- may fail if this depth is exceeded.
 
127
  | UndecidableInstances
 
128
 
 
129
  -- | [GHC &#xa7; 7.6.3.4] Implies 'OverlappingInstances'.  Allow the
 
130
  -- implementation to choose an instance even when it is possible
 
131
  -- that further instantiation of types will lead to a more specific
 
132
  -- instance being applicable.
 
133
  | IncoherentInstances
 
134
 
 
135
  -- | [GHC &#xa7; 7.3.8] Allows recursive bindings in @do@ blocks,
 
136
  -- using the @rec@ keyword.
 
137
  | DoRec
 
138
 
 
139
  -- | [GHC &#xa7; 7.3.8.2] Deprecated in GHC.  Allows recursive bindings
 
140
  -- using @mdo@, a variant of @do@.  @DoRec@ provides a different,
 
141
  -- preferred syntax.
 
142
  | RecursiveDo
 
143
 
 
144
  -- | [GHC &#xa7; 7.3.9] Provide syntax for writing list
 
145
  -- comprehensions which iterate over several lists together, like
 
146
  -- the 'zipWith' family of functions.
 
147
  | ParallelListComp
 
148
 
 
149
  -- | [GHC &#xa7; 7.6.1.1] Allow multiple parameters in a type class.
 
150
  | MultiParamTypeClasses
 
151
 
 
152
  -- | [GHC &#xa7; 7.17] Disable the dreaded monomorphism restriction.
 
153
  | NoMonomorphismRestriction
 
154
 
 
155
  -- | [GHC &#xa7; 7.6.2] Allow a specification attached to a
 
156
  -- multi-parameter type class which indicates that some parameters
 
157
  -- are entirely determined by others. The implementation will check
 
158
  -- that this property holds for the declared instances, and will use
 
159
  -- this property to reduce ambiguity in instance resolution.
 
160
  | FunctionalDependencies
 
161
 
 
162
  -- | [GHC &#xa7; 7.8.5] Like 'RankNTypes' but does not allow a
 
163
  -- higher-rank type to itself appear on the left of a function
 
164
  -- arrow.
 
165
  | Rank2Types
 
166
 
 
167
  -- | [GHC &#xa7; 7.8.5] Allow a universally-quantified type to occur on
 
168
  -- the left of a function arrow.
 
169
  | RankNTypes
 
170
 
 
171
  -- | [GHC &#xa7; 7.8.5] Allow data constructors to have polymorphic
 
172
  -- arguments.  Unlike 'RankNTypes', does not allow this for ordinary
 
173
  -- functions.
 
174
  | PolymorphicComponents
 
175
 
 
176
  -- | [GHC &#xa7; 7.4.4] Allow existentially-quantified data constructors.
 
177
  | ExistentialQuantification
 
178
 
 
179
  -- | [GHC &#xa7; 7.8.7] Cause a type variable in a signature, which has an
 
180
  -- explicit @forall@ quantifier, to scope over the definition of the
 
181
  -- accompanying value declaration.
 
182
  | ScopedTypeVariables
 
183
 
 
184
  -- | Deprecated, use 'ScopedTypeVariables' instead.
 
185
  | PatternSignatures
 
186
 
 
187
  -- | [GHC &#xa7; 7.8.3] Enable implicit function parameters with dynamic
 
188
  -- scope.
 
189
  | ImplicitParams
 
190
 
 
191
  -- | [GHC &#xa7; 7.8.2] Relax some restrictions on the form of the context
 
192
  -- of a type signature.
 
193
  | FlexibleContexts
 
194
 
 
195
  -- | [GHC &#xa7; 7.6.3.2] Relax some restrictions on the form of the
 
196
  -- context of an instance declaration.
 
197
  | FlexibleInstances
 
198
 
 
199
  -- | [GHC &#xa7; 7.4.1] Allow data type declarations with no constructors.
 
200
  | EmptyDataDecls
 
201
 
 
202
  -- | [GHC &#xa7; 4.10.3] Run the C preprocessor on Haskell source code.
 
203
  | CPP
 
204
 
 
205
  -- | [GHC &#xa7; 7.8.4] Allow an explicit kind signature giving the kind of
 
206
  -- types over which a type variable ranges.
 
207
  | KindSignatures
 
208
 
 
209
  -- | [GHC &#xa7; 7.11] Enable a form of pattern which forces evaluation
 
210
  -- before an attempted match, and a form of strict @let@/@where@
 
211
  -- binding.
 
212
  | BangPatterns
 
213
 
 
214
  -- | [GHC &#xa7; 7.6.3.1] Allow type synonyms in instance heads.
 
215
  | TypeSynonymInstances
 
216
 
 
217
  -- | [GHC &#xa7; 7.9] Enable Template Haskell, a system for compile-time
 
218
  -- metaprogramming.
 
219
  | TemplateHaskell
 
220
 
 
221
  -- | [GHC &#xa7; 8] Enable the Foreign Function Interface.  In GHC,
 
222
  -- implements the standard Haskell 98 Foreign Function Interface
 
223
  -- Addendum, plus some GHC-specific extensions.
 
224
  | ForeignFunctionInterface
 
225
 
 
226
  -- | [GHC &#xa7; 7.10] Enable arrow notation.
 
227
  | Arrows
 
228
 
 
229
  -- | [GHC &#xa7; 7.16] Enable generic type classes, with default instances
 
230
  -- defined in terms of the algebraic structure of a type.
 
231
  | Generics
 
232
 
 
233
  -- | [GHC &#xa7; 7.3.11] Disable the implicit importing of the module
 
234
  -- @Prelude@.  When desugaring certain built-in syntax into ordinary
 
235
  -- identifiers, use whatever is in scope rather than the @Prelude@
 
236
  -- version.
 
237
  | NoImplicitPrelude
 
238
 
 
239
  -- | [GHC &#xa7; 7.3.15] Enable syntax for implicitly binding local names
 
240
  -- corresponding to the field names of a record.  Puns bind specific
 
241
  -- names, unlike 'RecordWildCards'.
 
242
  | NamedFieldPuns
 
243
 
 
244
  -- | [GHC &#xa7; 7.3.5] Enable a form of guard which matches a pattern and
 
245
  -- binds variables.
 
246
  | PatternGuards
 
247
 
 
248
  -- | [GHC &#xa7; 7.5.4] Allow a type declared with @newtype@ to use
 
249
  -- @deriving@ for any class with an instance for the underlying type.
 
250
  | GeneralizedNewtypeDeriving
 
251
 
 
252
  -- | [Hugs &#xa7; 7.1] Enable the \"Trex\" extensible records system.
 
253
  | ExtensibleRecords
 
254
 
 
255
  -- | [Hugs &#xa7; 7.2] Enable type synonyms which are transparent in
 
256
  -- some definitions and opaque elsewhere, as a way of implementing 
 
257
  -- abstract datatypes.
 
258
  | RestrictedTypeSynonyms
 
259
 
 
260
  -- | [Hugs &#xa7; 7.3] Enable an alternate syntax for string literals,
 
261
  -- with string templating.
 
262
  | HereDocuments
 
263
 
 
264
  -- | [GHC &#xa7; 7.3.2] Allow the character @#@ as a postfix modifier on
 
265
  -- identifiers.  Also enables literal syntax for unboxed values.
 
266
  | MagicHash
 
267
 
 
268
  -- | [GHC &#xa7; 7.7] Allow data types and type synonyms which are
 
269
  -- indexed by types, i.e. ad-hoc polymorphism for types.
 
270
  | TypeFamilies
 
271
 
 
272
  -- | [GHC &#xa7; 7.5.2] Allow a standalone declaration which invokes the
 
273
  -- type class @deriving@ mechanism.
 
274
  | StandaloneDeriving
 
275
 
 
276
  -- | [GHC &#xa7; 7.3.1] Allow certain Unicode characters to stand for
 
277
  -- certain ASCII character sequences, e.g. keywords and punctuation.
 
278
  | UnicodeSyntax
 
279
 
 
280
  -- | [GHC &#xa7; 8.1.1] Allow the use of unboxed types as foreign types,
 
281
  -- e.g. in @foreign import@ and @foreign export@.
 
282
  | UnliftedFFITypes
 
283
 
 
284
  -- | [GHC &#xa7; 7.4.3] Defer validity checking of types until after
 
285
  -- expanding type synonyms, relaxing the constraints on how synonyms
 
286
  -- may be used.
 
287
  | LiberalTypeSynonyms
 
288
 
 
289
  -- | [GHC &#xa7; 7.4.2] Allow the name of a type constructor, type class,
 
290
  -- or type variable to be an infix operator.
 
291
  | TypeOperators
 
292
 
 
293
--PArr -- not ready yet, and will probably be renamed to ParallelArrays
 
294
 
 
295
  -- | [GHC &#xa7; 7.3.16] Enable syntax for implicitly binding local names
 
296
  -- corresponding to the field names of a record.  A wildcard binds
 
297
  -- all unmentioned names, unlike 'NamedFieldPuns'.
 
298
  | RecordWildCards
 
299
 
 
300
  -- | Deprecated, use 'NamedFieldPuns' instead.
 
301
  | RecordPuns
 
302
 
 
303
  -- | [GHC &#xa7; 7.3.14] Allow a record field name to be disambiguated
 
304
  -- by the type of the record it's in.
 
305
  | DisambiguateRecordFields
 
306
 
 
307
  -- | [GHC &#xa7; 7.6.4] Enable overloading of string literals using a
 
308
  -- type class, much like integer literals.
 
309
  | OverloadedStrings
 
310
 
 
311
  -- | [GHC &#xa7; 7.4.6] Enable generalized algebraic data types, in
 
312
  -- which type variables may be instantiated on a per-constructor
 
313
  -- basis.  Enables \"GADT syntax\" which can be used to declare
 
314
  -- GADTs as well as ordinary algebraic types.
 
315
  | GADTs
 
316
 
 
317
  -- | [GHC &#xa7; 7.17.2] Allow pattern bindings to be polymorphic.
 
318
  | NoMonoPatBinds
 
319
 
 
320
  -- | [GHC &#xa7; 7.8.8] Relax the requirements on mutually-recursive
 
321
  -- polymorphic functions.
 
322
  | RelaxedPolyRec
 
323
 
 
324
  -- | [GHC &#xa7; 2.4.5] Allow default instantiation of polymorphic
 
325
  -- types in more situations.
 
326
  | ExtendedDefaultRules
 
327
 
 
328
  -- | [GHC &#xa7; 7.2.2] Enable unboxed tuples.
 
329
  | UnboxedTuples
 
330
 
 
331
  -- | [GHC &#xa7; 7.5.3] Enable @deriving@ for classes
 
332
  -- @Data.Typeable.Typeable@ and @Data.Generics.Data@.
 
333
  | DeriveDataTypeable
 
334
 
 
335
  -- | [GHC &#xa7; 7.6.1.3] Allow a class method's type to place
 
336
  -- additional constraints on a class type variable.
 
337
  | ConstrainedClassMethods
 
338
 
 
339
  -- | [GHC &#xa7; 7.3.18] Allow imports to be qualified by the package
 
340
  -- name the module is intended to be imported from, e.g.
 
341
  --
 
342
  -- > import "network" Network.Socket
 
343
  | PackageImports
 
344
 
 
345
  -- | [GHC &#xa7; 7.8.6] Deprecated in GHC 6.12 and will be removed in
 
346
  -- GHC 7.  Allow a type variable to be instantiated at a
 
347
  -- polymorphic type.
 
348
  | ImpredicativeTypes
 
349
 
 
350
  -- | [GHC &#xa7; 7.3.3] Change the syntax for qualified infix
 
351
  -- operators.
 
352
  | NewQualifiedOperators
 
353
 
 
354
  -- | [GHC &#xa7; 7.3.12] Relax the interpretation of left operator
 
355
  -- sections to allow unary postfix operators.
 
356
  | PostfixOperators
 
357
 
 
358
  -- | [GHC &#xa7; 7.9.5] Enable quasi-quotation, a mechanism for defining
 
359
  -- new concrete syntax for expressions and patterns.
 
360
  | QuasiQuotes
 
361
 
 
362
  -- | [GHC &#xa7; 7.3.10] Enable generalized list comprehensions,
 
363
  -- supporting operations such as sorting and grouping.
 
364
  | TransformListComp
 
365
 
 
366
  -- | [GHC &#xa7; 7.3.6] Enable view patterns, which match a value by
 
367
  -- applying a function and matching on the result.
 
368
  | ViewPatterns
 
369
 
 
370
  -- | Allow concrete XML syntax to be used in expressions and patterns,
 
371
  -- as per the Haskell Server Pages extension language: 
 
372
  -- <http://www.haskell.org/haskellwiki/HSP>. The ideas behind it are 
 
373
  -- discussed in the paper \"Haskell Server Pages through Dynamic Loading\"
 
374
  -- by Niklas Broberg, from Haskell Workshop '05.
 
375
  | XmlSyntax
 
376
 
 
377
  -- | Allow regular pattern matching over lists, as discussed in the
 
378
  -- paper \"Regular Expression Patterns\" by Niklas Broberg, Andreas Farre
 
379
  -- and Josef Svenningsson, from ICFP '04.
 
380
  | RegularPatterns
 
381
 
 
382
  -- | Enables the use of tuple sections, e.g. @(, True)@ desugars into
 
383
  -- @\x -> (x, True)@.
 
384
  | TupleSections
 
385
 
 
386
  -- | Allows GHC primops, written in C--, to be imported into a Haskell
 
387
  -- file.
 
388
  | GHCForeignImportPrim
 
389
 
 
390
  -- | Support for patterns of the form @n + k@, where @k@ is an
 
391
  -- integer literal.
 
392
  | NPlusKPatterns
 
393
 
 
394
  -- | Improve the layout rule when @if@ expressions are used in a @do@
 
395
  -- block.
 
396
  | DoAndIfThenElse
 
397
 
 
398
  -- | Makes much of the Haskell sugar be desugared into calls to the
 
399
  -- function with a particular name that is in scope.
 
400
  | RebindableSyntax
 
401
 
 
402
  -- | Make @forall@ a keyword in types, which can be used to give the
 
403
  -- generalisation explicitly.
 
404
  | ExplicitForAll
 
405
 
 
406
  -- | Allow contexts to be put on datatypes, e.g. the @Eq a@ in
 
407
  -- @data Eq a => Set a = NilSet | ConsSet a (Set a)@.
 
408
  | DatatypeContexts
 
409
 
 
410
  -- | Local (@let@ and @where@) bindings are monomorphic.
 
411
  | MonoLocalBinds
 
412
 
 
413
  -- | Enable @deriving@ for the @Data.Functor.Functor@ class.
 
414
  | DeriveFunctor
 
415
 
 
416
  -- | Enable @deriving@ for the @Data.Traversable.Traversable@ class.
 
417
  | DeriveTraversable
 
418
 
 
419
  -- | Enable @deriving@ for the @Data.Foldable.Foldable@ class.
 
420
  | DeriveFoldable
 
421
 
 
422
  -- | An unknown extension, identified by the name of its @LANGUAGE@
 
423
  -- pragma.
 
424
  | UnknownExtension String
 
425
  deriving (Show, Read, Eq)
 
426
 
 
427
-- | Extensions that have been deprecated, possibly paired with another
 
428
-- extension that replaces it.
 
429
--
 
430
deprecatedExtensions :: [(Extension, Maybe Extension)]
 
431
deprecatedExtensions =
 
432
  [ (RecordPuns, Just NamedFieldPuns)
 
433
  , (PatternSignatures, Just ScopedTypeVariables)
 
434
  ]
 
435
 
 
436
knownExtensions :: [Extension]
 
437
knownExtensions =
 
438
  [ OverlappingInstances
 
439
  , UndecidableInstances
 
440
  , IncoherentInstances
 
441
  , DoRec
 
442
  , RecursiveDo
 
443
  , ParallelListComp
 
444
  , MultiParamTypeClasses
 
445
  , NoMonomorphismRestriction
 
446
  , FunctionalDependencies
 
447
  , Rank2Types
 
448
  , RankNTypes
 
449
  , PolymorphicComponents
 
450
  , ExistentialQuantification
 
451
  , ScopedTypeVariables
 
452
  , ImplicitParams
 
453
  , FlexibleContexts
 
454
  , FlexibleInstances
 
455
  , EmptyDataDecls
 
456
  , CPP
 
457
 
 
458
  , KindSignatures
 
459
  , BangPatterns
 
460
  , TypeSynonymInstances
 
461
  , TemplateHaskell
 
462
  , ForeignFunctionInterface
 
463
  , Arrows
 
464
  , Generics
 
465
  , NoImplicitPrelude
 
466
  , NamedFieldPuns
 
467
  , PatternGuards
 
468
  , GeneralizedNewtypeDeriving
 
469
 
 
470
  , ExtensibleRecords
 
471
  , RestrictedTypeSynonyms
 
472
  , HereDocuments
 
473
  , MagicHash
 
474
  , TypeFamilies
 
475
  , StandaloneDeriving
 
476
 
 
477
  , UnicodeSyntax
 
478
  , PatternSignatures
 
479
  , UnliftedFFITypes
 
480
  , LiberalTypeSynonyms
 
481
  , TypeOperators
 
482
--PArr -- not ready yet, and will probably be renamed to ParallelArrays
 
483
  , RecordWildCards
 
484
  , RecordPuns
 
485
  , DisambiguateRecordFields
 
486
  , OverloadedStrings
 
487
  , GADTs
 
488
  , NoMonoPatBinds
 
489
  , RelaxedPolyRec
 
490
  , ExtendedDefaultRules
 
491
  , UnboxedTuples
 
492
  , DeriveDataTypeable
 
493
  , ConstrainedClassMethods
 
494
  , PackageImports
 
495
  , ImpredicativeTypes
 
496
  , NewQualifiedOperators
 
497
  , PostfixOperators
 
498
  , QuasiQuotes
 
499
  , TransformListComp
 
500
  , ViewPatterns
 
501
  , XmlSyntax
 
502
  , RegularPatterns
 
503
 
 
504
  , TupleSections
 
505
  , GHCForeignImportPrim
 
506
  , NPlusKPatterns
 
507
  , DoAndIfThenElse
 
508
  , RebindableSyntax
 
509
  , ExplicitForAll
 
510
  , DatatypeContexts
 
511
  , MonoLocalBinds
 
512
  , DeriveFunctor
 
513
  , DeriveTraversable
 
514
  , DeriveFoldable
 
515
  ]
 
516
 
 
517
instance Text Extension where
 
518
  disp (UnknownExtension other) = Disp.text other
 
519
  disp other                    = Disp.text (show other)
 
520
 
 
521
  parse = do
 
522
    extension <- Parse.munch1 Char.isAlphaNum
 
523
    return (classifyExtension extension)
 
524
 
 
525
-- | 'read' for 'Extension's is really really slow so for the Text instance
 
526
-- what we do is make a simple table indexed off the first letter in the
 
527
-- extension name. The extension names actually cover the range @'A'-'Z'@
 
528
-- pretty densely and the biggest bucket is 7 so it's not too bad. We just do
 
529
-- a linear search within each bucket.
 
530
--
 
531
-- This gives an order of magnitude improvement in parsing speed, and it'll
 
532
-- also allow us to do case insensitive matches in future if we prefer.
 
533
--
 
534
classifyExtension :: String -> Extension
 
535
classifyExtension string@(c:_)
 
536
  | inRange (bounds extensionTable) c
 
537
  = case lookup string (extensionTable ! c) of
 
538
      Just extension    -> extension
 
539
      Nothing           -> UnknownExtension string
 
540
classifyExtension string = UnknownExtension string
 
541
 
 
542
extensionTable :: Array Char [(String, Extension)]
 
543
extensionTable =
 
544
  accumArray (flip (:)) [] ('A', 'Z')
 
545
    [ (head str, (str, extension))
 
546
    | extension <- knownExtensions
 
547
    , let str = show extension ]