X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=e56567e7d665b191a96d08b75dfab9bc781f614c;hp=242d19194d0a30f7f0d68bc375bc1914f0942505;hb=0678be8;hpb=545053db37e71ed18ca59c12467a8ecb10bf5f83 diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index 242d191..e56567e 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -12,9 +12,7 @@ module Network.HTTP.Lucu.Headers ( Headers , HasHeaders(..) - , headers - , printHeaders ) where import Control.Applicative hiding (empty) @@ -22,8 +20,11 @@ import Control.Applicative.Unicode hiding ((∅)) import Control.Monad import Data.Ascii (Ascii, AsciiBuilder, CIAscii) import qualified Data.Ascii as A -import Data.Attoparsec.Char8 as P +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 @@ -105,6 +106,27 @@ merge a b {-# 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 @@ -118,7 +140,7 @@ merge a b -} headers ∷ Parser Headers {-# INLINEABLE headers #-} -headers = do xs ← P.many header +headers = do xs ← many header crlf return $ fromFoldable xs where @@ -143,15 +165,3 @@ headers = do xs ← P.many header ∘ 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"