aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/src/Documentation/Haddock/Parser/Util.hs
diff options
context:
space:
mode:
authorSimon Hengel <sol@typeful.net>2014-11-02 10:13:00 +0800
committerSimon Hengel <sol@typeful.net>2014-11-03 09:34:19 +0800
commit77ed6a63df3d2653401f1869f116c8854021a71e (patch)
tree29772002bb64595d9caf06a1596988713005e70b /haddock-library/src/Documentation/Haddock/Parser/Util.hs
parent09323ec10f4213461cfc2712f3075673f681a3e2 (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.hs18
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