Reimplement MultipartForm

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

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 547947b4726b94240f1e909bc0180f7f2e5e5f68..35c168fb38cde77ea2227cb2b808d00c9da79322 100644 (file)
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -13,6 +13,7 @@ module Network.HTTP.Lucu.Response
     , printStatusCode
 
     , Response(..)
+    , emptyResponse
     , resCanHaveBody
     , printResponse
 
@@ -22,8 +23,6 @@ module Network.HTTP.Lucu.Response
     , isError
     , isClientError
     , isServerError
-
-    , statusCode
     )
     where
 import Data.Ascii (Ascii, AsciiBuilder)
@@ -36,8 +35,8 @@ import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
 -- |This is the definition of HTTP status code.
--- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses
--- so you don't have to memorize, for instance, that \"Gateway
+-- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named status
+-- codes so you don't have to memorize, for instance, that \"Gateway
 -- Timeout\" is 504.
 data StatusCode = Continue
                 | SwitchingProtocols
@@ -91,7 +90,7 @@ data StatusCode = Continue
                 | InsufficientStorage
                   deriving (Eq, Show, Typeable)
 
--- |Convert a 'StatusCode' to 'AsciiBuilder'.
+-- |Convert a 'StatusCode' to an 'AsciiBuilder'.
 printStatusCode ∷ StatusCode → AsciiBuilder
 {-# INLINEABLE printStatusCode #-}
 printStatusCode (statusCode → (# num, msg #))
@@ -100,6 +99,7 @@ printStatusCode (statusCode → (# num, msg #))
         A.toAsciiBuilder msg
       )
 
+-- |This is the definition of an HTTP response.
 data Response = Response {
       resVersion ∷ !HttpVersion
     , resStatus  ∷ !StatusCode
@@ -107,11 +107,18 @@ data Response = Response {
     } deriving (Show, Eq)
 
 instance HasHeaders Response where
-    {-# INLINE getHeaders #-}
-    getHeaders = resHeaders
-    {-# INLINE setHeaders #-}
+    getHeaders         = resHeaders
     setHeaders res hdr = res { resHeaders = hdr }
 
+-- |Returns an HTTP\/1.1 'Response' with no header fields.
+emptyResponse ∷ StatusCode → Response
+emptyResponse sc
+    = Response {
+        resVersion = HttpVersion 1 1
+      , resStatus  = sc
+      , resHeaders = (∅)
+      }
+
 -- |Returns 'True' iff a given 'Response' allows the existence of
 -- response entity body.
 resCanHaveBody ∷ Response → Bool
@@ -167,8 +174,6 @@ satisfy ∷ (Int → Bool) → StatusCode → Bool
 {-# INLINE satisfy #-}
 satisfy p (statusCode → (# num, _ #)) = p num
 
--- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
--- representation of @sc@.
 statusCode ∷ StatusCode → (# Int, Ascii #)
 {-# INLINEABLE statusCode #-}
 
@@ -222,3 +227,5 @@ statusCode ServiceUnavailable          = (# 503, "Service Unavailable"
 statusCode GatewayTimeout              = (# 504, "Gateway Timeout"               #)
 statusCode HttpVersionNotSupported     = (# 505, "HTTP Version Not Supported"    #)
 statusCode InsufficientStorage         = (# 507, "Insufficient Storage"          #)
+-- FIXME: Textual representations should also include numbers.
+-- FIXME: StatusCode should be a type class rather than a type.