StatusCode is now a type class, not an algebraic data type.

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

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 704feda9c79ca2e5ab4619b1550166bdd8023f4c..f7b90f925447a774d303b90458487611837d6562 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -161,6 +161,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time
 import qualified Data.Time.HTTP as HTTP
+import Data.Typeable
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Authentication
 import Network.HTTP.Lucu.Config
@@ -404,9 +405,9 @@ foundETag tag
 
          let statusForNoneMatch
                  = if method ≡ GET ∨ method ≡ HEAD then
-                       NotModified
+                       fromStatusCode NotModified
                    else
-                       PreconditionFailed
+                       fromStatusCode PreconditionFailed
 
          -- If-None-Match があればそれを見る。
          ifNoneMatch ← getHeader "If-None-Match"
@@ -454,9 +455,9 @@ foundTimeStamp timeStamp
 
          let statusForIfModSince
                  = if method ≡ GET ∨ method ≡ HEAD then
-                       NotModified
+                       fromStatusCode NotModified
                    else
-                       PreconditionFailed
+                       fromStatusCode PreconditionFailed
 
          -- If-Modified-Since があればそれを見る。
          ifModSince ← getHeader "If-Modified-Since"
@@ -612,16 +613,16 @@ getForm limit
 -- |@'redirect' code uri@ declares the response status as @code@ and
 -- \"Location\" header field as @uri@. The @code@ must satisfy
 -- 'isRedirection' or it raises an error.
-redirect ∷ StatusCode → URI → Resource ()
-redirect code uri
-    = do when (code ≡ NotModified ∨ not (isRedirection code))
+redirect ∷ StatusCode sc ⇒ sc → URI → Resource ()
+redirect sc uri
+    = do when (cast sc ≡ Just NotModified ∨ (¬) (isRedirection sc))
              $ abort
              $ mkAbortion' InternalServerError
              $ A.toText
              $ A.fromAsciiBuilder
              $ A.toAsciiBuilder "Attempted to redirect with status "
-             ⊕ printStatusCode code
-         setStatus code
+             ⊕ printStatusCode sc
+         setStatus sc
          setLocation uri
 
 -- |@'setContentType' mType@ declares the response header