Replace xhtml-combinators with blaze

xhtml-combinators was being used only for it's text -> html escape function, and even then that was only for the error page. Rather than bring in a new dependency on this, I've rewritten the code to use blaze-html instead - which we already have a transitive dependency on through heist. I've also used snap-blaze to do the final rendering, so we can somewhat dog food our own libraries.
ocharles · Sep 19, 2012 · 450f89c · 450f89c
1 parent b793520
commit 450f89c
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 8 deletions.
diff --git a/snap-website.cabal b/snap-website.cabal
@@ -29,13 +29,13 @@ Executable snap-website
     process,
     snap        >= 0.9 && <0.10,
     snap-core   >= 0.9 && <0.10,
+    snap-blaze  >= 0.2.1 && <0.3,
     snap-server >= 0.9 && <0.10,
     snap-static-pages >= 0.2 && <0.3,
     text,
     time,
     transformers,
     utf8-string,
-    xhtml-combinators >= 0.2.2 && < 0.3,
     xmlhtml >= 0.1 && < 0.3
 
   ghc-prof-options: -prof -auto-all

diff --git a/src/Main.hs b/src/Main.hs
@@ -20,13 +20,15 @@ import           Foreign.C.Types
 import           Prelude hiding (catch)
 import           Snap.Http.Server
 import           Snap.StaticPages
+import           Snap.Blaze (blaze)
 import           Snap.Core
 import           Snap.Snaplet
 import           Snap.Snaplet.Heist
 import           Snap.Util.FileServe
 import           Snap.Util.GZip
+import           Text.Blaze.Html5 (toHtml)
+import qualified Text.Blaze.Html5 as H
 import           Text.Templating.Heist
-import qualified Text.XHtmlCombinators.Escape as XH
 
 data App = App
     { _heist     :: Snaplet (Heist App)
@@ -81,12 +83,14 @@ catch500 :: MonadSnap m => m a -> m ()
 catch500 m = (m >> return ()) `catch` \(e::SomeException) -> do
     let t = T.pack $ show e
     putResponse r
-    writeBS "<html><head><title>Internal Server Error</title></head>"
+    blaze $ do
-    writeBS "<body><h1>Internal Server Error</h1>"
+      H.docType
-    writeBS "<p>A web handler threw an exception. Details:</p>"
+      H.html $ do
-    writeBS "<pre>\n"
+        H.head $ H.title "Internal Server Error"
-    writeText $ XH.escape t
+        H.body $ do
-    writeBS "\n</pre></body></html>"
+          H.h1 "Internal Server Error"
+          H.p "A web handler threw an exception. Details:"
+          H.pre $ "\n" >> (toHtml t) >> "\n"
 
     logError $ B.concat [ "caught exception: ", B.pack $ show e ]
   where