X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=35c168fb38cde77ea2227cb2b808d00c9da79322;hb=48bc90d;hp=547947b4726b94240f1e909bc0180f7f2e5e5f68;hpb=72a3e24a952616e32845eeb4fc05048e841c91a2;p=Lucu.git diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index 547947b..35c168f 100644 --- 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.