Exodus to GHC 6.8.1

[Rakka.git] / Rakka / Resource.hs

diff --git a/Rakka/Resource.hs b/Rakka/Resource.hs
index c79b215cfe5fb5e1bce74101982c18ee3cc7922c..a69a2242215c2603ccd6f7c79826df8d21ed21b7 100644 (file)
--- a/Rakka/Resource.hs
+++ b/Rakka/Resource.hs
@@ -10,18 +10,18 @@ import           Control.Monad
 import           Control.Monad.Trans
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
-import           Network.URI
+import           Network.URI hiding (path)
 import           Text.XML.HXT.Arrow.WriteDocument
 import           Text.XML.HXT.Arrow.XmlIOStateArrow
 import           Text.XML.HXT.DOM.TypeDefs
 import           Text.XML.HXT.DOM.XmlKeywords
 
 
--- /         ==> /
--- /foo      ==> /foo.html
--- /foo/     ==> /foo.html
--- /foo.bar/ ==> /foo.bar
--- /foo.bar  ==> /foo.bar
+-- "/"         ==> "/"
+-- "/foo"      ==> "/foo.html"
+-- "/foo/"     ==> "/foo.html"
+-- "/foo.bar/" ==> "/foo.bar"
+-- "/foo.bar"  ==> "/foo.bar"
 canonicalizeURI :: Resource ()
 canonicalizeURI 
     = do uri <- getRequestURI
@@ -70,10 +70,10 @@ outputXmlPage :: XmlTree -> IOSArrow XmlTree XmlTree -> Resource ()
 outputXmlPage tree toXHTML
     = do mType <- getEntityType
          setContentType mType
-         let formatter = if mType == read "text/xml" then
-                             this
-                         else
-                             toXHTML
+         let formatter = case mType of
+                           MIMEType "application" "xhtml+xml" _ -> toXHTML
+                           MIMEType "text"        "xml"       _ -> this
+                           _                                    -> undefined
          [resultStr] <- liftIO $ runX ( setErrorMsgHandler False fail
                                         >>>
                                         constA tree