From 6beba76f61faa41c4351fa4eb54161c060315a23 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 18 Mar 2011 11:27:42 -0700
Subject: Changed uri parser so it doesn't include trailing punctuation.

So, in RST, 'http://google.com.' should be parsed as a link
to 'http://google.com' followed by a period.

The parser is smart enough to recognize balanced parentheses,
as often occur in wikipedia links: 'http://foo.bar/baz_(bam)'.

Also added ()s to RST specialChars, so '(http://google.com)'
will be parsed as a link in parens.

Added test cases.

Resolves Issue #291.
---
 src/Text/Pandoc/Parsing.hs     | 22 +++++++++++++++++++---
 src/Text/Pandoc/Readers/RST.hs |  2 +-
 2 files changed, 20 insertions(+), 4 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 9ce064f91..187343f9c 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -78,7 +78,7 @@ import Text.Pandoc.Generic
 import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
 import Text.ParserCombinators.Parsec
 import Text.Pandoc.CharacterReferences ( characterReference )
-import Data.Char ( toLower, toUpper, ord, isAscii, isAlphaNum, isDigit )
+import Data.Char ( toLower, toUpper, ord, isAscii, isAlphaNum, isDigit, isPunctuation )
 import Data.List ( intercalate, transpose )
 import Network.URI ( parseURI, URI (..), isAllowedInURI )
 import Control.Monad ( join, liftM, guard )
@@ -264,8 +264,24 @@ uri = try $ do
   let protocols = [ "http:", "https:", "ftp:", "file:", "mailto:",
                     "news:", "telnet:" ]
   lookAhead $ oneOfStrings protocols
-  -- scan non-ascii characters and ascii characters allowed in a URI
-  str <- many1 $ satisfy (\c -> not (isAscii c) || isAllowedInURI c)
+  -- Scan non-ascii characters and ascii characters allowed in a URI.
+  -- We allow punctuation except when followed by a space, since
+  -- we don't want the trailing '.' in 'http://google.com.'
+  let innerPunct = try $ satisfy isPunctuation >>~
+                         notFollowedBy (newline <|> spaceChar)
+  let uriChar = innerPunct <|>
+                satisfy (\c -> not (isPunctuation c) &&
+                            (not (isAscii c) || isAllowedInURI c))
+  -- We want to allow
+  -- http://en.wikipedia.org/wiki/State_of_emergency_(disambiguation)
+  -- as a URL, while NOT picking up the closing paren in
+  -- (http://wikipedia.org)
+  -- So we include balanced parens in the URL.
+  let inParens = try $ do char '('
+                          res <- many uriChar
+                          char ')'
+                          return $ '(' : res ++ ")"
+  str <- liftM concat $ many1 $ inParens <|> count 1 (innerPunct <|> uriChar)
   -- now see if they amount to an absolute URI
   case parseURI (escapeURI str) of
        Just uri' -> if uriScheme uri' `elem` protocols
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 2cfab0f53..736219d68 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -58,7 +58,7 @@ underlineChars = "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"
 
 -- treat these as potentially non-text when parsing inline:
 specialChars :: [Char]
-specialChars = "\\`|*_<>$:[-.\"'\8216\8217\8220\8221"
+specialChars = "\\`|*_<>$:[]()-.\"'\8216\8217\8220\8221"
 
 --
 -- parsing documents
-- 
cgit v1.2.3