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 (\'-\'). Comparison
  32 -- of 'Scheme's are always case-insensitive. See:
  33 -- <http://tools.ietf.org/html/rfc3986#section-3.1>
  34 newtype Scheme = Scheme CIAscii
  35     deriving ( Eq
  36              , FoldCase
  37              , Hashable
  38              , Ord
  39              , Show
  40              , Typeable
  41              )
  42
  43 -- |'fromString' is a fast but unsafe way to create 'Scheme' such that
  44 -- no validation on the string is performed.
  45 deriving instance IsString Scheme
  46
  47 instance Default (Parser Scheme) where
  48     {-# INLINEABLE def #-}
  49     def = do x  ← satisfy first
  50              xs ← takeWhile nonFirst
  51              return ∘ fromBS $ x `BS.cons` xs
  52           <?>
  53           "scheme"
  54         where
  55           {-# INLINE first #-}
  56           first = isAlpha_ascii
  57           {-# INLINE nonFirst #-}
  58           nonFirst c
  59               = isAlpha_ascii c ∨
  60                 isDigit c       ∨
  61                 c ≡ '+'         ∨
  62                 c ≡ '-'         ∨
  63                 c ≡ '.'
  64           {-# INLINE fromBS #-}
  65           fromBS = Scheme ∘ A.toCIAscii ∘ A.unsafeFromByteString
  66
  67 -- |Extract a 'CIAscii' with all letters lowercased.
  68 instance ConvertSuccess Scheme CIAscii where
  69     {-# INLINE convertSuccess #-}
  70     convertSuccess (Scheme s) = foldCase s
  71
  72 -- |Create an 'AsciiBuilder' with all letters lowercased.
  73 instance ConvertSuccess Scheme AsciiBuilder where
  74     {-# INLINE convertSuccess #-}
  75     convertSuccess = A.toAsciiBuilder ∘ A.fromCIAscii ∘ cs
  76
  77 -- |Try to parse a 'Scheme' from 'CIAscii'.
  78 instance ConvertAttempt CIAscii Scheme where
  79     {-# INLINE convertAttempt #-}
  80     convertAttempt = parseAttempt' def ∘ A.fromCIAscii
  81
  82 deriveAttempts [ ([t| Scheme |], [t| AsciiBuilder |])
  83                , ([t| Scheme |], [t| CIAscii      |])
  84                ]