Optimized as possible as I can.

[Lucu.git] / Network / HTTP / Lucu / Headers.hs

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index fee6fadec1b595ae189b0b9515b2543cb93b7171..a5808838990efb9ea501b95b1770a19890273e20 100644 (file)
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -23,20 +23,24 @@ class HasHeaders a where
 
     getHeader :: String -> a -> Maybe String
     getHeader key a
-        = fmap snd $ find (noCaseEq key . fst) (getHeaders a)
+        = key `seq` a `seq`
+          fmap snd $ find (noCaseEq' key . fst) (getHeaders a)
 
     deleteHeader :: String -> a -> a
     deleteHeader key a
-        = setHeaders a $ filter (not . noCaseEq key . fst) (getHeaders a)
+        = key `seq` a `seq`
+          setHeaders a $ filter (not . noCaseEq' key . fst) (getHeaders a)
 
     addHeader :: String -> String -> a -> a
     addHeader key val a
-        = setHeaders a $ (getHeaders a) ++ [(key, val)]
+        = key `seq` val `seq` a `seq`
+          setHeaders a $ (getHeaders a) ++ [(key, val)]
 
     setHeader :: String -> String -> a -> a
     setHeader key val a
-        = let list    = getHeaders a
-              deleted = filter (not . noCaseEq key . fst) list
+        = key `seq` val `seq` a `seq`
+          let list    = getHeaders a
+              deleted = filter (not . noCaseEq' key . fst) list
               added   = deleted ++ [(key, val)]
           in 
             setHeaders a added
@@ -90,9 +94,14 @@ headersP = do xs <- many header
 
 
 hPutHeaders :: Handle -> Headers -> IO ()
-hPutHeaders h hds = mapM_ putH hds >> hPutStr h "\r\n"
+hPutHeaders h hds
+    = h `seq` hds `seq`
+      mapM_ putH hds >> hPutStr h "\r\n"
     where
-      putH (name, value) = do hPutStr h name
-                              hPutStr h ": "
-                              hPutStr h value
-                              hPutStr h "\r\n"
+      putH :: (String, String) -> IO ()
+      putH (name, value)
+          = name `seq` value `seq`
+            do hPutStr h name
+               hPutStr h ": "
+               hPutStr h value
+               hPutStr h "\r\n"