diagrams-pandoc 0.3.1.1 → 0.4

raw patch · 19 files changed

+244/−33 lines, 19 filesdep +SVGFontsdep +bytestringdep +pandocdep ~basedep ~pandoc-typesdep ~text

Dependencies added: SVGFonts, bytestring, pandoc, tasty, tasty-golden

Dependency ranges changed: base, pandoc-types, text

Files

• CHANGELOG.md +7/−0
• README.md +7/−3
• diagrams-pandoc.cabal +35/−18
• src/Text/Pandoc/Diagrams.hs +50/−12
• test/Main.hs +76/−0
• test/alt-no-caption.html +2/−0
• test/alt-no-caption.md +6/−0
• test/alt-with-caption.html +6/−0
• test/alt-with-caption.md +6/−0
• test/codeblock.html +4/−0
• test/codeblock.md +6/−0
• test/figure-md-caption.html +6/−0
• test/figure-md-caption.md +6/−0
• test/figure-simple.html +5/−0
• test/figure-simple.md +6/−0
• test/simple.html +2/−0
• test/simple.md +6/−0
• test/size.html +2/−0
• test/size.md +6/−0

@@ -1,3 +1,10 @@+## v0.4 (2024-02-29)++  - New support for figures ([#23](https://github.com/diagrams/diagrams-pandoc/pull/23); thanks to Berk Özkütük)+  - New test suite ([#22](https://github.com/diagrams/diagrams-pandoc/pull/22); thanks to Berk Özkütük)+  - Allow `base-4.19`, `text-2.1`, `tasty-1.5`+  - Test on GHC 9.8+ ## v0.3.1.1 (2023-07-10)    - Update upper bounds to allow:

@@ -28,15 +28,19 @@ You can specify attributes to control how the diagram is generated. The following, for example, ``` markdown-    ~~~ {.diagram width=800 height=400}+    ~~~ {.diagram width=800 height=400 caption="A circle"}     example = circle 1     ~~~ ```-will override the default width and height of the generated diagram.-The following attributes are supported:+will override the default width and height of the generated diagram, and+provide a caption for it. The following attributes are supported:  * `width`: The width of the generated diagram, in pixels. The default is 500. * `height`: The height of the generated diagram, in pixels. The default is 200.+* `caption`: The caption of the diagram. Providing a caption makes the diagram+appear as a figure, rather than an inline image. Diagrams have no caption by default.+* `alt`: The alt text of the diagram. The caption is used as the default value+if it is provided, otherwise it is empty.  ## Details 

@@ -1,5 +1,6 @@+cabal-version:       3.0 name:                diagrams-pandoc-version:             0.3.1.1+version:             0.4 synopsis:            A Pandoc filter to express diagrams inline using the Haskell EDSL _Diagrams_ description: 'diagrams-pandoc' replaces appropriately marked code     blocks in pandoc input with images.  The code blocks are compiled@@ -7,51 +8,67 @@     Diagram named 'example', to be output.  This name and other     defaults can be overridden by command-line arguments to the     diagrams-pandoc program.-license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE author:              Daniel Bergey maintainer:          diagrams-discuss@googlegroups.com category:            Text build-type:          Simple Bug-reports:         http://github.com/diagrams/diagrams-pandoc/issues-Extra-source-files:  README.md, CHANGELOG.md-cabal-version:       >=1.10-Tested-with:         GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.5 || ==9.6.1+Extra-source-files:  README.md, test/*.md, test/*.html+extra-doc-files:     CHANGELOG.md+Tested-with:         GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.3 || ==9.8.1 Source-repository head   type:     git   location: http://github.com/diagrams/diagrams-pandoc.git +common common-deps+  build-depends:       base >= 4.6 && < 4.20,+                       text >= 1.2 && < 2.2,+                       pandoc-types >= 1.23 && < 1.24,+                       directory >= 1.2 && < 1.4,+                       filepath >= 1.3 && < 1.5+ library-  build-depends:       base >= 4.6 && < 4.19,-                       text >= 1.2 && < 2.1,-                       pandoc-types >= 1.20 && < 1.24,-                       diagrams-lib >= 1.3 && < 1.5,+  import:              common-deps+  build-depends:       diagrams-lib >= 1.3 && < 1.5,                        linear >= 1.10 && < 1.23,                        diagrams-builder >= 0.7 && < 0.9,                        diagrams-cairo >= 1.3 && < 1.5,-                       directory >= 1.2 && < 1.4,-                       filepath >= 1.3 && < 1.5,                        diagrams-svg >= 1.4 && < 1.5,                        diagrams-core >= 1.4 && < 1.6,                        hashable >= 1.2 && < 1.5,-                       svg-builder >= 0.1 && < 0.2+                       svg-builder >= 0.1 && < 0.2,+                       pandoc >= 3.0 && < 3.2   exposed-modules: Text.Pandoc.Diagrams   default-language: Haskell2010   hs-source-dirs: src   ghc-options: -Wall +test-suite test+  import:              common-deps+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Main.hs+  build-depends:       diagrams-pandoc,+                       bytestring >= 0.10.10 && < 0.13,+                       pandoc >= 3.0 && < 3.2,+                       tasty >= 1.4.3 && < 1.6,+                       tasty-golden >= 2.3.5 && < 2.4,++                       -- sandbox dependencies+                       SVGFonts >= 1.8.0 && < 1.9++ executable diagrams-pandoc+  import:              common-deps   main-is:             src/Main.hs   other-extensions:    CPP-  build-depends:       base >= 4.6 && < 4.19,-                       text >= 1.2 && < 2.1,-                       pandoc-types >= 1.20 && < 1.24,-                       diagrams-lib >= 1.3 && < 1.5,+  build-depends:       diagrams-lib >= 1.3 && < 1.5,                        linear >= 1.10 && < 1.23,                        diagrams-builder >= 0.7 && < 0.9,                        diagrams-cairo >= 1.3 && < 1.5,-                       directory >= 1.2 && < 1.4,-                       filepath >= 1.3 && < 1.5,                        diagrams-pandoc,                        optparse-applicative >= 0.11 && < 0.19   default-language:    Haskell2010

