diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 28 |
1 files changed, 27 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index 4bcc0c8a..4e0d7382 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -1,5 +1,8 @@ module Haddock.Backends.Hyperlinker.Parser (parse) where +import Data.Char +import Data.List + data Token = Token { tkType :: TokenType , tkValue :: String @@ -27,7 +30,30 @@ parse :: String -> [Token] parse = tokenize . tag . chunk chunk :: String -> [String] -chunk = undefined +chunk [] = [] +chunk str@(c:_) + | isSpace c = chunk' $ span isSpace str +chunk str + | "--" `isPrefixOf` str = chunk' $ span (not . (== '\n')) str + | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str + | otherwise = chunk' $ head $ lex str + +chunk' :: (String, String) -> [String] +chunk' (c, rest) = c:(chunk rest) + +chunkComment :: Int -> String -> (String, String) +chunkComment _ [] = ("", "") +chunkComment depth ('{':'-':str) = + let (c, rest) = chunkComment (depth + 1) str + in ("{-" ++ c, rest) +chunkComment depth ('-':'}':str) + | depth == 1 = ("-}", str) + | otherwise = + let (c, rest) = chunkComment (depth - 1) str + in ("-}" ++ c, rest) +chunkComment depth (e:str) = + let (c, rest) = chunkComment depth str + in (e:c, rest) tag :: [String] -> [(Span, String)] tag = |