Writing a Wiki Server with Yesod

<a href="https://github.com/thma/HsWiki/actions"><img src="https://github.com/thma/HsWiki/workflows/Haskell%20CI/badge.svg" alt="Actions Status" /></a> <a href="https://github.com/thma/HsWiki"><img src="https://thma.github.io/img/forkme.png" height="20"></a></p>

Abstract

In this blog post I'm presenting an implementation of a Wiki System in the spirit of the legendary C2-Wiki - written in Haskell with the Yesod framework.

There will also be some nice add-ons like a graphical reprentation of the page links.

Introduction

The WikiWikiWeb is the first wiki, or user-editable website. It was launched on 25 March 1995 by its inventor, programmer Ward Cunningham, to accompany the Portland Pattern Repository website discussing software design patterns.

cited from Wikipedia

The WikiWikiWeb was the earliest incarnation of a collaborative hypertext platform on the internet. It started with a small set of features which proved to provide the essential tools required to create a large content base with a dense hyperlink structure. Editing and creating new pages was extremely simple which fostered free contributions and a high frequency of interactions between participants.

The most prominent features are:

• A tiny markup language allows basic adjustments of typography and layout.
• All content is rendered as HTML and thus allow easy navigation with any web browser.
• An inplace editor allows adhoc creation and editing of pages. On saving edited content, the page switches back to display mode, which renders the markup as HTML.
• WikiWords, that is Text in PascalCase or Upper Camel Case are interpreted as hyperlinks. If such a hyperlink does not link to an existing page, the editor is opened for creating a new page. This mechanism allows to create hyperlinked content in a very fast manner.
• Clicking on a Page Title will display a list of all references to the current page. This allows to identify related topics and also to organize semantic networks by creating category pages that just keep links to all pages in the category CategoryCategory
• The RecentChanges page shows the latest creation and edits to pages and thus makes it easy to identify hot topics
• There is a full text search available.

In the following I'm going to explain how I implemented each of those features.

A simple markup language: Just use Markdown

The original WikiWikiWeb markup language provided basic syntax for layouting text content. Modern markup languages like Markdown are a more convenient to use, provide much more features and are already widely used. So I'm going to use Markdown instead of the original markup language.

Rendering content as HTML

Yesod comes with a set of templating mechanisms that ease the generation of HTML, CSS and Javascript for dynamic web content. The HTML templating is backed by the Blaze Html generator. Thus Yesod is optimized to use Blaze for HTML content. If, for example, the Blaze Html data type is returned from route-handlers, Yesod will automatically set the Content-Type to text/html.

So my basic idea is to use a Markdown renderer that can output Blaze Html-data and let Yesod do all the heavy lifting.

I'm using the cmark-gfm library to render (GitHub flavoured) Markdown content to HTML. In order to output Html-data, my renderMdToHtml function has to look like follows:

import           CMarkGFM        (commonmarkToHtml)
import           Data.Text       (Text)
import           Text.Blaze.Html (Html, preEscapedToHtml)

renderMdToHtml :: Text -> Html
renderMdToHtml = preEscapedToHtml . commonmarkToHtml [] []

Inplace Content Editing

Type safe page names

In order to work with the wiki page names in a type safe manner we first introduce a newtype PageName. In order to make sure that only proper WikiWords can be used as page names I'm using a smart constructor pageName which only constructs a PageNameinstance if the intented page name matches the wikiWordMatch regular expression:

newtype PageName = Page Text deriving (Eq, Read, Show)

pageName :: Text -> Maybe PageName
pageName name =
  if isWikiWord name
    then Just (Page name)
    else Nothing

-- | checks if a given Text is a WikiWord
isWikiWord :: Text -> Bool
isWikiWord pageName =
  case find wikiWordMatch pageName of
    Nothing -> False
    Just _  -> True

-- | the magic WikiWord Regex
wikiWordMatch :: Regex
wikiWordMatch = "([A-Z][a-z0-9]+){2,}"    

The Yesod routes for the editor

The following PathPiece instance declaration is required to use the PageName as part of a Yesod route definition:

