-
-hPutResponse :: Handle -> Response -> IO ()
-hPutResponse h res = do hPutHttpVersion h (resVersion res)
- hPutChar h ' '
- hPutStatus h (resStatus res)
- hPutStr h "\r\n"
- hPutHeaders h (resHeaders res)
-
-hPutStatus :: Handle -> StatusCode -> IO ()
-hPutStatus h sc = let (num, msg) = statusCode sc
- in
- hPrintf h "%03d %s" num msg
-
-
-isInformational :: StatusCode -> Bool
-isInformational = doesMeet (< 200)
-
-isSuccessful :: StatusCode -> Bool
-isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
-
-isRedirection :: StatusCode -> Bool
-isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
-
-isError :: StatusCode -> Bool
-isError = doesMeet (>= 400)
-
-doesMeet :: (Int -> Bool) -> StatusCode -> Bool
-doesMeet p sc = let (num, _) = statusCode sc
- in
- p num
-
-
-statusCode :: StatusCode -> (Int, String)
-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")
\ No newline at end of file
+-- |Returns an HTTP\/1.1 'Response' with no header fields.
+emptyResponse ∷ StatusCode sc ⇒ sc → Response
+emptyResponse sc
+ = Response {
+ resVersion = HttpVersion 1 1
+ , resStatus = fromStatusCode 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
+{-# INLINEABLE resCanHaveBody #-}
+resCanHaveBody (Response {..})
+ | isInformational resStatus = False
+ | resStatus ≈ NoContent = False
+ | resStatus ≈ ResetContent = False
+ | resStatus ≈ NotModified = False
+ | otherwise = True
+
+-- |Convert a 'Response' to 'AsciiBuilder'.
+printResponse ∷ Response → AsciiBuilder
+{-# INLINEABLE printResponse #-}
+printResponse (Response {..})
+ = printHttpVersion resVersion ⊕
+ A.toAsciiBuilder " " ⊕
+ printStatusCode resStatus ⊕
+ A.toAsciiBuilder "\x0D\x0A" ⊕
+ printHeaders resHeaders
+
+-- |@'isInformational' sc@ returns 'True' iff @sc '<' 200@.
+isInformational ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isInformational #-}
+isInformational = satisfy (< 200)
+
+-- |@'isSuccessful' sc@ returns 'True' iff @200 '<=' sc '<' 300@.
+isSuccessful ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isSuccessful #-}
+isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
+
+-- |@'isRedirection' sc@ returns 'True' iff @300 '<=' sc '<' 400@.
+isRedirection ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isRedirection #-}
+isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
+
+-- |@'isError' sc@ returns 'True' iff @400 '<=' sc@
+isError ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isError #-}
+isError = satisfy (≥ 400)
+
+-- |@'isClientError' sc@ returns 'True' iff @400 '<=' sc '<' 500@.
+isClientError ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isClientError #-}
+isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
+
+-- |@'isServerError' sc@ returns 'True' iff @500 '<=' sc@.
+isServerError ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isServerError #-}
+isServerError = satisfy (≥ 500)
+
+satisfy ∷ StatusCode sc ⇒ (Int → Bool) → sc → Bool
+{-# INLINE satisfy #-}
+satisfy p (numericCode → num) = p num