module Network.HTTP.Lucu.Headers
( Headers
, HasHeaders(..)
-
, headers
- , printHeaders
)
where
import Control.Applicative hiding (empty)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8
import qualified Data.Collections.Newtype.TH as C
+import Data.Convertible.Base
+import Data.Convertible.Instances.Ascii ()
+import Data.Convertible.Utils
import Data.List (intersperse)
import qualified Data.Map as M (Map)
import Data.Collections
{-# INLINE nullA #-}
nullA = null ∘ A.toByteString
+instance ConvertSuccess Headers Ascii where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
+
+instance ConvertSuccess Headers AsciiBuilder where
+ {-# INLINEABLE convertSuccess #-}
+ convertSuccess (Headers m)
+ = mconcat (header <$> fromFoldable m) ⊕ cs ("\x0D\x0A" ∷ Ascii)
+ where
+ header ∷ (CIAscii, Ascii) → AsciiBuilder
+ {-# INLINE header #-}
+ header (name, value)
+ = cs name ⊕
+ cs (": " ∷ Ascii) ⊕
+ cs value ⊕
+ cs ("\x0D\x0A" ∷ Ascii)
+
+deriveAttempts [ ([t| Headers |], [t| Ascii |])
+ , ([t| Headers |], [t| AsciiBuilder |])
+ ]
+
{-
message-header = field-name ":" [ field-value ]
field-name = token
∘ mconcat
∘ intersperse (A.toAsciiBuilder "\x20")
∘ (A.toAsciiBuilder <$>)
-
-printHeaders ∷ Headers → AsciiBuilder
-printHeaders (Headers m)
- = mconcat (printHeader <$> fromFoldable m) ⊕
- A.toAsciiBuilder "\x0D\x0A"
- where
- printHeader ∷ (CIAscii, Ascii) → AsciiBuilder
- printHeader (name, value)
- = A.toAsciiBuilder (A.fromCIAscii name) ⊕
- A.toAsciiBuilder ": " ⊕
- A.toAsciiBuilder value ⊕
- A.toAsciiBuilder "\x0D\x0A"