Updates for pandoc 3.0 and bump version

Author: lierdakil

cabal.project

@@ -5,3 +5,5 @@ package pandoc
   ghc-options: -j +RTS -A64m -RTS
 package pandoc-crossref
   ghc-options: -j +RTS -A64m -RTS
+tests: True
+benchmarks: True

lib-internal/Text/Pandoc/CrossRef/References/Blocks.hs

@@ -37,16 +37,13 @@ import Text.Pandoc.CrossRef.References.Blocks.Subfigures
 import Text.Pandoc.CrossRef.References.Blocks.Table
 import Text.Pandoc.CrossRef.References.Blocks.Util
 import Text.Pandoc.CrossRef.References.Monad
-import Text.Pandoc.CrossRef.References.Types
 import Text.Pandoc.CrossRef.Util.Options
-import Text.Pandoc.CrossRef.Util.Template
 import Text.Pandoc.CrossRef.Util.Util
 
 replaceAll :: (Data a) => a -> WS a
 replaceAll x = do
   opts <- ask
   x & runReplace (mkRR replaceBlock
-    `extRR` replaceInline
     `extRR` replaceInlineMany
     )
     . runSplitMath opts
@@ -58,12 +55,25 @@ replaceAll x = do
       = everywhere (mkT splitMath)
       | otherwise = id
 
