X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=975744c5164f30ee6323fc1b48a222b710fc5da8;hb=558205096e7f51da7018458d173584ac31808082;hp=298b9b2541edd0f4d3d8b170bccb6cc9965bfe4e;hpb=ca338174155913a969808d7b20193973394e474e;p=Lucu.git diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 298b9b2..975744c 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -5,7 +5,6 @@ , RecordWildCards , UnicodeSyntax #-} -{-# OPTIONS_HADDOCK prune #-} -- |This is the Resource Monad; monadic actions to define the behavior -- of each resources. The 'Resource' Monad is a kind of 'Prelude.IO' @@ -70,7 +69,7 @@ module Network.HTTP.Lucu.Resource -- * Types Resource , FormData(..) - , runRes -- private + , runRes -- * Actions @@ -457,7 +456,9 @@ foundETag tag method ← getMethod when (method ≡ GET ∨ method ≡ HEAD) - $ setHeader' "ETag" (printETag tag) + $ setHeader' "ETag" + $ A.fromAsciiBuilder + $ printETag tag when (method ≡ POST) $ abort InternalServerError [] (Just "Illegal computation of foundETag for POST request.") @@ -624,7 +625,7 @@ input limit $ fail ("inputLBS: limit must be positive: " ⧺ show actualLimit) -- Reader にリクエスト liftIO $ atomically - $ writeTVar itrReqBodyWanted (Just actualLimit) + $ writeTVar itrReqBodyWanted actualLimit -- 應答を待つ。トランザクションを分けなければ當然デッドロックする。 chunk ← liftIO $ atomically $ do chunkLen ← readTVar itrReceivedBodyLen @@ -692,7 +693,7 @@ inputChunk limit $ fail ("inputChunkLBS: limit must be positive: " ++ show actualLimit) -- Reader にリクエスト liftIO $ atomically - $ writeTVar itrReqBodyWanted (Just actualLimit) + $ writeTVar itrReqBodyWanted actualLimit -- 應答を待つ。トランザクションを分けなければ當然デッドロック。 chunk ← liftIO $ atomically $ do chunkLen ← readTVar itrReceivedBodyLen