{"id":17997466,"url":"https://github.com/thma/hswiki","last_synced_at":"2025-03-26T04:31:19.783Z","repository":{"id":28772146,"uuid":"119286097","full_name":"thma/HsWiki","owner":"thma","description":"Simple Wiki in the spirit of the legendary C2-Wiki - written in haskell with yesod","archived":false,"fork":false,"pushed_at":"2024-01-18T05:33:09.000Z","size":1299,"stargazers_count":8,"open_issues_count":5,"forks_count":1,"subscribers_count":4,"default_branch":"master","last_synced_at":"2025-03-21T06:01:51.735Z","etag":null,"topics":["graphviz","haskell","html","markdown","milligram-css","regex","wiki","wikiwiki","yesod"],"latest_commit_sha":null,"homepage":"","language":"Haskell","has_issues":true,"has_wiki":null,"has_pages":null,"mirror_url":null,"source_name":null,"license":null,"status":null,"scm":"git","pull_requests_enabled":true,"icon_url":"https://github.com/thma.png","metadata":{"files":{"readme":"README.md","changelog":null,"contributing":null,"funding":null,"license":null,"code_of_conduct":null,"threat_model":null,"audit":null,"citation":null,"codeowners":null,"security":null,"support":null,"governance":null,"roadmap":null,"authors":null,"dei":null,"publiccode":null,"codemeta":null}},"created_at":"2018-01-28T18:31:59.000Z","updated_at":"2022-02-19T09:15:31.000Z","dependencies_parsed_at":"2024-10-29T22:09:09.776Z","dependency_job_id":null,"html_url":"https://github.com/thma/HsWiki","commit_stats":null,"previous_names":[],"tags_count":0,"template":false,"template_full_name":null,"repository_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/thma%2FHsWiki","tags_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/thma%2FHsWiki/tags","releases_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/thma%2FHsWiki/releases","manifests_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/thma%2FHsWiki/manifests","owner_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners/thma","download_url":"https://codeload.github.com/thma/HsWiki/tar.gz/refs/heads/master","host":{"name":"GitHub","url":"https://github.com","kind":"github","repositories_count":245589261,"owners_count":20640253,"icon_url":"https://github.com/github.png","version":null,"created_at":"2022-05-30T11:31:42.601Z","updated_at":"2022-07-04T15:15:14.044Z","host_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub","repositories_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories","repository_names_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repository_names","owners_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners"}},"keywords":["graphviz","haskell","html","markdown","milligram-css","regex","wiki","wikiwiki","yesod"],"created_at":"2024-10-29T21:18:44.860Z","updated_at":"2025-03-26T04:31:19.255Z","avatar_url":"https://github.com/thma.png","language":"Haskell","funding_links":[],"categories":[],"sub_categories":[],"readme":"# Writing a Wiki Server with Yesod\n\n\u003ca href=\"https://github.com/thma/HsWiki/actions\"\u003e\u003cimg src=\"https://github.com/thma/HsWiki/workflows/Haskell%20CI/badge.svg\" alt=\"Actions Status\" /\u003e\u003c/a\u003e \n\u003ca href=\"https://github.com/thma/HsWiki\"\u003e\u003cimg src=\"https://thma.github.io/img/forkme.png\" height=\"20\"\u003e\u003c/a\u003e\u003c/p\u003e\n\n## Abstract\n\nIn this blog post I'm presenting an implementation of a Wiki System \nin the spirit of the legendary [C2-Wiki](http://wiki.c2.com/) - written in Haskell with the [Yesod](https://www.yesodweb.com/) framework.\n\nThere will also be some nice add-ons like a graphical reprentation of the page links.\n\n## Introduction \n\n\u003e 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. \n\u003e \n\u003e[cited from Wikipedia](https://en.wikipedia.org/wiki/WikiWikiWeb)\n\n\nThe [WikiWikiWeb](http://wiki.c2.com/) was the earliest incarnation of a collaborative hypertext platform on the internet.\nIt started with a small set of features which proved to provide the essential tools required to create a large content \nbase with a dense hyperlink structure. \nEditing and creating new pages was extremely simple which fostered free contributions and a high frequency of \ninteractions between participants. \n\nThe most prominent features are:\n\n- A tiny markup language allows basic adjustments of typography and layout.\n- All content is rendered as HTML and thus allow easy navigation with any web browser.\n- An inplace editor allows adhoc creation and editing of pages. \n  On saving edited content, the page switches back to display mode, which renders the markup as HTML.\n- WikiWords, that is Text in PascalCase or [Upper Camel Case](https://en.wikipedia.org/wiki/Camel_case) are interpreted as\n  hyperlinks. If such a hyperlink does not link to an existing page, the editor is opened for creating a new page.\n  This mechanism allows to create hyperlinked content in a very fast manner.\n- Clicking on a Page Title will display a list of all references to the current page.\n  This allows to identify related topics and also to organize semantic networks by creating category pages \n  that just keep links to all pages in the category [CategoryCategory](http://wiki.c2.com/?CategoryCategory)\n- The RecentChanges page shows the latest creation and edits to pages and thus makes it easy to identify hot topics\n- There is a full text search available.\n\nIn the following I'm going to explain how I implemented each of those features.\n\n## A simple markup language: Just use Markdown\n\nThe original WikiWikiWeb markup language provided basic syntax for layouting text content. \nModern markup languages like Markdown are a more convenient to use, provide much more features and are already widely used.\nSo I'm going to use Markdown instead of the original markup language.\n\n## Rendering content as HTML\n\nYesod comes with a set of [templating mechanisms](https://www.yesodweb.com/book/shakespearean-templates) that ease the generation of HTML, CSS and Javascript for dynamic web content. The HTML templating is backed by the [Blaze Html generator](https://hackage.haskell.org/package/blaze-html). Thus Yesod is optimized to use [Blaze](https://hackage.haskell.org/package/blaze-html) 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`.\n\nSo my basic idea is to use a Markdown renderer that can output Blaze `Html`-data and let Yesod do all the heavy lifting.\n\nI'm using the [cmark-gfm](https://hackage.haskell.org/package/cmark-gfm) library to render (GitHub flavoured) Markdown content to HTML. \nIn order to output `Html`-data, my `renderMdToHtml` function has to look like follows: \n\n```haskell\nimport           CMarkGFM        (commonmarkToHtml)\nimport           Data.Text       (Text)\nimport           Text.Blaze.Html (Html, preEscapedToHtml)\n\nrenderMdToHtml :: Text -\u003e Html\nrenderMdToHtml = preEscapedToHtml . commonmarkToHtml [] []\n```\n\n## Inplace Content Editing\n\n### Type safe page names\n\nIn order to work with the wiki page names in a type safe manner we first introduce a newtype `PageName`.\nIn order to make sure that only proper [WikiWords](https://en.wikipedia.org/w/index.php?title=WikiWord) can be used as page names I'm using a [smart constructor](https://wiki.haskell.org/Smart_constructors) `pageName` which only constructs a `PageName`instance if the intented page name matches the `wikiWordMatch` regular expression:\n\n```haskell\nnewtype PageName = Page Text deriving (Eq, Read, Show)\n\npageName :: Text -\u003e Maybe PageName\npageName name =\n  if isWikiWord name\n    then Just (Page name)\n    else Nothing\n\n-- | checks if a given Text is a WikiWord\nisWikiWord :: Text -\u003e Bool\nisWikiWord pageName =\n  case find wikiWordMatch pageName of\n    Nothing -\u003e False\n    Just _  -\u003e True\n\n-- | the magic WikiWord Regex\nwikiWordMatch :: Regex\nwikiWordMatch = \"([A-Z][a-z0-9]+){2,}\"    \n```\n\n### The Yesod routes for the editor\n\nThe following `PathPiece` instance declaration is required to use the `PageName` as part of a Yesod route definition:\n\n```haskell\ninstance PathPiece PageName where\n  toPathPiece page   = asText page\n  fromPathPiece text = pageName text\n\nasText :: PageName -\u003e Text\nasText (Page name) = name\n```\n\nAgain the usage of the `pageName` smart constructor ensures that only proper WikiWord pagenames are constructed.\n\nHere comes the [Yesod route definition](https://www.yesodweb.com/book/basics#basics_routing) for displaying and editing of wiki pages:\n\n```haskell\nnewtype HsWiki = HsWiki\n  { contentDir :: String\n  }\n\nmkYesod \"HsWiki\" [parseRoutes|\n/#PageName      PageR     GET             -- (1)\n/edit/#PageName EditR     GET POST        -- (2)\n|]\n```\n\nDefinition (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:\n\n```haskell\ngetPageR :: PageName -\u003e Handler Html\n```\n\nThis 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.\n\n\nThe definition (2) states that for any route /edit/`PageName` two functions must be defined, one for GET one for POST:\n\n```haskell\ngetEditR  :: PageName -\u003e Handler Html\npostEditR :: PageName -\u003e Handler Html\n```\nIf 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](https://www.yesodweb.com/book/) which features a complete walkthrough with a HelloWorld application.\n\n### Serving an editor\n\nNow let's study the implementation of these two function step by step, first the GET handler:\n\n```haskell\n-- | handler for GET /edit/#PageName\ngetEditR :: PageName -\u003e Handler Html\ngetEditR pageName = do\n  path \u003c- getDocumentRoot                    -- obtain path to document root \n  let fileName = fileNameFor path pageName   -- construct a file from the page name\n  exists \u003c- liftIO $ doesFileExist fileName  -- check whether file already exists\n  markdown \u003c-\n    if exists\n      then liftIO $ TIO.readFile fileName    -- if file exists, assign markdown with file content\n      else return newPage                    -- else assign markdown with default content\n  return $ buildEditorFor pageName markdown  -- return Html for an Editor page\n\n-- | retrieve the name of the HsWiki {contentDir} attribute, defaults to 'content'\ngetDocumentRoot :: Handler String\ngetDocumentRoot = getsYesod contentDir  \n\n-- | construct the proper file name for a PageName\nfileNameFor :: FilePath -\u003e PageName  -\u003e FilePath\nfileNameFor path pageName = path ++ \"/\" ++ asString pageName ++ \".md\"\n\n-- | create default content for a new page\nnewPage :: Text\nnewPage =\n     \"Use WikiWords in PascalCase for Links. \\n\\n\"\n  \u003c\u003e \"Use [Markdown](https://github.com/adam-p/markdown-here/wiki/Markdown-Cheatsheet) to format page content\"\n```\n\nAs 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).\n\nNext we'll have a look at the `buildEditorFor` function that will generate the actual Html content of the editor page:\n\n\n```haskell\nbuildEditorFor :: PageName -\u003e Text -\u003e Html\nbuildEditorFor pageName markdown =\n  toHtml\n    [ pageHeader False,\n      menuBar \"\",\n      renderMdToHtml $ \"# \" \u003c\u003e page \u003c\u003e \" \\n\",\n      preEscapedToHtml $\n        \"\u003cform action=\\\"\"\n          \u003c\u003e page\n          \u003c\u003e \"\\\" method=\\\"POST\\\"\u003e\"\n          \u003c\u003e \"\u003ctextarea style=\\\"height: auto;\\\" name=\\\"content\\\" cols=\\\"120\\\" rows=\\\"25\\\"\u003e\"\n          \u003c\u003e markdown\n          \u003c\u003e \"\u003c/textarea\u003e\"\n          \u003c\u003e \"\u003cinput type=\\\"submit\\\" name=\\\"save\\\" value=\\\"save\\\" /\u003e \u0026nbsp; \"\n          \u003c\u003e \"\u003cinput class=\\\"button button-outline\\\" type=\\\"button\\\" name=\\\"cancel\\\" value=\\\"cancel\\\" onClick=\\\"window.history.back()\\\" /\u003e \"\n          \u003c\u003e \"\u003c/form\u003e\",\n      pageFooter\n    ]\n  where page = asText pageName\n  ```\n\nThe most important element here is the creation of an Html `\u003cform ...\u003e...\u003c/form\u003e element.\nThe action for that form is just the same page but with a `POST`-method (we'll come to the respective handler function `postEditR` shortly).\n\nNow 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:\n\n![The Editor for a new page](img/editor.png)\n\nAs we can see, I've applied some basic CSS styling [(using Milligram CSS)](https://milligram.io/). This is done in the `pageHeader` function.\n\n### processing the posting of data\n\nThe editor has two buttons, *SAVE* and *CANCEL*. On cancel we just navigate back to the previous page in the browser history. On save the browser sends the form data via the `POST` method to the server. To handle this incoming POST-request we'll the `postEditR` handler function:\n\n```haskell\npostEditR :: PageName -\u003e Handler Html\npostEditR pageName = do\n  path \u003c- getDocumentRoot                    -- obtain path to document root\n  let fileName = fileNameFor path pageName   -- construct a file from the page name\n  maybeContent \u003c- lookupPostParam \"content\"  -- retrieve POST data\n  client \u003c- remoteHost \u003c$\u003e waiRequest        -- retrieve info on remote client from request\n  case maybeContent of\n    Just content -\u003e liftIO $ do\n      TIO.writeFile fileName content         -- if content exists write it to disk\n      writeLogEntry path pageName client     -- also write a log entry to file RecentChanges\n    Nothing -\u003e return ()                     -- no content: do nothing\n  redirect $ PageR pageName                  -- redirect to GET Page route (display content)\n  ```\n\nSo essentially we are just writing the markdown content into a file. After that we redirect to \nthe `PageR` route. This will result in redirecting the browser to `http://localhost:3000/BrandNewPage`. As you can see in the following screen-shot the markdown content that was entered in the editor form is now rendered as HTML:\n\n![render existing page](img/renderPage.png)\n\n### rendering page content\n\nAs promised above we'll now have a closer look at the `getPageR` route handler function:\n\n```haskell\n-- | Handler for GET /#PageName\ngetPageR :: PageName -\u003e Handler Html\ngetPageR pageName = do\n  path \u003c- getDocumentRoot                            -- obtain path to document root \n  maybeShowRefs \u003c- lookupGetParam \"showBackrefs\"     -- check whether URL ends with '?showBackrefs'\n  maybeBackrefs \u003c- liftIO $                          -- if showBackrefs was set, Just [PageName] \n    computeMaybeBackrefs path pageName maybeShowRefs -- else Nothing\n  let fileName = fileNameFor path pageName           -- compute proper filename from pageName\n  exists \u003c- liftIO $ doesFileExist fileName          -- check whether such a file exists\n  if exists\n    then do                                                                  \n      content \u003c- liftIO $ TIO.readFile fileName      -- file exists, read its content\n      return $ buildViewFor \n        pageName content maybeBackrefs               -- build HTML for content and return it\n    else do\n      redirect $ EditR pageName                      -- file does not exist, redirect to EditR\n```\n\nLet's ignore the lines with `maybeShowRefs` and `maybeBackrefs` for a moment. We just assume that `maybeBackrefs == Nothing`. So we first check whether a file exists for the given `pageName`. If yes, the file-content is read and bound to `content`; next we build a HTML view for the page with `buildViewFor` and return it. If no file was found matching `pageName` we redirect directly to the `EditR`which will in turn open up an editor for an empty page as already shown in the previous section.\n\nLet's have a closer look at `buildViewFor`. It will first evaluate the `maybeBackrefs` arguments. For the moment let's assume equals `Nothing`, so that `hasBackref` is bound to `True` and `backrefEntry` to `\"\"`. \n\nThen the actual HTML for the page is constructed from a set of template functions: \n- `pageHeader` creates the HTML head with css definitions, \n- `menuBar` creates the menu line on top of the page, \n- `pageTitle` creates a headline from the `pageName`, \n- `backrefEntry` is just empty text in this scenario\n- `renderMdToHtml (wikiWordToMdLink content)` first replaces all ocurrences of *WikiWords* with proper Markdown hyperlinks of the form `[WikiWord](WikiWord)` the result is then rendered to HTML (this is the single place where we convert from *WikiWords* to hyperlinks and thus make the Wiki magic happen...), \n- finally `pageFooter` closes all open html tags:\n\n```haskell\nbuildViewFor :: PageName -\u003e Text -\u003e Maybe [PageName] -\u003e Html\nbuildViewFor pageName content maybeBackrefs =\n  let (hasBackref, backrefEntry) = case maybeBackrefs of\n        Nothing       -\u003e (False, text \"\")\n        Just backrefs -\u003e (True, renderedBackrefs)\n          where\n            concatMap :: (a -\u003e Text) -\u003e [a] -\u003e Text\n            concatMap = (T.intercalate \"\" .) . map\n            renderedBackrefs = renderMdToHtml $ concatMap ((\\b -\u003e \"- [\" \u003c\u003e b \u003c\u003e \"](/\" \u003c\u003e b \u003c\u003e \") \\n\") . asText) backrefs\n   in toHtml [pageHeader False, \n              menuBar (asText pageName), \n              pageTitle pageName hasBackref, \n              backrefEntry, \n              renderMdToHtml (wikiWordToMdLink content), \n              pageFooter]\n\n-- | converts a WikiWord into a Markdown link: [WikiWord](WikiWord)\nwikiWordToMdLink :: Text -\u003e Text\nwikiWordToMdLink text =\n  let match = wikiWordMatch\n      replace = \"[$0]($0)\"\n   in replaceAll match replace text              \n```\n\n## Displaying back links (aka reverse index) for each page\n\nAnother important feature of the original WikiWiki was the seamless integration of back links: \n\n\u003e If page A links to page B, then a 'back link' would be a link which goes from page B back to page A.\n\u003e\n\u003eOn this wiki, the title of each page works as a back link. Clicking on the title of any page finds all the pages referring to that page. It works for any wiki page. E.g. to find all pages that link to this page, click the title at the top of this page.\n\u003e\n\u003e [quoted from the WikiWiki](http://wiki.c2.com/?BackLink)\n\nThis feature can best be demonstrated with an example. First we lookup up page `http://localhost:3000/CategoryMammal`, a page meant to represent the class of all mammaĺ animals:\n\n![CategoryMammal](img/CategoryMammal.png)\n\nThe headline of this page is a hyperlink which references `http://localhost:3000/CategoryMammal?showBackrefs`. Following the link results in the following page:\n\n\n![CategoryMammal](img/CategoryMammalWithBackLinks.png)\n\nNow we see a bullet point list of all pages linking to *CategoryMammal* above the normal page content. Following one of these links, e.g. `http://localhost:3000/SpeciesCat`, leads to the following page:\n\n![SpeciesCat](img/SpeciesCat.png)\n\nAt the bottom of this page we see the *WikiWord* CategoryMammal. This is interpreted as a link from *SpeciesCat* to *CategoryMammal*. And as a result the back-link display on page *CategoryMammal* contains a link to *SpeciesCat*.\n\nLet's see how this works on the code level. In fact we already came across this mechanism but had skipped over it for the time being. Now it's time to revisit. We start with the `getPageR` function.\n\nIn our scenario a click on the link `http://localhost:3000/CategoryMammal?showBackrefs` leads to a call to `getPageR`. But this time `lookupGetParam \"showBackrefs\"` will succeed and thus now `maybeShowRefs` is bound to `Just \"\"`. This will lead to a different execution path in the call to `computeMaybeBackrefs`:\n\n```haskell\n-- | Handler for GET /#PageName\ngetPageR :: PageName -\u003e Handler Html\ngetPageR pageName = do\n  path \u003c- getDocumentRoot                            -- obtain path to document root \n  maybeShowRefs \u003c- lookupGetParam \"showBackrefs\"     -- check whether URL ends with '?showBackrefs'\n  maybeBackrefs \u003c- liftIO $                          -- if showBackrefs was set, Just [PageName] \n    computeMaybeBackrefs path pageName maybeShowRefs -- else Nothing\n  let fileName = fileNameFor path pageName           -- compute proper filename from pageName\n  exists \u003c- liftIO $ doesFileExist fileName          -- check whether such a file exists\n  if exists\n    then do                                                                  \n      content \u003c- liftIO $ TIO.readFile fileName      -- file exists, read its content\n      return $ buildViewFor \n        pageName content maybeBackrefs               -- build HTML for content and return it\n    else do\n      redirect $ EditR pageName                      -- file does not exist, redirect to EditR\n\n-- | if maybeShowRefs isJust then a list of a pages referencing pageName is computed\ncomputeMaybeBackrefs :: FilePath -\u003e PageName -\u003e Maybe Text -\u003e IO (Maybe [PageName])\ncomputeMaybeBackrefs path pageName maybeShowRefs =\n  case maybeShowRefs of\n    Nothing -\u003e return Nothing                      -- if maybeShowRefs == Nothing, return Nothing\n    Just _  -\u003e do                                  -- else compute list of all references to page by\n      allPages \u003c- computeIndex path                -- computing list of all pages in wiki\n      backrefs \u003c- computeBackRefs path pageName allPages -- compute all back references\n      return $ Just backrefs                       -- return this list wrapped as a Maybe\n\n\n-- | compute a list of all pages that contain references to pageName\ncomputeBackRefs :: FilePath -\u003e PageName -\u003e [PageName] -\u003e IO [PageName]\ncomputeBackRefs path pageName allPages = do\n  let filteredPages = delete pageName allPages   -- filter pagename from list of pages\n  markRefs \u003c- mapM                               -- create a list of bools: True if a page contains\n    (fmap containsBackref . TIO.readFile . fileNameFor path)             -- a reference, else False\n    filteredPages\n  let pageBoolPairs = zip filteredPages markRefs -- create a zipped list of (pageName, Bool) pairs\n  return $ map fst (filter snd pageBoolPairs)    -- return only pages marked True\n  where\n    containsBackref content =                    -- returns True if content contains pageName\n      asText pageName `T.isInfixOf` content\n```\n\nNext we revisit `buildViewFor`. Here we see a case match on `maybeBackrefs`. In our current scenario it will\nmatch to `Just backrefs`. Thus `renderedBackrefs` will be bound to Html generated by rendering a Markdown list of hyperlinks that is constructed from the `backrefs` list of PageNames. \n\nThis generated Html is then included as `backrefEntry` into the overall page layout:\n\n```haskell\nbuildViewFor :: PageName -\u003e Text -\u003e Maybe [PageName] -\u003e Html\nbuildViewFor pageName content maybeBackrefs =\n  let (hasBackref, backrefEntry) = case maybeBackrefs of\n        Nothing       -\u003e (False, text \"\")\n        Just backrefs -\u003e (True, renderedBackrefs)\n          where\n            concatMap :: (a -\u003e Text) -\u003e [a] -\u003e Text\n            concatMap = (T.intercalate \"\" .) . map\n            renderedBackrefs = \n              renderMdToHtml $ concatMap \n                  ((\\b -\u003e \"- [\" \u003c\u003e b \u003c\u003e \"](/\" \u003c\u003e b \u003c\u003e \") \\n\") . asText) \n                  backrefs\n   in toHtml [pageHeader False, \n              menuBar (asText pageName), \n              pageTitle pageName hasBackref, \n              backrefEntry, \n              renderMdToHtml (wikiWordToMdLink content), \n              pageFooter]        \n```\n\n## Show the latest creation and edits to pages \n\nI already covered the `postEditR` function, but I did not explain the `writeLogEntry` function which traces each change to page-content. So here comes the full picture:\n\n```haskell\npostEditR :: PageName -\u003e Handler Html\npostEditR pageName = do\n  path \u003c- getDocumentRoot                    -- obtain path to document root\n  let fileName = fileNameFor path pageName   -- construct a file from the page name\n  maybeContent \u003c- lookupPostParam \"content\"  -- retrieve POST data\n  client \u003c- remoteHost \u003c$\u003e waiRequest        -- retrieve info on remote client from request\n  case maybeContent of\n    Just content -\u003e liftIO $ do\n      TIO.writeFile fileName content         -- if content exists write it to disk\n      writeLogEntry path pageName client     -- also write a log entry to file RecentChanges\n    Nothing -\u003e return ()                     -- no content: do nothing\n  redirect $ PageR pageName                  -- redirect to GET Page route (display content)\n  \n-- | write a log entry to the RecentChanges page\nwriteLogEntry :: FilePath -\u003e PageName -\u003e SockAddr -\u003e IO ()\nwriteLogEntry path pageName client = do\n  let fileName = fileNameFor path recentChanges -- path to RecentChanges page\n  now \u003c- getCurrentTime                         -- create timestamp\n  let logEntry = toStrict $                     -- create a log entry consisting of:\n        format (\"- \" % string % \" \" % string % \" from \" % string % \"\\n\")\n          (asString pageName)                   -- page edited/created\n          (takeWhile (/= '.') (show now))       -- current timestamp\n          (takeWhile (/= ':') (show client))    -- IP address of client\n  TIO.appendFile fileName logEntry              -- add log entry at end of log file\n\n-- | the RecentChanges PageName\nrecentChanges :: PageName\nrecentChanges = Page \"RecentChanges\"\n```\n\nAnd here comes a sample screen shot of the RecentChanges page:\n\n![RecentChanges](img/RecentChanges.png)\n\n\n## Have a full text search\n\nFor the full text search Iǜe provided a specific route `/actions/find` to avoid overlap with ordinary content pages:\n\n```haskell\nmkYesod \"HsWiki\" [parseRoutes|\n/actions/find/  FindR     GET\n|]\n```\n\nThe corresponding handler function `getFindR` is defined as follows:\n\n```haskell\n-- | handler for GET /actions/find\ngetFindR :: Handler Html\ngetFindR = do\n  path \u003c- getDocumentRoot                       -- obtain path to document root\n  allPages \u003c- liftIO $ computeIndex path        -- compute a list of all page names in wiki\n  maybeSearch \u003c- lookupGetParam \"search\"        -- check whether query param 'search' is set\n  case maybeSearch of\n    Nothing     -\u003e return $ buildFindPage \"\" [] -- if maybeSearch == Nothing or Just \"\"\n    Just \"\"     -\u003e return $ buildFindPage \"\" [] -- then return empty find page\n    Just search -\u003e do                           \n      markMatches \u003c- liftIO $                   -- else create a list of Bools by\n        mapM                                    -- returning True for each file that matches\n          (\\p -\u003e fmap containsSearchText $      -- search, else False\n            return (asText p) \u003c\u003e TIO.readFile (fileNameFor path p)) \n          allPages\n      let pageBoolPairs = zip allPages markMatches  -- create a zipped list [(PageName, Bool)]\n      let matchingPages = map fst (filter snd pageBoolPairs) -- filter for all matching pages\n      return $ buildFindPage search matchingPages   -- build find page with search term and \n        where                                       -- list of matching pages\n          containsSearchText content = T.toLower search `T.isInfixOf` T.toLower content\n```\n\nThe `buildFindPage` function is responsible for assembling the Html view of this page.\n\n\n```haskell\nbuildFindPage :: Text -\u003e [PageName] -\u003e Html\nbuildFindPage search pages = toHtml\n  [ pageHeader True,\n    menuBar \"\",\n    renderMdToHtml \"# FindPage \",\n    searchBox search,\n    renderMdToHtml $ T.pack $ concatMap (\\p -\u003e \"- [\" ++ asString p ++ \"](/\" ++ asString p ++ \") \\n\") pages,\n    pageFooter\n  ]\n\nsearchBox :: Text -\u003e Html\nsearchBox search =\n  preEscapedToHtml $\n    \"\u003cscript type=\\\"text/javascript\\\"\u003e\"\n    ++ \"function init()\"\n    ++ \"{\"\n    ++ \"     document.getElementById(\\\"search\\\").focus();\"\n    ++ \"}\"\n    ++ \"\u003c/script\u003e\"\n    ++\n    \"\u003cform action=\\\"/actions/find\\\"\"\n      ++ \" method=\\\"GET\\\"\u003e\"\n      ++ \"\u003cinput type=\\\"text\\\" id=\\\"search\\\" name=\\\"search\\\" value=\\\"\" ++ T.unpack search ++ \"\\\" \"\n      ++ \"onfocus=\\\"this.setSelectionRange(9999, 9999)\\\" \"\n      ++ \"onkeyup=\\\"this.form.submit()\\\" /\u003e \"\n      ++ \"\u003cinput type=\\\"submit\\\" value=\\\"find\\\" /\u003e\"\n      ++ \"\u003c/form\u003e\"\n```\n\nThe only interesting thing here is that I've include a bit of JavaScript to enable page updates while typing into the\nfind box. See the FindPage in action below:\n\n\n![FindPage](img/FindPage.png)\n\n## Provide a graph view of pages and their links\n\nSo far I've just reimplemented stuff that was already there in the original WikiWiki. While toying around with my HsWiki I thought it might be a nice addition to have a graph representation of the site content.\n\nAs always I try to code as little as possible myself and get the hard work done by the experts. In this case I'm relying on my alltime favourite Graph rendering library [GraphViz](https://graphviz.org/). This time in it's web assembly incarnation [d3-graphviz](https://github.com/magjac/d3-graphviz).\n\nSo again we'll have a specific route:\n\n```haskell\nmkYesod \"HsWiki\" [parseRoutes|\n/actions/graph  GraphR    GET\n|]\n```\n\nAnd a corresponding route handler function:\n\n```haskell\n-- | handler for GET /actions/graph\ngetGraphR :: Handler Html\ngetGraphR = do                                    \n  path     \u003c- getDocumentRoot                     -- obtain document root folder\n  allPages \u003c- liftIO $ computeIndex path          -- compute list of all wiki pages\n  allRefs  \u003c- liftIO $ mapM                       -- compute list of all back references\n    (\\p -\u003e computeBackRefs path p allPages)       \n    allPages                                      -- for each file in allPages\n  return $ buildGraphView $ zip allRefs allPages  -- return Html view for [([PageName], PageName)] graph\n```\n\nPlease note that this implementation has $O(n^2)$. This is caused by relying on `computeBackrefs` this function traverses all files and is called once for each file by `mapM`. \nImproving this is left as an exercise for the intereseted reader (all pull requests are welcome!)\n\nThe actual Html rendering is a bit more involved as I have to integrate the JS code for d3-graphviz and also to render the GraphViz DOT graph representation:\n\n```haskell\n-- | build view for GraphViz representation of wiki page structure\nbuildGraphView :: [([PageName], PageName)] -\u003e Html\nbuildGraphView graph =\n  toHtml\n    [ pageHeader False,\n      menuBar \"\",\n      renderMdToHtml \"# Site Map \\n\",\n      renderMdToHtml \"[View as List](/actions/toc) \\n\",\n      preGraph,                                         -- load wasm scripts, begin JS script\n      preEscapedToHtml $ renderNodes $ allNodes graph,  -- build list of all PageName nodes\n      preEscapedToHtml $ renderGraph graph,             -- build link structure as directed graph\n      postGraph,                                        -- render DOT digraph\n      pageFooter\n    ]\n\n-- | render graph in DOT syntax (from -\u003e to;)\nrenderGraph :: [([PageName], PageName)] -\u003e String\nrenderGraph graph =\n  foldr\n    (\\str -\u003e ((str ++ \",\\n\") ++))\n    \"\"\n    (concatMap (\\(sources, target) -\u003e \n      map \n        (\\s -\u003e \"'\\\"\" ++ asString s ++ \"\\\" -\u003e \\\"\" ++ asString target ++ \"\\\";'\") \n        sources) \n      graph)\n\n-- | extract list of unique PageNames from graph\nallNodes :: [([PageName], PageName)] -\u003e [PageName]\nallNodes = nub . (uncurry (flip (:)) =\u003c\u003c)\n\n-- | render list of PageNames as DOT list of nodes with some nice formatting\nrenderNodes :: [PageName ] -\u003e String\nrenderNodes =\n  concatMap\n    ( \\n -\u003e\n        \"'\\\"\" ++ asString n\n          ++ \"\\\" [shape=\\\"rect\\\", style=\\\"rounded,filled\\\", fillcolor=\\\"#f4f5f6\\\", fontcolor=\\\"#9b4dca\\\", fontname=\\\"Roboto\\\",  URL=\\\"/\"\n          ++ asString n\n          ++ \"\\\"];', \\n\"\n    )\n\n-- | Html with script code for loading d3-graphviz and opening the DOT digraph\npreGraph :: Html\npreGraph =\n  preEscapedToHtml $\n    \"\u003cscript src=\\\"//d3js.org/d3.v5.min.js\\\"\u003e\u003c/script\u003e\"\n      ++ \"\u003cscript src=\\\"https://unpkg.com/@hpcc-js/wasm@0.3.11/dist/index.min.js\\\"\u003e\u003c/script\u003e\"\n      ++ \"\u003cscript src=\\\"https://unpkg.com/d3-graphviz@3.0.5/build/d3-graphviz.js\\\"\u003e\u003c/script\u003e\"\n      ++ \"\u003cdiv id=\\\"graph\\\" \u003e\u003c/div\u003e\"\n      ++ \"\u003cscript\u003e\"\n      ++ \"var dot =\\n\"\n      ++ \"    [\\n\"\n      ++ \"        'digraph  {',\\n\"\n\n-- | Html with script code for rendering the DOT digraph\npostGraph :: Html\npostGraph =\n  preEscapedToHtml $\n    \"        '}'\\n\"\n      ++ \"     ];\\n\"\n      ++ \" \\n\"\n      ++ \" d3.select(\\\"#graph\\\").graphviz()\\n\"\n      ++ \"     .renderDot(dot.join(''));\\n\"\n      ++ \" \\n\"\n      ++ \" \u003c/script\u003e\\n\"\n```\n\nYou can see this in action in the following screen shot:\n\n![SiteMap](img/SiteMap.png)\n\n## Appendix\n\n### How to build\n    stack init\n    stack install\n    HsWiki\n\n### Installation under Windows\n\nUnder Windows you will have to install the ICU library. I used the latest win64 version from https://github.com/unicode-org/icu/releases/tag/release-70-1. You'll have to manually copy *.ddl and *.h files to the following locations: \n\n- The actual lib files go to `C:\\Users\\\u003cusername\u003e\\AppData\\Local\\Programs\\stack\\x86_64-windows\\msys2-\u003cinstalldate\u003e\\mingw64\\lib`\n  Don't forget to strip version number from the .dll files (so icuuc70.dll becomes icuuc.dll)\n- The include files go to `C:\\Users\\\u003cusername\u003e\\AppData\\Local\\Programs\\stack\\x86_64-windows\\msys2-\u003cinstalldate\u003e\\mingw64\\include\\unicode`\n","project_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fthma%2Fhswiki","html_url":"https://awesome.ecosyste.ms/projects/github.com%2Fthma%2Fhswiki","lists_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fthma%2Fhswiki/lists"}