refactor(createPngFallbacks): store Image attributes too

Signed-off-by: Edwin Török <[email protected]>

Author: edwintorok

src/Text/Pandoc/App.hs

@@ -34,6 +34,7 @@ import Control.Monad.Catch ( MonadMask )
 import Control.Monad.Except (throwError)
 import qualified Data.ByteString.Lazy as BL
 import Data.Maybe (fromMaybe, isJust, isNothing)
+import Data.Map (findWithDefault)
 import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -308,7 +309,7 @@ convertWithOpts' scriptingEngine istty datadir opts = do
             )
 
   when (format == "docx" && not (optSandbox opts)) $ do
-    createPngFallbacks (writerDpi writerOptions)
+    createPngFallbacks writerOptions
 
   output <- case writer of
     ByteStringWriter f
@@ -372,14 +373,16 @@ readAbbreviations mbfilepath =
     >>= fmap (Set.fromList . filter (not . T.null) . T.lines) .
          toTextM (fromMaybe mempty mbfilepath)
 
-createPngFallbacks :: (PandocMonad m, MonadIO m) => Int -> m ()
-createPngFallbacks dpi = do
+createPngFallbacks :: (PandocMonad m, MonadIO m) => WriterOptions -> m ()
+createPngFallbacks opts = do
   -- create fallback pngs for svgs
   items <- mediaItems <$> getMediaBag
+  attributes <- getImageAttrs
   forM_ items $ \(fp, mt, bs) ->
     case T.takeWhile (/=';') mt of
       "image/svg+xml" -> do
-        res <- svgToPng dpi bs
+        let attr = Data.Map.findWithDefault nullAttr fp attributes
+        res <- svgToPng (writerDpi opts) bs
         case res of
           Right bs' -> do
             let fp' = fp <> ".png"

src/Text/Pandoc/Class/CommonState.hs

@@ -23,6 +23,8 @@ import Text.Collate.Lang (Lang)
 import Text.Pandoc.MediaBag (MediaBag)
 import Text.Pandoc.Logging (LogMessage, Verbosity (WARNING))
 import Text.Pandoc.Translations.Types (Translations)
+import Text.Pandoc.Definition (Attr)
+import qualified Data.Map as M
 
 -- | 'CommonState' represents state that is used by all
 -- instances of 'PandocMonad'.  Normally users should not
@@ -41,6 +43,8 @@ data CommonState = CommonState
     -- ^ Controls whether certificate validation is disabled
   , stMediaBag     :: MediaBag
     -- ^ Media parsed from binary containers
+  , stImageAttrs   :: M.Map FilePath Attr
+    -- ^ Image attributes
   , stTranslations :: Maybe (Lang, Maybe Translations)
     -- ^ Translations for localization
   , stInputFiles   :: [FilePath]
@@ -71,6 +75,7 @@ defaultCommonState = CommonState
   , stRequestHeaders = []
   , stNoCheckCertificate = False
   , stMediaBag = mempty
+  , stImageAttrs = M.empty
   , stTranslations = Nothing
   , stInputFiles = []
   , stOutputFile = Nothing

src/Text/Pandoc/Class/PandocMonad.hs

@@ -34,6 +34,7 @@ module Text.Pandoc.Class.PandocMonad
   , getLog
   , setVerbosity
   , getVerbosity
+  , getImageAttrs
   , getMediaBag
   , setMediaBag
   , insertMedia
@@ -86,6 +87,7 @@ import qualified Debug.Trace
 import qualified Text.Pandoc.MediaBag as MB
 import qualified Data.Text.Encoding as TSE
 import qualified Data.Text.Encoding.Error as TSE
+import Data.Map (Map, insert)
 
 -- | The PandocMonad typeclass contains all the potentially
 -- IO-related functions used in pandoc's readers and writers.
@@ -202,12 +204,26 @@ setMediaBag mb = modifyCommonState $ \st -> st{stMediaBag = mb}
 getMediaBag :: PandocMonad m => m MediaBag
 getMediaBag = getsCommonState stMediaBag
 
--- | Insert an item into the media bag.
+-- | Initialize the image attributes
+setImageAttrs :: PandocMonad m => Map FilePath Attr -> m ()
+setImageAttrs mb = modifyCommonState $ \st -> st{stImageAttrs = mb}
+
+-- | Retrieve the image attributes
+getImageAttrs :: PandocMonad m => m (Map FilePath Attr)
+getImageAttrs = getsCommonState stImageAttrs
+
 insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()
 insertMedia fp mime bs = do
-  mb <- getMediaBag
-  let mb' = MB.insertMedia fp mime bs mb
-  setMediaBag mb'
+    mb <- getMediaBag
+    let mb' = MB.insertMedia fp mime bs mb
+    setMediaBag mb'
+
+-- | Insert an item into the media bag.
+insertAttr :: PandocMonad m => FilePath -> Attr -> m ()
+insertAttr fp attr = do
+    attrs <- getImageAttrs
+    let attrs' = Data.Map.insert fp attr attrs
+    setImageAttrs attrs'
 
 -- | Retrieve the input filenames.
 getInputFiles :: PandocMonad m => m [FilePath]
@@ -464,6 +480,7 @@ fillMediaBag d = walkM handleImage d
                 Nothing -> do
                   (bs, mt) <- fetchItem src
                   insertMedia fp mt (BL.fromStrict bs)
+              insertAttr fp attr
               return $ Image attr lab (src, tit))
           (\e ->
               case e of