Simplify autolink parsing code, using Network.URI to test for
URIs. Added dependency on network library to debian/control and pandoc.cabal. git-svn-id: https://pandoc.googlecode.com/svn/trunk@982 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
parent
f8f9fa49d6
commit
76d462c1cd
3 changed files with 26 additions and 27 deletions
2
debian/control
vendored
2
debian/control
vendored
|
@ -2,7 +2,7 @@ Source: pandoc
|
|||
Section: text
|
||||
Priority: optional
|
||||
Maintainer: Recai Oktaş <roktas@debian.org>
|
||||
Build-Depends: debhelper (>= 4.0.0), haskell-devscripts (>=0.5.12), ghc6 (>= 6.6-1), libghc6-xhtml-dev, libghc6-mtl-dev, perl
|
||||
Build-Depends: debhelper (>= 4.0.0), haskell-devscripts (>=0.5.12), ghc6 (>= 6.6-1), libghc6-xhtml-dev, libghc6-mtl-dev, libghc6-network-dev, perl
|
||||
Build-Depends-Indep: haddock
|
||||
Standards-Version: 3.7.2.0
|
||||
XS-Vcs-Svn: http://pandoc.googlecode.com/svn/trunk
|
||||
|
|
|
@ -31,7 +31,7 @@ Description: Pandoc is a Haskell library for converting from one markup
|
|||
which convert this native representation into a target
|
||||
format. Thus, adding an input or output format requires
|
||||
only adding a reader or writer.
|
||||
Build-Depends: base, parsec, xhtml, mtl, regex-compat
|
||||
Build-Depends: base, parsec, xhtml, mtl, regex-compat, network
|
||||
Hs-Source-Dirs: src
|
||||
Exposed-Modules: Text.Pandoc,
|
||||
Text.Pandoc.Blocks,
|
||||
|
|
|
@ -31,9 +31,10 @@ module Text.Pandoc.Readers.Markdown (
|
|||
readMarkdown
|
||||
) where
|
||||
|
||||
import Data.List ( transpose, isSuffixOf, lookup, sortBy )
|
||||
import Data.List ( transpose, isPrefixOf, isSuffixOf, lookup, sortBy )
|
||||
import Data.Ord ( comparing )
|
||||
import Data.Char ( isAlphaNum )
|
||||
import Network.URI ( isURI )
|
||||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Shared
|
||||
import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment )
|
||||
|
@ -738,9 +739,9 @@ doubleQuoted = try $ do
|
|||
|
||||
failIfInQuoteContext context = do
|
||||
st <- getState
|
||||
if (stateQuoteContext st == context)
|
||||
then fail "already inside quotes"
|
||||
else return ()
|
||||
if stateQuoteContext st == context
|
||||
then fail "already inside quotes"
|
||||
else return ()
|
||||
|
||||
singleQuoteStart = do
|
||||
failIfInQuoteContext InSingleQuote
|
||||
|
@ -839,32 +840,30 @@ referenceLink label = do
|
|||
Nothing -> fail "no corresponding key"
|
||||
Just target -> return target
|
||||
|
||||
autoLink = autoLinkEmail <|> autoLinkRegular
|
||||
emailAddress = try $ do
|
||||
name <- many1 (alphaNum <|> char '+')
|
||||
char '@'
|
||||
first <- many1 alphaNum
|
||||
rest <- many1 (char '.' >> many1 alphaNum)
|
||||
return $ "mailto:" ++ name ++ "@" ++ joinWithSep "." (first:rest)
|
||||
|
||||
-- a link <like@this.com>
|
||||
autoLinkEmail = try $ do
|
||||
uri = try $ do
|
||||
str <- many1 (noneOf "\n\t >")
|
||||
if isURI str
|
||||
then return str
|
||||
else fail "not a URI"
|
||||
|
||||
autoLink = try $ do
|
||||
char '<'
|
||||
name <- many1Till (noneOf "/:<> \t\n") (char '@')
|
||||
domain <- sepBy1 (many1 (noneOf "/:.@<> \t\n")) (char '.')
|
||||
src <- uri <|> emailAddress
|
||||
char '>'
|
||||
let src = name ++ "@" ++ (joinWithSep "." domain)
|
||||
txt <- autoLinkText src
|
||||
return $ Link txt (("mailto:" ++ src), "")
|
||||
|
||||
-- a link <http://like.this.com>
|
||||
autoLinkRegular = try $ do
|
||||
char '<'
|
||||
prot <- oneOfStrings ["http:", "ftp:", "mailto:"]
|
||||
rest <- many1Till (noneOf " \t\n<>") (char '>')
|
||||
let src = prot ++ rest
|
||||
txt <- autoLinkText src
|
||||
return $ Link txt (src, "")
|
||||
|
||||
autoLinkText src = do
|
||||
let src' = if "mailto:" `isPrefixOf` src
|
||||
then drop 7 src
|
||||
else src
|
||||
st <- getState
|
||||
return $ if stateStrict st
|
||||
then [Str src]
|
||||
else [Code src]
|
||||
then Link [Str src'] (src, "")
|
||||
else Link [Code src'] (src, "")
|
||||
|
||||
image = try $ do
|
||||
char '!'
|
||||
|
|
Loading…
Reference in a new issue