From a010b83a7542d1324bde3d248c24faae9e681dbd Mon Sep 17 00:00:00 2001
From: mb21 <mb21@users.noreply.github.com>
Date: Sun, 26 Jul 2015 18:30:47 +0200
Subject: Updated readers, writers and README for link attribute

---
 src/Text/Pandoc/Readers/CommonMark.hs |  2 +-
 src/Text/Pandoc/Readers/DocBook.hs    |  3 ++-
 src/Text/Pandoc/Readers/Docx.hs       |  4 ++--
 src/Text/Pandoc/Readers/EPUB.hs       | 12 ++++++------
 src/Text/Pandoc/Readers/HTML.hs       | 18 ++++--------------
 src/Text/Pandoc/Readers/RST.hs        |  2 +-
 6 files changed, 16 insertions(+), 25 deletions(-)

(limited to 'src/Text/Pandoc/Readers')

diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 9112979ab..7f752c446 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -113,7 +113,7 @@ addInline (Node _ EMPH nodes) =
 addInline (Node _ STRONG nodes) =
   (Strong (addInlines nodes) :)
 addInline (Node _ (LINK url title) nodes) =
-  (Link (addInlines nodes) (unpack url, unpack title) :)
+  (Link nullAttr (addInlines nodes) (unpack url, unpack title) :)
 addInline (Node _ (IMAGE url title) nodes) =
   (Image nullAttr (addInlines nodes) (unpack url, unpack title) :)
 addInline _ = id
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index cbd50c252..db438e26d 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -967,7 +967,8 @@ parseInline (Elem e) =
                                Just h -> h
                                _      -> ('#' : attrValue "linkend" e)
              let ils' = if ils == mempty then str href else ils
-             return $ link href "" ils'
+             let attr = (attrValue "id" e, words $ attrValue "role" e, [])
+             return $ linkWith href "" attr ils'
         "foreignphrase" -> emph <$> innerInlines
         "emphasis" -> case attrValue "role" e of
                              "bold"   -> strong <$> innerInlines
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 67a97ae85..b80280553 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -533,10 +533,10 @@ bodyPartToBlocks (OMathPara e) = do
 
 -- replace targets with generated anchors.
 rewriteLink' :: Inline -> DocxContext Inline
-rewriteLink' l@(Link ils ('#':target, title)) = do
+rewriteLink' l@(Link attr ils ('#':target, title)) = do
   anchorMap <- gets docxAnchorMap
   return $ case M.lookup target anchorMap of
-    Just newTarget -> (Link ils ('#':newTarget, title))
+    Just newTarget -> (Link attr ils ('#':newTarget, title))
     Nothing        -> l
 rewriteLink' il = return il
 
diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs
index 04edf4c6a..fb86f1286 100644
--- a/src/Text/Pandoc/Readers/EPUB.hs
+++ b/src/Text/Pandoc/Readers/EPUB.hs
@@ -192,20 +192,20 @@ fixInlineIRs s (Span as v) =
   Span (fixAttrs s as) v
 fixInlineIRs s (Code as code) =
   Code (fixAttrs s as) code
-fixInlineIRs s (Link t ('#':url, tit)) =
-  Link t (addHash s url, tit)
+fixInlineIRs s (Link attr t ('#':url, tit)) =
+  Link attr t (addHash s url, tit)
 fixInlineIRs _ v = v
 
 normalisePath :: Inline -> Inline
-normalisePath (Link t (url, tit)) =
+normalisePath (Link attr t (url, tit)) =
   let (path, uid) = span (/= '#') url in
-  Link t (takeFileName path ++ uid, tit)
+  Link attr t (takeFileName path ++ uid, tit)
 normalisePath s = s
 
 prependHash :: [String] -> Inline -> Inline
-prependHash ps l@(Link is (url, tit))
+prependHash ps l@(Link attr is (url, tit))
   | or [s `isPrefixOf` url | s <- ps] =
-    Link is ('#':url, tit)
+    Link attr is ('#':url, tit)
   | otherwise = l
 prependHash _ i = i
 
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index d0ee893f2..5a93e0d5b 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -576,16 +576,8 @@ pLineBreak = do
   return B.linebreak
 
 pLink :: TagParser Inlines
-pLink = pRelLink <|> pAnchor
-
-pAnchor :: TagParser Inlines
-pAnchor = try $ do
-  tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "id"))
-  return $ B.spanWith (fromAttrib "id" tag , [], []) mempty
-
-pRelLink :: TagParser Inlines
-pRelLink = try $ do
-  tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
+pLink = try $ do
+  tag <- pSatisfy $ tagOpenLit "a" (const True)
   mbBaseHref <- baseHref <$> getState
   let url' = fromAttrib "href" tag
   let url = case (isURI url', mbBaseHref) of
@@ -593,11 +585,9 @@ pRelLink = try $ do
                  _               -> url'
   let title = fromAttrib "title" tag
   let uid = fromAttrib "id" tag
-  let spanC = case uid of
-              [] -> id
-              s  -> B.spanWith (s, [], [])
+  let cls = words $ fromAttrib "class" tag
   lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a")
-  return $ spanC $ B.link (escapeURI url) title lab
+  return $ B.linkWith (escapeURI url) title (uid, cls, []) lab
 
 pImage :: TagParser Inlines
 pImage = do
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 8969c3176..4138d65ea 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -814,7 +814,7 @@ substKey = try $ do
              -- use alt unless :alt: attribute on image:
              [Para [Image _ [Str "image"] (src,tit)]] ->
                 return $ B.image src tit alt
-             [Para [Link [Image _ [Str "image"] (src,tit)] (src',tit')]] ->
+             [Para [Link _ [Image _ [Str "image"] (src,tit)] (src',tit')]] ->
                 return $ B.link src' tit' (B.image src tit alt)
              [Para ils] -> return $ B.fromList ils
              _          -> mzero
-- 
cgit v1.2.3