aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Hyperlinker
diff options
context:
space:
mode:
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
commit413f7f322cd174e2ba4116dbf53c1b3c0d6a4f77 (patch)
treeee172771f0b91e3b362c8bb3396d8081ca62d80f /haddock-api/src/Haddock/Backends/Hyperlinker
parente17f62506ecf20d61781c610d6fbb5f3c8cd132e (diff)
Implement simple string chunking based on HsColour library.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs28
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 =