[commit: haddock] master: Create simple HTML renderer for parsed source file. (5e904cb)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/5e904cb1c3d769d5b99d459838b4b5368c8c1fb7

>---------------------------------------------------------------

commit 5e904cb1c3d769d5b99d459838b4b5368c8c1fb7
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Fri Jun 5 12:59:10 2015 +0200

    Create simple HTML renderer for parsed source file.


>---------------------------------------------------------------

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

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index b90e3bf..6c6dc81 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 0000000..eaf5b37
--- /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 = []