Many improvements

[Lucu.git] / Network / HTTP / Lucu / Response.hs

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 1c19da4cc87babe36f9f407aed2fdf1615e2ff7f..54d57b2972abe824cfd1d1931a1682a87d531a24 100644 (file)
--- 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)