diff options
author | Simon Hengel <sol@typeful.net> | 2014-11-02 10:13:00 +0800 |
---|---|---|
committer | Simon Hengel <sol@typeful.net> | 2014-11-03 09:34:19 +0800 |
commit | 77ed6a63df3d2653401f1869f116c8854021a71e (patch) | |
tree | 29772002bb64595d9caf06a1596988713005e70b /haddock-library/src/Documentation/Haddock/Parser/Util.hs | |
parent | 09323ec10f4213461cfc2712f3075673f681a3e2 (diff) |
Add support for markdown links (closes #336)
Diffstat (limited to 'haddock-library/src/Documentation/Haddock/Parser/Util.hs')
-rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser/Util.hs | 18 |
1 files changed, 10 insertions, 8 deletions
diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs index ef2af140..eff7dfc6 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs @@ -14,6 +14,7 @@ module Documentation.Haddock.Parser.Util ( unsnoc , strip , takeUntil +, removeEscapes , makeLabeled , takeHorizontalSpace , skipHorizontalSpace @@ -49,14 +50,15 @@ makeLabeled :: (String -> Maybe String -> a) -> String -> a makeLabeled f input = case break isSpace $ removeEscapes $ strip input of (uri, "") -> f uri Nothing (uri, label) -> f uri (Just $ dropWhile isSpace label) - where - -- As we don't parse these any further, we don't do any processing to the - -- string so we at least remove escape character here. Perhaps we should - -- actually be parsing the label at the very least? - removeEscapes "" = "" - removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs - removeEscapes ('\\':xs) = removeEscapes xs - removeEscapes (x:xs) = x : removeEscapes xs + +-- | Remove escapes from given string. +-- +-- Only do this if you do not process (read: parse) the input any further. +removeEscapes :: String -> String +removeEscapes "" = "" +removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs +removeEscapes ('\\':xs) = removeEscapes xs +removeEscapes (x:xs) = x : removeEscapes xs takeUntil :: ByteString -> Parser ByteString takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome |