Port filter to the diagrams 2.0 API

Swap the 1.x diagrams-lib/diagrams-builder/diagrams-cairo stack for this
workspace's 2.0 APIs on top of the upstream master merge:

* Build diagrams through the rewritten diagrams-builder interface
  (Snippets + DiagramBuilder + diaSnippet), interpreting a
  'saveDiagram <backend token>' expression instead of constructing
  per-backend BuildOpts.  The SomeBuildOpts/MkImage existential
  machinery is no longer needed.
* Replace the Cairo backend with Rasterific (diagrams-cairo is not part
  of the 2.0 cabal workspace).  Rasterific writes .png and, for the
  latex/beamer output formats, .pdf (dispatched on file extension), so
  upstream's latex->pdf behaviour is preserved; the CLI backend flag now
  accepts 'Rasterific' instead of 'Cairo'.  SVG behaviour is unchanged.
* Keep upstream behaviour otherwise: hash-named image files in the
  output directory, skip-if-exists regeneration, '.'/'O' progress
  output, width/height/caption/alt attributes, echo=Above/Below,
  absolute-path switch, Figure support, and the 'pad 1.1 . centerXY'
  post-processing (now applied inside the interpreted expression).
* Drop the snippet imports of Diagrams.TwoD.Types/Diagrams.Core.Points/
  Data.Typeable (1.x workarounds) and Graphics.SVGFonts (SVGFonts has no
  2.0-compatible release); Diagrams.Prelude plus the backend module are
  imported automatically by the builder.
* Update dependencies: diagrams 2.0 + diagrams-builder 2.0 +
  diagrams-svg/diagrams-rasterific (runtime deps for the interpreter);
  drop diagrams-lib/-core/-cairo, linear, svg-builder and the test
  suite's SVGFonts.

Tests (all 7 golden tests) pass; hint picks the workspace packages up
from cabal's .ghc.environment file as before (build with
--write-ghc-environment-files=always).

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>

Author: cchalmers

README.md

@@ -79,5 +79,8 @@ rst reader does not attach classes to code blocks, only to Div elements.
   code block alone?
 * provide command-line flags to override default behavior
 * add Backends besides Cairo
+  <!-- TODO(docs, human): the diagrams 2.0 port renders via Rasterific (default)
+       and SVG instead of Cairo; update the README (usage, backend flag values,
+       this TODO list) accordingly. -->
 * Support RST by handling `Div class=diagram [CodeBlock foo bar]` the same as `CodeBlock class=diagram bar`
 * Alternate install directions using `stack`

diagrams-pandoc.cabal

@@ -31,15 +31,14 @@ common common-deps
 
 library
   import:              common-deps
-  build-depends:       diagrams-lib >= 1.3 && < 1.6,
-                       linear >= 1.10 && < 1.24,
-                       diagrams-builder >= 0.7 && < 0.9,
-                       diagrams-cairo >= 1.3 && < 1.6,
-                       diagrams-svg >= 1.4 && < 1.6,
-                       diagrams-core >= 1.4 && < 1.6,
+  build-depends:       diagrams >= 2.0 && < 2.1,
+                       diagrams-builder >= 2.0 && < 2.1,
                        hashable >= 1.2 && < 1.6,
-                       svg-builder >= 0.1 && < 0.2,
-                       pandoc >= 3.0 && < 3.9
+                       pandoc >= 3.0 && < 3.9,
+
+                       -- sandbox dependencies
+                       diagrams-svg >= 2.0 && < 2.1,
+                       diagrams-rasterific >= 2.0 && < 2.1
   exposed-modules: Text.Pandoc.Diagrams
   default-language: Haskell2010
   hs-source-dirs: src
@@ -55,20 +54,13 @@ test-suite test
                        bytestring >= 0.10.10 && < 0.13,
                        pandoc >= 3.0 && < 3.9,
                        tasty >= 1.4.3 && < 1.6,
