From: PHO <pho@cielonegro.org>
Date: Mon, 14 Nov 2011 02:11:18 +0000 (+0900)
Subject: code cleanup
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=8cd9d79234344199a1644f661684bde3ed5e440b;p=Lucu.git

code cleanup
---

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 018ee00..fecb815 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -24,7 +24,6 @@ module Network.HTTP.Lucu.Interaction
     , InteractionQueue
     , mkInteractionQueue
 
-    , setResponseStatus
     , getCurrentDate
     )
     where
@@ -230,14 +229,5 @@ type InteractionQueue = TVar (Seq SomeInteraction)
 mkInteractionQueue ∷ IO InteractionQueue
 mkInteractionQueue = newTVarIO (∅)
 
--- FIXME: Response.hs should provide setStatus ∷ sc → Response → Response
-setResponseStatus ∷ StatusCode sc ⇒ NormalInteraction → sc → STM ()
-setResponseStatus (NI {..}) sc
-    = do res ← readTVar niResponse
-         let res' = res {
-                      resStatus = fromStatusCode sc
-                    }
-         writeTVar niResponse res'
-
 getCurrentDate ∷ IO Ascii
 getCurrentDate = HTTP.toAscii <$> getCurrentTime
diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs
index e34512d..54be5f3 100644
--- a/Network/HTTP/Lucu/Resource/Internal.hs
+++ b/Network/HTTP/Lucu/Resource/Internal.hs
@@ -318,7 +318,8 @@ setStatus sc
                 $ do state ← readTVar $ niState ni
                      when (state > DecidingHeader)
                          $ fail "Too late to declare the response status."
-                     setResponseStatus ni sc
+                     res ← readTVar $ niResponse ni
+                     writeTVar (niResponse ni) $ setStatusCode sc res
 
 -- |@'setHeader' name value@ declares the value of the response header
 -- @name@ as @value@. Note that this function is not intended to be
diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 191cebd..826cc0e 100644
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -15,6 +15,7 @@ module Network.HTTP.Lucu.Response
 
       -- * Functions
     , emptyResponse
+    , setStatusCode
     , resCanHaveBody
     , printStatusCode
     , printResponse
@@ -63,6 +64,13 @@ emptyResponse sc
       , resHeaders = (∅)
       }
 
+-- |@'setStatusCode' sc res@ sets the status code of @res@ to @sc@.
+setStatusCode ∷ StatusCode sc ⇒ sc → Response → Response
+setStatusCode sc res
+    = res {
+        resStatus = fromStatusCode sc
+      }
+
 -- |Returns 'True' iff a given 'Response' allows the existence of
 -- response entity body.
 resCanHaveBody ∷ Response → Bool