6 -- |This is an auxiliary parser utilities for parsing things related
9 -- In general you don't have to use this module directly.
10 module Network.HTTP.Lucu.Parser.Http
32 import Control.Applicative
33 import Control.Applicative.Unicode
34 import Control.Monad.Unicode
35 import Data.Ascii (Ascii)
36 import qualified Data.Ascii as A
37 import Data.Attoparsec.Char8 as P
38 import qualified Data.Attoparsec.FastSet as FS
39 import qualified Data.ByteString.Char8 as BS
40 import Prelude.Unicode
42 -- |@'isCtl' c@ is 'Prelude.False' iff @0x20 <= c < 0x7F@.
50 -- |@'isText'@ is equivalent to @'not' '.' 'isCtl'@
55 -- |@'isSeparator' c@ is 'Prelude.True' iff c is one of HTTP
57 isSeparator ∷ Char → Bool
58 {-# INLINE isSeparator #-}
59 isSeparator = flip FS.memberChar set
62 set = FS.charClass "()<>@,;:\\\"/[]?={}\x20\x09"
64 -- |@'isChar' c@ is 'Prelude.True' iff @c <= 0x7f@.
69 -- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator'
72 {-# INLINE isToken #-}
74 = (¬) (isCtl c ∨ isSeparator c)
76 -- |@'listOf' p@ is similar to @'sepBy' p ('char' \',\')@ but it
77 -- allows any occurrences of 'lws' before and after each tokens.
78 listOf ∷ Parser a → Parser [a]
79 {-# INLINEABLE listOf #-}
83 sepBy p $ do skipMany lws
87 -- |'token' is similar to @'takeWhile1' 'isToken'@
90 token = A.unsafeFromByteString <$> takeWhile1 isToken
92 -- |The CRLF: 0x0D 0x0A.
95 crlf = string "\x0D\x0A" ≫ return ()
100 sp = char '\x20' ≫ return ()
102 -- |HTTP LWS: crlf? (sp | ht)+
104 {-# INLINEABLE lws #-}
110 -- |Returns 'True' for SP and HT.
112 {-# INLINE isSPHT #-}
117 -- |@'separators'@ is similar to @'takeWhile1' 'isSeparator'@.
118 separators ∷ Parser Ascii
119 {-# INLINE separators #-}
120 separators = A.unsafeFromByteString <$> takeWhile1 isSeparator
122 -- |'quotedStr' accepts a string surrounded by double quotation
123 -- marks. Quotes can be escaped by backslashes.
124 quotedStr ∷ Parser Ascii
125 {-# INLINEABLE quotedStr #-}
128 xs ← P.many (qdtext <|> quotedPair)
130 return $ A.unsafeFromByteString $ BS.pack xs
133 {-# INLINE qdtext #-}
134 qdtext = satisfy (\c → c ≢ '"' ∧ (¬) (isCtl c))
136 quotedPair ∷ Parser Char
137 {-# INLINE quotedPair #-}
138 quotedPair = char '\\' ≫ satisfy isChar
140 -- |'qvalue' accepts a so-called qvalue.
141 qvalue ∷ Parser Double
142 {-# INLINEABLE qvalue #-}
143 qvalue = do x ← char '0'
153 ys ← atMost 3 (char '0')
157 -- |@'atMost' n v@ is like @'P.many' v@ but applies the given action
158 -- at most @n@ times.
159 atMost ∷ Alternative f ⇒ Int → f a → f [a]
160 {-# INLINE atMost #-}
162 atMost n v = ( (:) <$> v ⊛ atMost (n-1) v )