From: pho <pho@cielonegro.org>
Date: Sat, 6 Oct 2007 05:31:11 +0000 (+0900)
Subject: Slight changes
X-Git-Tag: RELEASE-0_2_1~23
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=83db536d11e8efb26848318ad4514b825f412460;p=Lucu.git

Slight changes

darcs-hash:20071006053111-62b54-66a2cb75afcd688194e7b1c7d7817e9fcdc7fd45.gz
---

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index c97c93c..b26dddd 100644
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -50,10 +50,12 @@ instance Show NCBS where
     show (NCBS x) = show x
 
 noCaseCmp :: ByteString -> ByteString -> Ordering
-noCaseCmp a b = toForeignPtr a `cmp` toForeignPtr b
+noCaseCmp a b = a `seq` b `seq`
+                toForeignPtr a `cmp` toForeignPtr b
     where
       cmp :: (ForeignPtr Word8, Int, Int) -> (ForeignPtr Word8, Int, Int) -> Ordering
       cmp (x1, s1, l1) (x2, s2, l2)
+          | x1 `seq` s1 `seq` l1 `seq` x2 `seq` s2 `seq` l2 `seq` False = undefined
           | l1 == 0  && l2 == 0               = EQ
           | x1 == x2 && s1 == s2 && l1 == l2  = EQ
           | otherwise
@@ -61,11 +63,12 @@ noCaseCmp a b = toForeignPtr a `cmp` toForeignPtr b
                 withForeignPtr x1 $ \ p1 ->
                 withForeignPtr x2 $ \ p2 ->
                 noCaseCmp' (p1 `plusPtr` s1) l1 (p2 `plusPtr` s2) l2
-{-# INLINE noCaseCmp #-}
+
 
 -- もし先頭の文字列が等しければ、短い方が小さい。
 noCaseCmp' :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Ordering
 noCaseCmp' p1 l1 p2 l2
+    | p1 `seq` l1 `seq` p2 `seq` l2 `seq` False = undefined
     | l1 == 0 && l2 == 0 = return EQ
     | l1 == 0 && l1 /= 0 = return LT
     | l1 /= 0 && l2 == 0 = return GT
@@ -78,10 +81,12 @@ noCaseCmp' p1 l1 p2 l2
 
 
 noCaseEq :: ByteString -> ByteString -> Bool
-noCaseEq a b = toForeignPtr a `cmp` toForeignPtr b
+noCaseEq a b = a `seq` b `seq`
+               toForeignPtr a `cmp` toForeignPtr b
     where
       cmp :: (ForeignPtr Word8, Int, Int) -> (ForeignPtr Word8, Int, Int) -> Bool
       cmp (x1, s1, l1) (x2, s2, l2)
+          | x1 `seq` s1 `seq` l1 `seq` x2 `seq` s2 `seq` l2 `seq` False = undefined
           | l1 /= l2                          = False
           | l1 == 0  && l2 == 0               = True
           | x1 == x2 && s1 == s2 && l1 == l2  = True
@@ -94,6 +99,7 @@ noCaseEq a b = toForeignPtr a `cmp` toForeignPtr b
 
 noCaseEq' :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
 noCaseEq' p1 p2 l
+    | p1 `seq` p2 `seq` l `seq` False = undefined
     | l == 0    = return True
     | otherwise
         = do c1 <- peek p1
diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 3445219..4c0735a 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -34,8 +34,6 @@ data Interaction = Interaction {
     , itrRequest      :: !(TVar (Maybe Request))
     , itrResponse     :: !(TVar Response)
 
-    -- FIXME: この三つは本來 TVar であるべきでないので、唯の Bool にす
-    -- るに越した事は無いが、それは重要でない。
     , itrRequestHasBody    :: !(TVar Bool)
     , itrRequestIsChunked  :: !(TVar Bool)
     , itrExpectedContinue  :: !(TVar Bool)
@@ -122,8 +120,8 @@ newInteraction conf addr req
                     , itrRequest      = request
                     , itrResponse     = responce
 
-                    , itrRequestHasBody    = requestHasBody
-                    , itrRequestIsChunked  = requestIsChunked
+                    , itrRequestHasBody   = requestHasBody
+                    , itrRequestIsChunked = requestIsChunked
                     , itrExpectedContinue = expectedContinue
 
                     , itrReqChunkLength    = reqChunkLength
diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs
index c40cacd..44cf155 100644
--- a/Network/HTTP/Lucu/Parser.hs
+++ b/Network/HTTP/Lucu/Parser.hs
@@ -144,7 +144,7 @@ allowEOF f = f `seq`
 satisfy :: (Char -> Bool) -> Parser Char
 satisfy f = f `seq`
             do c <- anyChar
-               if f c then
+               if f $! c then
                    return c
                  else
                    failP