-                       tasty-golden >= 2.3.5 && < 2.4,
-
-                       -- sandbox dependencies
-                       SVGFonts >= 1.8.0 && < 1.9
+                       tasty-golden >= 2.3.5 && < 2.4
 
 
 executable diagrams-pandoc
   import:              common-deps
   main-is:             src/Main.hs
   other-extensions:    CPP
-  build-depends:       diagrams-lib >= 1.3 && < 1.6,
-                       linear >= 1.10 && < 1.24,
-                       diagrams-builder >= 0.7 && < 0.9,
-                       diagrams-cairo >= 1.3 && < 1.6,
-                       diagrams-pandoc,
+  build-depends:       diagrams-pandoc,
                        optparse-applicative >= 0.11 && < 0.20
   default-language:    Haskell2010

src/Main.hs

@@ -27,7 +27,7 @@ optsParser = Opts
                             value "example")
              <*> switch    (long "absolute" <> short 'a' <>
                             help "output the name of Diagram in Haskell snippet as absolute path")
-             <*> option auto (long "backend" <> short 'b' <> metavar "BACKEND" <> value Cairo)
+             <*> option auto (long "backend" <> short 'b' <> metavar "BACKEND" <> value Rasterific)
 
 withHelp :: ParserInfo Opts
 withHelp = info

