X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=547947b4726b94240f1e909bc0180f7f2e5e5f68;hp=a593b3ad928a6710e932edfd0a2711d8a9d80b59;hb=72a3e24;hpb=895341e8b790e969be678c5cfb85c878e321c8fc diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index a593b3a..547947b 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -10,15 +10,19 @@ -- |Definition of things related on HTTP response. module Network.HTTP.Lucu.Response ( StatusCode(..) - , Response(..) , printStatusCode + + , Response(..) + , resCanHaveBody , printResponse + , isInformational , isSuccessful , isRedirection , isError , isClientError , isServerError + , statusCode ) where @@ -89,6 +93,7 @@ data StatusCode = Continue -- |Convert a 'StatusCode' to 'AsciiBuilder'. printStatusCode ∷ StatusCode → AsciiBuilder +{-# INLINEABLE printStatusCode #-} printStatusCode (statusCode → (# num, msg #)) = ( show3 num ⊕ A.toAsciiBuilder " " ⊕ @@ -102,11 +107,25 @@ data Response = Response { } deriving (Show, Eq) instance HasHeaders Response where + {-# INLINE getHeaders #-} getHeaders = resHeaders + {-# INLINE setHeaders #-} setHeaders res hdr = res { resHeaders = hdr } +-- |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 " " ⊕ @@ -114,37 +133,44 @@ printResponse (Response {..}) A.toAsciiBuilder "\x0D\x0A" ⊕ printHeaders resHeaders --- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@. +-- |@'isInformational' sc@ returns 'True' iff @sc < 200@. isInformational ∷ StatusCode → Bool -isInformational = doesMeet (< 200) +{-# INLINE isInformational #-} +isInformational = satisfy (< 200) --- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@. +-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@. isSuccessful ∷ StatusCode → Bool -isSuccessful = doesMeet (\ n → n ≥ 200 ∧ n < 300) +{-# INLINE isSuccessful #-} +isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300) --- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@. +-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@. isRedirection ∷ StatusCode → Bool -isRedirection = doesMeet (\ n → n ≥ 300 ∧ n < 400) +{-# INLINE isRedirection #-} +isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400) --- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@ +-- |@'isError' sc@ returns 'True' iff @400 <= sc@ isError ∷ StatusCode → Bool -isError = doesMeet (≥ 400) +{-# INLINE isError #-} +isError = satisfy (≥ 400) --- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@. +-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@. isClientError ∷ StatusCode → Bool -isClientError = doesMeet (\ n → n ≥ 400 ∧ n < 500) +{-# INLINE isClientError #-} +isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500) --- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@. +-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@. isServerError ∷ StatusCode → Bool -isServerError = doesMeet (≥ 500) +{-# INLINE isServerError #-} +isServerError = satisfy (≥ 500) -doesMeet ∷ (Int → Bool) → StatusCode → Bool -{-# INLINE doesMeet #-} -doesMeet p (statusCode → (# num, _ #)) = p num +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 #-} statusCode Continue = (# 100, "Continue" #) statusCode SwitchingProtocols = (# 101, "Switching Protocols" #)