diff options
Diffstat (limited to 'haddock-api/src')
| -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 = | 