src/Text/Pandoc/Diagrams.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts          #-}
-{-# LANGUAGE FlexibleInstances         #-}
 {-# LANGUAGE OverloadedStrings         #-}
 {-# LANGUAGE RecordWildCards           #-}
 
@@ -10,43 +7,36 @@
 
 module Text.Pandoc.Diagrams where
 
-import           Data.Hashable                   (Hashable)
+import           Control.Monad.IO.Class          (liftIO)
+import           Data.Foldable                   (fold)
+import           Data.Hashable                   (hash)
 import           Data.List                       (delete)
+import           Data.Maybe                      (fromMaybe)
 import           Data.Text                       (Text)
 import qualified Data.Text                       as T
-import           Data.Typeable                   (Typeable)
-import qualified Diagrams.Backend.Cairo.Internal as BCairo
-import qualified Diagrams.Backend.SVG            as BSvg
+import           Diagrams.Backend                (BackendInfo, rasterificInfo,
+                                                  svgInfo)
 import qualified Diagrams.Builder                as DB
-import qualified Diagrams.Core                   as DC
-import           Diagrams.Prelude                (centerXY, pad, (&), (.~))
-import           Diagrams.Size                   (dims)
-import qualified Graphics.Svg                    as Svg
-import           Linear                          (V2 (..), zero)
-import           System.Directory                (createDirectoryIfMissing)
+import           Diagrams.Builder.Opts           (emptySnippet, snippets)
+import           Diagrams.Prelude                (dims2D, (&), (.~))
+import           Numeric                         (showHex)
+import           System.Directory                (createDirectoryIfMissing,
+                                                  doesFileExist)
 import           System.FilePath                 (pathSeparator, (<.>), (</>))
 import           System.IO                       (hFlush, hPutStr, hPutStrLn, stderr)
 import           Text.Pandoc.Definition          (Block(..), Caption, Attr)
 import qualified Text.Pandoc.Builder as PB
 import qualified Text.Pandoc as Pandoc
 import qualified Text.Pandoc.Shared as Pandoc
 import           Text.Pandoc.Options             (def, readerExtensions, pandocExtensions)
-import           Data.Maybe                      (fromMaybe)
-import           Data.Foldable                   (fold)
 
 backendExt :: Opts -> String
 backendExt Opts {_backend = SVG } = "svg"
-backendExt Opts {_backend = Cairo, ..} = case _outFormat of
+backendExt Opts {_backend = Rasterific, ..} = case _outFormat of
   "beamer" -> "pdf"
   "latex"  -> "pdf"
   _        -> "png"
 
--- Return output type for a string
-findCairoOutputType :: String -> BCairo.OutputType
-findCairoOutputType "beamer" = BCairo.PDF
-findCairoOutputType "latex"  = BCairo.PDF
-findCairoOutputType _        = BCairo.PNG
-
 data Opts = Opts {
     _outFormat    :: String,
     _outDir       :: FilePath,
@@ -55,7 +45,7 @@ data Opts = Opts {
     _backend      :: Backend
     }
 
-data Backend = Cairo | SVG deriving (Read)
+data Backend = Rasterific | SVG deriving (Read)
 
 data Echo = Above | Below
 
@@ -113,100 +103,57 @@ parseCaption s = Pandoc.runIOorExplode $ do
     Pandoc.readMarkdown (def { readerExtensions = pandocExtensions }) s
   pure blks
 
--- Copied from https://github.com/diagrams/diagrams-doc/blob/master/doc/Xml2Html.hs
--- With the CPP removed, thereby requiring Cairo
--- TODO clean this up, move it into -builder somehow
 -- | Compile the literate source code of a diagram to a .png/.pdf file with
 --   a file name given by a hash of the source code contents
 compileDiagram :: Opts -> [(Text,Text)] -> Text -> IO (Either String Text)
 compileDiagram opts attrs src = do
   ensureDir $ _outDir opts
-  case mkBuildOpts opts attrs src of
-    SomeBuildOpts bo -> do
-      res <- DB.buildDiagram bo
-      case res of
-        DB.ParseErr err    -> do
-          hPutStrLn stderr ("\nError while parsing\n" ++ T.unpack src)
-          hPutStrLn stderr err
-          return $ Left "Error while parsing"
-
-        DB.InterpErr ierr  -> do
-          hPutStrLn stderr ("\nError while interpreting\n" ++ T.unpack src)
-          hPutStrLn stderr (DB.ppInterpError ierr)
-          return $ Left "Error while interpreting"
-
-        DB.Skipped hash    -> do
+  case DB.diaSnippet (emptySnippet & snippets .~ [T.unpack src]) (mkBuilder opts attrs) of
+    Left err -> do
+      hPutStrLn stderr ("\nError while parsing\n" ++ T.unpack src)
+      hPutStrLn stderr err
+      return $ Left "Error while parsing"
+
+    Right i -> do
+      let path = mkFile opts (hashToHexStr (hash i))
+      alreadyBuilt <- doesFileExist path
+      if alreadyBuilt
+        then do
           hPutStr stderr "."
           hFlush stderr
-          return $ Right (T.pack $ mkFile opts (DB.hashToHexStr hash))
-
-        DB.OK hash out -> do
-          hPutStr stderr "O"
-          hFlush stderr
-          let path = mkFile opts (DB.hashToHexStr hash)
-          handleResult path $ SomeResult out
           return $ Right (T.pack path)
+        else do
+          res <- DB.runSandboxInterpreter $ DB.runInterpret i >>= liftIO . ($ path)
+          case res of
+            Left ierr -> do
+              hPutStrLn stderr ("\nError while interpreting\n" ++ T.unpack src)
+              hPutStrLn stderr (DB.ppInterpError ierr)
+              return $ Left "Error while interpreting"
+            Right () -> do
+              hPutStr stderr "O"
+              hFlush stderr
+              return $ Right (T.pack path)
   where
     ensureDir = createDirectoryIfMissing True
-    handleResult path (SomeResult a) = mkImage path a
 
 mkFile :: Opts -> FilePath -> FilePath
 mkFile opts base = _outDir opts </> base <.> backendExt opts
 
-data SomeResult = forall r. (MkImage r) => SomeResult r
-
-data SomeBuildOpts v n =
-  forall a. (Typeable a, DC.Backend a v n, Hashable (DC.Options a v n), MkImage (DC.Result a v n))
-  => SomeBuildOpts (DB.BuildOpts a v n)
-
-class MkImage a where
-  mkImage :: FilePath -> a -> IO ()
-
-instance MkImage (IO (), r) where
-  mkImage _ = fst
-
-instance MkImage Svg.Element where
-  mkImage path e = writeFile path $ show e
-
-mkBuildOpts :: Opts -> [(Text, Text)] -> Text -> SomeBuildOpts V2 Double
-mkBuildOpts opts attrs src = case _backend opts of
-  Cairo -> SomeBuildOpts $ DB.mkBuildOpts BCairo.Cairo zero
-    ( BCairo.CairoOptions "default.png"
-      (dims $ V2 (widthAttribute attrs) (heightAttribute attrs))
-      (findCairoOutputType $ _outFormat opts)
-      False
-    )
-    & DB.snippets .~ [T.unpack src]
-    & DB.imports  .~
-      [ "Diagrams.TwoD.Types" -- WHY IS THIS NECESSARY =(
-      , "Diagrams.Core.Points" -- GHC 7.2 bug?  need  V (Point R2) = R2  (see #65)
-      , "Diagrams.Backend.Cairo"
-      , "Diagrams.Backend.Cairo.Internal"
-      , "Graphics.SVGFonts"
-      , "Data.Typeable"
-      ]
-    & DB.pragmas .~ ["DeriveDataTypeable"]
-    & DB.diaExpr .~ _expression opts
-    & DB.postProcess .~ postProcess
-    & DB.decideRegen .~
-      DB.hashedRegenerate
-        (\hash opts' -> opts' { BCairo._cairoFileName = mkFile opts hash })
-        (_outDir opts)
-  SVG -> SomeBuildOpts $ DB.mkBuildOpts BSvg.SVG zero
-    (BSvg.SVGOptions (dims $ V2 (widthAttribute attrs) (heightAttribute attrs)) Nothing "" [] True)
-    & DB.snippets .~ [T.unpack src]
-    & DB.imports  .~
-      [ "Diagrams.TwoD.Types"
-      , "Diagrams.Core.Points"
-      , "Diagrams.Backend.SVG"
-      , "Graphics.SVGFonts"
-      , "Data.Typeable"
-      ]
-    & DB.pragmas .~ ["DeriveDataTypeable"]
-    & DB.diaExpr .~ _expression opts
-    & DB.postProcess .~ postProcess
-  where
-    postProcess = pad 1.1 . centerXY
+mkBuilder :: Opts -> [(Text, Text)] -> DB.DiagramBuilder
+mkBuilder opts attrs = DB.DiagramBuilder
+  { DB._diaInfo    = backendInfo (_backend opts)
+  , DB._diaExpr    = "pad 1.1 (centerXY (" ++ _expression opts ++ "))"
+  , DB._diaOutSize = dims2D (round $ widthAttribute attrs) (round $ heightAttribute attrs)
+  }
+
+backendInfo :: Backend -> BackendInfo
+backendInfo Rasterific = rasterificInfo
+backendInfo SVG        = svgInfo
+
+-- Turn a Hash into a hex with no leading 0x. Hash is converted to a
+-- word to avoid negative values.
+hashToHexStr :: Int -> String
+hashToHexStr h = showHex (fromIntegral h :: Word) ""
 
 widthAttribute :: [(Text,Text)] -> Double
 widthAttribute attrs =
@@ -226,4 +173,3 @@ readEcho attrs = case lookup "echo" attrs of
   Just v -> case T.toLower v of
     "above" -> Above
     _       -> Below
-

test/Main.hs

@@ -38,7 +38,7 @@ defaultOpts = Opts
   , _outDir = "images"
   , _expression = "example"
   , _absolutePath = False
-  , _backend = Cairo
+  , _backend = Rasterific
   }
 
 diagramsFilter :: Pandoc.Pandoc -> IO Pandoc.Pandoc