--- #prune
+{-# LANGUAGE
+ DeriveDataTypeable
+ , OverloadedStrings
+ , RecordWildCards
+ , UnboxedTuples
+ , UnicodeSyntax
+ , ViewPatterns
+ #-}
+{-# OPTIONS_HADDOCK prune #-}
-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
( StatusCode(..)
, Response(..)
+ , printStatusCode
, hPutResponse
, isInformational
, isSuccessful
, statusCode
)
where
-
-import Data.Dynamic
-import Network.HTTP.Lucu.Format
-import Network.HTTP.Lucu.Headers
-import Network.HTTP.Lucu.HttpVersion
-import System.IO
+import Data.Ascii (Ascii)
+import qualified Data.Ascii as A
+import Data.Monoid.Unicode
+import Data.Typeable
+import Network.HTTP.Lucu.HandleLike
+import Network.HTTP.Lucu.Headers
+import Network.HTTP.Lucu.HttpVersion
+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
| GatewayTimeout
| HttpVersionNotSupported
| InsufficientStorage
- deriving (Typeable, Eq)
-
-instance Show StatusCode where
- show sc = let (# num, msg #) = statusCode sc
- in
- (fmtDec 3 num) ++ " " ++ msg
+ deriving (Eq, Show, Typeable)
+-- |Convert a 'StatusCode' to 'Ascii'.
+printStatusCode ∷ StatusCode → Ascii
+printStatusCode (statusCode → (# num, msg #))
+ = A.fromAsciiBuilder $
+ ( show3 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 :: Handle -> Response -> IO ()
-hPutResponse h res
- = h `seq` res `seq`
- do hPutHttpVersion h (resVersion res)
+hPutResponse ∷ HandleLike h ⇒ h → Response → IO ()
+hPutResponse h (Response {..})
+ = do hPutHttpVersion h resVersion
hPutChar h ' '
- hPutStatus h (resStatus res)
- hPutStr h "\r\n"
- hPutHeaders h (resHeaders res)
+ hPutStatus h resStatus
+ hPutBS h "\r\n"
+ hPutHeaders h resHeaders
-hPutStatus :: Handle -> StatusCode -> IO ()
-hPutStatus h sc
- = h `seq` sc `seq`
- hPutStr h (show sc)
+hPutStatus ∷ HandleLike h ⇒ h → StatusCode → IO ()
+hPutStatus h (statusCode → (# num, msg #))
+ = do hPutBS h (A.toByteString $ A.fromAsciiBuilder $ show3 num)
+ hPutChar h ' '
+ hPutBS h (A.toByteString 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)
-
-
-doesMeet :: (Int -> Bool) -> StatusCode -> Bool
-doesMeet p sc = case statusCode sc of
- (# num, _ #) -> p num
+isServerError ∷ StatusCode → Bool
+isServerError = doesMeet (≥ 500)
+doesMeet ∷ (Int → Bool) → StatusCode → Bool
+{-# INLINE doesMeet #-}
+doesMeet p (statusCode → (# num, _ #)) = p num
-- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
-- representation of @sc@.
-statusCode :: StatusCode -> (# Int, String #)
+statusCode ∷ StatusCode → (# Int, Ascii #)
statusCode Continue = (# 100, "Continue" #)
statusCode SwitchingProtocols = (# 101, "Switching Protocols" #)
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
+statusCode InsufficientStorage = (# 507, "Insufficient Storage" #)