diff options
| -rw-r--r-- | Text/Pandoc/Readers/Markdown.hs | 16 | ||||
| -rw-r--r-- | Text/Pandoc/Readers/RST.hs | 25 | ||||
| -rw-r--r-- | Text/Pandoc/Shared.hs | 35 |
3 files changed, 36 insertions, 40 deletions
diff --git a/Text/Pandoc/Readers/Markdown.hs b/Text/Pandoc/Readers/Markdown.hs index 38129d4b7..9b927ccd7 100644 --- a/Text/Pandoc/Readers/Markdown.hs +++ b/Text/Pandoc/Readers/Markdown.hs @@ -35,7 +35,6 @@ import Data.List ( transpose, isPrefixOf, isSuffixOf, lookup, sortBy, findIndex import Data.Ord ( comparing ) import Data.Char ( isAlphaNum ) import Data.Maybe ( fromMaybe ) -import Network.URI ( isURI ) import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment ) @@ -850,22 +849,9 @@ referenceLink label = do Nothing -> fail "no corresponding key" Just target -> return target -emailAddress = try $ do - name <- many1 (alphaNum <|> char '+') - char '@' - first <- many1 alphaNum - rest <- many1 (char '.' >> many1 alphaNum) - return $ "mailto:" ++ name ++ "@" ++ joinWithSep "." (first:rest) - -uri = try $ do - str <- many1 (noneOf "\n\t >") - if isURI str - then return str - else fail "not a URI" - autoLink = try $ do char '<' - src <- uri <|> emailAddress + src <- uri <|> (emailAddress >>= (return . ("mailto:" ++))) char '>' let src' = if "mailto:" `isPrefixOf` src then drop 7 src diff --git a/Text/Pandoc/Readers/RST.hs b/Text/Pandoc/Readers/RST.hs index 1239eb688..ad3467d84 100644 --- a/Text/Pandoc/Readers/RST.hs +++ b/Text/Pandoc/Readers/RST.hs @@ -592,35 +592,10 @@ referenceLink = try $ do setState $ state { stateKeys = keyTable' } return $ Link (normalizeSpaces label) src -uriScheme = oneOfStrings [ "http://", "https://", "ftp://", "file://", - "mailto:", "news:", "telnet:" ] - -uri = try $ do - scheme <- uriScheme - identifier <- many1 (noneOf " \t\n") - return $ scheme ++ identifier - autoURI = do src <- uri return $ Link [Str src] (src, "") -emailChar = alphaNum <|> oneOf "-+_." - -emailAddress = try $ do - firstLetter <- alphaNum - restAddr <- many emailChar - let addr = firstLetter:restAddr - char '@' - dom <- domain - return $ addr ++ '@':dom - -domainChar = alphaNum <|> char '-' - -domain = do - first <- many1 domainChar - dom <- many1 (try (do{ char '.'; many1 domainChar })) - return $ joinWithSep "." (first:dom) - autoEmail = do src <- emailAddress return $ Link [Str src] ("mailto:" ++ src, "") diff --git a/Text/Pandoc/Shared.hs b/Text/Pandoc/Shared.hs index 32cc2ce59..7086ca452 100644 --- a/Text/Pandoc/Shared.hs +++ b/Text/Pandoc/Shared.hs @@ -64,6 +64,8 @@ module Text.Pandoc.Shared ( charsInBalanced, charsInBalanced', romanNumeral, + emailAddress, + uri, withHorizDisplacement, nullBlock, failIfStrict, @@ -105,6 +107,7 @@ import Text.Pandoc.CharacterReferences ( characterReference ) import Data.Char ( toLower, toUpper, ord, isLower, isUpper ) import Data.List ( find, isPrefixOf ) import Control.Monad ( join ) +import Network.URI ( parseURI, URI (..), isAllowedInURI ) -- -- List processing @@ -404,6 +407,38 @@ romanNumeral upperCase = do then fail "not a roman numeral" else return total +-- Parsers for email addresses and URIs + +emailChar = alphaNum <|> oneOf "-+_." + +domainChar = alphaNum <|> char '-' + +domain = do + first <- many1 domainChar + dom <- many1 (try (do{ char '.'; many1 domainChar })) + return $ joinWithSep "." (first:dom) + +-- | Parses an email address; returns string. +emailAddress :: GenParser Char st [Char] +emailAddress = try $ do + firstLetter <- alphaNum + restAddr <- many emailChar + let addr = firstLetter:restAddr + char '@' + dom <- domain + return $ addr ++ '@':dom + +-- | Parses a URI. +uri = try $ do + str <- many1 $ satisfy isAllowedInURI + case parseURI str of + Just uri' -> if uriScheme uri' `elem` [ "http:", "https:", "ftp:", + "file:", "mailto:", + "news:", "telnet:" ] + then return $ show uri' + else fail "not a URI" + Nothing -> fail "not a URI" + -- | Applies a parser, returns tuple of its results and its horizontal -- displacement (the difference between the source column at the end -- and the source column at the beginning). Vertical displacement |