EPUB reader: Further URI handling improvements.

Now we outsource most of the work to `fetchItem'`.
Also, do not include queries in file extensions.

Improves fix to #1671.

It is possible that this will have some unexpected effects, so
further testing would be good.

1 files changed, 12 insertions, 25 deletions

diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 905cdfaf6..53574711f 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -64,8 +64,6 @@ import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
 import Text.Pandoc.UUID (getRandomUUID)
 import Text.Pandoc.Writers.HTML (writeHtmlString, writeHtml)
 import Data.Char ( toLower, isDigit, isAlphaNum )
-import Network.URI ( unEscapeString, nonStrictRelativeTo,
-                     escapeURIString, isAllowedInURI, parseURIReference )
 import Text.Pandoc.MIME (MimeType, getMimeType)
 import qualified Control.Exception as E
 import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
@@ -766,23 +764,20 @@ metadataElement version md currentTime =
 showDateTimeISO8601 :: UTCTime -> String
 showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
 
-transformTag :: WriterOptions
-             -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
+transformTag :: IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
              -> Tag String
              -> IO (Tag String)
-transformTag opts mediaRef tag@(TagOpen name attr)
+transformTag mediaRef tag@(TagOpen name attr)
   | name `elem` ["video", "source", "img", "audio"] = do
   let src = fromAttrib "src" tag
   let poster = fromAttrib "poster" tag
-  let oldsrc = src `relativeTo` writerSourceURL opts
-  let oldposter = poster `relativeTo` writerSourceURL opts
-  newsrc <- modifyMediaRef mediaRef oldsrc
-  newposter <- modifyMediaRef mediaRef oldposter
+  newsrc <- modifyMediaRef mediaRef src
+  newposter <- modifyMediaRef mediaRef poster
   let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
               [("src", newsrc) | not (null newsrc)] ++
               [("poster", newposter) | not (null newposter)]
   return $ TagOpen name attr'
-transformTag _ _ tag = return tag
+transformTag _ tag = return tag
 
 modifyMediaRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath
 modifyMediaRef _ "" = return ""
@@ -792,7 +787,7 @@ modifyMediaRef mediaRef oldsrc = do
          Just n  -> return n
          Nothing -> do
            let new = "media/file" ++ show (length media) ++
-                    takeExtension oldsrc
+                    takeExtension (takeWhile (/='?') oldsrc) -- remove query
            modifyIORef mediaRef ( (oldsrc, new): )
            return new
 
@@ -800,10 +795,10 @@ transformBlock  :: WriterOptions
                 -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
                 -> Block
                 -> IO Block
-transformBlock opts mediaRef (RawBlock fmt raw)
+transformBlock _ mediaRef (RawBlock fmt raw)
   | fmt == Format "html" = do
   let tags = parseTags raw
-  tags' <- mapM (transformTag opts mediaRef)  tags
+  tags' <- mapM (transformTag mediaRef)  tags
   return $ RawBlock fmt (renderTags' tags')
 transformBlock _ _ b = return b
 
@@ -811,18 +806,17 @@ transformInline  :: WriterOptions
                  -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
                  -> Inline
                  -> IO Inline
-transformInline opts mediaRef (Image lab (src,tit)) = do
-    let oldsrc = src `relativeTo` writerSourceURL opts
-    newsrc <- modifyMediaRef mediaRef oldsrc
+transformInline _ mediaRef (Image lab (src,tit)) = do
+    newsrc <- modifyMediaRef mediaRef src
     return $ Image lab (newsrc, tit)
 transformInline opts _ (x@(Math _ _))
   | WebTeX _ <- writerHTMLMathMethod opts = do
     raw <- makeSelfContained opts $ writeHtmlInline opts x
     return $ RawInline (Format "html") raw
-transformInline opts mediaRef  (RawInline fmt raw)
+transformInline _ mediaRef  (RawInline fmt raw)
   | fmt == Format "html" = do
   let tags = parseTags raw
-  tags' <- mapM (transformTag opts mediaRef) tags
+  tags' <- mapM (transformTag mediaRef) tags
   return $ RawInline fmt (renderTags' tags')
 transformInline _ _ x = return x
 
@@ -1205,10 +1199,3 @@ docTitle' meta = fromMaybe [] $ go <$> lookupMeta "title" meta
         go (MetaList xs) = concatMap go xs
         go _ = []
 
-relativeTo :: String -> Maybe String -> String
-relativeTo src mbbase =
-  case (parseURIReference (ensureEscaped src),
-        mbbase >>= parseURIReference . ensureEscaped) of
-        (Just src', Just base') -> show (src' `nonStrictRelativeTo` base')
-        _                       -> unEscapeString src
-  where ensureEscaped  = escapeURIString isAllowedInURI