{-# LANGUAGE
DeriveDataTypeable
+ , OverloadedStrings
, UnboxedTuples
, UnicodeSyntax
+ , ViewPatterns
#-}
{-# OPTIONS_HADDOCK prune #-}
module Network.HTTP.Lucu.Response
( StatusCode(..)
, Response(..)
+ , printStatusCode
, hPutResponse
, isInformational
, isSuccessful
, statusCode
)
where
-
+import Data.Ascii (Ascii)
+import qualified Data.Ascii as A
import qualified Data.ByteString as Strict (ByteString)
import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
-import Data.Typeable
-import Network.HTTP.Lucu.Format
-import Network.HTTP.Lucu.HandleLike
-import Network.HTTP.Lucu.Headers
-import Network.HTTP.Lucu.HttpVersion
+import Data.Monoid.Unicode
+import Data.Typeable
+import Network.HTTP.Lucu.Format
+import Network.HTTP.Lucu.HandleLike
+import Network.HTTP.Lucu.Headers
+import Network.HTTP.Lucu.HttpVersion
+import Prelude.Unicode
-- |This is the definition of HTTP status code.
-- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses
| GatewayTimeout
| HttpVersionNotSupported
| InsufficientStorage
- deriving (Typeable, Eq)
-
-instance Show StatusCode where
- show sc = case statusCode sc of
- (# num, msg #)
- -> (fmtDec 3 num) ++ " " ++ C8.unpack msg
+ deriving (Eq, Show, Typeable)
+-- |Convert a 'StatusCode' to 'Ascii'.
+printStatusCode ∷ StatusCode → Ascii
+printStatusCode (statusCode → (# num, msg #))
+ = A.fromAsciiBuilder $
+ ( fmtDec 3 num ⊕
+ A.toAsciiBuilder " " ⊕
+ A.toAsciiBuilder msg
+ )
data Response = Response {
- resVersion :: !HttpVersion
- , resStatus :: !StatusCode
- , resHeaders :: !Headers
+ resVersion ∷ !HttpVersion
+ , resStatus ∷ !StatusCode
+ , resHeaders ∷ !Headers
} deriving (Show, Eq)
-
instance HasHeaders Response where
getHeaders = resHeaders
setHeaders res hdr = res { resHeaders = hdr }
-
-hPutResponse :: HandleLike h => h -> Response -> IO ()
+hPutResponse ∷ HandleLike h => h → Response → IO ()
hPutResponse h res
- = h `seq` res `seq`
- do hPutHttpVersion h (resVersion res)
+ = do hPutHttpVersion h (resVersion res)
hPutChar h ' '
hPutStatus h (resStatus res)
- hPutBS h (C8.pack "\r\n")
+ hPutBS h "\r\n"
hPutHeaders h (resHeaders res)
-hPutStatus :: HandleLike h => h -> StatusCode -> IO ()
+hPutStatus ∷ HandleLike h => h → StatusCode → IO ()
hPutStatus h sc
- = h `seq` sc `seq`
- case statusCode sc of
+ = case statusCode sc of
(# num, msg #)
- -> do hPutStr h (fmtDec 3 num)
- hPutChar h ' '
- hPutBS h msg
-
+ → do hPutStr h (fmtDec 3 num)
+ hPutChar h ' '
+ hPutBS h msg
-- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
-isInformational :: StatusCode -> Bool
+isInformational ∷ StatusCode → Bool
isInformational = doesMeet (< 200)
-- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
-isSuccessful :: StatusCode -> Bool
-isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
+isSuccessful ∷ StatusCode → Bool
+isSuccessful = doesMeet (\ n → n ≥ 200 ∧ n < 300)
-- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
-isRedirection :: StatusCode -> Bool
-isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
+isRedirection ∷ StatusCode → Bool
+isRedirection = doesMeet (\ n → n ≥ 300 ∧ n < 400)
-- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
-isError :: StatusCode -> Bool
-isError = doesMeet (>= 400)
+isError ∷ StatusCode → Bool
+isError = doesMeet (≥ 400)
-- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
-isClientError :: StatusCode -> Bool
-isClientError = doesMeet (\ n -> n >= 400 && n < 500)
+isClientError ∷ StatusCode → Bool
+isClientError = doesMeet (\ n → n ≥ 400 ∧ n < 500)
-- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
-isServerError :: StatusCode -> Bool
-isServerError = doesMeet (>= 500)
+isServerError ∷ StatusCode → Bool
+isServerError = doesMeet (≥ 500)
-doesMeet :: (Int -> Bool) -> StatusCode -> Bool
+doesMeet ∷ (Int → Bool) → StatusCode → Bool
doesMeet p sc = case statusCode sc of
- (# num, _ #) -> p num
+ (# num, _ #) → p num
-- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
-- representation of @sc@.
-statusCode :: StatusCode -> (# Int, Strict.ByteString #)
-
-statusCode Continue = (# 100, C8.pack "Continue" #)
-statusCode SwitchingProtocols = (# 101, C8.pack "Switching Protocols" #)
-statusCode Processing = (# 102, C8.pack "Processing" #)
-
-statusCode Ok = (# 200, C8.pack "OK" #)
-statusCode Created = (# 201, C8.pack "Created" #)
-statusCode Accepted = (# 202, C8.pack "Accepted" #)
-statusCode NonAuthoritativeInformation = (# 203, C8.pack "Non Authoritative Information" #)
-statusCode NoContent = (# 204, C8.pack "No Content" #)
-statusCode ResetContent = (# 205, C8.pack "Reset Content" #)
-statusCode PartialContent = (# 206, C8.pack "Partial Content" #)
-statusCode MultiStatus = (# 207, C8.pack "Multi Status" #)
-
-statusCode MultipleChoices = (# 300, C8.pack "Multiple Choices" #)
-statusCode MovedPermanently = (# 301, C8.pack "Moved Permanently" #)
-statusCode Found = (# 302, C8.pack "Found" #)
-statusCode SeeOther = (# 303, C8.pack "See Other" #)
-statusCode NotModified = (# 304, C8.pack "Not Modified" #)
-statusCode UseProxy = (# 305, C8.pack "Use Proxy" #)
-statusCode TemporaryRedirect = (# 306, C8.pack "Temporary Redirect" #)
-
-statusCode BadRequest = (# 400, C8.pack "Bad Request" #)
-statusCode Unauthorized = (# 401, C8.pack "Unauthorized" #)
-statusCode PaymentRequired = (# 402, C8.pack "Payment Required" #)
-statusCode Forbidden = (# 403, C8.pack "Forbidden" #)
-statusCode NotFound = (# 404, C8.pack "Not Found" #)
-statusCode MethodNotAllowed = (# 405, C8.pack "Method Not Allowed" #)
-statusCode NotAcceptable = (# 406, C8.pack "Not Acceptable" #)
-statusCode ProxyAuthenticationRequired = (# 407, C8.pack "Proxy Authentication Required" #)
-statusCode RequestTimeout = (# 408, C8.pack "Request Timeout" #)
-statusCode Conflict = (# 409, C8.pack "Conflict" #)
-statusCode Gone = (# 410, C8.pack "Gone" #)
-statusCode LengthRequired = (# 411, C8.pack "Length Required" #)
-statusCode PreconditionFailed = (# 412, C8.pack "Precondition Failed" #)
-statusCode RequestEntityTooLarge = (# 413, C8.pack "Request Entity Too Large" #)
-statusCode RequestURITooLarge = (# 414, C8.pack "Request URI Too Large" #)
-statusCode UnsupportedMediaType = (# 415, C8.pack "Unsupported Media Type" #)
-statusCode RequestRangeNotSatisfiable = (# 416, C8.pack "Request Range Not Satisfiable" #)
-statusCode ExpectationFailed = (# 417, C8.pack "Expectation Failed" #)
-statusCode UnprocessableEntitiy = (# 422, C8.pack "Unprocessable Entity" #)
-statusCode Locked = (# 423, C8.pack "Locked" #)
-statusCode FailedDependency = (# 424, C8.pack "Failed Dependency" #)
-
-statusCode InternalServerError = (# 500, C8.pack "Internal Server Error" #)
-statusCode NotImplemented = (# 501, C8.pack "Not Implemented" #)
-statusCode BadGateway = (# 502, C8.pack "Bad Gateway" #)
-statusCode ServiceUnavailable = (# 503, C8.pack "Service Unavailable" #)
-statusCode GatewayTimeout = (# 504, C8.pack "Gateway Timeout" #)
-statusCode HttpVersionNotSupported = (# 505, C8.pack "HTTP Version Not Supported" #)
-statusCode InsufficientStorage = (# 507, C8.pack "Insufficient Storage" #)
\ No newline at end of file
+statusCode ∷ StatusCode → (# Int, Ascii #)
+
+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" #)
projects / Lucu.git / blobdiff