X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=5e48ee4bd52ad8a1edc1c5a3c9ede9b2b687f100;hp=06dc8f95f0f2ee2c9aca0c1927b9b049797abc49;hb=ece223c516e66223ef1d5d8e6bbe4054a235d983;hpb=9668dc27a02b59d7bfb1e9e40af3d2619700ad69 diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index 06dc8f9..5e48ee4 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -17,17 +17,18 @@ module Network.HTTP.Lucu.Headers ) where import Control.Applicative +import Control.Monad import Data.Ascii (Ascii, AsciiBuilder, CIAscii) import qualified Data.Ascii as A import Data.Attoparsec.Char8 as P import qualified Data.ByteString as BS +import Data.List import Data.Map (Map) import qualified Data.Map as M import qualified Data.Map.Unicode as M import Data.Monoid import Data.Monoid.Unicode import Network.HTTP.Lucu.Parser.Http -import Network.HTTP.Lucu.Utils import Prelude.Unicode newtype Headers @@ -123,9 +124,9 @@ headersP = do xs ← P.many header where header ∷ Parser (CIAscii, Ascii) header = do name ← A.toCIAscii <$> token - _ ← char ':' + void $ char ':' skipMany lws - values ← sepBy content (try lws) + values ← content `sepBy` try lws skipMany (try lws) crlf return (name, joinValues values) @@ -134,11 +135,14 @@ headersP = do xs ← P.many header {-# INLINE content #-} content = A.unsafeFromByteString <$> - takeWhile1 (\c → (¬) (isSPHT c) ∧ isText c) + takeWhile1 (\c → isText c ∧ c ≢ '\x20') joinValues ∷ [Ascii] → Ascii {-# INLINE joinValues #-} - joinValues = A.fromAsciiBuilder ∘ joinWith "\x20" ∘ map A.toAsciiBuilder + joinValues = A.fromAsciiBuilder + ∘ mconcat + ∘ intersperse (A.toAsciiBuilder "\x20") + ∘ map A.toAsciiBuilder printHeaders ∷ Headers → AsciiBuilder printHeaders (Headers m)