ResponseWriter now compiles.

[Lucu.git] / Network / HTTP / Lucu / Postprocess.hs

diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs
index 0e089cac47e7cb00504abefc8e3230e4393e0cc1..1a00b00b0eab578bca9db5d52e3e6bf4003abf46 100644 (file)
--- a/Network/HTTP/Lucu/Postprocess.hs
+++ b/Network/HTTP/Lucu/Postprocess.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE
-    BangPatterns
-  , DoAndIfThenElse
+    DoAndIfThenElse
   , OverloadedStrings
   , UnicodeSyntax
   #-}
@@ -63,9 +62,9 @@ import Prelude.Unicode
 -}
 
 postprocess ∷ Interaction → STM ()
-postprocess !itr
-    = do reqM ← readItr itrRequest  id itr
-         res  ← readItr itrResponse id itr
+postprocess itr
+    = do reqM ← readItr itrRequest  itr
+         res  ← readItr itrResponse itr
          let sc = resStatus res
 
          unless (any (\ p → p sc) [isSuccessful, isRedirection, isError])
@@ -98,15 +97,15 @@ postprocess !itr
 
          -- itrResponse の内容は relyOnRequest によって變へられてゐる可
          -- 能性が高い。
-         do oldRes ← readItr itrResponse id itr
+         do oldRes ← readItr itrResponse itr
             newRes ← unsafeIOToSTM
                      $ completeUnconditionalHeaders (itrConfig itr) oldRes
             writeItr itrResponse newRes itr
     where
       relyOnRequest ∷ STM ()
       relyOnRequest
-          = do status ← readItr itrResponse resStatus itr
-               req    ← readItr itrRequest  fromJust  itr
+          = do status ← resStatus <$> readItr itrResponse itr
+               req    ← fromJust  <$> readItr itrRequest  itr
 
                let reqVer      = reqVersion req
                    canHaveBody = if reqMethod req ≡ HEAD then
@@ -141,7 +140,7 @@ postprocess !itr
                  Just value → when (A.toCIAscii value ≡ "close")
                                   $ writeItr itrWillClose True itr
 
-               willClose ← readItr itrWillClose id itr
+               willClose ← readItr itrWillClose itr
                when willClose
                    $ updateRes $ setHeader "Connection" "close"
 
@@ -150,7 +149,7 @@ postprocess !itr
 
       readHeader ∷ CIAscii → STM (Maybe Ascii)
       {-# INLINE readHeader #-}
-      readHeader k = readItr itrResponse (getHeader k) itr
+      readHeader k = getHeader k <$> readItr itrResponse itr
 
       updateRes ∷ (Response → Response) → STM ()
       {-# INLINE updateRes #-}