X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=8942c762da36fa8104efe762288d1de33f0a6721;hp=7b64629bf832245669effa0acd8d55c5cc045a9c;hb=078fc2851ceae061fe368f2bc09fcd16d67ae00f;hpb=ba87ca171f0a058f501655ffa6f6e845f2f800a6

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 7b64629..8942c76 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -280,9 +280,9 @@ getAccept = do acceptM <- getHeader "Accept"
                      -> return []
                  Just accept
                      -> case parseStr mimeTypeListP accept of
-                          (Success xs, _) -> return xs
-                          _               -> abort BadRequest []
-                                             (Just $ "Unparsable Accept: " ++ accept)
+                          (# Success xs, _ #) -> return xs
+                          (# _         , _ #) -> abort BadRequest []
+                                                 (Just $ "Unparsable Accept: " ++ accept)
 
 -- |Get a list of @(contentCoding, qvalue)@ enumerated on header
 -- \"Accept-Encoding\". The list is sorted in descending order by
@@ -305,9 +305,9 @@ getAcceptEncoding
                -> return [("identity", Nothing)]
            Just accEnc
                -> case parseStr acceptEncodingListP accEnc of
-                    (Success x, _) -> return $ reverse $ sortBy orderAcceptEncodings x
-                    _              -> abort BadRequest []
-                                      (Just $ "Unparsable Accept-Encoding: " ++ accEnc)
+                    (# Success x, _ #) -> return $ reverse $ sortBy orderAcceptEncodings x
+                    (# _        , _ #) -> abort BadRequest []
+                                          (Just $ "Unparsable Accept-Encoding: " ++ accEnc)
 
 -- |Check whether a given content-coding is acceptable.
 isEncodingAcceptable :: String -> Resource Bool
@@ -327,9 +327,9 @@ getContentType
                -> return Nothing
            Just cType
                -> case parseStr mimeTypeP cType of
-                    (Success t, _) -> return $ Just t
-                    _              -> abort BadRequest []
-                                      (Just $ "Unparsable Content-Type: " ++ cType)
+                    (# Success t, _ #) -> return $ Just t
+                    (# _        , _ #) -> abort BadRequest []
+                                          (Just $ "Unparsable Content-Type: " ++ cType)
 
 
 {- ExaminingRequest 時に使用するアクション群 -}
@@ -388,13 +388,14 @@ foundETag tag
            Nothing   -> return ()
            Just "*"  -> return ()
            Just list -> case parseStr eTagListP list of
-                          (Success tags, _)
+                          (# Success tags, _ #)
                               -- tags の中に一致するものが無ければ
                               -- PreconditionFailed で終了。
                               -> when (not $ any (== tag) tags)
                                  $ abort PreconditionFailed []
                                        $! Just ("The entity tag doesn't match: " ++ list)
-                          _   -> abort BadRequest [] $! Just ("Unparsable If-Match: " ++ fromJust ifMatch)
+                          (# _, _ #)
+                              -> abort BadRequest [] $! Just ("Unparsable If-Match: " ++ fromJust ifMatch)
 
          let statusForNoneMatch = if method == GET || method == HEAD then
                                       NotModified
@@ -407,10 +408,11 @@ foundETag tag
            Nothing   -> return ()
            Just "*"  -> abort statusForNoneMatch [] $! Just ("The entity tag matches: *")
            Just list -> case parseStr eTagListP list of
-                          (Success tags, _)
+                          (# Success tags, _ #)
                               -> when (any (== tag) tags)
                                  $ abort statusForNoneMatch [] $! Just ("The entity tag matches: " ++ list)
-                          _   -> abort BadRequest [] $! Just ("Unparsable If-None-Match: " ++ list)
+                          (# _, _ #)
+                              -> abort BadRequest [] $! Just ("Unparsable If-None-Match: " ++ list)
 
          driftTo GettingBody