-headersP ∷ Parser Headers
-{-# INLINEABLE headersP #-}
-headersP = do xs ← P.many header
- crlf
- return $ toHeaders xs
- where
- header ∷ Parser (CIAscii, Ascii)
- header = do name ← A.toCIAscii <$> token
- _ ← char ':'
- skipMany lws
- values ← sepBy content (try lws)
- skipMany (try lws)
- crlf
- return (name, joinValues values)
-
- content ∷ Parser Ascii
- {-# INLINE content #-}
- content = A.unsafeFromByteString
- <$>
- takeWhile1 (\c → ((¬) (isSPHT c)) ∧ isText c)
-
- joinValues ∷ [Ascii] → Ascii
- {-# 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"
- 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"
+instance Default (Parser Headers) where
+ {-# INLINEABLE def #-}
+ def = do xs ← many header
+ crlf
+ return $ fromFoldable xs
+ where
+ header ∷ Parser (CIAscii, Ascii)
+ {-# INLINEABLE header #-}
+ header = do name ← cs <$> token
+ void $ char ':'
+ skipMany lws
+ values ← content `sepBy` try lws
+ skipMany (try lws)
+ crlf
+ return (name, joinValues values)
+
+ content ∷ Parser Ascii
+ {-# INLINEABLE content #-}
+ content = A.unsafeFromByteString
+ <$>
+ takeWhile1 (\c → isText c ∧ c ≢ '\x20')
+
+ joinValues ∷ [Ascii] → Ascii
+ {-# INLINEABLE joinValues #-}
+ joinValues = cs
+ ∘ mconcat
+ ∘ intersperse (cs ("\x20" ∷ Ascii) ∷ AsciiBuilder)
+ ∘ (cs <$>)