- writeContinueIfNecessary :: Interaction -> STM (IO ())
- writeContinueIfNecessary itr
- = do expectedContinue <- readItr itr itrExpectedContinue id
- if expectedContinue then
- do wroteContinue <- readItr itr itrWroteContinue id
- if wroteContinue then
- -- 既に Continue を書込み濟
- retry
- else
- do reqBodyWanted <- readItr itr itrReqBodyWanted id
- if reqBodyWanted /= Nothing then
- return $ writeContinue itr
- else
- retry
- else
- retry
-
- writeHeaderOrBodyIfNecessary :: Interaction -> STM (IO ())
- writeHeaderOrBodyIfNecessary itr
- -- DecidingBody 以降の状態にあり、まだヘッダを出力する前であ
- -- れば、ヘッダを出力する。ヘッダ出力後であり、bodyToSend が
- -- 空でなければ、それを出力する。空である時は、もし状態が
- -- Done であれば後処理をする。
- = do wroteHeader <- readItr itr itrWroteHeader id
-
- if not wroteHeader then
- return $ writeHeader itr
- else
- do bodyToSend <- readItr itr itrBodyToSend id
-
- if B.null bodyToSend then
- do state <- readItr itr itrState id
-
- if state == Done then
- return $ finalize itr
- else
- retry
- else
- return $ writeBodyChunk itr
+writeContinueIfNeeded ∷ HandleLike h ⇒ Context h → Interaction → STM (IO ())
+writeContinueIfNeeded ctx itr@(Interaction {..})
+ = do expectedContinue ← readTVar itrExpectedContinue
+ if expectedContinue then
+ do wroteContinue ← readTVar itrWroteContinue
+ if wroteContinue then
+ -- 既に Continue を書込み濟
+ retry
+ else
+ do reqBodyWanted ← readTVar itrReqBodyWanted
+ if reqBodyWanted ≢ Nothing then
+ return $ writeContinue ctx itr
+ else
+ retry
+ else
+ retry