From 5e904cb1c3d769d5b99d459838b4b5368c8c1fb7 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 12:59:10 +0200
Subject: Create simple HTML renderer for parsed source file.

---
 haddock-api/haddock-api.cabal                      |  3 ++-
 .../src/Haddock/Backends/Hyperlinker/Renderer.hs   | 26 ++++++++++++++++++++++
 2 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index b90e3bff..6c6dc810 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -57,6 +57,8 @@ library
 
   exposed-modules:
     Documentation.Haddock
+    Haddock.Backends.Hyperlinker.Parser
+    Haddock.Backends.Hyperlinker.Renderer
 
   other-modules:
     Haddock
@@ -79,7 +81,6 @@ library
     Haddock.Backends.LaTeX
     Haddock.Backends.HaddockDB
     Haddock.Backends.Hoogle
-    Haddock.Backends.Hyperlinker.Parser
     Haddock.ModuleTree
     Haddock.Types
     Haddock.Doc
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
new file mode 100644
index 00000000..eaf5b37b
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -0,0 +1,26 @@
+module Haddock.Backends.Hyperlinker.Renderer where
+
+import Haddock.Backends.Hyperlinker.Parser
+
+import Data.Monoid
+import Text.XHtml
+
+render :: [Token] -> Html
+render = body . pre . foldr (<>) noHtml . map renderToken
+
+renderToken :: Token -> Html
+renderToken (Token t v _) = thespan (toHtml v) ! tokenAttrs t
+
+tokenAttrs :: TokenType -> [HtmlAttr]
+tokenAttrs TkIdentifier = [theclass "hs-identifier"]
+tokenAttrs TkKeyword = [theclass "hs-keyword"]
+tokenAttrs TkString = [theclass "hs-string"]
+tokenAttrs TkChar = [theclass "hs-char"]
+tokenAttrs TkNumber = [theclass "hs-number"]
+tokenAttrs TkOperator = [theclass "hs-operator"]
+tokenAttrs TkGlyph = [theclass "hs-glyph"]
+tokenAttrs TkSpecial = [theclass "hs-special"]
+tokenAttrs TkSpace = []
+tokenAttrs TkComment = [theclass "hs-comment"]
+tokenAttrs TkCpp = [theclass "hs-cpp"]
+tokenAttrs TkUnknown = []
-- 
cgit v1.2.3