X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FParser%2FHttp.hs;h=e3fbf3501b1cc50800bf1af90f88b123beee0030;hb=9668dc2;hp=520034247726f3ec6398eb8b69b143eb08456ceb;hpb=b923d454928e3d01134b15d6072b6d3edf7a15ca;p=Lucu.git diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index 5200342..e3fbf35 100644 --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -1,6 +1,5 @@ {-# LANGUAGE - BangPatterns - , OverloadedStrings + OverloadedStrings , ScopedTypeVariables , UnicodeSyntax #-} @@ -48,7 +47,7 @@ import qualified Data.Sequence as S import Data.Sequence.Unicode hiding ((∅)) import Prelude.Unicode --- |@'isCtl' c@ is 'Prelude.False' iff @0x20 <= c < 0x7F@. +-- |@'isCtl' c@ returns 'False' iff @0x20 <= c < 0x7F@. isCtl ∷ Char → Bool {-# INLINE isCtl #-} isCtl c @@ -61,7 +60,7 @@ isText ∷ Char → Bool {-# INLINE isText #-} isText = (¬) ∘ isCtl --- |@'isSeparator' c@ is 'Prelude.True' iff c is one of HTTP +-- |@'isSeparator' c@ returns 'True' iff c is one of the HTTP -- separators. isSeparator ∷ Char → Bool {-# INLINE isSeparator #-} @@ -70,29 +69,27 @@ isSeparator = flip FS.memberChar set {-# NOINLINE set #-} set = FS.charClass "()<>@,;:\\\"/[]?={}\x20\x09" --- |@'isChar' c@ is 'Prelude.True' iff @c <= 0x7f@. +-- |@'isChar' c@ returns 'True' iff @c <= 0x7f@. isChar ∷ Char → Bool {-# INLINE isChar #-} isChar = (≤ '\x7F') --- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator' +-- |@'isToken' c@ is equivalent to @not ('isCtl' c '||' 'isSeparator' -- c)@ isToken ∷ Char → Bool {-# INLINE isToken #-} -isToken !c - = (¬) (isCtl c ∨ isSeparator c) +isToken c = (¬) (isCtl c ∨ isSeparator c) -- |@'listOf' p@ is similar to @'sepBy' p ('char' \',\')@ but it -- allows any occurrences of 'lws' before and after each tokens. listOf ∷ Parser a → Parser [a] {-# INLINEABLE listOf #-} -listOf p - = do skipMany lws - sepBy p $ do skipMany lws - _ <- char ',' - skipMany lws +listOf p = do skipMany lws + sepBy p $ do skipMany lws + _ ← char ',' + skipMany lws --- |'token' is similar to @'takeWhile1' 'isToken'@ +-- |'token' is almost the same as @'takeWhile1' 'isToken'@ token ∷ Parser Ascii {-# INLINE token #-} token = A.unsafeFromByteString <$> takeWhile1 isToken @@ -100,12 +97,12 @@ token = A.unsafeFromByteString <$> takeWhile1 isToken -- |The CRLF: 0x0D 0x0A. crlf ∷ Parser () {-# INLINE crlf #-} -crlf = string "\x0D\x0A" ≫ return () +crlf = string "\x0D\x0A" *> return () -- |The SP: 0x20. sp ∷ Parser () {-# INLINE sp #-} -sp = char '\x20' ≫ return () +sp = char '\x20' *> return () -- |HTTP LWS: crlf? (sp | ht)+ lws ∷ Parser () @@ -121,7 +118,7 @@ isSPHT '\x20' = True isSPHT '\x09' = True isSPHT _ = False --- |@'separators'@ is similar to @'takeWhile1' 'isSeparator'@. +-- |@'separators'@ is almost the same as @'takeWhile1' 'isSeparator'@. separators ∷ Parser Ascii {-# INLINE separators #-} separators = A.unsafeFromByteString <$> takeWhile1 isSeparator @@ -142,7 +139,7 @@ quotedStr = try $ quotedPair ∷ Parser Char {-# INLINE quotedPair #-} - quotedPair = char '\\' ≫ satisfy isChar + quotedPair = char '\\' *> satisfy isChar -- |'qvalue' accepts a so-called qvalue. qvalue ∷ Parser Double @@ -161,8 +158,8 @@ qvalue = do x ← char '0' return (y:ys) return $ read (x:xs) --- |@'atMost' n v@ is like @'P.many' v@ but applies the given action --- at most @n@ times. +-- |@'atMost' n v@ is like @'P.many' v@ but accumulates @v@ at most +-- @n@ times. atMost ∷ Alternative f ⇒ Int → f a → f [a] {-# INLINE atMost #-} atMost 0 _ = pure [] @@ -170,7 +167,6 @@ atMost n v = ( (:) <$> v ⊛ atMost (n-1) v ) <|> pure [] - data CharAccumState = CharAccumState { casChunks ∷ !(S.Seq BS.ByteString) @@ -213,6 +209,8 @@ finish cas in str +-- |@'manyCharsTill' p end@ takes as many characters untill @p@ +-- succeeds. manyCharsTill ∷ ∀m b. (Monad m, Alternative m) ⇒ m Char → m b