Data/URI/Internal/Scheme.hs

   1 {-# LANGUAGE
   2     DeriveDataTypeable
   3   , FlexibleInstances
   4   , GeneralizedNewtypeDeriving
   5   , MultiParamTypeClasses
   6   , StandaloneDeriving
   7   , TemplateHaskell
   8   , TypeSynonymInstances
   9   , UnicodeSyntax
  10   #-}
  11 module Data.URI.Internal.Scheme
  12     ( Scheme
  13     )
  14     where
  15 import Data.Ascii (AsciiBuilder, CIAscii)
  16 import qualified Data.Ascii as A
  17 import Data.Attoparsec.Char8
  18 import qualified Data.ByteString.Char8 as BS
  19 import Data.CaseInsensitive
  20 import Data.Convertible.Base
  21 import Data.Default
  22 import Data.Hashable
  23 import Data.String
  24 import Data.URI.Internal
  25 import Data.Typeable
  26 import Prelude hiding (takeWhile)
  27 import Prelude.Unicode
  28
  29 -- |'Scheme' names consist of a non-empty sequence of characters
  30 -- beginning with a letter and followed by any combination of letters,
  31 -- digits, plus (\'+\'), period (\'.\'), or hyphen (\'-\'):
  32 -- <http://tools.ietf.org/html/rfc3986#section-3.1>
  33 newtype Scheme = Scheme CIAscii
  34     deriving ( Eq
  35              , FoldCase
  36              , Hashable
  37              , Ord
  38              , Show
  39              , Typeable
  40              )
  41
  42 -- |'isString' is a fast but unsafe way to create 'Scheme' such that
  43 -- no validation on the string is performed.
  44 deriving instance IsString Scheme
  45
  46 instance Default (Parser Scheme) where
  47     {-# INLINEABLE def #-}
  48     def = do x  ← satisfy first
  49              xs ← takeWhile nonFirst
  50              return ∘ fromBS $ x `BS.cons` xs
  51           <?>
  52           "scheme"
  53         where
  54           {-# INLINE first #-}
  55           first = isAlpha_ascii
  56           {-# INLINE nonFirst #-}
  57           nonFirst c
  58               = isAlpha_ascii c ∨
  59                 isDigit c       ∨
  60                 c ≡ '+'         ∨
  61                 c ≡ '-'         ∨
  62                 c ≡ '.'
  63           {-# INLINE fromBS #-}
  64           fromBS = Scheme ∘ A.toCIAscii ∘ A.unsafeFromByteString
  65
  66 instance ConvertSuccess Scheme CIAscii where
  67     {-# INLINE convertSuccess #-}
  68     convertSuccess (Scheme s) = foldCase s
  69
  70 instance ConvertSuccess Scheme AsciiBuilder where
  71     {-# INLINE convertSuccess #-}
  72     convertSuccess = A.toAsciiBuilder ∘ A.fromCIAscii ∘ cs
  73
  74 instance ConvertAttempt CIAscii Scheme where
  75     {-# INLINE convertAttempt #-}
  76     convertAttempt = parseAttempt' def ∘ A.fromCIAscii
  77
  78 deriveAttempts [ ([t| Scheme |], [t| AsciiBuilder |])
  79                , ([t| Scheme |], [t| CIAscii      |])
  80                ]