The parser now returns unboxed tuple.

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

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 091a3a2f92e31735641e4bf46fc6dba7431deb39..8760cb80f45212bd041a9d0b454745fd1030ccd8 100644 (file)
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -50,9 +50,9 @@ requestReader cnf tree h addr tQueue
                -- Request 應答を設定し、それを出力してから切斷するやう
                -- に ResponseWriter に通知する。
                case parse requestP input of
-                 (Success req , input') -> acceptParsableRequest req input'
-                 (IllegalInput, _     ) -> acceptNonparsableRequest BadRequest
-                 (ReachedEOF  , _     ) -> acceptNonparsableRequest BadRequest
+                 (# Success req , input' #) -> acceptParsableRequest req input'
+                 (# IllegalInput, _      #) -> acceptNonparsableRequest BadRequest
+                 (# ReachedEOF  , _      #) -> acceptNonparsableRequest BadRequest
 
       acceptNonparsableRequest :: StatusCode -> IO ()
       acceptNonparsableRequest status
@@ -150,7 +150,7 @@ requestReader cnf tree h addr tQueue
                                                   -- 讀み終へてゐない
                                                   do let (_, input') = B.splitAt (fromIntegral
                                                                                   $ fromJust remainingM) input
-                                                         (footerR, input'') = parse chunkFooterP input'
+                                                         (# footerR, input'' #) = parse chunkFooterP input'
 
                                                      if footerR == Success () then
                                                          -- チャンクフッタを正常に讀めた
@@ -188,10 +188,11 @@ requestReader cnf tree h addr tQueue
                                               if newRemaining == Just 0 then
                                                   -- チャンクフッタを讀む
                                                   case parse chunkFooterP input' of
-                                                    (Success _, input'')
+                                                    (# Success _, input'' #)
                                                         -> do updateStates
                                                               return $ observeChunkedRequest itr input''
-                                                    _   -> return $ chunkWasMalformed itr
+                                                    (# _, _ #)
+                                                        -> return $ chunkWasMalformed itr
                                                 else
                                                   -- まだチャンクの終はりに達してゐない
                                                   do updateStates
@@ -206,23 +207,25 @@ requestReader cnf tree h addr tQueue
           = {-# SCC "seekNextChunk" #-}
             case parse chunkHeaderP input of
               -- 最終チャンク (中身が空)
-              (Success 0, input')
+              (# Success 0, input' #)
                   -> case parse chunkTrailerP input' of
-                       (Success _, input'')
+                       (# Success _, input'' #)
                            -> do writeItr itr itrReqChunkLength $ Nothing
                                  writeItr itr itrReqChunkRemaining $ Nothing
                                  writeItr itr itrReqChunkIsOver True
                                  
                                  return $ acceptRequest input''
-                       _   -> return $ chunkWasMalformed itr
+                       (# _, _ #)
+                           -> return $ chunkWasMalformed itr
               -- 最終でないチャンク
-              (Success len, input')
+              (# Success len, input' #)
                   -> do writeItr itr itrReqChunkLength $ Just len
                         writeItr itr itrReqChunkRemaining $ Just len
                         
                         return $ observeChunkedRequest itr input'
               -- チャンクヘッダがをかしい
-              _   -> return $ chunkWasMalformed itr
+              (# _, _ #)
+                  -> return $ chunkWasMalformed itr
 
       chunkWasMalformed :: Interaction -> IO ()
       chunkWasMalformed itr