X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=400e49b1291d284bd43a0def5f9aff5f2e5955a1;hb=b923d45;hp=2378ebcc529295f9495f1f1e5daf5daef46ce907;hpb=9bb89434103e9a22f100d6ecb7e65a5d461e0454;p=Lucu.git diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index 2378ebc..400e49b 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -57,6 +57,10 @@ class HasHeaders a where Headers m → setHeaders a $ Headers $ M.insert key val m +instance HasHeaders Headers where + getHeaders = id + setHeaders _ = id + toHeaders ∷ [(CIAscii, Ascii)] → Headers {-# INLINE toHeaders #-} toHeaders = flip mkHeaders (∅) @@ -97,17 +101,16 @@ fromHeaders (Headers m) = M.toList m -} headersP ∷ Parser Headers {-# INLINEABLE headersP #-} -headersP = do xs ← P.many header +headersP = do xs ← P.many $ try header crlf return $ toHeaders xs where header ∷ Parser (CIAscii, Ascii) - header = try $ - do name ← A.toCIAscii <$> token + header = do name ← A.toCIAscii <$> token _ ← char ':' skipMany lws - values ← sepBy content lws - skipMany lws + values ← sepBy content (try lws) + skipMany (try lws) crlf return (name, joinValues values) @@ -119,7 +122,7 @@ headersP = do xs ← P.many header joinValues ∷ [Ascii] → Ascii {-# INLINE joinValues #-} - joinValues = A.fromAsciiBuilder ∘ joinWith "\x20" + joinValues = A.fromAsciiBuilder ∘ joinWith "\x20" ∘ map A.toAsciiBuilder hPutHeaders ∷ HandleLike h => h → Headers → IO () hPutHeaders !h !(Headers m)