X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=a5fdb022e7437e5add0071bcf723834b36f85c23;hb=3fe5ca3;hp=424145586253bd0544f8070d540cad9c83e502ff;hpb=02d702c138d918386135245021d5778676ee6d0e;p=Lucu.git diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index 4241455..a5fdb02 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -12,11 +12,11 @@ module Network.HTTP.Lucu.Headers , fromHeaders , headersP - , hPutHeaders + , printHeaders ) where import Control.Applicative -import Data.Ascii (Ascii, CIAscii) +import Data.Ascii (Ascii, AsciiBuilder, CIAscii) import qualified Data.Ascii as A import Data.Attoparsec.Char8 as P import qualified Data.ByteString as BS @@ -24,7 +24,6 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Monoid import Data.Monoid.Unicode -import Network.HTTP.Lucu.HandleLike import Network.HTTP.Lucu.Parser.Http import Network.HTTP.Lucu.Utils import Prelude.Unicode @@ -106,12 +105,11 @@ headersP = do xs ← P.many header 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) @@ -125,13 +123,14 @@ headersP = do xs ← P.many header {-# INLINE joinValues #-} joinValues = A.fromAsciiBuilder ∘ joinWith "\x20" ∘ map A.toAsciiBuilder -hPutHeaders ∷ HandleLike h => h → Headers → IO () -hPutHeaders !h !(Headers m) - = mapM_ putH (M.toList m) >> hPutBS h "\r\n" +printHeaders ∷ Headers → AsciiBuilder +printHeaders (Headers m) + = mconcat (map printHeader (M.toList m)) ⊕ + A.toAsciiBuilder "\x0D\x0A" where - putH ∷ (CIAscii, Ascii) → IO () - putH (!name, !value) - = do hPutBS h (A.ciToByteString name) - hPutBS h ": " - hPutBS h (A.toByteString value) - hPutBS h "\r\n" + printHeader ∷ (CIAscii, Ascii) → AsciiBuilder + printHeader (name, value) + = A.toAsciiBuilder (A.fromCIAscii name) ⊕ + A.toAsciiBuilder ": " ⊕ + A.toAsciiBuilder value ⊕ + A.toAsciiBuilder "\x0D\x0A"