instance PathPiece PageName where
  toPathPiece page   = asText page
  fromPathPiece text = pageName text

asText :: PageName -> Text
asText (Page name) = name

Again the usage of the pageName smart constructor ensures that only proper WikiWord pagenames are constructed.

Here comes the Yesod route definition for displaying and editing of wiki pages:

newtype HsWiki = HsWiki
  { contentDir :: String
  }

mkYesod "HsWiki" [parseRoutes|
/#PageName      PageR     GET             -- (1)
/edit/#PageName EditR     GET POST        -- (2)
|]

Definition (1) can be read as follows: for any PageName that is accessed via a HTTP GET a route PageR is defined, which (according to the rules of the Yesod routing DSL) requires us to implement a function with the following signature:

getPageR :: PageName -> Handler Html

This function will have to lookup an existing page, render its Markdown content to Html and return it a Handler Html object. We'll have a look at this function shortly.

The definition (2) states that for any route /edit/PageName two functions must be defined, one for GET one for POST:

getEditR  :: PageName -> Handler Html
postEditR :: PageName -> Handler Html

If you want to know how exactly handler function are invoked from the Yesod framework and how the route dispatching works, please have a look at the excellent Yesod documentation which features a complete walkthrough with a HelloWorld application.

Serving an editor

Now let's study the implementation of these two function step by step, first the GET handler:

-- | handler for GET /edit/#PageName
getEditR :: PageName -> Handler Html
getEditR pageName = do
  path <- getDocumentRoot                    -- obtain path to document root 
  let fileName = fileNameFor path pageName   -- construct a file from the page name
  exists <- liftIO $ doesFileExist fileName  -- check whether file already exists
  markdown <-
    if exists
      then liftIO $ TIO.readFile fileName    -- if file exists, assign markdown with file content
      else return newPage                    -- else assign markdown with default content
  return $ buildEditorFor pageName markdown  -- return Html for an Editor page

-- | retrieve the name of the HsWiki {contentDir} attribute, defaults to 'content'
getDocumentRoot :: Handler String
getDocumentRoot = getsYesod contentDir  

-- | construct the proper file name for a PageName
fileNameFor :: FilePath -> PageName  -> FilePath
fileNameFor path pageName = path ++ "/" ++ asString pageName ++ ".md"

-- | create default content for a new page
newPage :: Text
newPage =
     "Use WikiWords in PascalCase for Links. \n\n"
  <> "Use [Markdown](https://github.com/adam-p/markdown-here/wiki/Markdown-Cheatsheet) to format page content"

As we can see from the reading of markdown content from files, the idea is to just keep all pages as static content files in the filesystem. By default these files reside in the local folder content (this folder can be configured by a commandline argument).

Next we'll have a look at the buildEditorFor function that will generate the actual Html content of the editor page:

buildEditorFor :: PageName -> Text -> Html
buildEditorFor pageName markdown =
  toHtml
    [ pageHeader False,
      menuBar "",
      renderMdToHtml $ "# " <> page <> " \n",
      preEscapedToHtml $
        "<form action=\""
          <> page
          <> "\" method=\"POST\">"
          <> "<textarea style=\"height: auto;\" name=\"content\" cols=\"120\" rows=\"25\">"
          <> markdown
          <> "</textarea>"
          <> "<input type=\"submit\" name=\"save\" value=\"save\" /> &nbsp; "
          <> "<input class=\"button button-outline\" type=\"button\" name=\"cancel\" value=\"cancel\" onClick=\"window.history.back()\" /> "
          <> "</form>",
      pageFooter
    ]
  where page = asText pageName

The most important element here is the creation of an Html <form ...>...</form> element. The action for that form is just the same page but with a POST-method (we'll come to the respective handler function postEditR` shortly).

Now imagine we point our browser to http://localhost:3000/edit/BrandNewPage. Yesod will do the routing to getEditR (Page "BrandNewPage") and the generated Html for editing a new page 'BrandNewPage' will be sent back to the browser. The page will look like this:

As we can see, I've applied some basic CSS styling (using Milligram CSS). This is done in the pageHeader function.

processing the posting of data

The editor has two buttons, SAVE and *CAN