module Network.HTTP.Lucu.Headers
( Headers
, HasHeaders(..)
- , headers
)
where
import Control.Applicative hiding (empty)
import Data.Convertible.Base
import Data.Convertible.Instances.Ascii ()
import Data.Convertible.Utils
+import Data.Default
import Data.List (intersperse)
import qualified Data.Map as M (Map)
import Data.Collections
getCIHeader ∷ CIAscii → a → Maybe CIAscii
{-# INLINE getCIHeader #-}
- getCIHeader = ((A.toCIAscii <$>) ∘) ∘ getHeader
+ getCIHeader = ((cs <$>) ∘) ∘ getHeader
deleteHeader ∷ CIAscii → a → a
{-# INLINE deleteHeader #-}
field-value の先頭および末尾にある LWS は全て削除され、それ以外の
LWS は單一の SP に變換される。
-}
-headers ∷ Parser Headers
-{-# INLINEABLE headers #-}
-headers = do xs ← many header
+instance Default (Parser Headers) where
+ {-# INLINEABLE def #-}
+ def = do xs ← many header
crlf
return $ fromFoldable xs
- where
- header ∷ Parser (CIAscii, Ascii)
- header = do name ← A.toCIAscii <$> token
- void $ char ':'
- skipMany lws
- values ← content `sepBy` try lws
- skipMany (try lws)
- crlf
- return (name, joinValues values)
-
- content ∷ Parser Ascii
- {-# INLINE content #-}
- content = A.unsafeFromByteString
- <$>
- takeWhile1 (\c → isText c ∧ c ≢ '\x20')
-
- joinValues ∷ [Ascii] → Ascii
- {-# INLINE joinValues #-}
- joinValues = A.fromAsciiBuilder
- ∘ mconcat
- ∘ intersperse (A.toAsciiBuilder "\x20")
- ∘ (A.toAsciiBuilder <$>)
+ 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 <$>)