Use the SimpleFigure in Readers

cabal.project

@@ -22,4 +22,3 @@ source-repository-package
   location: https://github.com/jgm/commonmark-hs.git
   tag: 3cba9f874db7516f49d221a94171b4af010b5bea
   subdir: commonmark-pandoc
-

src/Text/Pandoc/Readers/HTML.hs

@@ -551,7 +551,7 @@ pFigure = try $ do
   let caption = fromMaybe mempty mbcap
   case B.toList <$> mbimg of
        Just [Image attr _ (url, tit)] ->
-         return $ B.para $ B.imageWith attr url ("fig:" <> tit) caption
+         return $ B.simpleFigureWith attr caption url tit
        _ -> mzero
 
 pCodeBlock :: PandocMonad m => TagParser m Blocks

src/Text/Pandoc/Readers/LaTeX.hs

@@ -935,8 +935,8 @@ environments = M.union (tableEnvironments blocks inline) $
    , ("letter", env "letter" letterContents)
    , ("minipage", env "minipage" $
           skipopts *> spaces *> optional braced *> spaces *> blocks)
-   , ("figure", env "figure" $ skipopts *> figure)
-   , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
+   , ("figure", env "figure" $ skipopts *> Text.Pandoc.Readers.LaTeX.figure)
+   , ("subfigure", env "subfigure" $ skipopts *> tok *> Text.Pandoc.Readers.LaTeX.figure)
    , ("center", divWith ("", ["center"], []) <$> env "center" blocks)
    , ("quote", blockQuote <$> env "quote" blocks)
    , ("quotation", blockQuote <$> env "quotation" blocks)
@@ -1095,24 +1095,25 @@ figure = try $ do
 
 addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
 addImageCaption = walkM go
-  where go (Image attr@(_, cls, kvs) alt (src,tit))
+  where go p@(Para [Image attr@(_, cls, kvs) _ (src, tit)])
             | not ("fig:" `T.isPrefixOf` tit) = do
           st <- getState
