From 215dbaf779c5912cb40cd984eaafa7d7aa02e466 Mon Sep 17 00:00:00 2001
From: Laurent Rene de Cotret <l.rdc@socivolta.com>
Date: Fri, 27 Sep 2024 14:35:27 -0400
Subject: [PATCH] Fixed a test case that depended on caption structure

---
 src/Text/Pandoc/Filter/Plot/Embed.hs | 13 ++++++++++---
 src/Text/Pandoc/Filter/Plot/Parse.hs |  5 +++--
 tests/Common.hs                      | 18 +++++++++++-------
 tests/Main.hs                        |  6 ++++--
 4 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/src/Text/Pandoc/Filter/Plot/Embed.hs b/src/Text/Pandoc/Filter/Plot/Embed.hs
index cc7f343..7b33f8e 100644
--- a/src/Text/Pandoc/Filter/Plot/Embed.hs
+++ b/src/Text/Pandoc/Filter/Plot/Embed.hs
@@ -17,7 +17,6 @@ module Text.Pandoc.Filter.Plot.Embed
 where
 
 import Data.Default (def)
-import Data.Maybe (fromMaybe)
 import Data.Text (Text, pack)
 import qualified Data.Text.IO as T
 import Text.HTML.TagSoup
@@ -63,11 +62,19 @@ toFigure fmt spec = do
   target <- figurePath spec
   scp <- pack <$> sourceCodePath spec
   sourceLabel <- asksConfig sourceCodeLabel -- Allow the possibility for non-english labels
+
+  cap <- case (captionReader fmt $ caption spec) of
+    Left exc -> do
+      err $ "Unable to parse caption: " <> (pack $ show exc)
+      pure mempty
+    Right c -> do
+      debug $ "Parsed caption: " <> (pack $ show c)
+      pure $ fromList c
+  
   let srcLink = link scp mempty (str sourceLabel)
       attrs' = blockAttrs spec
-      captionText = fromList $ fromMaybe mempty (captionReader fmt $ caption spec)
       captionLinks = mconcat [" (", srcLink, ")"]
-      caption' = if withSource spec then captionText <> captionLinks else captionText
+      caption' = if withSource spec then cap <> captionLinks else cap
   builder attrs' target caption'
   where
     builder = case saveFormat spec of
diff --git a/src/Text/Pandoc/Filter/Plot/Parse.hs b/src/Text/Pandoc/Filter/Plot/Parse.hs
index f043ca2..faa077b 100644
--- a/src/Text/Pandoc/Filter/Plot/Parse.hs
+++ b/src/Text/Pandoc/Filter/Plot/Parse.hs
@@ -44,6 +44,7 @@ import Text.Pandoc.Filter.Plot.Renderers
 import Text.Pandoc.Format (parseFlavoredFormat)
 import Text.Pandoc.Options (ReaderOptions (..))
 import Text.Pandoc.Readers (Reader (..), getReader)
+import Text.Pandoc (PandocError)
 
 tshow :: (Show a) => a -> Text
 tshow = pack . show
@@ -162,8 +163,8 @@ plotToolkit (CodeBlock (_, classes, _) _) =
 plotToolkit _ = Nothing
 
 -- | Reader a caption, based on input document format
-captionReader :: Format -> Text -> Maybe [Inline]
-captionReader (Format f) t = either (const Nothing) (Just . extractFromBlocks) $
+captionReader :: Format -> Text -> Either PandocError [Inline]
+captionReader (Format f) t = fmap extractFromBlocks $
   runPure $ do
     fmt <- parseFlavoredFormat f
     (reader, exts) <- getReader fmt
diff --git a/tests/Common.hs b/tests/Common.hs
index 9952948..e55d8e7 100644
--- a/tests/Common.hs
+++ b/tests/Common.hs
@@ -380,12 +380,13 @@ testAttributesPreservedOnFigure tk =
     -- constructed
     let expectedAttrs = ("hello", [cls tk], [("key1", "val1"), ("key2", "val2")])
         cb =
-          setAttrs expectedAttrs $
             addDirectory tempDir $
-              addCaption "[title](https://google.com)" $
-                codeBlock tk (trivialContent tk)
+              addCaption "This is a caption [title](https://google.com)" $
+                setAttrs expectedAttrs $
+                  codeBlock tk (trivialContent tk)
         fmt = B.Format "markdown"
-    Figure (id', _, keyvals) _ _ <-
+
+    block  <-
       runPlotM
         Nothing
         ( defaultTestConfig
@@ -394,9 +395,12 @@ testAttributesPreservedOnFigure tk =
             }
         )
         $ make cb
-    let (expectedId, _, expectedKeyVals) = expectedAttrs
-    assertEqual "identifier" expectedId id'
-    assertEqual "key-value pairs" expectedKeyVals keyvals
+    case block of
+      Figure (id', _, keyvals) _ _ -> do
+        let (expectedId, _, expectedKeyVals) = expectedAttrs
+        assertEqual "identifier" expectedId id'
+        assertEqual "key-value pairs" expectedKeyVals keyvals
+      other -> assertFailure $ "Unexpected block: " <> show block
   where
     extractCaption (B.Figure _ (Caption _ caption) _) = caption
 
diff --git a/tests/Main.hs b/tests/Main.hs
index 09abdd8..c72dbf0 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -109,11 +109,13 @@ testCaptionReader =
     -- Note that this test is fragile, in the sense that the expected result must be carefully
     -- constructed
     let caption = "Here is a [link](https://www.google.com) in a caption."
-        expected = Just [Str "Here", Space, Str "is", Space, Str "a", Space, Link ("", [], []) [Str "link"] ("https://www.google.com", ""), Space, Str "in", Space, Str "a", Space, Str "caption."]
+        expected = [Str "Here", Space, Str "is", Space, Str "a", Space, Link ("", [], []) [Str "link"] ("https://www.google.com", ""), Space, Str "in", Space, Str "a", Space, Str "caption."]
         fmt = B.Format "markdown+tex_math_dollars"
         parsed = captionReader fmt caption
 
-    assertEqual "" expected parsed
+    case parsed of
+      Left exc -> assertFailure $ show exc
+      Right result -> assertEqual "" expected result
 
 testHtmlBodyEmbedding :: TestTree
 testHtmlBodyEmbedding =