X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=54d57b2972abe824cfd1d1931a1682a87d531a24;hp=1c19da4cc87babe36f9f407aed2fdf1615e2ff7f;hb=e624f0db8c4610b36da9e4463a656e0cb8a104dd;hpb=1e48e402adec79653203dc19a1800efa7b1c467b diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index 1c19da4..54d57b2 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -3,11 +3,14 @@ module Network.HTTP.Lucu.Response , Response(..) , hPutResponse -- Handle -> Response -> IO () , isInformational -- StatusCode -> Bool + , isSuccessful -- StatusCode -> Bool + , isRedirection -- StatusCode -> Bool , isError -- StatusCode -> Bool , statusCode -- StatusCode -> (Int, String) ) where +import Data.Dynamic import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.HttpVersion import System.IO @@ -63,7 +66,7 @@ data StatusCode = Continue | GatewayTimeout | HttpVersionNotSupported | InsufficientStorage - deriving (Eq) + deriving (Typeable, Eq) instance Show StatusCode where show sc = let (num, msg) = statusCode sc @@ -97,12 +100,21 @@ hPutStatus h sc = let (num, msg) = statusCode sc isInformational :: StatusCode -> Bool -isInformational sc = let (num, _) = statusCode sc - in num < 200 +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 sc = let (num, _) = statusCode sc - in num >= 400 +isError = doesMeet (>= 400) + +doesMeet :: (Int -> Bool) -> StatusCode -> Bool +doesMeet p sc = let (num, _) = statusCode sc + in + p num statusCode :: StatusCode -> (Int, String)