refactor(svgToPng): introduce PandocMonad.svgToPng

This will be needed to run the conversion inside the PandocMonad,
where we know the desired image size.

The arguments are: (dpi, width, height).
The width and height is optional to more easily convert existing code.

[API change]

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

Author: edwintorok

pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs

@@ -70,6 +70,7 @@ instance PandocMonad PandocLua where
   readFileLazy = IO.readFileLazy
   readFileStrict = IO.readFileStrict
   readStdinStrict = IO.readStdinStrict
+  svgToPng = IO.svgToPng
 
   glob = IO.glob
   fileExists = IO.fileExists

src/Text/Pandoc/App.hs

@@ -50,7 +50,6 @@ import qualified System.IO as IO (Newline (..))
 import Text.Pandoc
 import Text.Pandoc.Builder (setMeta)
 import Text.Pandoc.MediaBag (mediaItems)
-import Text.Pandoc.Image (svgToPng)
 import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), defaultOpts,
                             IpynbOutput (..), OptInfo(..))
 import Text.Pandoc.App.CommandLineOptions (parseOptions, parseOptionsFromArgs,
@@ -372,14 +371,14 @@ readAbbreviations mbfilepath =
     >>= fmap (Set.fromList . filter (not . T.null) . T.lines) .
          toTextM (fromMaybe mempty mbfilepath)
 
-createPngFallbacks :: (PandocMonad m, MonadIO m) => Int -> m ()
+createPngFallbacks :: (PandocMonad m) => Int -> m ()
 createPngFallbacks dpi = do
   -- create fallback pngs for svgs
   items <- mediaItems <$> getMediaBag
   forM_ items $ \(fp, mt, bs) ->
     case T.takeWhile (/=';') mt of
       "image/svg+xml" -> do
-        res <- svgToPng dpi bs
+        res <- svgToPng (dpi, Nothing, Nothing, bs)
         case res of
           Right bs' -> do
             let fp' = fp <> ".png"

src/Text/Pandoc/Class/IO.hs

@@ -31,6 +31,7 @@ module Text.Pandoc.Class.IO
   , readFileLazy
   , readFileStrict
   , readStdinStrict
+  , svgToPng
   , extractMedia
   , writeMedia
  ) where
@@ -80,6 +81,7 @@ import qualified System.Environment as Env
 import qualified System.FilePath.Glob
 import qualified System.Random
 import qualified Text.Pandoc.UTF8 as UTF8
+import Text.Pandoc.Image (svgToPngIO)
 #ifndef EMBED_DATA_FILES
 import qualified Paths_pandoc as Paths
 #endif
@@ -170,6 +172,11 @@ readFileStrict s = liftIOError B.readFile s
 readStdinStrict :: (PandocMonad m, MonadIO m) => m B.ByteString
 readStdinStrict = liftIOError (const B.getContents) "stdin"
 
+-- | Runs an image conversion step, returning an error on failure.
+-- Not available when sandboxed.
+svgToPng :: (PandocMonad m, MonadIO m) => (Int, Maybe Double, Maybe Double, BL.ByteString) -> m (Either T.Text BL.ByteString)
+svgToPng (dpi, xPt, yPt, bs) = svgToPngIO dpi xPt yPt bs
+
 -- | Return a list of paths that match a glob, relative to the working
 -- directory. See 'System.FilePath.Glob' for the glob syntax.
 glob :: (PandocMonad m, MonadIO m) => String -> m [FilePath]

src/Text/Pandoc/Class/PandocIO.hs

@@ -63,6 +63,7 @@ instance PandocMonad PandocIO where
   readFileLazy = IO.readFileLazy
   readFileStrict = IO.readFileStrict
   readStdinStrict = IO.readStdinStrict
+  svgToPng = IO.svgToPng
 
   glob = IO.glob
   fileExists = IO.fileExists

src/Text/Pandoc/Class/PandocMonad.hs

@@ -116,6 +116,9 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)
   -- | Read the contents of stdin as a strict ByteString, raising
   -- an error on failure.
   readStdinStrict :: m B.ByteString
+  -- | Converts an SVG to a PNG (dpiX, widthPoints, heightPoints, svgBlob)
+  -- Not called when sandboxed.
+  svgToPng :: (Int, Maybe Double, Maybe Double, BL.ByteString) -> m (Either T.Text BL.ByteString)
   -- | Return a list of paths that match a glob, relative to
   -- the working directory.  See 'System.FilePath.Glob' for
   -- the glob syntax.
@@ -505,6 +508,7 @@ instance (MonadTrans t, PandocMonad m, Functor (t m),
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
   readStdinStrict = lift readStdinStrict
+  svgToPng = lift . svgToPng
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName
@@ -523,6 +527,7 @@ instance {-# OVERLAPS #-} PandocMonad m => PandocMonad (ParsecT s st m) where
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
   readStdinStrict = lift readStdinStrict
+  svgToPng = lift . svgToPng
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName

src/Text/Pandoc/Class/PandocPure.hs

@@ -205,6 +205,8 @@ instance PandocMonad PandocPure where
       Nothing -> throwError $ PandocResourceNotFound $ T.pack fp
 
   readStdinStrict = getsPureState stStdin
+  
+  svgToPng _ = return $ Left "SVG conversion not available in PandocPure"
 
   glob s = do
     FileTree ftmap <- getsPureState stFiles

src/Text/Pandoc/Image.hs

@@ -10,7 +10,7 @@ Portability : portable
 
 Functions for converting images.
 -}
-module Text.Pandoc.Image ( svgToPng ) where
+module Text.Pandoc.Image ( svgToPngIO ) where
 import Text.Pandoc.Process (pipeProcess)
 import qualified Data.ByteString.Lazy as L
 import System.Exit
@@ -20,16 +20,20 @@ import qualified Control.Exception as E
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Text.Pandoc.Class.PandocMonad
 import qualified Data.Text as T
+import Text.Printf (printf)
 
 -- | Convert svg image to png. rsvg-convert
 -- is used and must be available on the path.
-svgToPng :: (PandocMonad m, MonadIO m)
+svgToPngIO :: (PandocMonad m, MonadIO m)
          => Int           -- ^ DPI
+         -> Maybe Double        -- ^ width in Points
+         -> Maybe Double        -- ^ height in Points
          -> L.ByteString  -- ^ Input image as bytestring
          -> m (Either Text L.ByteString)
-svgToPng dpi bs = do
+svgToPngIO dpi widthPt heightPt bs = do
   let dpi' = show dpi
   let args = ["-f","png","-a","--dpi-x",dpi',"--dpi-y",dpi']
+        ++ pt "width" widthPt ++ pt "height" heightPt
   trace (T.intercalate " " $ map T.pack $ "rsvg-convert" : args)
   liftIO $ E.catch
        (do (exit, out) <- pipeProcess Nothing "rsvg-convert"
@@ -40,3 +44,4 @@ svgToPng dpi bs = do
               else Left "conversion from SVG failed")
        (\(e :: E.SomeException) -> return $ Left $
            "check that rsvg-convert is in path.\n" <> tshow e)
+  where pt name = maybe [] $ \points -> ["--" <> name, printf "%.6fpt" points]