, writeItr
, readItr
- , readItrF
, updateItr
- , updateItrF
)
where
+import Blaze.ByteString.Builder (Builder)
import Control.Applicative
import Control.Concurrent.STM
import Data.Ascii (Ascii)
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
import OpenSSL.X509
-import Prelude.Unicode
data Interaction = Interaction {
itrConfig ∷ !Config
, itrReqBodyWanted ∷ !(TVar (Maybe Int))
, itrReqBodyWasteAll ∷ !(TVar Bool)
, itrReceivedBody ∷ !(TVar (Seq BS.ByteString))
+ , itrReceivedBodyLen ∷ !(TVar Int)
, itrWillReceiveBody ∷ !(TVar Bool)
, itrWillChunkBody ∷ !(TVar Bool)
, itrWillDiscardBody ∷ !(TVar Bool)
, itrWillClose ∷ !(TVar Bool)
- , itrBodyToSend ∷ !(TVar (Seq BS.ByteString))
+ , itrBodyToSend ∷ !(TMVar Builder)
, itrBodyIsNull ∷ !(TVar Bool)
, itrState ∷ !(TVar InteractionState)
reqBodyWanted ← newTVarIO Nothing -- Resource が要求してゐるチャンク長
reqBodyWasteAll ← newTVarIO False -- 殘りの body を讀み捨てよと云ふ要求
receivedBody ← newTVarIO S.empty
+ receivedBodyLen ← newTVarIO 0
willReceiveBody ← newTVarIO False
willChunkBody ← newTVarIO False
willDiscardBody ← newTVarIO False
willClose ← newTVarIO False
- bodyToSend ← newTVarIO S.empty
+ bodyToSend ← newEmptyTMVarIO
bodyIsNull ← newTVarIO True -- 一度でも bodyToSend が空でなくなったら False
state ← newTVarIO ExaminingRequest
, itrReqBodyWanted = reqBodyWanted
, itrReqBodyWasteAll = reqBodyWasteAll
, itrReceivedBody = receivedBody
+ , itrReceivedBodyLen = receivedBodyLen
, itrWillReceiveBody = willReceiveBody
, itrWillChunkBody = willChunkBody
, itrWroteHeader = wroteHeader
}
-writeItr ∷ Interaction → (Interaction → TVar a) → a → STM ()
+{-
+chunksToLBS ∷ Seq BS.ByteString → LBS.ByteString
+{-# INLINE chunksToLBS #-}
+chunksToLBS = LBS.fromChunks ∘ toList
+
+chunksFromLBS ∷ LBS.ByteString → Seq BS.ByteString
+{-# INLINE chunksFromLBS #-}
+chunksFromLBS = S.fromList ∘ LBS.toChunks
+-}
+
+writeItr ∷ (Interaction → TVar a) → a → Interaction → STM ()
{-# INLINE writeItr #-}
-writeItr itr accessor
- = writeTVar (accessor itr)
+writeItr accessor a itr
+ = writeTVar (accessor itr) a
-readItr ∷ Interaction → (Interaction → TVar a) → (a → b) → STM b
+readItr ∷ (Interaction → TVar a) → (a → b) → Interaction → STM b
{-# INLINE readItr #-}
-readItr itr accessor reader
+readItr accessor reader itr
= reader <$> readTVar (accessor itr)
-readItrF ∷ Functor f => Interaction → (Interaction → TVar (f a)) → (a → b) → STM (f b)
-{-# INLINE readItrF #-}
-readItrF itr accessor reader
- = readItr itr accessor (fmap reader)
-
-updateItr ∷ Interaction → (Interaction → TVar a) → (a → a) → STM ()
+updateItr ∷ (Interaction → TVar a) → (a → a) → Interaction → STM ()
{-# INLINE updateItr #-}
-updateItr itr accessor updator
- = do old ← readItr itr accessor id
- writeItr itr accessor (updator old)
-
-updateItrF ∷ Functor f => Interaction → (Interaction → TVar (f a)) → (a → a) → STM ()
-{-# INLINE updateItrF #-}
-updateItrF itr accessor
- = updateItr itr accessor ∘ fmap
+updateItr accessor updator itr
+ = do old ← readItr accessor id itr
+ writeItr accessor (updator old) itr