+extractCaption :: Block -> Maybe [Inline]
+extractCaption = \case
+  Para caption -> Just caption
+  Div (_, dcls, _) [Para caption] | "caption" `elem` dcls -> Just caption
+  _ -> Nothing
+
 replaceBlock :: Block -> WS (ReplacedResult Block)
 replaceBlock (Header n attr text') = runHeader n attr text'
-replaceBlock (Div attr@(label, _, _) images)
+replaceBlock (Figure attr@(label, _, _) caption content)
+  | "fig:" `T.isPrefixOf` label
+  = runFigure False attr caption content
+replaceBlock (Div attr@(label, _, _) content)
   | "fig:" `T.isPrefixOf` label
-  , Para caption <- last images
-  = runSubfigures attr images caption
+  , Just caption <- extractCaption $ last content
+  = case init content of
+      [Figure ("", [], []) _ content'] -- nested figure due to implicit_figures...
+        -> runFigure False attr (Caption Nothing [Para caption]) content'
+      [x] -> runFigure False attr (Caption Nothing [Para caption]) [x]
+      xs -> runSubfigures attr xs caption
 replaceBlock (Div attr@(label, _, _) [Table tattr (Caption short (btitle:rest)) colspec header cells foot])
   | not $ null $ blocksToInlines [btitle]
   , "tbl:" `T.isPrefixOf` label
@@ -103,18 +113,6 @@ replaceInlineMany (Span spanAttr@(label,clss,attrs) [Math DisplayMath eq]:xs) =
   else noReplaceRecurse
 replaceInlineMany _ = noReplaceRecurse
 
-replaceInline :: Inline -> WS (ReplacedResult Inline)
-replaceInline (Image (label,cls,attrs) alt img@(_, tit))
-  | "fig:" `T.isPrefixOf` label && "fig:" `T.isPrefixOf` tit
-  = do
-    opts <- ask
-    idxStr <- replaceAttr (Right label) (lookup "label" attrs) alt imgRefs
-    let alt' = case outFormat opts of
-          f | isLatexFormat f -> alt
-          _  -> applyTemplate idxStr alt $ figureTemplate opts
-    replaceNoRecurse $ Image (label,cls,setLabel opts idxStr attrs) alt' img
-replaceInline _ = noReplaceRecurse
-
 divBlocks :: Block -> Block
 divBlocks (Table tattr (Caption short (btitle:rest)) colspec header cells foot)
   | not $ null title

lib-internal/Text/Pandoc/CrossRef/References/Blocks/Subfigures.hs

@@ -18,7 +18,7 @@ with this program; if not, write to the Free Software Foundation, Inc.,
 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 -}
 
-{-# LANGUAGE Rank2Types, OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE Rank2Types, OverloadedStrings, FlexibleContexts, LambdaCase #-}
 
 module Text.Pandoc.CrossRef.References.Blocks.Subfigures where
 
@@ -35,10 +35,11 @@ import Data.Maybe
 import Text.Pandoc.Walk (walk)
 import Lens.Micro
 import Lens.Micro.Mtl
+import Text.Pandoc.Shared (blocksToInlines)
 
 import Text.Pandoc.CrossRef.References.Types
 import Text.Pandoc.CrossRef.References.Monad
-import Text.Pandoc.CrossRef.References.Blocks.Util (setLabel, replaceAttr, mkCaption)
+import Text.Pandoc.CrossRef.References.Blocks.Util (setLabel, replaceAttr, walkReplaceInlines)
 import Text.Pandoc.CrossRef.Util.Options
 import Text.Pandoc.CrossRef.Util.Template
 import Text.Pandoc.CrossRef.Util.Util
@@ -47,7 +48,10 @@ runSubfigures :: Attr -> [Block] -> [Inline] -> WS (ReplacedResult Block)
 runSubfigures (label, cls, attrs) images caption = do
   opts <- ask
   idxStr <- replaceAttr (Right label) (lookup "label" attrs) caption imgRefs
-  let (cont, st) = flip runState def $ flip runReaderT opts' $ runWS $ runReplace (mkRR $ replaceSubfigs) $ init images
+  let (cont, st) = flip runState def $ flip runReaderT opts' $ runWS $ runReplace (mkRR replaceSubfigs `extRR` doFigure) $ images
+      doFigure :: Block -> WS (ReplacedResult Block)
+      doFigure (Figure attr caption' content) = runFigure True attr caption' content
+      doFigure _ = noReplaceRecurse
       opts' = opts
           { figureTemplate = subfigureChildTemplate opts
           , customLabel = \r i -> customLabel opts ("sub"<>r) i
@@ -77,32 +81,33 @@ runSubfigures (label, cls, attrs) images caption = do
         (M.map (\v -> v{refIndex = refIndex lastRef, refSubfigure = Just $ refIndex v})
         $ st^.imgRefs)
   case outFormat opts of
-        f | isLatexFormat f ->
-          replaceNoRecurse $ Div nullAttr $
-            [ RawBlock (Format "latex") "\\begin{pandoccrossrefsubfigures}" ]
-            <> cont <>
-            [ Para [RawInline (Format "latex") "\\caption["
-                      , Span nullAttr (removeFootnotes caption)
-                      , RawInline (Format "latex") "]"
-                      , Span nullAttr caption]
-            , RawBlock (Format "latex") $ mkLaTeXLabel label
-            , RawBlock (Format "latex") "\\end{pandoccrossrefsubfigures}"]
-        _  -> replaceNoRecurse $ Div (label, "subfigures":cls, setLabel opts idxStr attrs) $ toTable opts cont capt
+    f | isLatexFormat f ->
+      replaceNoRecurse $ Div nullAttr $
+        [ RawBlock (Format "latex") "\\begin{pandoccrossrefsubfigures}" ]
+        <> cont <>
+        [ Para [RawInline (Format "latex") "\\caption["
+                  , Span nullAttr (removeFootnotes caption)
+                  , RawInline (Format "latex") "]"
+                  , Span nullAttr caption]
+        , RawBlock (Format "latex") $ mkLaTeXLabel label
+        , RawBlock (Format "latex") "\\end{pandoccrossrefsubfigures}"]
+    _ -> replaceNoRecurse
+      $ Figure (label, "subfigures":cls, setLabel opts idxStr attrs) (Caption Nothing [Para capt])
+      $ toTable opts cont
   where
     removeFootnotes = walk removeFootnote
     removeFootnote Note{} = Str ""
     removeFootnote x = x
-    toTable :: Options ->[Block] -> [Inline] -> [Block]
-    toTable opts blks capt
-      | subfigGrid opts = [ simpleTable align (map ColWidth widths) (map blkToRow blks)
-                          , mkCaption opts "Image Caption" capt]
-      | otherwise = blks <> [mkCaption opts "Image Caption" capt]
+    toTable :: Options -> [Block] -> [Block]
+    toTable opts blks
+      | isLatexFormat $ outFormat opts = concatMap imagesToFigures blks
+      | subfigGrid opts = [simpleTable align (map ColWidth widths) (map (fmap pure . blkToRow) blks)]
+      | otherwise = blks
       where
-        align | Para ils:_ <- blks = replicate (length $ mapMaybe getWidth ils) AlignCenter
+        align | b:_ <- blks = let ils = blocksToInlines [b] in replicate (length $ mapMaybe getWidth ils) AlignCenter
               | otherwise = error "Misformatted subfigures block"
-        widths | Para ils:_ <- blks
-                = fixZeros $ mapMaybe getWidth ils
-                | otherwise = error "Misformatted subfigures block"
+        widths | b:_ <- blks = let ils = blocksToInlines [b] in fixZeros $ mapMaybe getWidth ils
+               | otherwise = error "Misformatted subfigures block"
         getWidth (Image (_id, _class, as) _ _)
           = Just $ maybe 0 percToDouble $ lookup "width" as
         getWidth _ = Nothing
@@ -118,34 +123,42 @@ runSubfigures (label, cls, attrs) images caption = do
           | Right (perc, "%") <- T.double percs
           = perc/100.0
           | otherwise = error "Only percent allowed in subfigure width!"
-        blkToRow :: Block -> [[Block]]
+        blkToRow :: Block -> [Block]
         blkToRow (Para inls) = mapMaybe inlToCell inls
-        blkToRow x = [[x]]
-        inlToCell :: Inline -> Maybe [Block]
-        inlToCell (Image (id', cs, as) txt tgt)  = Just [Para [Image (id', cs, setW as) txt tgt]]
+        blkToRow x = [x]
+        inlToCell :: Inline -> Maybe Block
+        inlToCell (Image (id', cs, as) txt tgt) = Just $
+          Figure (id', cs, as) (Caption Nothing [Para txt]) [Plain [Image ("", cs, setW as) txt tgt]]
         inlToCell _ = Nothing
         setW as = ("width", "100%"):filter ((/="width") . fst) as
 
 replaceSubfigs :: [Inline] -> WS (ReplacedResult [Inline])
 replaceSubfigs = (replaceNoRecurse . concat) <=< mapM replaceSubfig
 
+imagesToFigures :: Block -> [Block]
+imagesToFigures = \case
+  x@Figure{} -> [x]
+  Para xs -> mapMaybe imageToFigure xs
+  Plain xs -> mapMaybe imageToFigure xs
+  _ -> []
+
+imageToFigure :: Inline -> Maybe Block
+imageToFigure = \case
+  Image (label,cls,attrs) alt tgt -> Just $ Figure (label, cls, attrs) (Caption Nothing [Para alt])
+    [Plain [Image ("",cls,attrs) alt tgt]]
+  _ -> Nothing
+
 replaceSubfig :: Inline -> WS [Inline]
-replaceSubfig x@(Image (label,cls,attrs) alt (src, tit))
+replaceSubfig x@(Image (label,cls,attrs) alt tgt)
   = do
       opts <- ask
-      let label' | "fig:" `T.isPrefixOf` label = Right label
-                 | T.null label = Left "fig"
-                 | otherwise  = Right $ "fig:" <> label
+      let label' = normalizeLabel label
       idxStr <- replaceAttr label' (lookup "label" attrs) alt imgRefs
+      let alt' = applyTemplate idxStr alt $ figureTemplate opts
       case outFormat opts of
         f | isLatexFormat f ->
-          return $ latexSubFigure x label
-        _  ->
-          let alt' = applyTemplate idxStr alt $ figureTemplate opts
-              tit' | "nocaption" `elem` cls = fromMaybe tit $ T.stripPrefix "fig:" tit
-                   | "fig:" `T.isPrefixOf` tit = tit
-                   | otherwise = "fig:" <> tit
-          in return [Image (label, cls, setLabel opts idxStr attrs) alt' (src, tit')]
+          pure $ latexSubFigure x label
+        _ -> return [Image (label, cls, setLabel opts idxStr attrs) alt' tgt]
 replaceSubfig x = return [x]
 
 latexSubFigure :: Inline -> T.Text -> [Inline]
@@ -168,6 +181,12 @@ latexSubFigure (Image (_, cls, attrs) alt (src, title)) label =
       ]
 latexSubFigure x _ = [x]
 
+normalizeLabel :: T.Text -> Either T.Text T.Text
+normalizeLabel label
+  | "fig:" `T.isPrefixOf` label = Right label
+  | T.null label = Left "fig"
+  | otherwise  = Right $ "fig:" <> label
+
 simpleTable :: [Alignment] -> [ColWidth] -> [[[Block]]] -> Block
 simpleTable align width bod = Table nullAttr noCaption (zip align width)
   noTableHead [mkBody bod] noTableFoot
@@ -178,3 +197,22 @@ simpleTable align width bod = Table nullAttr noCaption (zip align width)
   noCaption = Caption Nothing mempty
   noTableHead = TableHead nullAttr []
   noTableFoot = TableFoot nullAttr []
+
+runFigure :: Bool -> Attr -> Caption -> [Block] -> WS (ReplacedResult Block)
+runFigure subFigure (label, cls, fattrs) (Caption short (btitle : rest)) content = do
+  opts <- ask
+  let label' = normalizeLabel label
+  let title = blocksToInlines [btitle]
+      attrs = fromMaybe fattrs $ case blocksToInlines content of
+        [Image (_, _, as) _ _] -> Just as
+        _ -> Nothing
+  idxStr <- replaceAttr label' (lookup "label" attrs) title imgRefs
+  let title' = case outFormat opts of
+        f | isLatexFormat f -> title
+        _  -> applyTemplate idxStr title $ figureTemplate opts
+      caption' = Caption short (walkReplaceInlines title' title btitle:rest)
+  replaceNoRecurse $
+    if subFigure && isLatexFormat (outFormat opts)
+    then Plain $ latexSubFigure (head $ blocksToInlines content) label
+    else Figure (label,cls,setLabel opts idxStr attrs) caption' content
+runFigure _ _ _ _ = noReplaceNoRecurse

lib-internal/Text/Pandoc/CrossRef/Util/CodeBlockCaptions.hs

@@ -18,12 +18,13 @@ with this program; if not, write to the Free Software Foundation, Inc.,
 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, LambdaCase #-}
 module Text.Pandoc.CrossRef.Util.CodeBlockCaptions
     (
     mkCodeBlockCaptions
     ) where
 
+import Control.Monad.Reader (ask)
 import Data.List (stripPrefix)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
@@ -32,12 +33,16 @@ import Text.Pandoc.CrossRef.Util.Options
 import Text.Pandoc.CrossRef.Util.Util
 import Text.Pandoc.Definition
 
-mkCodeBlockCaptions :: Options -> [Block] -> WS [Block]
-mkCodeBlockCaptions opts x@(cb@(CodeBlock _ _):p@(Para _):xs)
-  = return $ fromMaybe x $ orderAgnostic opts $ p:cb:xs
-mkCodeBlockCaptions opts x@(p@(Para _):cb@(CodeBlock _ _):xs)
-  = return $ fromMaybe x $ orderAgnostic opts $ p:cb:xs
-mkCodeBlockCaptions _ x = return x
+mkCodeBlockCaptions :: [Block] -> WS [Block]
+mkCodeBlockCaptions = \case
+  x@(cb@CodeBlock{}:p@Para{}:xs) -> go x p cb xs
+  x@(p@Para{}:cb@CodeBlock{}:xs) -> go x p cb xs
+  x -> pure x
+  where
+    go :: [Block] -> Block -> Block -> [Block] -> WS [Block]
+    go x p cb xs = do
+      opts <- ask
+      return $ fromMaybe x $ orderAgnostic opts $ p:cb:xs
 
 orderAgnostic :: Options -> [Block] -> Maybe [Block]
 orderAgnostic opts (Para ils:CodeBlock (label,classes,attrs) code:xs)

lib/Text/Pandoc/CrossRef.hs

@@ -109,7 +109,7 @@ crossRefBlocks blocks = do
   opts <- R.asks creOptions
   let
     doWalk =
-      bottomUpM (mkCodeBlockCaptions opts) blocks
+      bottomUpM mkCodeBlockCaptions blocks
       >>= replaceAll
       >>= bottomUpM replaceRefs
       >>= bottomUpM listOf

package.yaml

@@ -1,5 +1,5 @@
 name: pandoc-crossref
-version: '0.3.14.0'
+version: '0.3.15.0'
 synopsis: Pandoc filter for cross-references
 description: pandoc-crossref is a pandoc filter for numbering figures, equations,
   tables and cross-references to them.
@@ -20,8 +20,8 @@ data-files:
 dependencies:
 - base >=4.11 && <5
 - text >=1.2.2 && <2.1
-- pandoc >=2.18 && < 2.20
-- pandoc-types >=1.22.2 && <1.23
+- pandoc >=3.0 && < 3.1
+- pandoc-types
 library:
   source-dirs: lib
   ghc-options: -Wall
@@ -112,6 +112,8 @@ tests:
     - hspec >=2.4.4 && <3
     - directory >=1 && <1.4
     - filepath >=1.1 && <1.5
+    build-tools:
+    - pandoc-cli:pandoc
 benchmarks:
   simple:
     main: bench-simple.hs