Tue Nov 28 11:46:43 UTC 2017

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

On branches: alexbiehl-patch-1,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,master,pr-filter-maps,pr/cabal-desc,travis,v2.18,wip-located-module-as,wip/D2418,wip/T12942,wip/T13163,wip/T14529,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/7c60df10642d90d7205cb9c4296903b8de094029

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

commit 7c60df10642d90d7205cb9c4296903b8de094029
Author: Oleg Grenrus <oleg.grenrus at iki.fi>
Date:   Tue May 24 16:53:35 2016 +0300

    Change Hyperlinked lexer to know about DataKinds ticks


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

7c60df10642d90d7205cb9c4296903b8de094029
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 12 +++++++++++-
 haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs  |  3 +++
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index e206413..e434560 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -31,12 +31,20 @@ chunk str@(c:_)
 chunk str
     | "--" `isPrefixOf` str = chunk' $ spanToNewline str
     | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
-    | otherwise = case lex str of
+    | otherwise = case lex' str of
         (tok:_) -> chunk' tok
         [] -> [str]
   where
     chunk' (c, rest) = c:(chunk rest)
 
+-- | A bit better lexer then the default, i.e. handles DataKinds quotes
+lex' :: ReadS String
+lex' ('\'' : '\'' : rest)              = [("''", rest)]
+lex' str@('\'' : '\\' : _ : '\'' : _)  = lex str
+lex' str@('\'' : _ : '\'' : _)         = lex str
+lex' ('\'' : rest)                     = [("'", rest)]
+lex' str                               = lex str
+
 -- | Split input to "first line" string and the rest of it.
 --
 -- Ideally, this should be done simply with @'break' (== '\n')@. However,
@@ -124,6 +132,8 @@ classify str
     | "--" `isPrefixOf` str = TkComment
     | "{-#" `isPrefixOf` str = TkPragma
     | "{-" `isPrefixOf` str = TkComment
+classify "''" = TkSpecial
+classify "'"  = TkSpecial
 classify str@(c:_)
     | isSpace c = TkSpace
     | isDigit c = TkNumber
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
index 5f4dbc8..b27ec4d 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -12,16 +12,19 @@ data Token = Token
     , tkValue :: String
     , tkSpan :: Span
     }
+    deriving (Show)
 
 data Position = Position
     { posRow :: !Int
     , posCol :: !Int
     }
+    deriving (Show)
 
 data Span = Span
     { spStart :: Position
     , spEnd :: Position
     }
+    deriving (Show)
 
 data TokenType
     = TkIdentifier

