X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=acc62057549f0527e40daac13e6024ff7395bda6;hb=243b99439640480fc148d2e175247dacce04a222;hp=1abf14be8e6bc7782d47e97bb3ddda75128b8c3b;hpb=90fca0675b1694e69b8e431c989343855cbd125d;p=Lucu.git diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 1abf14b..acc6205 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -8,6 +8,7 @@ , QuasiQuotes , RecordWildCards , UnicodeSyntax + , ViewPatterns #-} -- |This is the Resource Monad; monadic actions to define a behavior -- of resource. The 'Rsrc' Monad is a kind of 'IO' Monad thus it @@ -181,6 +182,7 @@ import Network.HTTP.Lucu.Parser import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Resource.Internal import Network.HTTP.Lucu.Response +import Network.HTTP.Lucu.Response.StatusCode import Network.HTTP.Lucu.MIMEType import Network.HTTP.Lucu.Utils import Network.Socket hiding (accept) @@ -623,13 +625,13 @@ getForm limit -- \"Location\" header field as @uri@. The @code@ must satisfy -- 'isRedirection' or it raises an error. redirect ∷ StatusCode sc ⇒ sc → URI → Rsrc () -redirect sc uri - = do when (sc ≈ NotModified ∨ (¬) (isRedirection sc)) +redirect (fromStatusCode → sc) uri + = do when (sc ≡ cs NotModified ∨ (¬) (isRedirection sc)) $ abort $ mkAbortion' InternalServerError $ cs $ ("Attempted to redirect with status " ∷ Ascii) - ⊕ cs (fromStatusCode sc) + ⊕ cs sc setStatus sc setLocation uri