@@ -25,9 +25,14 @@ import           Linear                          (V2 (..), zero) import           System.Directory                (createDirectoryIfMissing) import           System.FilePath                 (pathSeparator, (<.>), (</>))-import           System.IO-import           Text.Pandoc.Definition-import Data.Maybe (maybeToList)+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"@@ -57,23 +62,56 @@ insertDiagrams :: Opts -> Block -> IO [Block] insertDiagrams opts@Opts{..} (CodeBlock (ident, classes, attrs) code)     | "diagram-haskell" `elem` classes = do-      i <- maybeToList <$> img+      i <- PB.toList <$> img       return $ case echo of         Above -> bl' : i         Below -> i <> [bl']-    | "diagram" `elem` classes = maybeToList <$> img+    | "diagram" `elem` classes = PB.toList <$> img   where     img = do-        d <- compileDiagram opts attrs code-        return $ case d of-            Left _err     -> Nothing  -- TODO log an error here-            Right imgName -> Just $ Para-              [Image ("",[],[]) []-                 (if _absolutePath then T.cons pathSeparator imgName else imgName,"")-              ] -- no alt text, no title+      d <- compileDiagram opts attrs code+      case d of+        Left _err     -> pure mempty  -- TODO log an error here+        Right imgName -> case captionRaw of+          Just captionRaw' -> do+            captionBlocks <- parseCaption captionRaw'+            let caption = blocksToCaption captionBlocks+                alt = fromMaybe (blocksToAlt captionBlocks) altAttr+            pure $ figureWithCaption+              -- transfer identifier from code block to figure, so that+              -- it can be referenced by `pandoc-crossref` and the like.+              (ident, [], [])+              caption+              (if _absolutePath then T.cons pathSeparator imgName else imgName)+              ""+              alt+          Nothing ->+            pure $ PB.plain $ PB.imageWith+              (ident, [], [])+              (if _absolutePath then T.cons pathSeparator imgName else imgName)+              ""+              (fold altAttr)     bl' = CodeBlock (ident, "haskell":delete "diagram-haskell" classes, attrs) code     echo = readEcho attrs+    captionRaw = lookup "caption" attrs+    altAttr = PB.str <$> lookup "alt" attrs insertDiagrams _ block = return [block]++figureWithCaption :: Attr -> Caption -> Text -> Text -> PB.Inlines -> PB.Blocks+figureWithCaption attr caption url title alt =+  PB.figure caption . PB.plain $ PB.imageWith attr url title alt++blocksToCaption :: [Block] -> Caption+blocksToCaption = PB.simpleCaption . PB.fromList++blocksToAlt :: [Block] -> PB.Inlines+blocksToAlt = Pandoc.blocksToInlines'++parseCaption :: Text -> IO [Block]+parseCaption s = Pandoc.runIOorExplode $ do+  (Pandoc.Pandoc _ blks) <-+    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

