]> gitweb @ CieloNegro.org - Lucu.git/blob - Data/URI/Internal/Scheme.hs
8bb5a7dd90522eb30061817586662be4b176a820
[Lucu.git] / 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                ]