]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/Abortion/Internal.hs
docs
[Lucu.git] / Network / HTTP / Lucu / Abortion / Internal.hs
index 93fb8da44a70d87375d79bf47cb763385ba75450..69d7a9e9b247ce23a7b725afca47964e70ca616d 100644 (file)
@@ -12,7 +12,7 @@ import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
 import Control.Arrow.ListArrow
 import Control.Arrow.Unicode
 import Control.Exception
-import Data.Collections
+import Data.Monoid.Unicode
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Typeable
@@ -26,12 +26,12 @@ import Text.XML.HXT.Arrow.XmlArrow
 import Text.XML.HXT.Arrow.XmlState
 
 -- |'Abortion' is an 'Exception' that aborts the execution of
--- 'Network.HTTP.Lucu.Resource.Resource' monad with a 'StatusCode',
--- additional response headers, and an optional message text.
+-- 'Network.HTTP.Lucu.Rsrc' monad with a 'StatusCode', additional
+-- response headers, and an optional message text.
 --
--- 1. If the 'Network.HTTP.Lucu.Resource.Resource' is in the /Deciding
---    Header/ or any precedent states, throwing an 'Abortion' affects
---    the HTTP response to be sent to the client.
+-- 1. If the 'Network.HTTP.Lucu.Rsrc' is in the /Deciding Header/ or
+--    any precedent states, throwing an 'Abortion' affects the HTTP
+--    response to be sent to the client.
 --
 -- 2. Otherwise it's too late to overwrite the HTTP response so the
 --    only possible thing the system can do is to dump the exception
@@ -41,9 +41,11 @@ import Text.XML.HXT.Arrow.XmlState
 -- 'isError' so you can abuse this exception for redirections as well
 -- as error reporting e.g.
 --
--- > abort $ mkAbortion MovedPermanently
--- >         [("Location", "http://example.net/")]
--- >         "It has been moved to example.net"
+-- @
+--   'Network.HTTP.Lucu.abort' '$' 'Network.HTTP.Lucu.mkAbortion' 'MovedPermanently'
+--           [(\"Location\", \"http://example.net/\")]
+--           ('Just' \"It's been moved to example.net.\")
+-- @
 data Abortion = Abortion {
       aboStatus  ∷ !SomeStatusCode
     , aboHeaders ∷ !Headers
@@ -69,7 +71,7 @@ abortPage conf reqM res abo
         Nothing
             → let res' = res {
                             resStatus  = aboStatus abo
-                          , resHeaders = insertMany (aboHeaders abo) (resHeaders res)
+                          , resHeaders = resHeaders res ⊕ aboHeaders abo
                           }
                in
                  getDefaultPage conf reqM res'