From 61942ce564edcb3c0a64051042c8ed850f2090bd Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Thu, 18 Jun 2015 15:19:59 +0200
Subject: Add support for parsing C preprocessor macros.

---
 .../src/Haddock/Backends/Hyperlinker/Parser.hs       | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

(limited to 'haddock-api')

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index fa5a58b3..7f408165 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -6,6 +6,7 @@ module Haddock.Backends.Hyperlinker.Parser
 
 import Data.Char
 import Data.List
+import Data.Maybe
 
 data Token = Token
     { tkType :: TokenType
@@ -45,14 +46,15 @@ parse = tokenize . tag . chunk
 chunk :: String -> [String]
 chunk [] = []
 chunk str@(c:_)
-    | isSpace c = chunk' $ span isSpace str
+    | isSpace c =
+        let (space, mcpp, rest) = spanSpaceOrCpp str
+        in [space] ++ maybeToList mcpp ++ chunk rest
 chunk str
     | "--" `isPrefixOf` str = chunk' $ spanToNewline str
     | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
     | otherwise = chunk' $ head $ lex str
-
-chunk' :: (String, String) -> [String]
-chunk' (c, rest) = c:(chunk rest)
+  where
+    chunk' (c, rest) = c:(chunk rest)
 
 spanToNewline :: String -> (String, String)
 spanToNewline [] = ([], [])
@@ -64,6 +66,16 @@ spanToNewline (c:str) =
     let (str', rest) = spanToNewline str
     in (c:str', rest)
 
+spanSpaceOrCpp :: String -> (String, Maybe String, String)
+spanSpaceOrCpp ('\n':'#':str) =
+    let (str', rest) = spanToNewline str
+    in ("\n", Just $ '#':str', rest)
+spanSpaceOrCpp (c:str')
+    | isSpace c =
+        let (space, mcpp, rest) = spanSpaceOrCpp str'
+        in (c:space, mcpp, rest)
+spanSpaceOrCpp str = ("", Nothing, str)
+
 chunkComment :: Int -> String -> (String, String)
 chunkComment _ [] = ("", "")
 chunkComment depth ('{':'-':str) =
-- 
cgit v1.2.3