@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Test.Tasty (TestTree)+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Golden as Tasty++import qualified Text.Pandoc as Pandoc+import Text.Pandoc.Options (def, readerExtensions, pandocExtensions, writerExtensions)+import qualified Text.Pandoc.Walk as Pandoc++import Control.Monad.IO.Class (liftIO)+import qualified Data.ByteString.Lazy as LBS+import Data.Text (Text)+import qualified Data.Text.IO as T+import qualified Data.Text.Encoding as T+import System.Directory (removeDirectoryRecursive)+import System.FilePath (replaceExtension, takeBaseName)++import Text.Pandoc.Diagrams (Opts (..), Backend (..), insertDiagrams)+++main :: IO ()+main = Tasty.defaultMain . withCleanup =<< goldenTests++-- Cleanup the generated "images" directory after the test runs complete+withCleanup :: TestTree -> TestTree+withCleanup tt = Tasty.withResource (pure ()) (const cleanup) (const tt)+  where+    cleanup :: IO ()+    cleanup = removeDirectoryRecursive (_outDir defaultOpts)++-- Extracted from the CLI parser+defaultOpts :: Opts+defaultOpts = Opts+  { _outFormat = "html"+  , _outDir = "images"+  , _expression = "example"+  , _absolutePath = False+  , _backend = Cairo+  }++diagramsFilter :: Pandoc.Pandoc -> IO Pandoc.Pandoc+diagramsFilter = Pandoc.walkM (fmap concat . mapM (insertDiagrams defaultOpts))++-- We are renaming the image files so that the file names would be deterministic+-- across environments, GHC versions, etc. We are interested in the actual+-- generated image anyway.+renameImageHash ::  Pandoc.Inline -> Pandoc.Inline+renameImageHash (Pandoc.Image attr alt (_, title)) = Pandoc.Image attr alt ("image.png", title)+renameImageHash x = x++mdToHtml :: String -> IO Text+mdToHtml f = do+  mdContents <- T.readFile f+  Pandoc.runIOorExplode $ do+    -- Pandoc extensions that are enabled by default in Pandoc CLI are also+    -- enabled here, because the input files make use of some fancy syntax+    -- (backtick_code_blocks, fenced_code_attributes, etc.)+    ast <- Pandoc.readMarkdown (def { readerExtensions = pandocExtensions }) mdContents+    filteredAst <- liftIO $ diagramsFilter ast+    let renamedAst = Pandoc.walk renameImageHash filteredAst+    Pandoc.writeHtml5String (def { writerExtensions = pandocExtensions }) renamedAst++goldenTests :: IO TestTree+goldenTests = do+  mdFiles <- Tasty.findByExtension [".md"] "test"+  pure $ Tasty.testGroup "golden tests"+    [ Tasty.goldenVsString+        (takeBaseName mdFile)+        htmlFile+        (LBS.fromStrict . T.encodeUtf8 <$> mdToHtml mdFile)+    | mdFile <- mdFiles+    , let htmlFile = replaceExtension mdFile ".html"+    ]

@@ -0,0 +1,2 @@+<p>Here is a square:</p>+<img src="image.png" alt="a square" />

@@ -0,0 +1,6 @@+Here is a square:++``` {.diagram alt="a square"}+example = square 1+```+

@@ -0,0 +1,6 @@+<p>Here is a square:</p>+<figure>+<img src="image.png" alt="a square" />+<figcaption><p>This <em>is</em> a square with area <span+class="math inline">1<sup>2</sup></span></p></figcaption>+</figure>

@@ -0,0 +1,6 @@+Here is a square:++``` {.diagram alt="a square" caption="This _is_ a square with area $1^2$"}+example = square 1+```+

@@ -0,0 +1,4 @@+<p>Here is a square:</p>+<div class="sourceCode" id="cb1" data-echo="Above"><pre+class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a>example <span class="ot">=</span> square <span class="dv">1</span></span></code></pre></div>+<img src="image.png" />

@@ -0,0 +1,6 @@+Here is a square:++``` {.diagram-haskell echo=Above}+example = square 1+```+

@@ -0,0 +1,6 @@+<p>Here is a square:</p>+<figure>+<img src="image.png" alt="This is a square with area 1^2" />+<figcaption aria-hidden="true"><p>This <em>is</em> a square with area+<span class="math inline">1<sup>2</sup></span></p></figcaption>+</figure>

@@ -0,0 +1,6 @@+Here is a square:++``` {.diagram caption="This _is_ a square with area $1^2$"}+example = square 1+```+

@@ -0,0 +1,5 @@+<p>Here is a square:</p>+<figure>+<img src="image.png" alt="This is a square" />+<figcaption aria-hidden="true"><p>This is a square</p></figcaption>+</figure>

@@ -0,0 +1,6 @@+Here is a square:++``` {.diagram caption="This is a square"}+example = square 1+```+

@@ -0,0 +1,2 @@+<p>Here is a square:</p>+<img src="image.png" />

@@ -0,0 +1,6 @@+Here is a square:++``` {.diagram}+example = square 1+```+

@@ -0,0 +1,2 @@+<p>Here is a square:</p>+<img src="image.png" />

@@ -0,0 +1,6 @@+Here is a square:++``` {.diagram width=100 height=100}+example = square 1+```+