X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FInteraction.hs;h=1c2679cd9eee65d14c5bf70d0a0b623e3abbe616;hb=cc55fb9a095c9c583ed6fe2ded3eaf6401fb760f;hp=3508a5156c6e4f05279cdabe7fef784f8970f673;hpb=0ff03469c29b791f2c609a659bbf59be97e306f2;p=Lucu.git diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs index 3508a51..1c2679c 100644 --- a/Network/HTTP/Lucu/Interaction.hs +++ b/Network/HTTP/Lucu/Interaction.hs @@ -17,7 +17,6 @@ module Network.HTTP.Lucu.Interaction ) where import Blaze.ByteString.Builder (Builder) -import Control.Applicative import Control.Concurrent.STM import Data.Ascii (Ascii) import qualified Data.ByteString as BS @@ -59,7 +58,7 @@ data Interaction = Interaction { , itrWillClose ∷ !(TVar Bool) , itrBodyToSend ∷ !(TMVar Builder) - , itrBodyIsNull ∷ !(TVar Bool) + , itrSentNoBody ∷ !(TVar Bool) , itrState ∷ !(TVar InteractionState) @@ -111,7 +110,7 @@ newInteraction !conf !port !addr !cert !req willClose ← newTVarIO False bodyToSend ← newEmptyTMVarIO - bodyIsNull ← newTVarIO True -- 一度でも bodyToSend が空でなくなったら False + sentNoBody ← newTVarIO True -- 一度でも bodyToSend が空でなくなったら False state ← newTVarIO ExaminingRequest @@ -145,7 +144,7 @@ newInteraction !conf !port !addr !cert !req , itrWillClose = willClose , itrBodyToSend = bodyToSend - , itrBodyIsNull = bodyIsNull + , itrSentNoBody = sentNoBody , itrState = state @@ -168,13 +167,13 @@ writeItr ∷ (Interaction → TVar a) → a → Interaction → STM () writeItr accessor a itr = writeTVar (accessor itr) a -readItr ∷ (Interaction → TVar a) → (a → b) → Interaction → STM b +readItr ∷ (Interaction → TVar a) → Interaction → STM a {-# INLINE readItr #-} -readItr accessor reader itr - = reader <$> readTVar (accessor itr) +readItr accessor itr + = readTVar (accessor itr) updateItr ∷ (Interaction → TVar a) → (a → a) → Interaction → STM () {-# INLINE updateItr #-} updateItr accessor updator itr - = do old ← readItr accessor id itr + = do old ← readItr accessor itr writeItr accessor (updator old) itr