Some error handling and link relativizing

config/routes

@@ -8,3 +8,4 @@
 /news NewsR GET
 /report/#Int ReportR GET
 /wiki/#Text WikiR GET
+/wiki/ WikiHomeR GET

src/HL/Controller/Wiki.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Wiki page controller.
@@ -8,34 +9,44 @@ import           HL.Foundation
 import           HL.View.Wiki
 
 import           Blaze (renderHtml)
+import           Control.Exception.Lifted (catch)
 import           Data.Conduit
 import           Data.Conduit.Binary
 import qualified Data.Conduit.List as CL
+import           Data.List (isPrefixOf)
 import           Data.Maybe
 import           Data.Monoid
-import           Data.Text (Text,unpack)
+import           Data.Text (Text,unpack,pack)
 import           Network.HTTP.Conduit
-import           Prelude hiding (readFile)
+import           Prelude hiding (readFile,catch)
+import           Text.Pandoc.Definition
 import           Text.Pandoc.Readers.MediaWiki
+import           Text.Pandoc.Walk
 import           Text.Pandoc.Writers.HTML
 import           Text.XML
 import           Text.XML.Cursor
 
+-- | Wiki home (no page specified).
+getWikiHomeR :: Handler Html
+getWikiHomeR =
+  redirect (WikiR "HaskellWiki:Community")
+
 -- | Wiki controller.
 getWikiR :: Text -> Handler Html
 getWikiR name =
-  do html <- liftIO (getWikiPageHtml name)
+  do url <- getUrlRender
+     html <- liftIO (getWikiPageHtml url name)
      blaze (wikiV html)
 
 -- | Get the MediaWiki markup of a wiki page and then convert it to
 -- HTML.
-getWikiPageHtml :: Text -> IO (Either Text (Text,Html))
+getWikiPageHtml url article =
-getWikiPageHtml article =
   do request <- parseUrl ("http://www.haskell.org/haskellwiki/Special:Export/" <> unpack article)
      withManager $ \manager -> do
        response <- http request manager
-       doc <- responseBody response $$+- sinkDoc def
+       doc <- catch (fmap Just (responseBody response $$+- sinkDoc def))
-       case parse doc of
+                    (\(e::UnresolvedEntityException) -> return Nothing)
+       case doc >>= parse of
          Nothing -> return (Left "Unable to parse XML from haskell.org.")
          Just (title,text) -> return (Right (title,writeHtml def text))
   where
@@ -43,7 +54,10 @@ getWikiPageHtml article =
       do let cursor = fromDocument doc
          title <- listToMaybe (getTitle cursor)
          text <- listToMaybe (getText cursor)
-         return (title,readMediaWiki def (unpack text))
+         return (title,walk' (relativize url)
+                             (readMediaWiki def (unpack text)))
+      where walk' :: (Inline -> Inline) -> Pandoc -> Pandoc
+            walk' = walk
     name n =
       Name {nameLocalName = n
            ,nameNamespace = Just "http://www.mediawiki.org/xml/export-0.6/"
@@ -64,3 +78,10 @@ getWikiPageHtml article =
       element (name "title") >>=
       descendant >>=
       content
+
+
+relativize url = walk links
+  where links asis@(Link is (ref,title))
+          | isPrefixOf "http://" ref || isPrefixOf "https://" ref = asis
+          | otherwise = Link is (unpack (url (WikiR (pack ref))),title)
+        links x = x

src/HL/View/Template.hs

@@ -70,7 +70,7 @@ navigation cur url =
                          ,(CommunityR,"Community")
                          ,(DocumentationR,"Documentation")
                          ,(NewsR,"News")
-                         ,(WikiR "","Wiki")]))
+                         ,(WikiHomeR,"Wiki")]))
           where item route title = li theclass (a [href (url route)] title)
                   where theclass
                           | Just route == cur = [class_ "active"]

src/HL/View/Wiki.hs

@@ -16,7 +16,8 @@ import Data.Text (Text)
 wikiV :: Either Text (Text,Html) -> Blaze App
 wikiV result =
   template
-    [(WikiR "","Wiki")]
+    ([(WikiHomeR,"Wiki")] ++
+     [(WikiR name,name) | Right (name,_) <- [result]])
     (\_ ->
        container
          (row