X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=5e48ee4bd52ad8a1edc1c5a3c9ede9b2b687f100;hb=ece223c516e66223ef1d5d8e6bbe4054a235d983;hp=e72022c72c0d5f11f253504fd5ed34c4288bd1d4;hpb=6126eb9cbe5b38c300d855d96d2238831e59b5dd;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index e72022c..5e48ee4 100644
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -17,16 +17,18 @@ module Network.HTTP.Lucu.Headers
     )
     where
 import Control.Applicative
+import Control.Monad
 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 Data.List
 import Data.Map (Map)
 import qualified Data.Map as M
+import qualified Data.Map.Unicode as M
 import Data.Monoid
 import Data.Monoid.Unicode
 import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
 newtype Headers
@@ -42,6 +44,12 @@ class HasHeaders a where
         = case getHeaders a of
             Headers m → M.lookup key m
 
+    hasHeader ∷ CIAscii → a → Bool
+    {-# INLINE hasHeader #-}
+    hasHeader key a
+        = case getHeaders a of
+            Headers m → key M.∈ m
+
     getCIHeader ∷ CIAscii → a → Maybe CIAscii
     {-# INLINE getCIHeader #-}
     getCIHeader key a
@@ -116,9 +124,9 @@ headersP = do xs ← P.many header
     where
       header ∷ Parser (CIAscii, Ascii)
       header = do name ← A.toCIAscii <$> token
-                  _    ← char ':'
+                  void $ char ':'
                   skipMany lws
-                  values ← sepBy content (try lws)
+                  values ← content `sepBy` try lws
                   skipMany (try lws)
                   crlf
                   return (name, joinValues values)
@@ -127,11 +135,14 @@ headersP = do xs ← P.many header
       {-# INLINE content #-}
       content = A.unsafeFromByteString
                 <$>
-                takeWhile1 (\c → (¬) (isSPHT c) ∧ isText c)
+                takeWhile1 (\c → isText c ∧ c ≢ '\x20')
 
       joinValues ∷ [Ascii] → Ascii
       {-# INLINE joinValues #-}
-      joinValues = A.fromAsciiBuilder ∘ joinWith "\x20" ∘ map A.toAsciiBuilder
+      joinValues = A.fromAsciiBuilder
+                   ∘ mconcat
+                   ∘ intersperse (A.toAsciiBuilder "\x20")
+                   ∘ map A.toAsciiBuilder
 
 printHeaders ∷ Headers → AsciiBuilder
 printHeaders (Headers m)