X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=cfff8197ddbaea7ea17d3d55be11398f8a76c714;hp=35c168fb38cde77ea2227cb2b808d00c9da79322;hb=51eda5b;hpb=19043d7882f936be9b073cae34b52905016c3ad7 diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index 35c168f..cfff819 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -1,20 +1,21 @@ {-# LANGUAGE - DeriveDataTypeable - , OverloadedStrings + OverloadedStrings , RecordWildCards - , UnboxedTuples , UnicodeSyntax , ViewPatterns #-} - -- |Definition of things related on HTTP response. module Network.HTTP.Lucu.Response - ( StatusCode(..) - , printStatusCode - + ( -- * Class and Types + StatusCode(..) + , SomeStatusCode(..) , Response(..) + , module Network.HTTP.Lucu.StatusCode + + -- * Functions , emptyResponse , resCanHaveBody + , printStatusCode , printResponse , isInformational @@ -25,84 +26,24 @@ module Network.HTTP.Lucu.Response , isServerError ) where -import Data.Ascii (Ascii, AsciiBuilder) +import Data.Ascii (AsciiBuilder) import qualified Data.Ascii as A import Data.Monoid.Unicode -import Data.Typeable import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.HttpVersion -import Network.HTTP.Lucu.Utils +import Network.HTTP.Lucu.StatusCode +import Network.HTTP.Lucu.StatusCode.Internal import Prelude.Unicode --- |This is the definition of HTTP status code. --- '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 - | Processing - -- - | Ok - | Created - | Accepted - | NonAuthoritativeInformation - | NoContent - | ResetContent - | PartialContent - | MultiStatus - -- - | MultipleChoices - | MovedPermanently - | Found - | SeeOther - | NotModified - | UseProxy - | TemporaryRedirect - -- - | BadRequest - | Unauthorized - | PaymentRequired - | Forbidden - | NotFound - | MethodNotAllowed - | NotAcceptable - | ProxyAuthenticationRequired - | RequestTimeout - | Conflict - | Gone - | LengthRequired - | PreconditionFailed - | RequestEntityTooLarge - | RequestURITooLarge - | UnsupportedMediaType - | RequestRangeNotSatisfiable - | ExpectationFailed - | UnprocessableEntitiy - | Locked - | FailedDependency - -- - | InternalServerError - | NotImplemented - | BadGateway - | ServiceUnavailable - | GatewayTimeout - | HttpVersionNotSupported - | InsufficientStorage - deriving (Eq, Show, Typeable) - -- |Convert a 'StatusCode' to an 'AsciiBuilder'. -printStatusCode ∷ StatusCode → AsciiBuilder +printStatusCode ∷ StatusCode sc ⇒ sc → AsciiBuilder {-# INLINEABLE printStatusCode #-} -printStatusCode (statusCode → (# num, msg #)) - = ( show3 num ⊕ - A.toAsciiBuilder " " ⊕ - A.toAsciiBuilder msg - ) +printStatusCode = A.toAsciiBuilder ∘ textualStatus -- |This is the definition of an HTTP response. data Response = Response { resVersion ∷ !HttpVersion - , resStatus ∷ !StatusCode + , resStatus ∷ !SomeStatusCode , resHeaders ∷ !Headers } deriving (Show, Eq) @@ -111,11 +52,11 @@ instance HasHeaders Response where setHeaders res hdr = res { resHeaders = hdr } -- |Returns an HTTP\/1.1 'Response' with no header fields. -emptyResponse ∷ StatusCode → Response +emptyResponse ∷ StatusCode sc ⇒ sc → Response emptyResponse sc = Response { resVersion = HttpVersion 1 1 - , resStatus = sc + , resStatus = fromStatusCode sc , resHeaders = (∅) } @@ -124,11 +65,11 @@ emptyResponse sc resCanHaveBody ∷ Response → Bool {-# INLINEABLE resCanHaveBody #-} resCanHaveBody (Response {..}) - | isInformational resStatus = False - | resStatus ≡ NoContent = False - | resStatus ≡ ResetContent = False - | resStatus ≡ NotModified = False - | otherwise = True + | isInformational resStatus = False + | toStatusCode resStatus ≡ Just NoContent = False + | toStatusCode resStatus ≡ Just ResetContent = False + | toStatusCode resStatus ≡ Just NotModified = False + | otherwise = True -- |Convert a 'Response' to 'AsciiBuilder'. printResponse ∷ Response → AsciiBuilder @@ -141,91 +82,35 @@ printResponse (Response {..}) printHeaders resHeaders -- |@'isInformational' sc@ returns 'True' iff @sc < 200@. -isInformational ∷ StatusCode → Bool +isInformational ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isInformational #-} isInformational = satisfy (< 200) -- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@. -isSuccessful ∷ StatusCode → Bool +isSuccessful ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isSuccessful #-} isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300) -- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@. -isRedirection ∷ StatusCode → Bool +isRedirection ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isRedirection #-} isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400) -- |@'isError' sc@ returns 'True' iff @400 <= sc@ -isError ∷ StatusCode → Bool +isError ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isError #-} isError = satisfy (≥ 400) -- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@. -isClientError ∷ StatusCode → Bool +isClientError ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isClientError #-} isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500) -- |@'isServerError' sc@ returns 'True' iff @500 <= sc@. -isServerError ∷ StatusCode → Bool +isServerError ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isServerError #-} isServerError = satisfy (≥ 500) -satisfy ∷ (Int → Bool) → StatusCode → Bool +satisfy ∷ StatusCode sc ⇒ (Int → Bool) → sc → Bool {-# INLINE satisfy #-} -satisfy p (statusCode → (# num, _ #)) = p num - -statusCode ∷ StatusCode → (# Int, Ascii #) -{-# INLINEABLE statusCode #-} - -statusCode Continue = (# 100, "Continue" #) -statusCode SwitchingProtocols = (# 101, "Switching Protocols" #) -statusCode Processing = (# 102, "Processing" #) - -statusCode Ok = (# 200, "OK" #) -statusCode Created = (# 201, "Created" #) -statusCode Accepted = (# 202, "Accepted" #) -statusCode NonAuthoritativeInformation = (# 203, "Non Authoritative Information" #) -statusCode NoContent = (# 204, "No Content" #) -statusCode ResetContent = (# 205, "Reset Content" #) -statusCode PartialContent = (# 206, "Partial Content" #) -statusCode MultiStatus = (# 207, "Multi Status" #) - -statusCode MultipleChoices = (# 300, "Multiple Choices" #) -statusCode MovedPermanently = (# 301, "Moved Permanently" #) -statusCode Found = (# 302, "Found" #) -statusCode SeeOther = (# 303, "See Other" #) -statusCode NotModified = (# 304, "Not Modified" #) -statusCode UseProxy = (# 305, "Use Proxy" #) -statusCode TemporaryRedirect = (# 306, "Temporary Redirect" #) - -statusCode BadRequest = (# 400, "Bad Request" #) -statusCode Unauthorized = (# 401, "Unauthorized" #) -statusCode PaymentRequired = (# 402, "Payment Required" #) -statusCode Forbidden = (# 403, "Forbidden" #) -statusCode NotFound = (# 404, "Not Found" #) -statusCode MethodNotAllowed = (# 405, "Method Not Allowed" #) -statusCode NotAcceptable = (# 406, "Not Acceptable" #) -statusCode ProxyAuthenticationRequired = (# 407, "Proxy Authentication Required" #) -statusCode RequestTimeout = (# 408, "Request Timeout" #) -statusCode Conflict = (# 409, "Conflict" #) -statusCode Gone = (# 410, "Gone" #) -statusCode LengthRequired = (# 411, "Length Required" #) -statusCode PreconditionFailed = (# 412, "Precondition Failed" #) -statusCode RequestEntityTooLarge = (# 413, "Request Entity Too Large" #) -statusCode RequestURITooLarge = (# 414, "Request URI Too Large" #) -statusCode UnsupportedMediaType = (# 415, "Unsupported Media Type" #) -statusCode RequestRangeNotSatisfiable = (# 416, "Request Range Not Satisfiable" #) -statusCode ExpectationFailed = (# 417, "Expectation Failed" #) -statusCode UnprocessableEntitiy = (# 422, "Unprocessable Entity" #) -statusCode Locked = (# 423, "Locked" #) -statusCode FailedDependency = (# 424, "Failed Dependency" #) - -statusCode InternalServerError = (# 500, "Internal Server Error" #) -statusCode NotImplemented = (# 501, "Not Implemented" #) -statusCode BadGateway = (# 502, "Bad Gateway" #) -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. +satisfy p (numericCode → num) = p num