Each instances of StatusCode should not be an instance of Eq.

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

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 704feda9c79ca2e5ab4619b1550166bdd8023f4c..97b2cbe3cb491c4b64853fe6a60bfab0895ca171 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -404,9 +404,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 +454,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 +612,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 (sc ≈ 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