Shared: export `adjustImagePaths`...images2

and use it in the Markdown reader.

2 files changed, 32 insertions, 14 deletions

diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index f6a1589da..55354c3e5 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -29,7 +29,7 @@ import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.ByteString.Lazy as BL
-import System.FilePath (addExtension, takeExtension, takeDirectory, (</>))
+import System.FilePath (takeDirectory)
 import Text.HTML.TagSoup hiding (Row)
 import Text.Pandoc.Builder (Blocks, Inlines)
 import qualified Text.Pandoc.Builder as B
@@ -1917,18 +1917,8 @@ image = try $ do
   (lab,raw) <- reference
   loc <- takeDirectory . sourceName <$> getPosition
   defaultExt <- getOption readerDefaultImageExtension
-  let constructor (ident, classes, kvs) src =
-        let attr' = (ident, classes,
-                       if loc == "."
-                          then kvs
-                          else ("basename", src):kvs)
-            src' = if loc == "."
-                      then T.unpack src
-                      else loc </> T.unpack src
-         in case takeExtension src' of
-              "" -> B.imageWith attr' (T.pack $ addExtension src'
-                                                (T.unpack defaultExt))
-              _  -> B.imageWith attr' (T.pack src')
+  let constructor attr src tit = adjustImagePaths loc defaultExt
+                                 . B.imageWith attr src tit
   regLink constructor lab <|> referenceLink constructor (lab,raw)
 
 note :: PandocMonad m => MarkdownParser m (F Inlines)
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 920edca7b..f8a5062de 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -70,6 +70,7 @@ module Text.Pandoc.Shared (
                      htmlSpanLikeElements,
                      splitSentences,
                      filterIpynbOutput,
+                     adjustImagePaths,
                      -- * TagSoup HTML handling
                      renderTags',
                      -- * File handling
@@ -116,7 +117,8 @@ import Data.Version (showVersion)
 import Network.URI (URI (uriScheme), escapeURIString, parseURI)
 import Paths_pandoc (version)
 import System.Directory
-import System.FilePath (isPathSeparator, splitDirectories)
+import System.FilePath (isPathSeparator, splitDirectories, (</>), addExtension,
+                       takeExtension)
 import qualified System.FilePath.Posix as Posix
 import Text.HTML.TagSoup (RenderOptions (..), Tag (..), renderOptions,
                           renderTagsOptions)
@@ -776,6 +778,32 @@ filterIpynbOutput mode = walk go
                     | otherwise = ""
         go x = x
 
+-- | Adjust image paths by (a) adding the default extension,
+-- if one is defined and the image lacks an extension, and
+-- (b) adding the (relative) directory of the containing file to the
+-- path (e.g. an image link to @foo.jpg@ that occurs in @bar/baz.md@
+-- would be changed to @bar/foo.jpg@).  When transformation (b)
+-- is done, a @basename@ attribute is added to the image with the
+-- original name. (This may be needed if we have to seek the image in the
+-- resource path.)
+adjustImagePaths :: FilePath -> T.Text -> Inlines -> Inlines
+adjustImagePaths directory defaultExt = fmap go
+ where
+   go :: Inline -> Inline
+   go (Image (ident,classes,kvs) alt (src,tit)) =
+     let attr' = (ident, classes,
+                    if null directory || directory == "."
+                       then kvs
+                       else ("basename", src):kvs)
+         src' = if null directory || directory == "."
+                   then T.unpack src
+                   else directory </> T.unpack src
+         src'' = case takeExtension src' of
+                   "" -> T.pack $ addExtension src' (T.unpack defaultExt)
+                   _  -> T.pack src'
+      in Image attr' alt (src'',tit)
+   go x = x
+
 --
 -- TagSoup HTML handling
 --