diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-04 21:10:26 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-30 22:37:48 +0200 |
commit | 413f7f322cd174e2ba4116dbf53c1b3c0d6a4f77 (patch) | |
tree | ee172771f0b91e3b362c8bb3396d8081ca62d80f | |
parent | e17f62506ecf20d61781c610d6fbb5f3c8cd132e (diff) |
Implement simple string chunking based on HsColour library.
-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 = |