X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=0dd73c96113971e2aa20d41f71eff4045bc1e6e6;hp=c8ca45d00579daff37db145dc98b217ab1f1a3d9;hb=cc55fb9;hpb=32a6ebbb18856ab1203e8a114414f235c2abe22b

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index c8ca45d..0dd73c9 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -239,7 +239,7 @@ getRemoteCertificate = itrRemoteCert <$> getInteraction
 getRequest ∷ Resource Request
 getRequest
     = do itr ← getInteraction
-         liftIO $ atomically $ readItr itrRequest fromJust itr
+         liftIO $ atomically $ fromJust <$> readItr itrRequest itr
 
 -- |Get the 'Method' value of the request.
 getMethod ∷ Resource Method
@@ -609,7 +609,7 @@ input ∷ Int → Resource Lazy.ByteString
 input limit
     = do driftTo GettingBody
          itr     ← getInteraction
-         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody id itr
+         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody itr
          chunk   ← if hasBody then
                        askForInput itr
                    else
@@ -628,7 +628,7 @@ input limit
                         $ fail ("inputLBS: limit must be positive: " ⧺ show actualLimit)
                -- Reader にリクエスト
                liftIO $ atomically
-                      $ do chunkLen ← readItr itrReqChunkLength id itr
+                      $ do chunkLen ← readItr itrReqChunkLength itr
                            writeItr itrWillReceiveBody True itr
                            if ((> actualLimit) <$> chunkLen) ≡ Just True then
                                -- 受信前から多過ぎる事が分かってゐる
@@ -637,8 +637,8 @@ input limit
                                writeItr itrReqBodyWanted (Just actualLimit) itr
                -- 應答を待つ。トランザクションを分けなければ當然デッドロックする。
                chunk ← liftIO $ atomically
-                       $ do chunkLen    ← readItr itrReceivedBodyLen id itr
-                            chunkIsOver ← readItr itrReqChunkIsOver  id itr
+                       $ do chunkLen    ← readItr itrReceivedBodyLen itr
+                            chunkIsOver ← readItr itrReqChunkIsOver  itr
                             if chunkLen < actualLimit then
                                 -- 要求された量に滿たなくて、まだ殘りが
                                 -- あるなら再試行。
@@ -651,7 +651,7 @@ input limit
                                     $ tooLarge actualLimit
                             -- 成功。itr 内にチャンクを置いたままにする
                             -- とメモリの無駄になるので除去。
-                            chunk ← readItr itrReceivedBody seqToLBS itr
+                            chunk ← seqToLBS <$> readItr itrReceivedBody itr
                             writeItr itrReceivedBody    (∅) itr
                             writeItr itrReceivedBodyLen 0   itr
                             return chunk
@@ -684,7 +684,7 @@ inputChunk ∷ Int → Resource Lazy.ByteString
 inputChunk limit
     = do driftTo GettingBody
          itr     ← getInteraction
-         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody id itr
+         hasBody ← liftIO $ atomically $ readItr itrRequestHasBody itr
          chunk   ← if hasBody then
                         askForInput itr
                     else
@@ -707,15 +707,15 @@ inputChunk limit
                            writeItr itrWillReceiveBody True itr
                -- 應答を待つ。トランザクションを分けなければ當然デッドロック。
                chunk ← liftIO $ atomically
-                       $ do chunkLen ← readItr itrReceivedBodyLen id itr
+                       $ do chunkLen ← readItr itrReceivedBodyLen itr
                             -- 要求された量に滿たなくて、まだ殘りがある
                             -- なら再試行。
                             when (chunkLen < actualLimit)
-                                $ do chunkIsOver ← readItr itrReqChunkIsOver id itr
+                                $ do chunkIsOver ← readItr itrReqChunkIsOver itr
                                      unless chunkIsOver
                                          $ retry
                             -- 成功
-                            chunk ← readItr itrReceivedBody seqToLBS itr
+                            chunk ← seqToLBS <$> readItr itrReceivedBody itr
                             writeItr itrReceivedBody    (∅) itr
                             writeItr itrReceivedBodyLen 0   itr
                             return chunk
@@ -906,7 +906,7 @@ outputChunk wholeChunk
                (Just $ "cnfMaxOutputChunkLength must be positive: " ⊕ T.pack (show limit))
 
          discardBody ← liftIO $ atomically $
-                       readItr itrWillDiscardBody id itr
+                       readItr itrWillDiscardBody itr
 
          unless (discardBody)
              $ sendChunks wholeChunk limit
@@ -949,7 +949,7 @@ outputChunk wholeChunk
 driftTo ∷ InteractionState → Resource ()
 driftTo newState
     = do itr ← getInteraction
-         liftIO $ atomically $ do oldState ← readItr itrState id itr
+         liftIO $ atomically $ do oldState ← readItr itrState itr
                                   if newState < oldState then
                                       throwStateError oldState newState
                                     else
@@ -977,9 +977,9 @@ driftTo newState
           = postprocess itr
 
       drift itr _ Done
-          = do bodyIsNull ← readItr itrSentNoBody id itr
+          = do bodyIsNull ← readItr itrSentNoBody itr
                when bodyIsNull
-                        $ writeDefaultPage itr
+                   $ writeDefaultPage itr
 
       drift _ _ _
           = return ()