X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FParser%2FHttp.hs;h=4153dcb6eaf62f071e5ba7fe3406daa9d3c4c881;hb=6126eb9;hp=4ac11a4686624c3d66da14d4a034d29116b85640;hpb=02d702c138d918386135245021d5778676ee6d0e;p=Lucu.git diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index 4ac11a4..4153dcb 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 #-} @@ -41,7 +40,7 @@ import qualified Data.Attoparsec.FastSet as FS import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LS import qualified Data.ByteString.Lazy.Internal as LS -import qualified Data.Foldable as F +import Data.Foldable import Data.Monoid import Data.Monoid.Unicode import qualified Data.Sequence as S @@ -79,19 +78,16 @@ isChar = (≤ '\x7F') -- 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 - = try $ - 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 ∷ Parser Ascii @@ -101,20 +97,19 @@ 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 () {-# INLINEABLE lws #-} -lws = try $ - do option () crlf - _ ← satisfy isSPHT - skipWhile isSPHT +lws = do option () crlf + _ ← takeWhile1 isSPHT + return () -- |Returns 'True' for SP and HT. isSPHT ∷ Char → Bool @@ -144,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 @@ -192,7 +187,7 @@ instance Monoid CharAccumState where lastChunk ∷ CharAccumState → BS.ByteString {-# INLINE lastChunk #-} -lastChunk = BS.pack ∘ F.toList ∘ casLastChunk +lastChunk = BS.pack ∘ toList ∘ casLastChunk snoc ∷ CharAccumState → Char → CharAccumState {-# INLINEABLE snoc #-} @@ -210,7 +205,7 @@ snoc cas c finish ∷ CharAccumState → LS.ByteString {-# INLINEABLE finish #-} finish cas - = let chunks = F.toList $ casChunks cas ⊳ lastChunk cas + = let chunks = toList $ casChunks cas ⊳ lastChunk cas str = LS.fromChunks chunks in str