, 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
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
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 (∅)
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)
{-# 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"