X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=f318fcf7ca7a9cb9a0b2ec7d14ec166ab54d9a84;hb=42aad5a;hp=191cebd3deaa7d5191ea5b02ac2ab411b3b4ba51;hpb=3318fe04b2d541a29228a96f69e0dcf81392a38f;p=Lucu.git diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index 191cebd..f318fcf 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -1,6 +1,9 @@ {-# LANGUAGE - OverloadedStrings + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings , RecordWildCards + , TemplateHaskell , UnicodeSyntax , ViewPatterns #-} @@ -8,19 +11,16 @@ module Network.HTTP.Lucu.Response ( -- * Class and Types StatusCode(..) - , SomeStatusCode(..) + , SomeStatusCode , Response(..) , statusCodes , module Network.HTTP.Lucu.StatusCode -- * Functions , emptyResponse + , setStatusCode , resCanHaveBody - , printStatusCode - , printResponse - , (≈) - , (≉) , isInformational , isSuccessful , isRedirection @@ -29,8 +29,11 @@ module Network.HTTP.Lucu.Response , isServerError ) where -import Data.Ascii (AsciiBuilder) -import qualified Data.Ascii as A +import Data.Ascii (Ascii, AsciiBuilder) +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Utils +import Data.Eq.Indirect import Data.Monoid.Unicode import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.HttpVersion @@ -38,11 +41,6 @@ import Network.HTTP.Lucu.StatusCode import Network.HTTP.Lucu.StatusCode.Internal import Prelude.Unicode --- |Convert a 'StatusCode' to an 'AsciiBuilder'. -printStatusCode ∷ StatusCode sc ⇒ sc → AsciiBuilder -{-# INLINEABLE printStatusCode #-} -printStatusCode = A.toAsciiBuilder ∘ textualStatus - -- |This is the definition of an HTTP response. data Response = Response { resVersion ∷ !HttpVersion @@ -54,6 +52,23 @@ instance HasHeaders Response where getHeaders = resHeaders setHeaders res hdr = res { resHeaders = hdr } +instance ConvertSuccess Response Ascii where + {-# INLINE convertSuccess #-} + convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder) + +instance ConvertSuccess Response AsciiBuilder where + {-# INLINE convertSuccess #-} + convertSuccess (Response {..}) + = cs resVersion ⊕ + cs (" " ∷ Ascii) ⊕ + cs resStatus ⊕ + cs ("\x0D\x0A" ∷ Ascii) ⊕ + cs resHeaders + +deriveAttempts [ ([t| Response |], [t| Ascii |]) + , ([t| Response |], [t| AsciiBuilder |]) + ] + -- |Returns an HTTP\/1.1 'Response' with no header fields. emptyResponse ∷ StatusCode sc ⇒ sc → Response emptyResponse sc @@ -63,53 +78,50 @@ emptyResponse 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 + | 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' 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' 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' 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' 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' 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' sc@ returns 'True' iff @500 '<=' sc@. isServerError ∷ StatusCode sc ⇒ sc → Bool {-# INLINE isServerError #-} isServerError = satisfy (≥ 500)