-          let (alt', tit') = case sCaption st of
-                               Just ils -> (toList ils, "fig:" <> tit)
-                               Nothing  -> (alt, tit)
-              attr' = case sLastLabel st of
-                        Just lab -> (lab, cls, kvs)
-                        Nothing  -> attr
-          case attr' of
-               ("", _, _)    -> return ()
-               (ident, _, _) -> do
-                  num <- getNextNumber sLastFigureNum
-                  setState
-                    st{ sLastFigureNum = num
-                      , sLabels = M.insert ident
-                                 [Str (renderDottedNum num)] (sLabels st) }
-          return $ Image attr' alt' (src, tit')
+          case sCaption st of
+            Nothing -> return p
+            Just figureCaption -> do
+              let attr' = case sLastLabel st of
+                            Just lab -> (lab, cls, kvs)
+                            Nothing  -> attr
+              case attr' of
+                   ("", _, _)    -> return ()
+                   (ident, _, _) -> do
+                      num <- getNextNumber sLastFigureNum
+                      setState
+                        st{ sLastFigureNum = num
+                          , sLabels = M.insert ident
+                                     [Str (renderDottedNum num)] (sLabels st) }
+
+              return $ SimpleFigure attr' (B.toList figureCaption) (src, tit)
         go x = return x
 
 coloredBlock :: PandocMonad m => Text -> LP m Blocks

src/Text/Pandoc/Readers/Markdown.hs

@@ -1013,19 +1013,18 @@ normalDefinitionList = do
 para :: PandocMonad m => MarkdownParser m (F Blocks)
 para = try $ do
   exts <- getOption readerExtensions
-  let implicitFigures x
-       | extensionEnabled Ext_implicit_figures exts = do
-         x' <- x
-         case B.toList x' of
-               [Image attr alt (src,tit)]
-                 | not (null alt) ->
-                    -- the fig: at beginning of title indicates a figure
-                    return $ B.singleton
-                           $ Image attr alt (src, "fig:" <> tit)
-               _ -> return x'
-       | otherwise = x
-  result <- implicitFigures . trimInlinesF <$> inlines1
-  option (B.plain <$> result)
+
+  result <- trimInlinesF <$> inlines1
+  let figureOr constr inlns =
+        case B.toList inlns of
+          [Image attr figCaption (src, tit)]
+            | extensionEnabled Ext_implicit_figures exts
+            , not (null figCaption) -> do
+                B.simpleFigureWith attr (B.fromList figCaption) src tit
+
+          _ -> constr inlns
+
+  option (figureOr B.plain <$> result)
     $ try $ do
             newline
             (mempty <$ blanklines)
@@ -1047,7 +1046,7 @@ para = try $ do
                      if divLevel > 0
                         then lookAhead divFenceEnd
                         else mzero
-            return $ B.para <$> result
+            return $ figureOr B.para <$> result
 
 plain :: PandocMonad m => MarkdownParser m (F Blocks)
 plain = fmap B.plain . trimInlinesF <$> inlines1

src/Text/Pandoc/Readers/MediaWiki.hs

@@ -201,7 +201,12 @@ para = do
   contents <- trimInlines . mconcat <$> many1 inline
   if F.all (==Space) contents
      then return mempty
-     else return $ B.para contents
+     else case B.toList contents of
+         -- For the MediaWiki format all images are considered figures
+         [Image attr figureCaption (src, title)] ->
+             return $ B.simpleFigureWith
+                 attr (B.fromList figureCaption) src title
+         _ -> return $ B.para contents
 
 table :: PandocMonad m => MWParser m Blocks
 table = do
@@ -631,7 +636,7 @@ image = try $ do
   let attr = ("", [], kvs)
   caption <-   (B.str fname <$ sym "]]")
            <|> try (char '|' *> (mconcat <$> manyTill inline (sym "]]")))
-  return $ B.imageWith attr fname ("fig:" <> stringify caption) caption
+  return $ B.imageWith attr fname (stringify caption) caption
 
 imageOption :: PandocMonad m => MWParser m Text
 imageOption = try $ char '|' *> opt

src/Text/Pandoc/Readers/Org/Blocks.hs

@@ -474,15 +474,16 @@ figure = try $ do
        figCaption = fromMaybe mempty $ blockAttrCaption figAttrs
        figKeyVals = blockAttrKeyValues figAttrs
        attr       = (figLabel, mempty, figKeyVals)
-       figTitle   = (if isFigure then withFigPrefix else id) figName
-     in
-       B.para . B.imageWith attr imgSrc figTitle <$> figCaption
-
-   withFigPrefix :: Text -> Text
-   withFigPrefix cs =
-     if "fig:" `T.isPrefixOf` cs
-     then cs
-     else "fig:" <> cs
+     in if isFigure
+           then (\c ->
+               B.simpleFigureWith
+                   attr c imgSrc (unstackFig figName)) <$> figCaption
+           else B.para . B.imageWith attr imgSrc figName <$> figCaption
+   unstackFig :: Text -> Text
+   unstackFig figName =
+       if "fig:" `T.isPrefixOf` figName
+           then T.drop 4 figName
+           else figName
 
 -- | Succeeds if looking at the end of the current paragraph
 endOfParagraph :: Monad m => OrgParser m ()

src/Text/Pandoc/Readers/RST.hs

@@ -725,8 +725,8 @@ directive' = do
         "figure" -> do
            (caption, legend) <- parseFromString' extractCaption body'
            let src = escapeURI $ trim top
-           return $ B.para (B.imageWith (imgAttr "figclass") src "fig:"
-                       caption) <> legend
+           return $ B.simpleFigureWith
+               (imgAttr "figclass") caption src "" <> legend
         "image" -> do
            let src = escapeURI $ trim top
            let alt = B.str $ maybe "image" trim $ lookup "alt" fields

src/Text/Pandoc/Writers/AsciiDoc.hs

@@ -148,9 +148,8 @@ blockToAsciiDoc opts (Div (id',"section":_,_)
 blockToAsciiDoc opts (Plain inlines) = do
   contents <- inlineListToAsciiDoc opts inlines
   return $ contents <> blankline
-blockToAsciiDoc opts (Para [Image attr alternate (src,tgt)])
+blockToAsciiDoc opts (SimpleFigure attr alternate (src, tit))
   -- image::images/logo.png[Company logo, title="blah"]
-  | Just tit <- T.stripPrefix "fig:" tgt
   = (\args -> "image::" <> args <> blankline) <$>
     imageArguments opts attr alternate src tit
 blockToAsciiDoc opts (Para inlines) = do

src/Text/Pandoc/Writers/ConTeXt.hs

@@ -161,10 +161,7 @@ blockToConTeXt (Div attr@(_,"section":_,_)
   innerContents <- blockListToConTeXt xs
   return $ header' $$ innerContents $$ footer'
 blockToConTeXt (Plain lst) = inlineListToConTeXt lst
--- title beginning with fig: indicates that the image is a figure
-blockToConTeXt (Para [Image attr txt (src,tgt)])
-  | Just _ <- T.stripPrefix "fig:" tgt
-  = do
+blockToConTeXt (SimpleFigure attr txt (src, _)) = do
       capt <- inlineListToConTeXt txt
       img  <- inlineToConTeXt (Image attr txt (src, ""))
       let (ident, _, _) = attr

src/Text/Pandoc/Writers/Docbook.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternGuards     #-}
-{-# LANGUAGE ViewPatterns      #-}
 {- |
    Module      : Text.Pandoc.Writers.Docbook
    Copyright   : Copyright (C) 2006-2021 John MacFarlane
@@ -187,7 +186,7 @@ blockToDocbook opts (Div (id',"section":_,_) (Header lvl (_,_,attrs) ils : xs))
       -- standalone documents will include them in the template.
                  then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
                  else []
-      
+
       -- Populate miscAttr with Header.Attr.attributes, filtering out non-valid DocBook section attributes, id, and xml:id
       miscAttr = filter (isSectionAttr version) attrs
       attribs = nsAttr <> idAttr <> miscAttr
@@ -232,7 +231,7 @@ blockToDocbook _ h@Header{} = do
   return empty
 blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst
 -- title beginning with fig: indicates that the image is a figure
-blockToDocbook opts (Para [Image attr txt (src,T.stripPrefix "fig:" -> Just _)]) = do
+blockToDocbook opts (SimpleFigure attr txt (src, _)) = do
   alt <- inlinesToDocbook opts txt
   let capt = if null txt
                 then empty

src/Text/Pandoc/Writers/Docx.hs

@@ -853,8 +853,7 @@ blockToOpenXML' opts (Plain lst) = do
      then withParaProp prop block
      else block
 -- title beginning with fig: indicates that the image is a figure
-blockToOpenXML' opts (Para [Image attr@(imgident,_,_) alt
-                             (src,T.stripPrefix "fig:" -> Just tit)]) = do
+blockToOpenXML' opts (SimpleFigure attr@(imgident, _, _) alt (src, tit)) = do
   setFirstPara
   fignum <- gets stNextFigureNum
   unless (null alt) $ modify $ \st -> st{ stNextFigureNum = fignum + 1 }

src/Text/Pandoc/Writers/DokuWiki.hs

@@ -107,9 +107,7 @@ blockToDokuWiki opts (Plain inlines) =
 
 -- title beginning with fig: indicates that the image is a figure
 -- dokuwiki doesn't support captions - so combine together alt and caption into alt
-blockToDokuWiki opts (Para [Image attr txt (src,tgt)])
-  | Just tit <- T.stripPrefix "fig:" tgt
-  = do
+blockToDokuWiki opts (SimpleFigure attr txt (src, tit)) = do
       capt <- if null txt
               then return ""
               else (" " <>) `fmap` inlineListToDokuWiki opts txt

src/Text/Pandoc/Writers/FB2.hs

@@ -299,9 +299,8 @@ blockToXml :: PandocMonad m => Block -> FBM m [Content]
 blockToXml (Plain ss) = cMapM toXml ss  -- FIXME: can lead to malformed FB2
 blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula
 -- title beginning with fig: indicates that the image is a figure
-blockToXml (Para [Image atr alt (src,tgt)])
-  | Just tit <- T.stripPrefix "fig:" tgt
-  = insertImage NormalImage (Image atr alt (src,tit))
+blockToXml (SimpleFigure atr alt (src, tit)) =
+    insertImage NormalImage (Image atr alt (src,tit))
 blockToXml (Para ss) = list . el "p" <$> cMapM toXml ss
 blockToXml (CodeBlock _ s) = return . spaceBeforeAfter .
                              map (el "p" . el "code") . T.lines $ s

src/Text/Pandoc/Writers/HTML.hs

@@ -741,8 +741,8 @@ blockToHtmlInner opts (Para [Image attr@(_,classes,_) txt (src,tit)])
          inlineToHtml opts (Image attr txt (src, tit))
        _ -> figure opts attr txt (src, tit)
 -- title beginning with fig: indicates that the image is a figure
-blockToHtmlInner opts (Para [Image attr txt (s,T.stripPrefix "fig:" -> Just tit)]) =
-  figure opts attr txt (s,tit)
+blockToHtmlInner opts (SimpleFigure attr caption (src, title)) =
+  figure opts attr caption (src, title)
 blockToHtmlInner opts (Para lst) = do
   contents <- inlineListToHtml opts lst
   case contents of

src/Text/Pandoc/Writers/Haddock.hs

@@ -97,8 +97,7 @@ blockToHaddock opts (Plain inlines) = do
   contents <- inlineListToHaddock opts inlines
   return $ contents <> cr
 -- title beginning with fig: indicates figure
-blockToHaddock opts (Para [Image attr alt (src,tgt)])
-  | Just tit <- T.stripPrefix "fig:" tgt
+blockToHaddock opts (SimpleFigure attr alt (src, tit))
   = blockToHaddock opts (Para [Image attr alt (src,tit)])
 blockToHaddock opts (Para inlines) =
   -- TODO:  if it contains linebreaks, we need to use a @...@ block

src/Text/Pandoc/Writers/ICML.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
 
 {- |
    Module      : Text.Pandoc.Writers.ICML
@@ -309,9 +308,8 @@ blocksToICML opts style lst = do
 -- | Convert a Pandoc block element to ICML.
 blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m (Doc Text)
 blockToICML opts style (Plain lst) = parStyle opts style "" lst
--- title beginning with fig: indicates that the image is a figure
-blockToICML opts style (Para img@[Image _ txt (_,Text.stripPrefix "fig:" -> Just _)]) = do
-  figure  <- parStyle opts (figureName:style) "" img
+blockToICML opts style (SimpleFigure attr txt (src, tit)) = do
+  figure  <- parStyle opts (figureName:style) "" [Image attr txt (src, tit)]
   caption <- parStyle opts (imgCaptionName:style) "" txt
   return $ intersperseBrs [figure, caption]
 blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) "" lst

src/Text/Pandoc/Writers/JATS.hs

@@ -290,9 +290,7 @@ blockToJATS opts (Header _ _ title) = do
   return $ inTagsSimple "title" title'
 -- No Plain, everything needs to be in a block-level tag
 blockToJATS opts (Plain lst) = blockToJATS opts (Para lst)
--- title beginning with fig: indicates that the image is a figure
-blockToJATS opts (Para [Image (ident,_,kvs) txt
-  (src,T.stripPrefix "fig:" -> Just tit)]) = do
+blockToJATS opts (SimpleFigure (ident, _, kvs) txt (src, tit)) = do
   alt <- inlinesToJATS opts txt
   let (maintype, subtype) = imageMimeType src kvs
   let capt = if null txt

src/Text/Pandoc/Writers/LaTeX.hs

@@ -345,10 +345,7 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do
   wrapNotes <$> wrapDiv (identifier,classes,kvs) result
 blockToLaTeX (Plain lst) =
   inlineListToLaTeX lst
--- title beginning with fig: indicates that the image is a figure
-blockToLaTeX (Para [Image attr@(ident, _, _) txt (src,tgt)])
-  | Just tit <- T.stripPrefix "fig:" tgt
-  = do
+blockToLaTeX (SimpleFigure attr@(ident, _, _) txt (src, tit)) = do
       (capt, captForLof, footnotes) <- getCaption inlineListToLaTeX True txt
       lab <- labelFor ident
       let caption = "\\caption" <> captForLof <> braces capt <> lab

src/Text/Pandoc/Writers/Markdown.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
-{-# LANGUAGE ViewPatterns        #-}
 {- |
    Module      : Text.Pandoc.Writers.Markdown
    Copyright   : Copyright (C) 2006-2021 John MacFarlane
@@ -364,14 +363,13 @@ blockToMarkdown' opts (Plain inlines) = do
                   _ -> inlines
   contents <- inlineListToMarkdown opts inlines'
   return $ contents <> cr
--- title beginning with fig: indicates figure
-blockToMarkdown' opts (Para [Image attr alt (src,tgt@(T.stripPrefix "fig:" -> Just tit))])
+blockToMarkdown' opts (SimpleFigure attr alt (src, tit))
   | isEnabled Ext_raw_html opts &&
     not (isEnabled Ext_link_attributes opts || isEnabled Ext_attributes opts) &&
     attr /= nullAttr = -- use raw HTML
     (<> blankline) . literal . T.strip <$>
       writeHtml5String opts{ writerTemplate = Nothing }
-        (Pandoc nullMeta [Para [Image attr alt (src,tgt)]])
+        (Pandoc nullMeta [SimpleFigure attr alt (src, tit)])
   | otherwise = blockToMarkdown opts (Para [Image attr alt (src,tit)])
 blockToMarkdown' opts (Para inlines) =
   (<> blankline) `fmap` blockToMarkdown opts (Plain inlines)

src/Text/Pandoc/Writers/MediaWiki.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns      #-}
 {- |
    Module      : Text.Pandoc.Writers.MediaWiki
    Copyright   : Copyright (C) 2008-2021 John MacFarlane
@@ -89,8 +88,7 @@ blockToMediaWiki (Div attrs bs) = do
 blockToMediaWiki (Plain inlines) =
   inlineListToMediaWiki inlines
 
--- title beginning with fig: indicates that the image is a figure
-blockToMediaWiki (Para [Image attr txt (src,T.stripPrefix "fig:" -> Just tit)]) = do
+blockToMediaWiki (SimpleFigure attr txt (src, tit)) = do
   capt <- inlineListToMediaWiki txt
   img  <- imageToMediaWiki attr
   let opt = if T.null tit

src/Text/Pandoc/Writers/OpenDocument.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternGuards     #-}
-{-# LANGUAGE ViewPatterns      #-}
 {- |
    Module      : Text.Pandoc.Writers.OpenDocument
    Copyright   : Copyright (C) 2008-2020 Andrea Rossato and John MacFarlane
@@ -377,7 +376,7 @@ blockToOpenDocument o = \case
     Plain          b -> if null b
                         then return empty
                         else inParagraphTags =<< inlinesToOpenDocument o b
-    Para [Image attr c (s,T.stripPrefix "fig:" -> Just t)] -> figure attr c s t
+    SimpleFigure attr c (s, t) -> figure attr c s t
     Para           b -> if null b &&
                            not (isEnabled Ext_empty_paragraphs o)
                         then return empty

src/Text/Pandoc/Writers/Org.hs

@@ -104,9 +104,7 @@ blockToOrg :: PandocMonad m
            -> Org m (Doc Text)
 blockToOrg (Div attr bs) = divToOrg attr bs
 blockToOrg (Plain inlines) = inlineListToOrg inlines
--- title beginning with fig: indicates that the image is a figure
-blockToOrg (Para [Image attr txt (src,tgt)])
-  | Just tit <- T.stripPrefix "fig:" tgt = do
+blockToOrg (SimpleFigure attr txt (src, tit)) = do
       capt <- if null txt
               then return empty
               else ("#+caption: " <>) `fmap` inlineListToOrg txt