code cleanup

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 018ee00d0eaa65e197c508a8d8d7c968d2fb3fe2..fecb81543083babe065501dc03d4d52a529cee94 100644 (file)
--- 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 e34512dd449614562ec9783d362a62182284aa95..54be5f3934f5755c24a152850e6a8227f5a72146 100644 (file)
--- 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 191cebd3deaa7d5191ea5b02ac2ab411b3b4ba51..826cc0e0ce5d035e9a5aacd2999f59702366ccd8 100644 (file)
--- 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