{-# LANGUAGE DeriveDataTypeable #-}
module Language.Haskell.Extension (
Language(..),
knownLanguages,
Extension(..),
KnownExtension(..),
knownExtensions,
deprecatedExtensions
) where
import Distribution.Text (Text(..))
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import qualified Data.Char as Char (isAlphaNum)
import Data.Array (Array, accumArray, bounds, Ix(inRange), (!))
import Data.Data (Data)
import Data.Typeable (Typeable)
data Language =
Haskell98
| Haskell2010
| UnknownLanguage String
deriving (Show, Read, Eq, Typeable, Data)
knownLanguages :: [Language]
knownLanguages = [Haskell98, Haskell2010]
instance Text Language where
disp (UnknownLanguage other) = Disp.text other
disp other = Disp.text (show other)
parse = do
lang <- Parse.munch1 Char.isAlphaNum
return (classifyLanguage lang)
classifyLanguage :: String -> Language
classifyLanguage = \str -> case lookup str langTable of
Just lang -> lang
Nothing -> UnknownLanguage str
where
langTable = [ (show lang, lang)
| lang <- knownLanguages ]
data Extension =
EnableExtension KnownExtension
| DisableExtension KnownExtension
| UnknownExtension String
deriving (Show, Read, Eq, Typeable, Data)
data KnownExtension =
OverlappingInstances
| UndecidableInstances
| IncoherentInstances
| DoRec
| RecursiveDo
| ParallelListComp
| MultiParamTypeClasses
| MonomorphismRestriction
| FunctionalDependencies
| Rank2Types
| RankNTypes
| PolymorphicComponents
| ExistentialQuantification
| ScopedTypeVariables
| PatternSignatures
| ImplicitParams
| FlexibleContexts
| FlexibleInstances
| EmptyDataDecls
| CPP
| KindSignatures
| BangPatterns
| TypeSynonymInstances
| TemplateHaskell
| ForeignFunctionInterface
| Arrows
| Generics
| ImplicitPrelude
| NamedFieldPuns
| PatternGuards
| GeneralizedNewtypeDeriving
| ExtensibleRecords
| RestrictedTypeSynonyms
| HereDocuments
| MagicHash
| TypeFamilies
| StandaloneDeriving
| UnicodeSyntax
| UnliftedFFITypes
| InterruptibleFFI
| CApiFFI
| LiberalTypeSynonyms
| TypeOperators
| RecordWildCards
| RecordPuns
| DisambiguateRecordFields
| TraditionalRecordSyntax
| OverloadedStrings
| GADTs
| GADTSyntax
| MonoPatBinds
| RelaxedPolyRec
| ExtendedDefaultRules
| UnboxedTuples
| DeriveDataTypeable
| DeriveGeneric
| DefaultSignatures
| InstanceSigs
| ConstrainedClassMethods
| PackageImports
| ImpredicativeTypes
| NewQualifiedOperators
| PostfixOperators
| QuasiQuotes
| TransformListComp
| MonadComprehensions
| ViewPatterns
| XmlSyntax
| RegularPatterns
| TupleSections
| GHCForeignImportPrim
| NPlusKPatterns
| DoAndIfThenElse
| MultiWayIf
| LambdaCase
| RebindableSyntax
| ExplicitForAll
| DatatypeContexts
| MonoLocalBinds
| DeriveFunctor
| DeriveTraversable
| DeriveFoldable
| NondecreasingIndentation
| SafeImports
| Safe
| Trustworthy
| Unsafe
| ConstraintKinds
| PolyKinds
| DataKinds
| ParallelArrays
| RoleAnnotations
| OverloadedLists
| EmptyCase
| AutoDeriveTypeable
| NegativeLiterals
| NumDecimals
| NullaryTypeClasses
| ExplicitNamespaces
| AllowAmbiguousTypes
deriving (Show, Read, Eq, Enum, Bounded, Typeable, Data)
{-# DEPRECATED knownExtensions
"KnownExtension is an instance of Enum and Bounded, use those instead." #-}
knownExtensions :: [KnownExtension]
knownExtensions = [minBound..maxBound]
deprecatedExtensions :: [(Extension, Maybe Extension)]
deprecatedExtensions =
[ (EnableExtension RecordPuns, Just (EnableExtension NamedFieldPuns))
, (EnableExtension PatternSignatures, Just (EnableExtension ScopedTypeVariables))
]
instance Text Extension where
disp (UnknownExtension other) = Disp.text other
disp (EnableExtension ke) = Disp.text (show ke)
disp (DisableExtension ke) = Disp.text ("No" ++ show ke)
parse = do
extension <- Parse.munch1 Char.isAlphaNum
return (classifyExtension extension)
instance Text KnownExtension where
disp ke = Disp.text (show ke)
parse = do
extension <- Parse.munch1 Char.isAlphaNum
case classifyKnownExtension extension of
Just ke ->
return ke
Nothing ->
fail ("Can't parse " ++ show extension ++ " as KnownExtension")
classifyExtension :: String -> Extension
classifyExtension string
= case classifyKnownExtension string of
Just ext -> EnableExtension ext
Nothing ->
case string of
'N':'o':string' ->
case classifyKnownExtension string' of
Just ext -> DisableExtension ext
Nothing -> UnknownExtension string
_ -> UnknownExtension string
classifyKnownExtension :: String -> Maybe KnownExtension
classifyKnownExtension "" = Nothing
classifyKnownExtension string@(c : _)
| inRange (bounds knownExtensionTable) c
= lookup string (knownExtensionTable ! c)
| otherwise = Nothing
knownExtensionTable :: Array Char [(String, KnownExtension)]
knownExtensionTable =
accumArray (flip (:)) [] ('A', 'Z')
[ (head str, (str, extension))
| extension <- [toEnum 0 ..]
, let str = show extension ]