Suppress unused-do-bind warnings which GHC 6.12.1 emits

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

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index 5eeab6feb699b8455b717ea920b81e60a94ece3c..87d858c55ec023a07a263a3f6d2280adaf958eb6 100644 (file)
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -21,14 +21,15 @@ import           Data.Char
 import           Data.List
 import           Data.Map (Map)
 import qualified Data.Map as M
+import           Data.Ord
 import           Data.Word
 import           Foreign.ForeignPtr
 import           Foreign.Ptr
 import           Foreign.Storable
+import           Network.HTTP.Lucu.HandleLike
 import           Network.HTTP.Lucu.Parser
 import           Network.HTTP.Lucu.Parser.Http
 import           Network.HTTP.Lucu.Utils
-import           System.IO
 
 type Headers = Map NCBS Strict.ByteString
 newtype NCBS = NCBS Strict.ByteString
@@ -76,7 +77,7 @@ noCaseCmp' p1 l1 p2 l2
     | otherwise
         = do c1 <- peek p1
              c2 <- peek p2
-             case toLower (w2c c1) `compare` toLower (w2c c2) of
+             case comparing (toLower . w2c) c1 c2 of
                EQ -> noCaseCmp' (p1 `plusPtr` 1) (l1 - 1) (p2 `plusPtr` 1) (l2 - 1)
                x  -> return x
 
@@ -173,12 +174,12 @@ fromHeaders hs = [(fromNCBS a, b) | (a, b) <- M.toList hs]
 -}
 headersP :: Parser Headers
 headersP = do xs <- many header
-              crlf
+              _  <- crlf
               return $! toHeaders xs
     where
       header :: Parser (Strict.ByteString, Strict.ByteString)
       header = do name <- token
-                  char ':'
+                  _    <- char ':'
                   -- FIXME: これは多少インチキだが、RFC 2616 のこの部分
                   -- の記述はひどく曖昧であり、この動作が本當に間違って
                   -- ゐるのかどうかも良く分からない。例へば
@@ -186,7 +187,7 @@ headersP = do xs <- many header
                   -- のか？直勸的には駄目さうに思へるが、そんな記述は見
                   -- 付からない。
                   contents <- many (lws <|> many1 text)
-                  crlf
+                  _        <- crlf
                   let value = foldr (++) "" contents
                       norm  = normalize value
                   return (C8.pack name, C8.pack norm)
@@ -194,7 +195,7 @@ headersP = do xs <- many header
       normalize :: String -> String
       normalize = trimBody . trim isWhiteSpace
 
-      trimBody = foldr (++) []
+      trimBody = concat
                  . map (\ s -> if head s == ' ' then
                                    " "
                                else
@@ -205,15 +206,15 @@ headersP = do xs <- many header
                                else c)
 
 
-hPutHeaders :: Handle -> Headers -> IO ()
+hPutHeaders :: HandleLike h => h -> Headers -> IO ()
 hPutHeaders h hds
     = h `seq` hds `seq`
-      mapM_ putH (M.toList hds) >> C8.hPut h (C8.pack "\r\n")
+      mapM_ putH (M.toList hds) >> hPutBS h (C8.pack "\r\n")
     where
       putH :: (NCBS, Strict.ByteString) -> IO ()
       putH (name, value)
           = name `seq` value `seq`
-            do C8.hPut h (fromNCBS name)
-               C8.hPut h (C8.pack ": ")
-               C8.hPut h value
-               C8.hPut h (C8.pack "\r\n")
+            do hPutBS h (fromNCBS name)
+               hPutBS h (C8.pack ": ")
+               hPutBS h value
+               hPutBS h (C8.pack "\r\n")