diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 894d1482..8ef84139 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -5,6 +5,7 @@ on: [push] jobs: build: strategy: + fail-fast: false matrix: os: [ubuntu-latest, macos-latest, windows-latest] pandocver: ["2.13"] @@ -38,11 +39,11 @@ jobs: - uses: actions/cache@v2 with: path: .cabal-store - key: r2-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}}-${{hashFiles('pandoc-crossref.cabal')}}-${{hashFiles('dist-newstyle/cache/plan.json')}} + key: r3-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}}-${{hashFiles('pandoc-crossref.cabal')}}-${{hashFiles('dist-newstyle/cache/plan.json')}} restore-keys: | - r2-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}}-${{hashFiles('pandoc-crossref.cabal')}}-${{hashFiles('dist-newstyle/cache/plan.json')}} - r2-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}}-${{hashFiles('pandoc-crossref.cabal')}} - r2-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}} + r3-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}}-${{hashFiles('pandoc-crossref.cabal')}}-${{hashFiles('dist-newstyle/cache/plan.json')}} + r3-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}}-${{hashFiles('pandoc-crossref.cabal')}} + r3-${{runner.os}}-${{matrix.ghcver}}-${{matrix.pandocver}} - shell: bash run: | rm -rvf .cabal-store/ghc-${{matrix.ghcver}}/pandoc-crossref-* @@ -144,6 +145,7 @@ jobs: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} uses: softprops/action-gh-release@v1 with: + prerelease: true body_path: description.md files: | assets/* diff --git a/README.md b/README.md index f2654b91..c91513c6 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# pandoc-crossref filter ![Build status](https://github.com/lierdakil/pandoc-crossref/workflows/Haskell%20CI/badge.svg) +# pandoc-crossref filter ![Build status](https://github.com/lierdakil/pandoc-crossref/workflows/Haskell%20CI/badge.svg?branch=any-prefix) pandoc-crossref is a pandoc filter for numbering figures, equations, tables and cross-references to them. diff --git a/docs/demo/demo.md b/docs/demo/demo.md index a3ad93b2..bf54e119 100644 --- a/docs/demo/demo.md +++ b/docs/demo/demo.md @@ -1,14 +1,12 @@ --- codeBlockCaptions: True -figureTitle: | - Figure # -lofTitle: | - ## List of Figures -lotTitle: | - ## List of Tables -tableTemplate: | - *$$tableTitle$$ $$i$$*$$titleDelim$$ $$t$$ -autoSectionLabels: True +adjustSectionIdentifiers: True +autoFigLabels: fig +defaultOption: +- numberSections +- titleSections +- chapters +- subfigures title: pandoc-crossref demo document --- @@ -30,7 +28,7 @@ You can also have custom chapter reference labels, like @sec:custlabs Subfigures are supported, see [@fig:subfigures; @fig:subfigureB] -# Chapter 1. Figures {#sec:sec1} +# Figures {#sec:sec1} ![First figure](img1.jpg){#fig:figure1} @@ -45,10 +43,10 @@ Subfigures are supported, see [@fig:subfigures; @fig:subfigureB] ![Subfigure b](img1.jpg){#fig:subfigureB} -Subfigures caption +\: Subfigures caption. []{} -# Chapter 2. Equations {#sec:sec2} +# Equations {#sec:sec2} Display equations are labelled and numbered @@ -57,7 +55,7 @@ $$ P_i(x) = \sum_i a_i x^i $$ {#eq:eqn1} Since 0.1.6.0 those can also appear in the middle of paragraph $$a x^2 + b x^2 + c = 0$${#eq:quadr} like this. -# Chapter 3. Tables +# Tables | First Header | Second Header | |:-------------|:--------------| @@ -73,7 +71,7 @@ Table without caption: | Content Cell | Content Cell | | Content Cell | Content Cell | -# Chapter 4. Code blocks +# Code blocks There are a couple options for code block labels. Those work only if code block id starts with `lst:`, e.g. `{#lst:label}` @@ -103,14 +101,14 @@ main = putStrLn "Hello World!" ## Wrapping div -Wrapping code block without label in a div with id `lst:...` and class, starting with `listing`, and adding paragraph before code block, but inside div, will treat said paragraph as code block caption. +Wrapping code block without label in a div with id `lst:...` and class, starting with `listing`, and adding paragraph after code block, but inside div, starting with `:` will treat said paragraph as code block caption.
-Listing caption ```{.haskell} main :: IO () main = putStrLn "Hello World!" ``` +: Listing caption
# Unnumbered chapter. {-} @@ -118,16 +116,16 @@ main = putStrLn "Hello World!" This chapter doesn't change chapter prefix of referenced elements, instead keeping number of previous chapter, e.g. $$ S(x) = \int_{x_1}^{x_2} a x+b \ \mathrm{d}x $$ {#eq:eqn2} -# Chapter 5. Reference lists +# Reference lists It's also possible to show lists of figures and tables, like this: -\listoffigures +\listof{fig} -\listoftables +\listof{tbl} -\listoflistings +\listof{lst} -# Appendix A. Custom labels {label=AppA} +# Custom labels {label=A title=Appendix} -## This section will have custom label {#sec:custlabs label=CustLab} +## This section will have custom label {#sec:custlabs label=I} diff --git a/hie.yaml b/hie.yaml index 0d94c0b1..de55c867 100644 --- a/hie.yaml +++ b/hie.yaml @@ -3,6 +3,9 @@ cradle: - path: "./lib" component: "lib:pandoc-crossref" + - path: "./lib-internal" + component: "pandoc-crossref:lib:pandoc-crossref-internal" + - path: "./src/pandoc-crossref.hs" component: "pandoc-crossref:exe:pandoc-crossref" @@ -12,14 +15,14 @@ cradle: - path: "./src/Paths_pandoc_crossref.hs" component: "pandoc-crossref:exe:pandoc-crossref" - - path: "./test" + - path: "./test/test-integrative.hs" component: "pandoc-crossref:test:test-integrative" - - path: "./test" - component: "pandoc-crossref:test:test-pandoc-crossref" - - - path: "./lib" + - path: "./test/test-pandoc-crossref.hs" component: "pandoc-crossref:test:test-pandoc-crossref" - path: "./test/bench-simple.hs" component: "pandoc-crossref:bench:simple" + + - path: "./test/Native.hs" + component: "pandoc-crossref:bench:simple" diff --git a/lib-internal/Text/Pandoc/CrossRef/References/Blocks.hs b/lib-internal/Text/Pandoc/CrossRef/References/Blocks.hs index 8eef10b0..725c47a7 100644 --- a/lib-internal/Text/Pandoc/CrossRef/References/Blocks.hs +++ b/lib-internal/Text/Pandoc/CrossRef/References/Blocks.hs @@ -18,353 +18,189 @@ 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 #-} +{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections, OverloadedStrings #-} module Text.Pandoc.CrossRef.References.Blocks ( replaceAll ) where import Text.Pandoc.Definition import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Shared (stringify, blocksToInlines) +import Text.Pandoc.Shared (stringify, makeSections, blocksToInlines) import Text.Pandoc.Walk (walk) import Control.Monad.State hiding (get, modify) import Data.List import Data.Maybe import qualified Data.Map as M import qualified Data.Text as T -import qualified Data.Text.Read as T -import Data.Accessor -import Data.Accessor.Monad.Trans.State -import Text.Pandoc.CrossRef.References.Types +import Text.Pandoc.CrossRef.References.Types as Types +import Text.Pandoc.CrossRef.References.Subfigures import Text.Pandoc.CrossRef.Util.Util import Text.Pandoc.CrossRef.Util.Options +import Text.Pandoc.CrossRef.Util.Prefixes import Text.Pandoc.CrossRef.Util.Template +import Text.Pandoc.CrossRef.Util.CustomLabels +import Text.Pandoc.CrossRef.Util.CodeBlockCaptions +import Text.Pandoc.CrossRef.Util.VarFunction +import Text.Pandoc.CrossRef.Util.Replace import Control.Applicative +import Control.Arrow (second) +import Data.Default (def) import Prelude -import Data.Default -replaceAll :: (Data a) => Options -> a -> WS a -replaceAll opts = - runReplace (mkRR (replaceBlock opts) - `extRR` replaceInline opts - `extRR` replaceInlineMany opts - ) - . runSplitMath - . everywhere (mkT divBlocks `extT` spanInlines opts) - where - runSplitMath | tableEqns opts - , not $ isLatexFormat (outFormat opts) - = everywhere (mkT splitMath) - | otherwise = id - -simpleTable :: [Alignment] -> [ColWidth] -> [[[Block]]] -> Block -simpleTable align width bod = Table nullAttr noCaption (zip align width) - noTableHead [mkBody bod] noTableFoot - where - mkBody xs = TableBody nullAttr (RowHeadColumns 0) [] (map mkRow xs) - mkRow xs = Row nullAttr (map mkCell xs) - mkCell xs = Cell nullAttr AlignDefault (RowSpan 0) (ColSpan 0) xs - noCaption = Caption Nothing mempty - noTableHead = TableHead nullAttr [] - noTableFoot = TableFoot nullAttr [] +replaceAll :: [Block] -> WS [Block] +replaceAll bs = + asks creOptions >>= \opts -> + let run = + fmap unhierarchicalize + . runReplace [] (mkRR (replaceBlock opts) `extRR` replaceInline opts) + . makeSections False Nothing + . everywhere (mkT $ makeSubfigures opts) + . everywhere (mkT (divBlocks opts) `extT` spanInlines opts) + . everywhere (mkT $ mkCodeBlockCaptions opts) + in run bs -setLabel :: Options -> [Inline] -> [(T.Text, T.Text)] -> [(T.Text, T.Text)] -setLabel opts idx +setLabel :: Options -> RefRec -> [(T.Text, T.Text)] -> [(T.Text, T.Text)] +setLabel opts RefRec{..} | setLabelAttribute opts - = (("label", stringify idx) :) + = (("label", stringify refIxInlRaw) :) . filter ((/= "label") . fst) | otherwise = id -replaceBlock :: Options -> Block -> WS (ReplacedResult Block) -replaceBlock opts (Header n (label, cls, attrs) text') - = do - let label' = if autoSectionLabels opts && not ("sec:" `T.isPrefixOf` label) - then "sec:"<>label - else label - unless ("unnumbered" `elem` cls) $ do - modify curChap $ \cc -> - let ln = length cc - cl i = lookup "label" attrs <|> customHeadingLabel opts n i <|> customLabel opts "sec" i - inc l = let i = fst (last l) + 1 in init l <> [(i, cl i)] - cc' | ln > n = inc $ take n cc - | ln == n = inc cc - | otherwise = cc <> take (n-ln-1) (zip [1,1..] $ repeat Nothing) <> [(1,cl 1)] - in cc' - when ("sec:" `T.isPrefixOf` label') $ do - index <- get curChap - modify secRefs $ M.insert label' RefRec { - refIndex=index - , refTitle= text' - , refSubfigure = Nothing - } - cc <- get curChap - let textCC | numberSections opts - , sectionsDepth opts < 0 - || n <= if sectionsDepth opts == 0 then chaptersDepth opts else sectionsDepth opts - , "unnumbered" `notElem` cls - = applyTemplate' (M.fromDistinctAscList [ - ("i", idxStr) - , ("n", [Str $ T.pack $ show $ n - 1]) - , ("t", text') - ]) $ secHeaderTemplate opts - | otherwise = text' - idxStr = chapPrefix (chapDelim opts) cc - attrs' | "unnumbered" `notElem` cls - = setLabel opts idxStr attrs - | otherwise = attrs - replaceNoRecurse $ Header n (label', cls, attrs') textCC --- subfigures -replaceBlock opts (Div (label,cls,attrs) images) - | "fig:" `T.isPrefixOf` label - , Para caption <- last images - = do - idxStr <- replaceAttr opts (Right label) (lookup "label" attrs) caption imgRefs - let (cont, st) = runState (runReplace (mkRR $ replaceSubfigs opts') $ init images) def - collectedCaptions = B.toList $ - intercalate' (B.fromList $ ccsDelim opts) - $ map (B.fromList . collectCaps . snd) - $ sortOn (refIndex . snd) - $ filter (not . null . refTitle . snd) - $ M.toList - $ imgRefs_ st - collectCaps v = - applyTemplate - (chapPrefix (chapDelim opts) (refIndex v)) - (refTitle v) - (ccsTemplate opts) - vars = M.fromDistinctAscList - [ ("ccs", collectedCaptions) - , ("i", idxStr) - , ("t", caption) - ] - capt = applyTemplate' vars $ subfigureTemplate opts - lastRef <- fromJust . M.lookup label <$> get imgRefs - modify imgRefs $ \old -> - M.union - old - (M.map (\v -> v{refIndex = refIndex lastRef, refSubfigure = Just $ refIndex v}) - $ imgRefs_ st) - 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 cont capt - where - opts' = opts - { figureTemplate = subfigureChildTemplate opts - , customLabel = \r i -> customLabel opts ("sub"<>r) i - } - removeFootnotes = walk removeFootnote - removeFootnote Note{} = Str "" - removeFootnote x = x - toTable :: [Block] -> [Inline] -> [Block] - toTable blks capt - | subfigGrid opts = [ simpleTable align (map ColWidth widths) (map blkToRow blks) - , mkCaption opts "Image Caption" capt] - | otherwise = blks <> [mkCaption opts "Image Caption" capt] - where - align | Para ils:_ <- blks = replicate (length $ mapMaybe getWidth ils) AlignCenter - | otherwise = error "Misformatted subfigures block" - widths | Para ils:_ <- blks - = fixZeros $ mapMaybe getWidth ils - | otherwise = error "Misformatted subfigures block" - getWidth (Image (_id, _class, as) _ _) - = Just $ maybe 0 percToDouble $ lookup "width" as - getWidth _ = Nothing - fixZeros :: [Double] -> [Double] - fixZeros ws - = let nz = length $ filter (== 0) ws - rzw = (0.99 - sum ws) / fromIntegral nz - in if nz>0 - then map (\x -> if x == 0 then rzw else x) ws - else ws - percToDouble :: T.Text -> Double - percToDouble percs - | Right (perc, "%") <- T.double percs - = perc/100.0 - | otherwise = error "Only percent allowed in subfigure width!" - 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]] - inlToCell _ = Nothing - setW as = ("width", "100%"):filter ((/="width") . fst) as -replaceBlock opts (Div (label,clss,attrs) [Table tattr (Caption short (btitle:rest)) colspec header cells foot]) +setLabel' :: Options -> RefRec -> Attr -> Attr +setLabel' opts idx (i, c, a) = (i, c, setLabel opts idx a) + +replaceBlock :: Options -> Scope -> Block -> WS (ReplacedResult Block) +-- sections +replaceBlock opts scope (Div (ident, "section":cls, attr) (Header lvl (hident, hcls, hattr) text' : body)) + | Just (pfx, label') <- + fmap (, ExplicitLabel label) (getRefPrefix opts label) + <|> (autoSectionLabels opts >>= \asl -> return $ + if adjustSectionIdentifiers opts + then let l = asl <> ":" <> label in (asl, ExplicitLabel l) + else (asl, AutoLabel) + ) + = let newlabel = fromMaybe label $ labelToMaybe label' + (newident, newhident) + | T.null hident = (newlabel, hident) + | otherwise = (ident, newlabel) + result title attrf = Div (newident, "section":cls, attrf attr) (Header lvl (newhident, hcls, attrf hattr) title : body) + in if "unnumbered" `elem` hcls + then replaceRecurse scope $ result text' id + else do + let ititle = B.fromList text' + rec' <- replaceAttr opts scope label' hattr ititle pfx + let title' = B.toList $ refCaption rec' + replaceRecurse (newScope rec' scope) $ result title' (setLabel opts rec') + where label | T.null hident = ident + | otherwise = hident +-- tables +replaceBlock opts scope (Div divOps@(label,_,attrs) [Table tattr (Caption short (btitle:rest)) colspec header cells foot]) | not $ null title - , "tbl:" `T.isPrefixOf` label + , Just pfx <- getRefPrefix opts label = do - idxStr <- replaceAttr opts (Right label) (lookup "label" attrs) title tblRefs - let title' = - case outFormat opts of - f | isLatexFormat f -> - RawInline (Format "latex") (mkLaTeXLabel label) : title - _ -> applyTemplate idxStr title $ tableTemplate opts - caption' = Caption short (walkReplaceInlines title' title btitle:rest) - replaceNoRecurse $ Div (label, clss, setLabel opts idxStr attrs) [Table tattr caption' colspec header cells foot] + let ititle = B.fromList title + rr@RefRec{..} <- replaceAttr opts scope (ExplicitLabel label) attrs ititle pfx + let caption' = Caption short (walkReplaceInlines (B.toList refCaption) title btitle:rest) + replaceNoRecurse $ Div (setLabel' opts rr divOps) [Table tattr caption' colspec header cells foot] where title = blocksToInlines [btitle] -replaceBlock opts (Table (label,clss,attrs) (Caption short (btitle:rest)) colspec header cells foot) +replaceBlock opts scope (Table divOps@(label,_,attrs) (Caption short (btitle:rest)) colspec header cells foot) | not $ null title - , "tbl:" `T.isPrefixOf` label + , Just pfx <- getRefPrefix opts label = do - idxStr <- replaceAttr opts (Right label) (lookup "label" attrs) title tblRefs - let title' = - case outFormat opts of - f | isLatexFormat f -> - RawInline (Format "latex") (mkLaTeXLabel label) : title - _ -> applyTemplate idxStr title $ tableTemplate opts - caption' = Caption short (walkReplaceInlines title' title btitle:rest) - replaceNoRecurse $ Table (label, clss, setLabel opts idxStr attrs) caption' colspec header cells foot + let ititle = B.fromList title + rr@RefRec{..} <- replaceAttr opts scope (ExplicitLabel label) attrs ititle pfx + let caption' = Caption short (walkReplaceInlines (B.toList refCaption) title btitle:rest) + replaceNoRecurse $ Table (setLabel' opts rr divOps) caption' colspec header cells foot where title = blocksToInlines [btitle] -replaceBlock opts cb@(CodeBlock (label, classes, attrs) code) - | not $ T.null label - , "lst:" `T.isPrefixOf` label - , Just caption <- lookup "caption" attrs - = case outFormat opts of - f - --if used with listings package,nothing shoud be done - | isLatexFormat f, listings opts -> noReplaceNoRecurse - --if not using listings, however, wrap it in a codelisting environment - | isLatexFormat f -> - replaceNoRecurse $ Div nullAttr [ - RawBlock (Format "latex") "\\begin{codelisting}" - , Plain [ - RawInline (Format "latex") "\\caption{" - , Str caption - , RawInline (Format "latex") "}" - ] - , cb - , RawBlock (Format "latex") "\\end{codelisting}" - ] - _ -> do - let cap = B.toList $ B.text caption - idxStr <- replaceAttr opts (Right label) (lookup "label" attrs) cap lstRefs - let caption' = applyTemplate idxStr cap $ listingTemplate opts - replaceNoRecurse $ Div (label, "listing":classes, []) [ - mkCaption opts "Caption" caption' - , CodeBlock ("", classes, filter ((/="caption") . fst) $ setLabel opts idxStr attrs) code - ] -replaceBlock opts - (Div (label,"listing":divClasses, divAttrs) - [Para caption, CodeBlock ("",cbClasses,cbAttrs) code]) - | not $ T.null label - , "lst:" `T.isPrefixOf` label - = case outFormat opts of - f - --if used with listings package, return code block with caption - | isLatexFormat f, listings opts -> - replaceNoRecurse $ CodeBlock (label,classes,("caption",escapeLaTeX $ stringify caption):attrs) code - --if not using listings, however, wrap it in a codelisting environment - | isLatexFormat f -> - replaceNoRecurse $ Div nullAttr [ - RawBlock (Format "latex") "\\begin{codelisting}" - , Para [ - RawInline (Format "latex") "\\caption" - , Span nullAttr caption - ] - , CodeBlock (label,classes,attrs) code - , RawBlock (Format "latex") "\\end{codelisting}" - ] - _ -> do - idxStr <- replaceAttr opts (Right label) (lookup "label" attrs) caption lstRefs - let caption' = applyTemplate idxStr caption $ listingTemplate opts - replaceNoRecurse $ Div (label, "listing":classes, []) [ - mkCaption opts "Caption" caption' - , CodeBlock ("", classes, setLabel opts idxStr attrs) code - ] - where attrs = divAttrs <> cbAttrs - classes = nub $ divClasses <> cbClasses -replaceBlock opts (Para [Span sattrs@(label, cls, attrs) [Math DisplayMath eq]]) - | not $ isLatexFormat (outFormat opts) - , tableEqns opts +-- code blocks +replaceBlock opts scope (Div (label, divclasses, divattrs) [CodeBlock ("",classes,cbattrs) code, Para (Str ":":Space:caption)]) + | Just pfx <- getRefPrefix opts label = do - (eq', idxStr) <- replaceEqn opts sattrs eq - replaceNoRecurse $ Div (label,cls,setLabel opts idxStr attrs) [ - simpleTable [AlignCenter, AlignRight] [ColWidth 0.9, ColWidth 0.09] - [[[Plain [Math DisplayMath eq']], [eqnNumber $ stringify idxStr]]]] - where - eqnNumber idx - | outFormat opts == Just (Format "docx") - = Div nullAttr [ - RawBlock (Format "openxml") "" - , mathIdx - ] - | otherwise = mathIdx - where mathIdx = Plain [Math DisplayMath $ "(" <> idx <> ")"] -replaceBlock _ _ = noReplaceRecurse + ref <- replaceAttr opts scope (ExplicitLabel label) divattrs (B.fromList caption) pfx + let divattrs' = setLabel opts ref divattrs + replaceNoRecurse $ + Div (label, divclasses, divattrs') + $ placeCaption opts ref [CodeBlock ("", divclasses <> classes, divattrs <> cbattrs) code] +-- Generic div +replaceBlock opts scope (Div ats@(label, _, attrs) content) + | Just pfx <- getRefPrefix opts label + = do + let (caption, content') + | not (null content) + , Para (Str ":":Space:c) <- last content + = (B.fromList c, init content) + | otherwise = (mempty, content) + ref <- replaceAttr opts scope (ExplicitLabel label) attrs caption pfx + replaceRecurse (newScope ref scope) $ + Div (setLabel' opts ref ats) $ placeCaption opts ref content' +replaceBlock _ scope _ = noReplaceRecurse scope -replaceEqn :: Options -> Attr -> T.Text -> WS (T.Text, [Inline]) -replaceEqn opts (label, _, attrs) eq = do - let label' | T.null label = Left "eq" - | otherwise = Right label - idxStr <- replaceAttr opts label' (lookup "label" attrs) [] eqnRefs - let eq' | tableEqns opts = eq - | otherwise = eq<>"\\qquad("<>idxTxt<>")" - idxTxt = stringify idxStr - return (eq', idxStr) +placeCaption :: Options -> RefRec -> [Block] -> [Block] +placeCaption opts RefRec{..} body + | Above <- refCaptionPosition + = mkCaption opts "Caption" refCaption : body + | Below <- refCaptionPosition + = body <> [mkCaption opts "Caption" refCaption] -replaceInlineMany :: Options -> [Inline] -> WS (ReplacedResult [Inline]) -replaceInlineMany opts (Span spanAttr@(label,clss,attrs) [Math DisplayMath eq]:xs) - | "eq:" `T.isPrefixOf` label || T.null label && autoEqnLabels opts - = replaceRecurse . (<>xs) =<< case outFormat opts of - f | isLatexFormat f -> - pure [RawInline (Format "latex") "\\begin{equation}" - , Span spanAttr [RawInline (Format "latex") eq] - , RawInline (Format "latex") $ mkLaTeXLabel label <> "\\end{equation}"] - _ -> do - (eq', idxStr) <- replaceEqn opts spanAttr eq - pure [Span (label,clss,setLabel opts idxStr attrs) [Math DisplayMath eq']] -replaceInlineMany _ _ = noReplaceRecurse +data ItemLabel = ExplicitLabel T.Text | AutoLabel -replaceInline :: Options -> Inline -> WS (ReplacedResult Inline) -replaceInline opts (Image (label,cls,attrs) alt img@(_, tit)) - | "fig:" `T.isPrefixOf` label && "fig:" `T.isPrefixOf` tit - = do - idxStr <- replaceAttr opts (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 +labelToMaybe :: ItemLabel -> Maybe T.Text +labelToMaybe (ExplicitLabel s) = Just s +labelToMaybe AutoLabel = Nothing -replaceSubfigs :: Options -> [Inline] -> WS (ReplacedResult [Inline]) -replaceSubfigs opts = (replaceNoRecurse . concat) <=< mapM (replaceSubfig opts) +autoLabel :: T.Text -> T.Text -> Maybe ItemLabel +autoLabel pfx label + | T.null label = Just AutoLabel + | (pfx <> ":") `T.isPrefixOf` label = Just $ ExplicitLabel label + | otherwise = Nothing -replaceSubfig :: Options -> Inline -> WS [Inline] -replaceSubfig opts x@(Image (label,cls,attrs) alt (src, tit)) +replaceInline :: Options -> Scope -> Inline -> WS (ReplacedResult Inline) +replaceInline opts scope (Span ats@(label,_,attrs) [Math DisplayMath eq]) + | Just pfx <- getRefPrefix opts label <|> autoEqnLabels opts + , Just lbl <- autoLabel pfx label + = do + rr@RefRec{..} <- replaceAttr opts scope lbl attrs (B.displayMath eq) pfx + replaceNoRecurse $ Span (setLabel' opts rr ats) [Math DisplayMath $ stringify refCaption] +replaceInline opts scope (Image attr@(label,_,attrs) alt img@(_, tit)) + | Just pfx <- getRefPrefix opts label <|> autoFigLabels opts + , Just lbl <- autoLabel pfx label + , "fig:" `T.isPrefixOf` tit + = do + rr@RefRec{..} <- replaceAttr opts scope lbl attrs (B.fromList alt) pfx + replaceNoRecurse $ Image (setLabel' opts rr attr) (B.toList refCaption) img +-- generic span +replaceInline opts scope (Span (label,cls,attrs) content) + | Just pfx <- getRefPrefix opts label = do - let label' | "fig:" `T.isPrefixOf` label = Right label - | T.null label = Left "fig" - | otherwise = Right $ "fig:" <> label - idxStr <- replaceAttr opts label' (lookup "label" attrs) alt imgRefs - 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')] -replaceSubfig _ x = return [x] + ref@RefRec{} <- replaceAttr opts scope (ExplicitLabel label) attrs (B.fromList content) pfx + replaceRecurse (newScope ref scope) . Span (label, cls, setLabel opts ref attrs) + . B.toList $ applyTitleTemplate ref +replaceInline _opts (scope@RefRec{refPfxRec=Prefix{..}}:_) (Span ("",_,attrs) []) = do + rd <- get referenceData + let ccd = filter ((== Just scope) . refScope) . M.elems $ rd + prefix = maybe mempty B.str $ lookup "prefix" attrs + suffix = maybe mempty B.str $ lookup "suffix" attrs + delim = maybe prefixCollectedCaptionDelim B.str $ lookup "delim" attrs + varFunc rr x = fix defaultVarFunc rr x <|> (MetaString <$> lookup x attrs) + replaceNoRecurse . Span nullAttr . B.toList $ + prefix <> ( + mconcat + . intersperse delim + . map (applyTemplate prefixCollectedCaptionTemplate . varFunc) + $ sort ccd) <> suffix +replaceInline _ scope _ = noReplaceRecurse scope -divBlocks :: Block -> Block -divBlocks (Table tattr (Caption short (btitle:rest)) colspec header cells foot) - | not $ null title - , Just label <- getRefLabel "tbl" [last title] - = Div (label,[],[]) [ - Table tattr (Caption short $ walkReplaceInlines (dropWhileEnd isSpace (init title)) title btitle:rest) colspec header cells foot] +applyTitleTemplate :: RefRec -> B.Inlines +applyTitleTemplate rr@RefRec{refPfxRec} = + applyTemplate (prefixCaptionTemplate refPfxRec) (fix defaultVarFunc rr) + +applyTitleIndexTemplate :: RefRec -> B.Inlines +applyTitleIndexTemplate rr@RefRec{..} = + applyTemplate (prefixCaptionIndexTemplate refPfxRec) vf where - title = blocksToInlines [btitle] -divBlocks x = x + vf "i" = Nothing + vf x = fix defaultVarFunc rr x walkReplaceInlines :: [Inline] -> [Inline] -> Block -> Block walkReplaceInlines newTitle title = walk replaceInlines @@ -373,66 +209,86 @@ walkReplaceInlines newTitle title = walk replaceInlines | xs == title = newTitle | otherwise = xs -splitMath :: [Block] -> [Block] -splitMath (Para ils:xs) - | length ils > 1 = map Para (split [] [] ils) <> xs - where - split res acc [] = reverse (reverse acc : res) - split res acc (x@(Span _ [Math DisplayMath _]):ys) = - split ([x] : reverse (dropSpaces acc) : res) - [] (dropSpaces ys) - split res acc (y:ys) = split res (y:acc) ys - dropSpaces = dropWhile isSpace -splitMath xs = xs +divBlocks :: Options -> Block -> Block +divBlocks opts (Table tattr@("", _, _) (Caption short (btitle:rest)) colspec header cells foot) + | [Span (label, cls, attr) title] <- titleWSpan + , not $ null title + , isJust $ getRefPrefix opts label + = Div (label, cls, attr) [Table tattr (Caption short $ walkReplaceInlines title titleWSpan btitle : rest) colspec header cells foot] + where titleWSpan = blocksToInlines [btitle] +divBlocks opts (Table tattr@("", _, _) (Caption short (btitle:rest)) colspec header cells foot) + | not $ null title + , Just label <- getRefLabel opts [last title] + = Div (label,[],[]) [Table tattr (Caption short $ walkReplaceInlines (dropWhileEnd isSpace (init title)) title btitle : rest) colspec header cells foot] + where title = blocksToInlines [btitle] +divBlocks opts (CodeBlock (label, classes, attrs) code) + | Just caption <- lookup "caption" attrs + , isJust $ getRefPrefix opts label + = let p = Para $ Str ":" : Space : B.toList (B.text caption) + cb' = CodeBlock ("", classes, delete ("caption", caption) attrs) code + in Div (label, [], []) [cb', p] +divBlocks _ x = x spanInlines :: Options -> [Inline] -> [Inline] spanInlines opts (math@(Math DisplayMath _eq):ils) | c:ils' <- dropWhile isSpace ils - , Just label <- getRefLabel "eq" [c] + , Just label <- getRefLabel opts [c] = Span (label,[],[]) [math]:ils' - | autoEqnLabels opts + | isJust $ autoEqnLabels opts = Span nullAttr [math]:ils spanInlines _ x = x -replaceAttr :: Options -> Either T.Text T.Text -> Maybe T.Text -> [Inline] -> Accessor References RefMap -> WS [Inline] -replaceAttr o label refLabel title prop +replaceAttr :: Options -> Scope -> ItemLabel -> [(T.Text, T.Text)] -> B.Inlines -> T.Text -> WS RefRec +replaceAttr o scope label attrs title pfx = do - chap <- take (chaptersDepth o) `fmap` get curChap - prop' <- get prop - let i = 1+ (M.size . M.filter (\x -> (chap == init (refIndex x)) && isNothing (refSubfigure x)) $ prop') - index = chap <> [(i, refLabel <|> customLabel o ref i)] - ref = either id (T.takeWhile (/=':')) label - label' = either (<> T.pack (':' : show index)) id label - when (M.member label' prop') $ - error . T.unpack $ "Duplicate label: " <> label' - modify prop $ M.insert label' RefRec { - refIndex= index - , refTitle= title - , refSubfigure = Nothing - } - return $ chapPrefix (chapDelim o) index - -latexSubFigure :: Inline -> T.Text -> [Inline] -latexSubFigure (Image (_, cls, attrs) alt (src, title)) label = - let - title' = fromMaybe title $ T.stripPrefix "fig:" title - texlabel | T.null label = [] - | otherwise = [RawInline (Format "latex") $ mkLaTeXLabel label] - texalt | "nocaption" `elem` cls = [] - | otherwise = concat - [ [ RawInline (Format "latex") "["] - , alt - , [ RawInline (Format "latex") "]"] - ] - img = Image (label, cls, attrs) alt (src, title') - in concat [ - [ RawInline (Format "latex") "\\subfloat" ] - , texalt - , [Span nullAttr $ img:texlabel] - ] -latexSubFigure x _ = [x] + roptMain <- liftEither $ getPfx o pfx + let attrMap = M.fromListWith (flip (++)) $ map (second return) attrs + metaAttrMap = M.map attr2meta attrMap + attr2meta [s] = MetaString s + attr2meta ss = MetaList $ map MetaString ss + scopeSpecifier = fromMaybe (prefixScope ropt) $ M.lookup "scope" attrMap + itemScope = find ((`elem` scopeSpecifier) . refPfx) scope + lvl = length $ filter ((== pfx) . refPfx) scope + ropt = recurseSub lvl roptMain + recurseSub 0 r = r + recurseSub l r + | Just i <- prefixSub r = recurseSub (l-1) i + | otherwise = r + cr <- (\CounterRec{..} -> CounterRec{ + crIndex = crIndex+1 + , crIndexInScope = M.insertWith (+) itemScope 1 crIndexInScope + }) . fromMaybe def . M.lookup pfx <$> get pfxCounter + modify pfxCounter $ M.insert pfx cr + let refLabel' = lookup "label" attrs + label' = + case label of + ExplicitLabel l -> l + AutoLabel -> pfx <> T.pack (':':'\0':show i) + iInSc = fromJust $ M.lookup itemScope $ crIndexInScope cr + i = crIndex cr + customLabel = maybe (prefixNumbering ropt) + (mkLabel $ label' <> " attribute numbering") + $ M.lookup "numbering" metaAttrMap + hasLabel <- M.member label' <$> get referenceData + when hasLabel $ throwError $ WSEDuplicateLabel label' + let rec' = RefRec { + refIndex = i + , refTitle = title + , refLabel = label' + , refIxInl = applyTitleIndexTemplate rec' + , refIxInlRaw = B.text $ fromMaybe (customLabel iInSc) refLabel' + , refScope = itemScope + , refLevel = lvl + , refPfx = pfx + , refPfxRec = ropt + , refCaption = applyTitleTemplate rec' + , refAttrs = (`M.lookup` metaAttrMap) + , refCaptionPosition = prefixCaptionPosition ropt + } + modify referenceData $ M.insert label' rec' + return rec' -mkCaption :: Options -> T.Text -> [Inline] -> Block +mkCaption :: Options -> T.Text -> B.Inlines -> Block mkCaption opts style - | outFormat opts == Just (Format "docx") = Div ("", [], [("custom-style", style)]) . return . Para - | otherwise = Para + | outFormat opts == Just (Format "docx") = Div ("", [], [("custom-style", style)]) . B.toList . B.para + | otherwise = Para . B.toList diff --git a/lib-internal/Text/Pandoc/CrossRef/References/List.hs b/lib-internal/Text/Pandoc/CrossRef/References/List.hs index 3ae055a1..0df948ca 100644 --- a/lib-internal/Text/Pandoc/CrossRef/References/List.hs +++ b/lib-internal/Text/Pandoc/CrossRef/References/List.hs @@ -18,45 +18,49 @@ 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 NamedFieldPuns, OverloadedStrings #-} + module Text.Pandoc.CrossRef.References.List (listOf) where import Text.Pandoc.Definition -import Data.Accessor.Monad.Trans.State -import Control.Arrow +import Text.Pandoc.Builder import Data.List +import Data.Function import qualified Data.Map as M import qualified Data.Text as T import Text.Pandoc.CrossRef.References.Types import Text.Pandoc.CrossRef.Util.Util import Text.Pandoc.CrossRef.Util.Options +import Text.Pandoc.CrossRef.Util.Template +import Text.Pandoc.CrossRef.Util.Prefixes.Types +import Text.Pandoc.CrossRef.Util.VarFunction -listOf :: Options -> [Block] -> WS [Block] -listOf Options{outFormat=f} x | isLatexFormat f = return x -listOf opts (RawBlock fmt "\\listoffigures":xs) - | isLaTeXRawBlockFmt fmt - = get imgRefs >>= makeList opts lofTitle xs -listOf opts (RawBlock fmt "\\listoftables":xs) - | isLaTeXRawBlockFmt fmt - = get tblRefs >>= makeList opts lotTitle xs -listOf opts (RawBlock fmt "\\listoflistings":xs) +listOf :: [Block] -> WS [Block] +listOf (RawBlock fmt cmd:xs) | isLaTeXRawBlockFmt fmt - = get lstRefs >>= makeList opts lolTitle xs -listOf _ x = return x - -makeList :: Options -> (Options -> [Block]) -> [Block] -> M.Map T.Text RefRec -> WS [Block] -makeList opts titlef xs refs - = return $ - titlef opts ++ - (if chaptersDepth opts > 0 - then Div ("", ["list"], []) (itemChap `map` refsSorted) - else OrderedList style (item `map` refsSorted)) - : xs + , Just pfxBrace <- "\\listof{" `T.stripPrefix` cmd + , (pfx, "}") <- T.span (/='}') pfxBrace + = getPfxData pfx >>= fmap toList . makeList pfx (fromList xs) +listOf x = return x + +getPfxData :: T.Text -> WS RefMap +getPfxData pfx = M.filterWithKey (\k _ -> (pfx <> ":") `T.isPrefixOf` k) <$> get referenceData + +makeList :: T.Text -> Blocks -> M.Map T.Text RefRec -> WS Blocks +makeList titlef xs refs + = do + opts <- asks creOptions + title <- liftEither $ getTitleForListOf opts titlef + return $ title + <> divWith ("", ["list"], []) (mconcat $ map itemChap refsSorted) + <> xs where - refsSorted = sortBy compare' $ M.toList refs - compare' (_,RefRec{refIndex=i}) (_,RefRec{refIndex=j}) = compare i j - item = (:[]) . Plain . refTitle . snd - itemChap = Para . uncurry ((. (Space :)) . (++)) . (numWithChap . refIndex &&& refTitle) . snd - numWithChap = chapPrefix (chapDelim opts) - style = (1,DefaultStyle,DefaultDelim) + refsSorted :: [RefRec] + refsSorted = sortBy (compare `on` refIndex) $ M.elems refs + itemChap :: RefRec -> Blocks + itemChap = para . applyListItemTemplate + +applyListItemTemplate :: RefRec -> Inlines +applyListItemTemplate rr@RefRec{refPfxRec} = + applyTemplate (prefixListItemTemplate refPfxRec) (fix defaultVarFunc rr) diff --git a/lib-internal/Text/Pandoc/CrossRef/References/Refs.hs b/lib-internal/Text/Pandoc/CrossRef/References/Refs.hs index 667f015d..ef3cd897 100644 --- a/lib-internal/Text/Pandoc/CrossRef/References/Refs.hs +++ b/lib-internal/Text/Pandoc/CrossRef/References/Refs.hs @@ -18,7 +18,9 @@ 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 RecordWildCards, NamedFieldPuns, FlexibleInstances, + FlexibleContexts, OverloadedStrings #-} + module Text.Pandoc.CrossRef.References.Refs (replaceRefs) where import Text.Pandoc.Definition @@ -30,226 +32,186 @@ import qualified Data.Text as T import Data.Maybe import Data.Function import qualified Data.Map as M +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty(..)) import Control.Arrow as A -import Data.Accessor -import Data.Accessor.Monad.Trans.State import Text.Pandoc.CrossRef.References.Types import Text.Pandoc.CrossRef.Util.Template import Text.Pandoc.CrossRef.Util.Util -import Text.Pandoc.CrossRef.Util.Options +import Text.Pandoc.CrossRef.Util.Options hiding (getRefPrefix) +import Text.Pandoc.CrossRef.Util.Prefixes +import Text.Pandoc.CrossRef.Util.VarFunction import Control.Applicative -import Debug.Trace +import Data.Either import Prelude -replaceRefs :: Options -> [Inline] -> WS [Inline] -replaceRefs opts (Cite cits _:xs) - = toList . (<> fromList xs) . intercalate' (text ", ") . map fromList <$> mapM replaceRefs' (groupBy eqPrefix cits) - where - eqPrefix a b = uncurry (==) $ - (fmap uncapitalizeFirst . getLabelPrefix . citationId) <***> (a,b) - (<***>) = join (***) - replaceRefs' cits' - | Just prefix <- allCitsPrefix cits' - = replaceRefs'' prefix opts cits' - | otherwise = return [Cite cits' il'] - where - il' = toList $ - str "[" - <> intercalate' (text "; ") (map citationToInlines cits') - <> str "]" - citationToInlines c = - fromList (citationPrefix c) <> text ("@" <> citationId c) - <> fromList (citationSuffix c) - replaceRefs'' = case outFormat opts of - f | isLatexFormat f -> replaceRefsLatex - _ -> replaceRefsOther -replaceRefs _ x = return x - --- accessors to state variables -accMap :: M.Map T.Text (Accessor References RefMap) -accMap = M.fromList [("fig:",imgRefs) - ,("eq:" ,eqnRefs) - ,("tbl:",tblRefs) - ,("lst:",lstRefs) - ,("sec:",secRefs) - ] - --- accessors to options -prefMap :: M.Map T.Text (Options -> Bool -> Int -> [Inline], Options -> Template) -prefMap = M.fromList [("fig:",(figPrefix, figPrefixTemplate)) - ,("eq:" ,(eqnPrefix, eqnPrefixTemplate)) - ,("tbl:",(tblPrefix, tblPrefixTemplate)) - ,("lst:",(lstPrefix, lstPrefixTemplate)) - ,("sec:",(secPrefix, secPrefixTemplate)) - ] - -prefixes :: [T.Text] -prefixes = M.keys accMap - -getRefPrefix :: Options -> T.Text -> Bool -> Int -> [Inline] -> [Inline] -getRefPrefix opts prefix capitalize num cit = - applyTemplate' (M.fromDistinctAscList [("i", cit), ("p", refprefix)]) - $ reftempl opts - where (refprefixf, reftempl) = lookupUnsafe prefix prefMap - refprefix = refprefixf opts capitalize num - - -lookupUnsafe :: Ord k => k -> M.Map k v -> v -lookupUnsafe = (fromJust .) . M.lookup - -allCitsPrefix :: [Citation] -> Maybe T.Text -allCitsPrefix cits = find isCitationPrefix prefixes - where - isCitationPrefix p = - all ((p `T.isPrefixOf`) . uncapitalizeFirst . citationId) cits - -replaceRefsLatex :: T.Text -> Options -> [Citation] -> WS [Inline] -replaceRefsLatex prefix opts cits - | cref opts - = replaceRefsLatex' prefix opts cits - | otherwise - = toList . intercalate' (text ", ") . map fromList <$> - mapM (replaceRefsLatex' prefix opts) (groupBy citationGroupPred cits) - -replaceRefsLatex' :: T.Text -> Options -> [Citation] -> WS [Inline] -replaceRefsLatex' prefix opts cits = - return $ p [texcit] - where - texcit = - RawInline (Format "tex") $ - if cref opts then - cref'<>"{"<>listLabels prefix "" "," "" cits<>"}" - else - listLabels prefix "\\ref{" ", " "}" cits - suppressAuthor = all ((==SuppressAuthor) . citationMode) cits - noPrefix = all (null . citationPrefix) cits - p | cref opts = id - | suppressAuthor - = id - | noPrefix - = getRefPrefix opts prefix cap (length cits - 1) - | otherwise = ((citationPrefix (head cits) <> [Space]) <>) - cap = maybe False isFirstUpper $ getLabelPrefix . citationId . head $ cits - cref' | suppressAuthor = "\\labelcref" - | cap = "\\Cref" - | otherwise = "\\cref" - -listLabels :: T.Text -> T.Text -> T.Text -> T.Text -> [Citation] -> T.Text -listLabels prefix p sep s = - T.intercalate sep . map ((p <>) . (<> s) . mkLaTeXLabel' . (prefix<>) . getLabelWithoutPrefix . citationId) - -getLabelWithoutPrefix :: T.Text -> T.Text -getLabelWithoutPrefix = T.drop 1 . T.dropWhile (/=':') - -getLabelPrefix :: T.Text -> Maybe T.Text -getLabelPrefix lab - | uncapitalizeFirst p `elem` prefixes = Just p - | otherwise = Nothing - where p = flip T.snoc ':' . T.takeWhile (/=':') $ lab - -replaceRefsOther :: T.Text -> Options -> [Citation] -> WS [Inline] -replaceRefsOther prefix opts cits = toList . intercalate' (text ", ") . map fromList <$> - mapM (replaceRefsOther' prefix opts) (groupBy citationGroupPred cits) - -citationGroupPred :: Citation -> Citation -> Bool -citationGroupPred = (==) `on` liftM2 (,) citationPrefix citationMode - -replaceRefsOther' :: T.Text -> Options -> [Citation] -> WS [Inline] -replaceRefsOther' prefix opts cits = do - indices <- mapM (getRefIndex prefix opts) cits +groupEither :: [Either a b] -> [Either [a] [b]] +groupEither [] = [] +groupEither (Left x:xs) + = Left (x:lefts ys) : groupEither zs + where (ys,zs) = span isLeft xs +groupEither (Right x:xs) + = Right (x:rights ys) : groupEither zs + where (ys,zs) = span isRight xs + +replaceRefs :: [Inline] -> WS [Inline] +replaceRefs ils + | Cite cits _:xs <- ils + = do + opts <- asks creOptions + let + eqPred :: RefDataComplete -> RefDataComplete -> Bool + eqPred = (==) `on` liftM2 (,) rdLevel rdPrefix + intrclt = intercalate' (text ", ") + replaceRefs' (Left xs') = restoreCits' xs' + replaceRefs' (Right xs') = intrclt <$> mapM (replaceRefsOther opts) (NE.groupBy eqPred xs') + restoreCits' refs = liftM2 cite cits' il' + where + cits' = mapM getCit refs + getCit RefDataIncomplete{rdCitation, rdiLabel} + | T.takeWhile (/=':') rdiLabel `elem` M.keys (prefixes opts) + = tell ["Undefined cross-reference: " <> rdiLabel] >> return rdCitation + | otherwise = return rdCitation + il' = do + i <- map citationToInlines <$> cits' + return $ str "[" + <> intercalate' (text "; ") i + <> str "]" + citationToInlines c = + fromList (citationPrefix c) <> text ("@" <> citationId c) + <> fromList (citationSuffix c) + citRefData <- groupEither <$> mapM getRefData cits + toList . (<> fromList xs) . intrclt <$> mapM replaceRefs' citRefData +replaceRefs x = return x + +getRefPrefix :: Bool -> Int -> RefRec -> Inlines -> Inlines +getRefPrefix capitalize num rr@RefRec{..} cit = + applyRefTemplate reftempl vf capitalize + where Prefix{prefixReferenceTemplate=reftempl} = refPfxRec + vf "rs" = Just $ MetaInlines $ toList cit + vf "n" = Just $ MetaString $ T.pack $ show num + vf x = fix defaultVarFunc rr x + +replaceRefsOther :: Options -> NonEmpty RefDataComplete -> WS Inlines +replaceRefsOther opts cits = intercalate' (text ", ") <$> + mapM (replaceRefsOther' opts) (NE.groupBy citationGroupPred cits) + +citationGroupPred :: RefDataComplete -> RefDataComplete -> Bool +citationGroupPred = (==) `on` liftM2 (,) rdCitPrefix rdSuppressPrefix + +replaceRefsOther' :: Options -> NonEmpty RefDataComplete -> WS Inlines +replaceRefsOther' opts indices = do let - cap = maybe False isFirstUpper $ getLabelPrefix . citationId . head $ cits - writePrefix | all ((==SuppressAuthor) . citationMode) cits - = id - | all (null . citationPrefix) cits - = cmap $ getRefPrefix opts prefix cap (length cits - 1) - | otherwise - = cmap $ toList . ((fromList (citationPrefix (head cits)) <> space) <>) . fromList - cmap f [Link attr t w] - | nameInLink opts = [Link attr (f t) w] + cmap f x + | nameInLink opts + , [Link attr t (y, z)] <- toList x = linkWith attr y z (f $ fromList t) cmap f x = f x - return $ writePrefix (makeIndices opts indices) + return $ cmap (writePrefix indices) (makeIndices opts indices) -data RefData = RefData { rdLabel :: T.Text - , rdIdx :: Maybe Index - , rdSubfig :: Maybe Index - , rdSuffix :: [Inline] - } deriving (Eq) +writePrefix :: NonEmpty RefDataComplete -> Inlines -> Inlines +writePrefix (RefDataComplete{..}:|rds) + | rdSuppressPrefix = id + | isNothing rdCitPrefix = getRefPrefix rdUpperCase (length rds) rdRec + | otherwise = ((fromJust rdCitPrefix <> space) <>) -instance Ord RefData where - (<=) = (<=) `on` rdIdx +data RefDataIncomplete = RefDataIncomplete + { rdiLabel :: T.Text + , rdiSuffix :: Inlines + , rdCitation :: Citation + } +data RefDataComplete = RefDataComplete + { rdRec :: RefRec + , rdcSuffix :: Inlines + , rdCitPrefix :: Maybe Inlines + , rdUpperCase :: Bool + , rdSuppressPrefix :: Bool + } -getRefIndex :: T.Text -> Options -> Citation -> WS RefData -getRefIndex prefix _opts Citation{citationId=cid,citationSuffix=suf} - = do - ref <- M.lookup lab <$> get prop - let sub = refSubfigure <$> ref - idx = refIndex <$> ref - return RefData - { rdLabel = lab - , rdIdx = idx - , rdSubfig = join sub - , rdSuffix = suf - } - where - prop = lookupUnsafe prefix accMap - lab = prefix <> getLabelWithoutPrefix cid +type RefData = Either RefDataIncomplete RefDataComplete -data RefItem = RefRange RefData RefData | RefSingle RefData +rdIdx :: RefDataComplete -> Int +rdIdx RefDataComplete{rdRec} = refIndex rdRec -makeIndices :: Options -> [RefData] -> [Inline] -makeIndices o s = format $ concatMap f $ HT.groupBy g $ sort $ nub s +rdScope :: RefDataComplete -> Maybe RefRec +rdScope RefDataComplete{rdRec} = refScope rdRec + +rdPrefix :: RefDataComplete -> T.Text +rdPrefix RefDataComplete{rdRec} = refPfx rdRec + +rdLevel :: RefDataComplete -> Int +rdLevel RefDataComplete{rdRec} = refLevel rdRec + +instance Eq RefDataComplete where + (==) = (==) `on` rdRec + +instance Ord RefDataComplete where + (<=) = (<=) `on` rdRec + +getRefData :: Citation -> WS RefData +getRefData c@Citation{..} + = do + ref <- M.lookup llab <$> get referenceData + return $ case ref of + Nothing -> Left $ RefDataIncomplete + { rdiLabel = llab + , rdiSuffix = suf' + , rdCitation = c + } + Just x -> Right $ RefDataComplete + { rdRec = x + , rdcSuffix = suf' + , rdCitPrefix = if null citationPrefix + then Nothing + else Just $ fromList citationPrefix + , rdUpperCase = isFirstUpper citationId + , rdSuppressPrefix = SuppressAuthor == citationMode + } + where llab = uncapitalizeFirst citationId + suf' = fromList citationSuffix + +data RefItem = RefRange RefDataComplete RefDataComplete | RefSingle RefDataComplete + +makeIndices :: Options -> NonEmpty RefDataComplete -> Inlines +makeIndices o s = format $ concatMap f $ HT.groupBy g $ sort $ nub $ NE.toList s where - g :: RefData -> RefData -> Bool - g a b = all (null . rdSuffix) [a, b] && ( - all (isNothing . rdSubfig) [a, b] && - Just True == (liftM2 follows `on` rdIdx) b a || - rdIdx a == rdIdx b && - Just True == (liftM2 follows `on` rdSubfig) b a - ) - follows :: Index -> Index -> Bool - follows a b - | Just (ai, al) <- HT.viewR a - , Just (bi, bl) <- HT.viewR b - = ai == bi && A.first (+1) bl == al - follows _ _ = False - f :: [RefData] -> [RefItem] + g :: RefDataComplete -> RefDataComplete -> Bool + g a b = all (null . rdcSuffix) [a, b] + && (follows `on` rdIdx) b a + && ((==) `on` rdScope) a b + follows :: Int -> Int -> Bool + follows a b = b + 1 == a + f :: [RefDataComplete] -> [RefItem] f [] = [] -- drop empty lists f [w] = [RefSingle w] -- single value f [w1,w2] = [RefSingle w1, RefSingle w2] -- two values f (x:xs) = [RefRange x (last xs)] -- shorten more than two values - format :: [RefItem] -> [Inline] - format [] = [] - format [x] = toList $ show'' x - format [x, y] = toList $ show'' x <> fromList (pairDelim o) <> show'' y - format xs = toList $ intercalate' (fromList $ refDelim o) init' <> fromList (lastDelim o) <> last' - where initlast [] = error "emtpy list in initlast" - initlast [y] = ([], y) - initlast (y:ys) = first (y:) $ initlast ys - (init', last') = initlast $ map show'' xs + format :: [RefItem] -> Inlines + format [] = mempty + format [x] = show'' x + format [x, y] = show'' x <> pairDelim o <> show'' y + format (x:xs) = intercalate' (refDelim o) init' <> lastDelim o <> last' + where initlast (y :| []) = ([], y) + initlast (y :| (z:zs)) = first (y:) $ initlast (z:|zs) + (init', last') = initlast $ NE.map show'' (x:|xs) show'' :: RefItem -> Inlines show'' (RefSingle x) = show' x - show'' (RefRange x y) = show' x <> fromList (rangeDelim o) <> show' y - show' :: RefData -> Inlines - show' RefData{rdLabel=l, rdIdx=Just i, rdSubfig = sub, rdSuffix = suf} - | linkReferences o = link ('#' `T.cons` l) "" (fromList txt) - | otherwise = fromList txt - where - txt - | Just sub' <- sub - = let vars = M.fromDistinctAscList - [ ("i", chapPrefix (chapDelim o) i) - , ("s", chapPrefix (chapDelim o) sub') - , ("suf", suf) - ] - in applyTemplate' vars $ subfigureRefIndexTemplate o - | otherwise - = let vars = M.fromDistinctAscList - [ ("i", chapPrefix (chapDelim o) i) - , ("suf", suf) - ] - in applyTemplate' vars $ refIndexTemplate o - show' RefData{rdLabel=l, rdIdx=Nothing, rdSuffix = suf} = - trace (T.unpack $ "Undefined cross-reference: " <> l) - (strong (text $ "¿" <> l <> "?") <> fromList suf) + show'' (RefRange x y) = show' x <> rangeDelim o <> show' y + show' :: RefDataComplete -> Inlines + show' RefDataComplete{..} + | linkReferences o = link ('#' `T.cons` refLabel rdRec) "" txt + | otherwise = txt + where txt = applyIndexTemplate rdcSuffix rdRec + +applyIndexTemplate :: Inlines -> RefRec -> Inlines +applyIndexTemplate suf rr = + let varsSc rr' "ref" = Just $ inlines False rr' + varsSc rr' "Ref" = Just $ inlines True rr' + varsSc rr' "refi" = Just . MetaInlines . toList $ applyIndexTemplate mempty rr' + varsSc rr' x = defaultVarFunc varsSc rr' x + vars _ "suf" = Just $ MetaInlines $ toList suf + vars rr' x = defaultVarFunc varsSc rr' x + template = prefixReferenceIndexTemplate $ refPfxRec rr + inlines cap ref = MetaInlines $ toList $ + getRefPrefix cap 0 ref $ applyIndexTemplate mempty ref + in applyTemplate template (vars rr) diff --git a/lib-internal/Text/Pandoc/CrossRef/References/Subfigures.hs b/lib-internal/Text/Pandoc/CrossRef/References/Subfigures.hs new file mode 100644 index 00000000..3f1e0d31 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/References/Subfigures.hs @@ -0,0 +1,128 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2019 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE OverloadedStrings #-} +module Text.Pandoc.CrossRef.References.Subfigures where + +import Text.Pandoc.Definition +import Data.List +import Data.Maybe +import Data.Monoid +import qualified Data.Text as T +import qualified Data.Text.Read as T + +import Text.Pandoc.CrossRef.Util.Util +import Text.Pandoc.CrossRef.Util.Options +import Text.Pandoc.CrossRef.Util.Prefixes +import Prelude + +makeSubfigures :: Options -> Block -> Block +makeSubfigures opts (Div (label,cls,attrs) contents) + | Just pfx <- getRefPrefix opts label + , Right pfxRec <- getPfx opts pfx + , prefixSubcaptions pfxRec + = Div (label, "subcaption":cls, attrs) + $ if prefixSubcaptionsGrid pfxRec + then wrapSubcaptionEnv (toTable (init cont)) <> [last cont] + else cont + where cont = map figImageParas contents -- modified contents + figImageParas (Para cs) + | all isImageOrSpace cs + = Para $ mapMaybe mkFigure cs + figImageParas (Plain cs) + | all isImageOrSpace cs + = Para $ mapMaybe mkFigure cs + figImageParas x = x + isImageOrSpace Image{} = True + isImageOrSpace x = isSpace x + mkFigure (Image attr alt (src, tit)) + = Just $ Image attr alt (src, + if "fig:" `T.isPrefixOf` tit + then tit + else "fig:" <> tit + ) + mkFigure _ = Nothing + wrapSubcaptionEnv p + | isLatexFormat $ outFormat opts + = RawBlock (Format "latex") "\\begin{pandoccrossrefsubcaption}\n" : + (p <> [RawBlock (Format "latex") "\\end{pandoccrossrefsubcaption}\n"]) + | otherwise = p +makeSubfigures _ x = x + +toTable :: [Block] -> [Block] +toTable blks = [simpleTable align widths $ map blkToRow blks] + where + align | Para ils:_ <- blks = replicate (length $ mapMaybe getWidth ils) AlignCenter + | otherwise = error "Misformatted subfigures block" + widths | Para ils:_ <- blks + = fixZeros $ mapMaybe getWidth ils + | otherwise = error "Misformatted subfigures block" + getWidth (Image (_id, _class, as) _ _) + = Just $ maybe 0 percToDouble $ lookup "width" as + getWidth _ = Nothing + fixZeros :: [Double] -> [Double] + fixZeros ws + = let nz = length $ filter (== 0) ws + rzw = (0.99 - sum ws) / fromIntegral nz + in if nz>0 + then map (\x -> if x == 0 then rzw else x) ws + else ws + percToDouble :: T.Text -> Double + percToDouble percs + | Right (perc, "%") <- T.double percs + = perc/100.0 + | otherwise = error "Only percent allowed in subfigure width!" + blkToRow :: Block -> [[Block]] + blkToRow (Para inls) = mapMaybe inlToCell inls + blkToRow x = [[x]] + inlToCell :: Inline -> Maybe [Block] + inlToCell (Image (id', cs, as) txt tgt) = Just [Div nullAttr [Para [Image (id', cs, setW as) txt tgt]]] + inlToCell _ = Nothing + setW as = ("width", "100%"):filter ((/="width") . fst) as +-- +-- latexSubFigure :: Inline -> String -> [Inline] +-- latexSubFigure (Image (_, cls, attrs) alt (src, title)) label = +-- let +-- title' = fromMaybe title $ stripPrefix "fig:" title +-- texlabel | null label = [] +-- | otherwise = [RawInline (Format "latex") $ mkLaTeXLabel label] +-- texalt | "nocaption" `elem` cls = [] +-- | otherwise = concat +-- [ [ RawInline (Format "latex") "["] +-- , alt +-- , [ RawInline (Format "latex") "]"] +-- ] +-- img = Image (label, cls, attrs) alt (src, title') +-- in concat [ +-- [ RawInline (Format "latex") "\\subfloat" ] +-- , texalt +-- , [Span nullAttr $ img:texlabel] +-- ] +-- latexSubFigure x _ = [x] +-- +-- latexEnv :: String -> [Block] -> [Inline] -> String -> Block +-- latexEnv env contents caption label = +-- Div (label, [], []) $ +-- [ RawBlock (Format "latex") $ "\\begin{"<>env<>"}\n\\centering" ] +-- ++ contents ++ +-- [ Para [RawInline (Format "latex") "\\caption" +-- , Span nullAttr caption] +-- , RawBlock (Format "latex") $ mkLaTeXLabel label +-- , RawBlock (Format "latex") $ "\\end{"<>env<>"}"] diff --git a/lib-internal/Text/Pandoc/CrossRef/References/Types.hs b/lib-internal/Text/Pandoc/CrossRef/References/Types.hs index 2c7d97c1..e146f680 100644 --- a/lib-internal/Text/Pandoc/CrossRef/References/Types.hs +++ b/lib-internal/Text/Pandoc/CrossRef/References/Types.hs @@ -18,39 +18,9 @@ with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} -{-# LANGUAGE TemplateHaskell #-} -module Text.Pandoc.CrossRef.References.Types where +module Text.Pandoc.CrossRef.References.Types ( + module X +) where -import qualified Data.Map as M -import Text.Pandoc.Definition -import Control.Monad.State -import Data.Default -import Data.Accessor.Template -import Data.Text (Text) - -type Index = [(Int, Maybe Text)] - -data RefRec = RefRec { refIndex :: Index - , refTitle :: [Inline] - , refSubfigure :: Maybe Index - } deriving (Show, Eq) - -type RefMap = M.Map Text RefRec - --- state data type -data References = References { imgRefs_ :: RefMap - , eqnRefs_ :: RefMap - , tblRefs_ :: RefMap - , lstRefs_ :: RefMap - , secRefs_ :: RefMap - , curChap_ :: Index - } deriving (Show, Eq) - ---state monad -type WS a = State References a - -instance Default References where - def = References n n n n n [] - where n = M.empty - -deriveAccessors ''References +import Text.Pandoc.CrossRef.References.Types.Ref as X +import Text.Pandoc.CrossRef.References.Types.Monad as X diff --git a/lib-internal/Text/Pandoc/CrossRef/References/Types/Monad.hs b/lib-internal/Text/Pandoc/CrossRef/References/Types/Monad.hs new file mode 100644 index 00000000..50e47c24 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/References/Types/Monad.hs @@ -0,0 +1,70 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2019 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-} +module Text.Pandoc.CrossRef.References.Types.Monad ( + module Text.Pandoc.CrossRef.References.Types.Monad + , module X +) where + +import Text.Pandoc.CrossRef.References.Types.Ref +import Text.Pandoc.CrossRef.Util.Options.Types +import Text.Pandoc.CrossRef.Util.Settings.Types +import Control.Monad.State +import Control.Monad.Reader as X +import Control.Monad.Writer as X +import Control.Monad.Except as X +import qualified Control.Monad.Fail as Fail +import qualified Data.Text as T + +data WSException = WSENoSuchPrefix T.Text + | WSEDuplicateLabel T.Text + | WSEFail T.Text + deriving Show + +type PureErr a = Either WSException a + +-- | Enviromnent for 'CrossRefM' +data CrossRefEnv = CrossRefEnv { + creSettings :: Settings -- ^Metadata settings + , creOptions :: Options -- ^Internal pandoc-crossref options + } + +-- | Essentially a reader monad for basic pandoc-crossref environment +type CrossRefM = ExceptT WSException (WriterT [T.Text] (Reader CrossRefEnv)) + +newtype CrossRef a = CrossRef { unCrossRef :: CrossRefM a } + deriving ( Functor, Applicative, Monad + , MonadError WSException, MonadReader CrossRefEnv + , MonadWriter [T.Text] ) +--state monad +newtype WS a = WS { + unWS :: StateT References CrossRefM a + } deriving ( Functor, Applicative, Monad, MonadState References + , MonadError WSException, MonadReader CrossRefEnv + , MonadWriter [T.Text] ) + +instance Fail.MonadFail WS where + fail s = throwError $ WSEFail $ T.pack s + +pretty :: WSException -> T.Text +pretty (WSENoSuchPrefix s) = "No such prefix: " <> s +pretty (WSEDuplicateLabel s) = "Duplicate label: " <> s +pretty (WSEFail s) = "Generic failure: " <> s diff --git a/lib-internal/Text/Pandoc/CrossRef/References/Types/Ref.hs b/lib-internal/Text/Pandoc/CrossRef/References/Types/Ref.hs new file mode 100644 index 00000000..a0ce8b4c --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/References/Types/Ref.hs @@ -0,0 +1,73 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2015 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving #-} +module Text.Pandoc.CrossRef.References.Types.Ref where + +import qualified Data.Map as M +import Control.Monad +import Data.Default +import Data.Function +import Data.Accessor.Template +import Text.Pandoc.Builder +import Text.Pandoc.CrossRef.Util.Prefixes.Types +import qualified Data.Text as T + +data RefRec = RefRec { refIndex :: !Int -- global ordinal number for prefix + , refIxInl :: Inlines -- templated index as inilnes + , refIxInlRaw :: !Inlines -- raw index as inilnes + , refTitle :: !Inlines -- title text + , refScope :: !(Maybe RefRec) -- reference to parent scope label (as specified in scopes array) + , refLevel :: !Int -- number of upper scopes of the same prefix + , refLabel :: !T.Text -- label, i.e. pfx:label string + , refPfx :: !T.Text -- reference prefix, the part in label before : + , refPfxRec :: !Prefix -- reference prefix, the part in label before : + , refCaption :: Inlines -- caption after applying template; must be non-strict + , refAttrs :: !(T.Text -> Maybe MetaValue) -- attribute map + , refCaptionPosition :: !CaptionPosition + } + +instance Eq RefRec where + (==) = (==) `on` liftM2 (,) refPfx refIndex + +instance Ord RefRec where + (<=) = (<=) `on` liftM2 (,) refPfx refIndex + +type RefMap = M.Map T.Text RefRec + +-- state data type +data References = References { referenceData_ :: !RefMap + , pfxCounter_ :: !(M.Map T.Text CounterRec) + } + +data CounterRec = CounterRec { + crIndex :: Int + , crIndexInScope :: M.Map (Maybe RefRec) Int + } + +type Scope = [RefRec] + +instance Default References where + def = References M.empty M.empty + +instance Default CounterRec where + def = CounterRec 0 M.empty + +deriveAccessors ''References diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/CodeBlockCaptions.hs b/lib-internal/Text/Pandoc/CrossRef/Util/CodeBlockCaptions.hs index 342ecf77..edbd9400 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/CodeBlockCaptions.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/CodeBlockCaptions.hs @@ -26,33 +26,32 @@ module Text.Pandoc.CrossRef.Util.CodeBlockCaptions import Text.Pandoc.Definition import Data.List (stripPrefix) -import Data.Maybe (fromMaybe) -import Text.Pandoc.CrossRef.References.Types import Text.Pandoc.CrossRef.Util.Options -import Text.Pandoc.CrossRef.Util.Util import qualified Data.Text as T -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 :: Options -> [Block] -> [Block] +mkCodeBlockCaptions opts (cb@(CodeBlock _ _):p@(Para _):xs) + | Just res <- orderAgnostic opts $ p:cb:xs + = res +mkCodeBlockCaptions opts (p@(Para _):cb@(CodeBlock _ _):xs) + | Just res <- orderAgnostic opts $ p:cb:xs + = res +mkCodeBlockCaptions _ x = x orderAgnostic :: Options -> [Block] -> Maybe [Block] orderAgnostic opts (Para ils:CodeBlock (label,classes,attrs) code:xs) | codeBlockCaptions opts , Just caption <- getCodeBlockCaption ils , not $ T.null label - , "lst" `T.isPrefixOf` label - = return $ Div (label,["listing"], []) - [Para caption, CodeBlock ("",classes,attrs) code] : xs + , Just _ <- getRefPrefix opts label + = return $ Div (label, [], []) + [CodeBlock ("",classes,attrs) code, Para $ Str ":":Space:caption] : xs orderAgnostic opts (Para ils:CodeBlock (_,classes,attrs) code:xs) | codeBlockCaptions opts , Just (caption, labinl) <- splitLast <$> getCodeBlockCaption ils - , Just label <- getRefLabel "lst" labinl - = return $ Div (label,["listing"], []) - [Para $ init caption, CodeBlock ("",classes,attrs) code] : xs + , Just label <- getRefLabel opts labinl + = return $ Div (label, [], []) + [CodeBlock ("",classes,attrs) code, Para $ Str ":":Space:init caption] : xs where splitLast xs' = splitAt (length xs' - 1) xs' orderAgnostic _ _ = Nothing diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/CustomLabels.hs b/lib-internal/Text/Pandoc/CrossRef/Util/CustomLabels.hs index e7705dfa..bc2ba9dd 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/CustomLabels.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/CustomLabels.hs @@ -19,37 +19,24 @@ with this program; if not, write to the Free Software Foundation, Inc., -} {-# LANGUAGE OverloadedStrings #-} -module Text.Pandoc.CrossRef.Util.CustomLabels (customLabel, customHeadingLabel) where +module Text.Pandoc.CrossRef.Util.CustomLabels where import Text.Pandoc.Definition import Text.Pandoc.CrossRef.Util.Meta import Text.Numeral.Roman import qualified Data.Text as T -customLabel :: Meta -> T.Text -> Int -> Maybe T.Text -customLabel meta ref i - | refLabel <- T.takeWhile (/=':') ref - , Just cl <- lookupMeta (refLabel <> "Labels") meta - = mkLabel i (refLabel <> "Labels") cl - | otherwise = Nothing - -customHeadingLabel :: Meta -> Int -> Int -> Maybe T.Text -customHeadingLabel meta lvl i - | Just cl <- getMetaList Just "secLevelLabels" meta (lvl-1) - = mkLabel i "secLevelLabels" cl - | otherwise = Nothing - -mkLabel :: Int -> T.Text -> MetaValue -> Maybe T.Text -mkLabel i n lt +mkLabel :: T.Text -> MetaValue -> Int -> T.Text +mkLabel n lt i | MetaList _ <- lt , Just val <- toString n <$> getList (i-1) lt - = Just val + = val | toString n lt == "arabic" - = Nothing + = T.pack $ show i | toString n lt == "roman" - = Just $ toRoman i + = toRoman i + | Just (startWith,_) <- T.uncons =<< T.stripPrefix "alpha " (toString n lt) + = T.singleton . toEnum $ fromEnum startWith + i - 1 | toString n lt == "lowercase roman" - = Just $ T.toLower $ toRoman i - | Just (startWith, _) <- T.uncons =<< T.stripPrefix "alpha " (toString n lt) - = Just . T.singleton $ [startWith..] !! (i-1) + = T.toLower $ toRoman i | otherwise = error $ "Unknown numeration type: " ++ show lt diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Meta.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Meta.hs index 20ac5c13..9197d36b 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/Meta.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Meta.hs @@ -18,44 +18,67 @@ with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} -{-# LANGUAGE FlexibleContexts, Rank2Types #-} +{-# LANGUAGE FlexibleContexts, Rank2Types, UndecidableInstances + , FlexibleInstances, OverloadedStrings #-} module Text.Pandoc.CrossRef.Util.Meta ( getMetaList , getMetaBool + , getMetaBoolDefault , getMetaInlines , getMetaBlock , getMetaString + , getMetaStringMaybe + , getMetaStringList , getList + , getObj , toString , toInlines - , tryCapitalizeM + , capitalize ) where import Text.Pandoc.CrossRef.Util.Util +import Text.Pandoc.CrossRef.Util.Settings.Types import Text.Pandoc.Definition import Text.Pandoc.Builder import Data.Default import Text.Pandoc.Walk -import Text.Pandoc.Shared hiding (capitalize, toString) +import Text.Pandoc.Shared hiding (capitalize) +import Data.Maybe +import qualified Data.Map as M import qualified Data.Text as T -getMetaList :: (Default a) => (MetaValue -> a) -> T.Text -> Meta -> Int -> a -getMetaList f name meta i = maybe def f $ lookupMeta name meta >>= getList i +getMetaList :: (Default a) => (MetaValue -> a) -> T.Text -> Settings -> Int -> a +getMetaList f name (Settings meta) i = maybe def f $ lookupMeta name meta >>= getList i -getMetaBool :: T.Text -> Meta -> Bool +getMetaStringList :: T.Text -> Settings -> [T.Text] +getMetaStringList name (Settings meta) = maybe [] (getList' name) $ lookupMeta name meta + where + getList' n (MetaList l) = map (toString n) l + getList' n x = [toString n x] + +getMetaBool :: T.Text -> Settings -> Bool getMetaBool = getScalar toBool -getMetaInlines :: T.Text -> Meta -> [Inline] +getMetaBoolDefault :: T.Text -> Settings -> Bool -> Bool +getMetaBoolDefault = getScalarDefault toBool + +getMetaInlines :: T.Text -> Settings -> Inlines getMetaInlines = getScalar toInlines -getMetaBlock :: T.Text -> Meta -> [Block] +getMetaBlock :: T.Text -> Settings -> Blocks getMetaBlock = getScalar toBlocks -getMetaString :: T.Text -> Meta -> T.Text +getMetaString :: T.Text -> Settings -> T.Text getMetaString = getScalar toString -getScalar :: Def b => (T.Text -> MetaValue -> b) -> T.Text -> Meta -> b -getScalar conv name meta = maybe def' (conv name) $ lookupMeta name meta +getMetaStringMaybe :: T.Text -> Settings -> Maybe T.Text +getMetaStringMaybe = getScalar (const toMaybeString) + +getScalar :: Def b => (T.Text -> MetaValue -> b) -> T.Text -> Settings -> b +getScalar conv name (Settings meta) = maybe def' (conv name) $ lookupMeta name meta + +getScalarDefault :: (T.Text -> MetaValue -> b) -> T.Text -> Settings -> b -> b +getScalarDefault conv name (Settings meta) dv = maybe dv (conv name) $ lookupMeta name meta class Def a where def' :: a @@ -63,14 +86,17 @@ class Def a where instance Def Bool where def' = False -instance Def [a] where - def' = [] - instance Def T.Text where - def' = T.empty + def' = "" + +instance Def (Maybe a) where + def' = Nothing + +instance (Monoid (Many a)) => Def (Many a) where + def' = mempty -unexpectedError :: forall a. String -> T.Text -> MetaValue -> a -unexpectedError e n x = error $ "Expected " <> e <> " in metadata field " <> T.unpack n <> " but got " <> g x +unexpectedError :: forall a. T.Text -> T.Text -> MetaValue -> a +unexpectedError e n x = error . T.unpack $ "Expected " <> e <> " in metadata field " <> n <> " but got " <> g x where g (MetaBlocks _) = "blocks" g (MetaString _) = "string" @@ -79,27 +105,30 @@ unexpectedError e n x = error $ "Expected " <> e <> " in metadata field " <> T.u g (MetaMap _) = "map" g (MetaList _) = "list" -toInlines :: T.Text -> MetaValue -> [Inline] -toInlines _ (MetaBlocks s) = blocksToInlines s -toInlines _ (MetaInlines s) = s -toInlines _ (MetaString s) = toList $ text s +toInlines :: T.Text -> MetaValue -> Inlines +toInlines _ (MetaBlocks s) = fromList $ blocksToInlines s +toInlines _ (MetaInlines s) = fromList s +toInlines _ (MetaString s) = text s toInlines n x = unexpectedError "inlines" n x toBool :: T.Text -> MetaValue -> Bool toBool _ (MetaBool b) = b toBool n x = unexpectedError "bool" n x -toBlocks :: T.Text -> MetaValue -> [Block] -toBlocks _ (MetaBlocks bs) = bs -toBlocks _ (MetaInlines ils) = [Plain ils] -toBlocks _ (MetaString s) = toList $ plain $ text s +toBlocks :: T.Text -> MetaValue -> Blocks +toBlocks _ (MetaBlocks bs) = fromList bs +toBlocks _ (MetaInlines ils) = fromList [Plain ils] +toBlocks _ (MetaString s) = plain $ text s toBlocks n x = unexpectedError "blocks" n x toString :: T.Text -> MetaValue -> T.Text -toString _ (MetaString s) = s -toString _ (MetaBlocks b) = stringify b -toString _ (MetaInlines i) = stringify i -toString n x = unexpectedError "string" n x +toString n x = fromMaybe (unexpectedError "string" n x) $ toMaybeString x + +toMaybeString :: MetaValue -> Maybe T.Text +toMaybeString (MetaString s) = Just s +toMaybeString (MetaBlocks b) = Just $ stringify b +toMaybeString (MetaInlines i) = Just $ stringify i +toMaybeString _ = Nothing getList :: Int -> MetaValue -> Maybe MetaValue getList i (MetaList l) = l !!? i @@ -109,15 +138,22 @@ getList i (MetaList l) = l !!? i | otherwise = Nothing getList _ x = Just x -tryCapitalizeM :: (Functor m, Monad m, Walkable Inline a, Default a, Eq a) => - (T.Text -> m a) -> T.Text -> Bool -> m a -tryCapitalizeM f varname capitalize - | capitalize = do - res <- f (capitalizeFirst varname) - case res of - xs | xs == def -> f varname >>= walkM capStrFst - | otherwise -> return xs - | otherwise = f varname +getObj :: T.Text -> MetaValue -> Maybe MetaValue +getObj i (MetaMap m) = M.lookup i m +getObj _ _ = Nothing + +capitalize :: (T.Text -> Maybe MetaValue) -> T.Text -> Maybe MetaValue +capitalize f varname = case f (capitalizeFirst varname) of + Nothing -> case f varname of + Nothing -> Nothing + Just x -> Just $ cap x + Just xs -> Just xs where - capStrFst (Str s) = return $ Str $ capitalizeFirst s - capStrFst x = return x + cap (MetaString s) = MetaString $ capitalizeFirst s + cap (MetaInlines i) = MetaInlines $ walk capStrFst i + cap (MetaBlocks b) = MetaBlocks $ walk capStrFst b + cap (MetaMap m) = MetaMap $ M.map cap m + cap (MetaList l) = MetaList $ map cap l + cap x = x + capStrFst (Str s) = Str $ capitalizeFirst s + capStrFst x = x diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/ModifyMeta.hs b/lib-internal/Text/Pandoc/CrossRef/Util/ModifyMeta.hs index f87daf14..24ff8685 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/ModifyMeta.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/ModifyMeta.hs @@ -18,7 +18,8 @@ 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 RecordWildCards, OverloadedStrings #-} + module Text.Pandoc.CrossRef.Util.ModifyMeta ( modifyMeta @@ -27,108 +28,30 @@ module Text.Pandoc.CrossRef.Util.ModifyMeta import Text.Pandoc import Text.Pandoc.Builder hiding ((<>)) import Text.Pandoc.CrossRef.Util.Options -import Text.Pandoc.CrossRef.Util.Meta +import Text.Pandoc.CrossRef.References.Types +import Text.Pandoc.CrossRef.Util.Settings.Types import Text.Pandoc.CrossRef.Util.Util import qualified Data.Text as T -import Control.Monad.Writer -modifyMeta :: Options -> Meta -> Meta -modifyMeta opts meta - | isLatexFormat (outFormat opts) - = setMeta "header-includes" - (headerInc $ lookupMeta "header-includes" meta) - meta - | otherwise = meta - where +modifyMeta :: Meta -> CrossRef Meta +modifyMeta meta = do + Options{..} <- asks creOptions + Settings (Meta settingskv) <- asks creSettings + let headerInc :: Maybe MetaValue -> MetaValue headerInc Nothing = incList headerInc (Just (MetaList x)) = MetaList $ x <> [incList] headerInc (Just x) = MetaList [x, incList] incList = MetaBlocks $ return $ RawBlock (Format "latex") $ T.unlines $ execWriter $ do tell [ "\\makeatletter" ] - tell subfig - tell floatnames - tell listnames - tell subfigures - unless (listings opts) $ - tell codelisting - tell lolcommand - when (cref opts) $ do - tell cleveref - unless (listings opts) $ - tell cleverefCodelisting + tell [ "\\@ifpackageloaded{caption}{\\captionsetup{labelformat=empty}}{\\usepackage[labelformat=empty]{caption}}" ] + tell [ "\\newenvironment{pandoccrossrefsubcaption}{\\renewcommand{\\toprule}{}\\renewcommand{\\bottomrule}{}}{}" ] tell [ "\\makeatother" ] - where - subfig = [ - usepackage [] "subfig" - , usepackage [] "caption" - , "\\captionsetup[subfloat]{margin=0.5em}" - ] - floatnames = [ - "\\AtBeginDocument{%" - , "\\renewcommand*\\figurename{" <> metaString "figureTitle" <> "}" - , "\\renewcommand*\\tablename{" <> metaString "tableTitle" <> "}" - , "}" - ] - listnames = [ - "\\AtBeginDocument{%" - , "\\renewcommand*\\listfigurename{" <> metaString' "lofTitle" <> "}" - , "\\renewcommand*\\listtablename{" <> metaString' "lotTitle" <> "}" - , "}" - ] - subfigures = [ - "\\newcounter{pandoccrossref@subfigures@footnote@counter}" - , "\\newenvironment{pandoccrossrefsubfigures}{%" - , "\\setcounter{pandoccrossref@subfigures@footnote@counter}{0}" - , "\\begin{figure}\\centering%" - , "\\gdef\\global@pandoccrossref@subfigures@footnotes{}%" - , "\\DeclareRobustCommand{\\footnote}[1]{\\footnotemark%" - , "\\stepcounter{pandoccrossref@subfigures@footnote@counter}%" - , "\\ifx\\global@pandoccrossref@subfigures@footnotes\\empty%" - , "\\gdef\\global@pandoccrossref@subfigures@footnotes{{##1}}%" - , "\\else%" - , "\\g@addto@macro\\global@pandoccrossref@subfigures@footnotes{, {##1}}%" - , "\\fi}}%" - , "{\\end{figure}%" - , "\\addtocounter{footnote}{-\\value{pandoccrossref@subfigures@footnote@counter}}" - , "\\@for\\f:=\\global@pandoccrossref@subfigures@footnotes\\do{\\stepcounter{footnote}\\footnotetext{\\f}}%" - , "\\gdef\\global@pandoccrossref@subfigures@footnotes{}}" - ] - codelisting = [ - usepackage [] "float" - , "\\floatstyle{ruled}" - , "\\@ifundefined{c@chapter}{\\newfloat{codelisting}{h}{lop}}{\\newfloat{codelisting}{h}{lop}[chapter]}" - , "\\floatname{codelisting}{" <> metaString "listingTitle" <> "}" - ] - lolcommand - | listings opts = [ - "\\newcommand*\\listoflistings\\lstlistoflistings" - , "\\AtBeginDocument{%" - , "\\renewcommand*{\\lstlistlistingname}{" <> metaString' "lolTitle" <> "}" - , "}" - ] - | otherwise = ["\\newcommand*\\listoflistings{\\listof{codelisting}{" <> metaString' "lolTitle" <> "}}"] - cleveref = [ usepackage cleverefOpts "cleveref" ] - <> crefname "figure" figPrefix - <> crefname "table" tblPrefix - <> crefname "equation" eqnPrefix - <> crefname "listing" lstPrefix - <> crefname "section" secPrefix - cleverefCodelisting = [ - "\\crefname{codelisting}{\\cref@listing@name}{\\cref@listing@name@plural}" - , "\\Crefname{codelisting}{\\Cref@listing@name}{\\Cref@listing@name@plural}" - ] - cleverefOpts | nameInLink opts = [ "nameinlink" ] - | otherwise = [] - crefname n f = [ - "\\crefname{" <> n <> "}" <> prefix f False - , "\\Crefname{" <> n <> "}" <> prefix f True - ] - usepackage [] p = "\\@ifpackageloaded{" <> p <> "}{}{\\usepackage{" <> p <> "}}" - usepackage xs p = "\\@ifpackageloaded{" <> p <> "}{}{\\usepackage" <> o <> "{" <> p <> "}}" - where o = "[" <> T.intercalate "," xs <> "]" - toLatex = either (error . show) id . runPure . writeLaTeX def . Pandoc nullMeta . return . Plain - metaString s = toLatex $ getMetaInlines s meta - metaString' s = toLatex [Str $ getMetaString s meta] - prefix f uc = "{" <> toLatex (f opts uc 0) <> "}" <> - "{" <> toLatex (f opts uc 1) <> "}" + tweakedMeta + | Just _ <- lookupMeta "crossref" meta = setMeta "crossref" (MetaMap settingskv) meta + | otherwise = Meta settingskv + return $ if isLatexFormat outFormat + then setMeta "header-includes" + (headerInc $ lookupMeta "header-includes" meta) + tweakedMeta + else tweakedMeta diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Options.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Options.hs index 72566fc4..0eac9fc2 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/Options.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Options.hs @@ -18,54 +18,58 @@ with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} -module Text.Pandoc.CrossRef.Util.Options (Options(..)) where +{-# LANGUAGE OverloadedStrings #-} +module Text.Pandoc.CrossRef.Util.Options ( + module Text.Pandoc.CrossRef.Util.Options + , module Text.Pandoc.CrossRef.Util.Options.Types +) where + import Text.Pandoc.Definition +import Text.Pandoc.CrossRef.Util.Options.Types +import Text.Pandoc.CrossRef.References.Types.Monad import Text.Pandoc.CrossRef.Util.Template -import Data.Text (Text) +import Text.Pandoc.CrossRef.Util.Prefixes +import qualified Data.Map as M +import Text.Pandoc.Builder +import qualified Data.Text as T + +prefixList :: Options -> [T.Text] +prefixList = M.keys . prefixes + +pfxCaptionTemplate :: Options -> T.Text -> PureErr Template +pfxCaptionTemplate opts pfx = prefixCaptionTemplate <$> getPfx opts pfx + +pfxListItemTemplate :: Options -> T.Text -> PureErr Template +pfxListItemTemplate opts pfx = prefixListItemTemplate <$> getPfx opts pfx + +pfxCaptionIndexTemplate :: Options -> T.Text -> PureErr Template +pfxCaptionIndexTemplate opts pfx = prefixCaptionIndexTemplate <$> getPfx opts pfx + +getPfx :: Options -> T.Text -> PureErr Prefix +getPfx o pn = maybe defaultPfx return $ M.lookup pn $ prefixes o + where + defaultPfx = Left $ WSENoSuchPrefix pn + +getRefPrefix :: Options -> T.Text -> Maybe T.Text +getRefPrefix opts label + | (pfx, rest) <- T.span (/=':') label + , not $ T.null rest + = if pfx `elem` prefixList opts + then Just pfx + else Nothing + | otherwise = Nothing + +getRefLabel :: Options -> [Inline] -> Maybe T.Text +getRefLabel _ [] = Nothing +getRefLabel opts ils + | Str attr <- last ils + , all (==Space) (init ils) + , Just lbl <- T.stripPrefix "{#" attr >>= T.stripSuffix "}" + , Just _ <- getRefPrefix opts lbl + = Just lbl +getRefLabel _ _ = Nothing -data Options = Options { cref :: Bool - , chaptersDepth :: Int - , listings :: Bool - , codeBlockCaptions :: Bool - , autoSectionLabels :: Bool - , numberSections :: Bool - , sectionsDepth :: Int - , figPrefix :: Bool -> Int -> [Inline] - , eqnPrefix :: Bool -> Int -> [Inline] - , tblPrefix :: Bool -> Int -> [Inline] - , lstPrefix :: Bool -> Int -> [Inline] - , secPrefix :: Bool -> Int -> [Inline] - , figPrefixTemplate :: Template - , eqnPrefixTemplate :: Template - , tblPrefixTemplate :: Template - , lstPrefixTemplate :: Template - , secPrefixTemplate :: Template - , refIndexTemplate :: Template - , subfigureRefIndexTemplate :: Template - , secHeaderTemplate :: Template - , chapDelim :: [Inline] - , rangeDelim :: [Inline] - , pairDelim :: [Inline] - , lastDelim :: [Inline] - , refDelim :: [Inline] - , lofTitle :: [Block] - , lotTitle :: [Block] - , lolTitle :: [Block] - , outFormat :: Maybe Format - , figureTemplate :: Template - , subfigureTemplate :: Template - , subfigureChildTemplate :: Template - , ccsTemplate :: Template - , tableTemplate :: Template - , listingTemplate :: Template - , customLabel :: Text -> Int -> Maybe Text - , customHeadingLabel :: Int -> Int -> Maybe Text - , ccsDelim :: [Inline] - , ccsLabelSep :: [Inline] - , tableEqns :: Bool - , autoEqnLabels :: Bool - , subfigGrid :: Bool - , linkReferences :: Bool - , nameInLink :: Bool - , setLabelAttribute :: Bool - } +getTitleForListOf :: Options -> T.Text -> PureErr Blocks +getTitleForListOf opts pfxn = do + pfx <- getPfx opts pfxn + return $ applyBlockTemplate (prefixListOfTitle pfx) (prefixDef pfx) diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Options/Types.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Options/Types.hs new file mode 100644 index 00000000..1421f454 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Options/Types.hs @@ -0,0 +1,41 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2015 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +module Text.Pandoc.CrossRef.Util.Options.Types where +import Text.Pandoc.Definition +import Text.Pandoc.CrossRef.Util.Prefixes +import Text.Pandoc.Builder +import qualified Data.Text as T + +data Options = Options { codeBlockCaptions :: Bool + , autoSectionLabels :: Maybe T.Text + , autoEqnLabels :: Maybe T.Text + , autoFigLabels :: Maybe T.Text + , adjustSectionIdentifiers :: Bool + , rangeDelim :: Inlines + , pairDelim :: Inlines + , lastDelim :: Inlines + , refDelim :: Inlines + , outFormat :: Maybe Format + , linkReferences :: Bool + , nameInLink :: Bool + , prefixes :: Prefixes + , setLabelAttribute :: Bool + } diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Prefixes.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Prefixes.hs new file mode 100644 index 00000000..4f838274 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Prefixes.hs @@ -0,0 +1,86 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2017 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE OverloadedStrings #-} +module Text.Pandoc.CrossRef.Util.Prefixes ( + getPrefixes + , module Types +) where + +import Text.Pandoc.Definition +import Text.Pandoc.CrossRef.Util.Template +import Text.Pandoc.CrossRef.Util.Prefixes.Types as Types +import Text.Pandoc.CrossRef.Util.Settings.Types +import Text.Pandoc.CrossRef.Util.Meta +import Text.Pandoc.CrossRef.Util.CustomLabels +import qualified Data.Map as M +import Data.Maybe +import qualified Data.Text as T + +getPrefixes :: Maybe Format -> T.Text -> Settings -> Prefixes +getPrefixes fmt varN dtv + | Just (MetaMap m) <- lookupSettings varN dtv = + let + m2p :: T.Text -> MetaValue -> Prefix + m2p k (MetaMap kv') = Prefix { + prefixCaptionTemplate = makeTemplate $ getTemplInline "captionTemplate" + , prefixReferenceTemplate = makeTemplate $ getTemplInline "referenceTemplate" + , prefixReferenceIndexTemplate = makeTemplate $ getTemplInline "referenceIndexTemplate" + , prefixCaptionIndexTemplate = makeTemplate $ getTemplInline "captionIndexTemplate" + , prefixListItemTemplate = makeTemplate $ getTemplInline "listItemTemplate" + , prefixCollectedCaptionTemplate = makeTemplate $ getTemplInline "collectedCaptionTemplate" + , prefixListOfTitle = makeTemplate $ getTemplBlock "listOfTitle" + , prefixCollectedCaptionDelim = getMetaInlines "collectedCaptionDelim" kv + , prefixScope = getMetaStringList "scope" kv + , prefixNumbering = + let prettyVarName = varN <> "." <> k <> "." <> varName + varName = "numbering" + in mkLabel prettyVarName + (fromMaybe (reportError prettyVarName "Numbering") + $ lookupSettings varName kv) + , prefixSubcaptions = getMetaBool "subcaptions" kv + , prefixSubcaptionsGrid = getMetaBoolDefault "subcaptionsGrid" kv True + , prefixCaptionPosition = case getMetaString "captionPosition" kv of + "above" -> Above + _ -> Below + , prefixSub = m2p k . (`merge` MetaMap kv') <$> lookupSettings "sub" (Settings (Meta kv') <> from) + , prefixDef = (`lookupSettings` kv) + } + where kv = Settings (Meta kv') + <> from + <> dtv + <> Settings (Meta fmtm) + fmtm | Just (Format fmt') <- fmt = M.singleton "crossrefOutputFormat" $ MetaString fmt' + | otherwise = M.empty + from | Just fromRef <- M.lookup "from" kv' + , Just (MetaMap kv'') <- M.lookup (toString "from" fromRef) m + = Settings (Meta kv'') + | otherwise = mempty + getTemplInline = getTemplDefault getMetaInlines + getTemplBlock = getTemplDefault getMetaBlock + getTemplDefault f n = + if isJust $ lookupSettings n kv + then f n kv + else reportError n "Template" + reportError n what = error . T.unpack $ what <> " meta variable " <> n <> " not set for " + <> varN <> "." <> k <> ". This should not happen. Please report a bug" + m2p k _ = error . T.unpack $ "Invalid value for prefix " <> k + in M.mapWithKey m2p m + | otherwise = error "Prefixes not defined" diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Prefixes/Types.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Prefixes/Types.hs new file mode 100644 index 00000000..b69a98cf --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Prefixes/Types.hs @@ -0,0 +1,50 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2019 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE Rank2Types, TypeFamilies #-} + +module Text.Pandoc.CrossRef.Util.Prefixes.Types where + +import qualified Data.Map as M +import qualified Data.Text as T +import Text.Pandoc.CrossRef.Util.Template.Types +import Text.Pandoc.Builder + +type Prefixes = M.Map T.Text Prefix + +data CaptionPosition = Above | Below + +data Prefix = Prefix { + prefixCaptionTemplate :: !Template + , prefixReferenceIndexTemplate :: !Template + , prefixCaptionIndexTemplate :: !Template + , prefixListItemTemplate :: !Template + , prefixCollectedCaptionTemplate :: !Template + , prefixReferenceTemplate :: !RefTemplate + , prefixListOfTitle :: !BlockTemplate + , prefixCollectedCaptionDelim :: !Inlines + , prefixScope :: ![T.Text] + , prefixNumbering :: !(Int -> T.Text) + , prefixSubcaptions :: !Bool + , prefixSubcaptionsGrid :: !Bool + , prefixCaptionPosition :: !CaptionPosition + , prefixSub :: !(Maybe Prefix) + , prefixDef :: !(T.Text -> Maybe MetaValue) +} diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Replace.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Replace.hs new file mode 100644 index 00000000..4873cae1 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Replace.hs @@ -0,0 +1,70 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2015 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE FlexibleContexts, Rank2Types #-} +module Text.Pandoc.CrossRef.Util.Replace ( + module Text.Pandoc.CrossRef.Util.Replace + , module Data.Generics +) where + +import Text.Pandoc.CrossRef.References.Types +import Data.Generics hiding (Prefix) + +data ReplacedResult a = ReplacedRecurse Scope a + | NotReplacedRecurse Scope + | ReplacedNoRecurse a + | NotReplacedNoRecurse +type GenRR m = forall a. Data a => (Scope -> a -> m (ReplacedResult a)) +newtype RR m a = RR {unRR :: Scope -> a -> m (ReplacedResult a)} + +runReplace :: (MonadError WSException m, Monad m) => Scope -> GenRR m -> GenericM m +runReplace s f x = do + res <- f s x `catchError` handler + case res of + ReplacedRecurse s' x' -> gmapM (runReplace s' f) x' + ReplacedNoRecurse x' -> return x' + NotReplacedRecurse s' -> gmapM (runReplace s' f) x + NotReplacedNoRecurse -> return x + where + handler (WSENoSuchPrefix _) = return $ NotReplacedRecurse s + handler e = throwError e + +mkRR :: (Monad m, Typeable a, Typeable b) + => (Scope -> b -> m (ReplacedResult b)) + -> (Scope -> a -> m (ReplacedResult a)) +mkRR = extRR (\s _ -> noReplaceRecurse s) + +extRR :: ( Monad m, Typeable a, Typeable b) + => (Scope -> a -> m (ReplacedResult a)) + -> (Scope -> b -> m (ReplacedResult b)) + -> (Scope -> a -> m (ReplacedResult a)) +extRR def' ext = unRR (RR def' `ext0` RR ext) + +replaceRecurse :: Monad m => Scope -> a -> m (ReplacedResult a) +replaceRecurse s = return . ReplacedRecurse s + +replaceNoRecurse :: Monad m => a -> m (ReplacedResult a) +replaceNoRecurse = return . ReplacedNoRecurse + +noReplaceRecurse :: Monad m => Scope -> m (ReplacedResult a) +noReplaceRecurse = return . NotReplacedRecurse + +noReplaceNoRecurse :: Monad m => m (ReplacedResult a) +noReplaceNoRecurse = return NotReplacedNoRecurse diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Settings.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Settings.hs index 253aa6bb..8ef87462 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/Settings.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Settings.hs @@ -19,96 +19,50 @@ with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} -{-# LANGUAGE OverloadedStrings #-} -module Text.Pandoc.CrossRef.Util.Settings (getSettings, defaultMeta) where +{-# LANGUAGE OverloadedStrings, TemplateHaskell, BangPatterns #-} +module Text.Pandoc.CrossRef.Util.Settings (readSettings, defaultMeta, Settings(..)) where import Text.Pandoc -import Text.Pandoc.Builder import Control.Exception (handle,IOException) -import Text.Pandoc.CrossRef.Util.Settings.Gen +import Text.Pandoc.CrossRef.Util.Settings.Embed +import Text.Pandoc.CrossRef.Util.Settings.Util +import Text.Pandoc.CrossRef.Util.Settings.Types import Text.Pandoc.CrossRef.Util.Meta import System.Directory import System.FilePath -import System.IO import qualified Data.Text as T +import qualified Data.Map as M -getSettings :: Maybe Format -> Meta -> IO Meta -getSettings fmt meta = do - dirConfig <- readConfig (T.unpack $ getMetaString "crossrefYaml" (defaultMeta <> meta)) +readSettings :: Maybe Format -> Meta -> IO Settings +readSettings fmt inMeta = do + let meta = + case inMeta of + Meta m | Just (MetaMap cm) <- M.lookup "crossref" m + -> Settings (Meta cm) + _ -> Settings inMeta + dirConfig <- readConfig' . T.unpack $ getMetaString "crossrefYaml" (meta <> defaultMeta meta) home <- getHomeDirectory - globalConfig <- readConfig (home ".pandoc-crossref" "config.yaml") - formatConfig <- maybe (return nullMeta) (readFmtConfig home) fmt - return $ defaultMeta <> globalConfig <> formatConfig <> dirConfig <> meta + globalConfig <- readConfig' (home ".pandoc-crossref" "config.yaml") + formatConfig <- maybe (return mempty) (readFmtConfig home) fmt + return $ globalConfig <> formatConfig <> dirConfig <> meta where - readConfig path = - handle handler $ do - h <- openFile path ReadMode - hSetEncoding h utf8 - yaml <- hGetContents h - Pandoc meta' _ <- readMd $ T.pack $ unlines ["---", yaml, "---"] - return meta' - readMd = handleError . runPure . readMarkdown def{readerExtensions=pandocExtensions} - readFmtConfig home fmt' = readConfig (home ".pandoc-crossref" "config-" ++ fmtStr fmt' ++ ".yaml") - handler :: IOException -> IO Meta - handler _ = return nullMeta - fmtStr (Format fmtstr) = T.unpack fmtstr + readConfig' = handle handler . readConfig + readFmtConfig home fmt' = readConfig' (home ".pandoc-crossref" "config-" ++ T.unpack (fmtStr fmt') ++ ".yaml") + handler :: IOException -> IO Settings + handler _ = return mempty + fmtStr (Format fmtstr) = fmtstr - -defaultMeta :: Meta -defaultMeta = - cref False - <> chapters False - <> chaptersDepth (MetaString "1") - <> listings False - <> codeBlockCaptions False - <> autoSectionLabels False - <> numberSections False - <> sectionsDepth (MetaString "0") - <> figLabels (MetaString "arabic") - <> eqLabels (MetaString "arabic") - <> tblLabels (MetaString "arabic") - <> lstLabels (MetaString "arabic") - <> secLabels (MetaString "arabic") - <> figureTitle (str "Figure") - <> tableTitle (str "Table") - <> listingTitle (str "Listing") - <> titleDelim (str ":") - <> chapDelim (str ".") - <> rangeDelim (str "-") - <> pairDelim (str "," <> space) - <> lastDelim (str "," <> space) - <> refDelim (str "," <> space) - <> figPrefix [str "fig.", str "figs."] - <> eqnPrefix [str "eq." , str "eqns."] - <> tblPrefix [str "tbl.", str "tbls."] - <> lstPrefix [str "lst.", str "lsts."] - <> secPrefix [str "sec.", str "secs."] - <> figPrefixTemplate (var "p" <> str "\160" <> var "i") - <> eqnPrefixTemplate (var "p" <> str "\160" <> var "i") - <> tblPrefixTemplate (var "p" <> str "\160" <> var "i") - <> lstPrefixTemplate (var "p" <> str "\160" <> var "i") - <> secPrefixTemplate (var "p" <> str "\160" <> var "i") - <> refIndexTemplate (var "i" <> var "suf") - <> subfigureRefIndexTemplate (var "i" <> var "suf" <> space <> str "(" <> var "s" <> str ")") - <> secHeaderTemplate (var "i" <> var "secHeaderDelim[n]" <> var "t") - <> secHeaderDelim space - <> lofTitle (header 1 $ text "List of Figures") - <> lotTitle (header 1 $ text "List of Tables") - <> lolTitle (header 1 $ text "List of Listings") - <> figureTemplate (var "figureTitle" <> space <> var "i" <> var "titleDelim" <> space <> var "t") - <> tableTemplate (var "tableTitle" <> space <> var "i" <> var "titleDelim" <> space <> var "t") - <> listingTemplate (var "listingTitle" <> space <> var "i" <> var "titleDelim" <> space <> var "t") - <> crossrefYaml (MetaString "pandoc-crossref.yaml") - <> subfigureChildTemplate (var "i") - <> subfigureTemplate (var "figureTitle" <> space <> var "i" <> var "titleDelim" <> space <> var "t" <> str "." <> space <> var "ccs") - <> subfigLabels (MetaString "alpha a") - <> ccsDelim (str "," <> space) - <> ccsLabelSep (space <> str "—" <> space) - <> ccsTemplate (var "i" <> var "ccsLabelSep" <> var "t") - <> tableEqns False - <> autoEqnLabels False - <> subfigGrid False - <> linkReferences False - <> nameInLink False - where var = displayMath +defaultMeta :: Settings -> Settings +defaultMeta userSettings + | null option = basicMeta + | option == ["none"] = mempty + | otherwise = mconcat . reverse $ basicMeta : map name2set option + where + option = getMetaStringList "defaultOption" userSettings + name2set "chapters" = $(embedFile "chapters") + name2set "subfigures" = $(embedFile "subfigures") + name2set "numberSections" = $(embedFile "numberSections") + name2set "titleSections" = $(embedFile "titleSections") + name2set x = error . T.unpack $ "Unknown defaultOption value: " <> x + basicMeta = $(embedFile "default") diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Embed.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Embed.hs new file mode 100644 index 00000000..5c9f4eea --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Embed.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell, DeriveLift, StandaloneDeriving #-} +module Text.Pandoc.CrossRef.Util.Settings.Embed where + +import Text.Pandoc.CrossRef.Util.Settings.Util +import Text.Pandoc.CrossRef.Util.Settings.LiftPandoc() +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import System.FilePath + +embedFile :: FilePath -> Q Exp +embedFile name = + qAddDependentFile fp >> + runIO (readConfig fp) >>= \v -> [|v|] + where fp = "settings" (name <> ".yaml") diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Gen.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Gen.hs index d278efb6..6f3535be 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Gen.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Gen.hs @@ -23,7 +23,7 @@ with this program; if not, write to the Free Software Foundation, Inc., module Text.Pandoc.CrossRef.Util.Settings.Gen where import Text.Pandoc.CrossRef.Util.Settings.Template -import Text.Pandoc.CrossRef.Util.Meta +import Text.Pandoc.CrossRef.Util.Settings.Types import Text.Pandoc.CrossRef.Util.Options as O (Options(..)) import Language.Haskell.TH (mkName) import Text.Pandoc.Definition @@ -31,24 +31,20 @@ import Text.Pandoc.Definition nameDeriveSetters ''Options concat <$> mapM (makeAcc . mkName) - [ "figureTitle" - , "tableTitle" - , "listingTitle" + [ "crossrefYaml" , "titleDelim" - , "crossrefYaml" - , "subfigLabels" - , "chapters" - , "figLabels" - , "eqLabels" - , "tblLabels" - , "lstLabels" - , "secLabels" - , "secHeaderDelim" + , "listItemNumberDelim" + , "captionTemplate" + , "referenceTemplate" + , "referenceIndexTemplate" + , "captionIndexTemplate" + , "listItemTemplate" + , "numbering" + , "listOfTitle" + , "collectedCaptionDelim" + , "collectedCaptionItemDelim" + , "collectedCaptionTemplate" ] -getOptions :: Meta -> Maybe Format -> Options -getOptions dtv fmt = - let opts = $(makeCon ''Options 'Options) - in if getMetaBool "chapters" dtv - then opts - else opts{O.chaptersDepth = 0} +getOptions :: Settings -> Maybe Format -> Options +getOptions dtv fmt = $(makeCon ''Options 'Options) diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/LiftPandoc.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/LiftPandoc.hs new file mode 100644 index 00000000..197a5a53 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/LiftPandoc.hs @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE TemplateHaskell, DeriveLift, StandaloneDeriving #-} +module Text.Pandoc.CrossRef.Util.Settings.LiftPandoc where + +import Text.Pandoc.CrossRef.Util.Settings.Types +import Language.Haskell.TH.Syntax (Lift(..)) +import Text.Pandoc +import Data.Map.Internal (Map(..)) + +deriving instance Lift Format +deriving instance Lift ColSpan +deriving instance Lift RowSpan +deriving instance Lift Alignment +deriving instance Lift Cell +deriving instance Lift Row +deriving instance Lift TableFoot +deriving instance Lift ListNumberDelim +deriving instance Lift ListNumberStyle +deriving instance Lift RowHeadColumns +deriving instance Lift TableBody +deriving instance Lift TableHead +deriving instance Lift ColWidth +deriving instance Lift Caption +deriving instance Lift Block +deriving instance Lift Citation +deriving instance Lift CitationMode +deriving instance Lift QuoteType +deriving instance Lift MathType +deriving instance Lift Inline +deriving instance Lift MetaValue +deriving instance (Lift k, Lift v) => Lift (Map k v) +deriving instance Lift Meta +deriving instance Lift Settings diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Template.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Template.hs index c675886a..c25cc8bc 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Template.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Template.hs @@ -25,13 +25,11 @@ import Text.Pandoc.Definition import Text.Pandoc.Builder import Text.Pandoc.CrossRef.Util.Meta import qualified Data.Map as M +import qualified Data.Text as T import Language.Haskell.TH hiding (Inline) import Language.Haskell.TH.Syntax hiding (Inline) import Data.List -import Text.Pandoc.CrossRef.Util.Template -import Text.Pandoc.CrossRef.Util.CustomLabels -import Data.Text (Text) -import qualified Data.Text as T +import Text.Pandoc.CrossRef.Util.Prefixes namedFields :: Con -> [VarStrictType] namedFields (RecC _ fs) = fs @@ -72,27 +70,26 @@ makeCon t cname = fromRecDef t cname makeCon' RecConE makeCon' :: Name -> Name -> Q [(Name, Exp)] makeCon' t accName = do VarI _ t' _ <- reify accName - funT <- [t|$(conT t) -> Bool -> Int -> [Inline]|] - inlT <- [t|$(conT t) -> [Inline]|] - blkT <- [t|$(conT t) -> [Block]|] + inlT <- [t|$(conT t) -> Inlines|] + blkT <- [t|$(conT t) -> Blocks|] fmtT <- [t|$(conT t) -> Maybe Format|] boolT <- [t|$(conT t) -> Bool|] intT <- [t|$(conT t) -> Int|] - tmplT <- [t|$(conT t) -> Template|] - clT <- [t|$(conT t) -> Text -> Int -> Maybe Text|] - chlT <- [t|$(conT t) -> Int -> Int -> Maybe Text|] + pfxT <- [t|$(conT t) -> Prefixes|] + strT <- [t|$(conT t) -> String|] + mstT <- [t|$(conT t) -> Maybe T.Text|] let varName | Name (OccName n) _ <- accName = liftString n - let dtv = return $ VarE $ mkName "dtv" + dtv = return $ VarE $ mkName "dtv" + fmt = return $ VarE $ mkName "fmt" body <- if | t' == boolT -> [|getMetaBool $(varName) $(dtv)|] - | t' == intT -> [|read $ T.unpack $ getMetaString $(varName) $(dtv)|] - | t' == funT -> [|tryCapitalizeM (flip (getMetaList (toInlines $(varName))) $(dtv)) $(varName)|] + | t' == intT -> [|read . T.unpack $ getMetaString $(varName) $(dtv)|] | t' == inlT -> [|getMetaInlines $(varName) $(dtv)|] | t' == blkT -> [|getMetaBlock $(varName) $(dtv)|] - | t' == tmplT -> [|makeTemplate $(dtv) $ getMetaInlines $(varName) $(dtv)|] - | t' == clT -> [|customLabel $(dtv)|] - | t' == chlT -> [|customHeadingLabel $(dtv)|] - | t' == fmtT -> return $ VarE $ mkName "fmt" + | t' == fmtT -> fmt + | t' == pfxT -> [|getPrefixes $(fmt) $(varName) $(dtv)|] + | t' == strT -> [|getMetaString $(varName) $(dtv)|] + | t' == mstT -> [|getMetaStringMaybe $(varName) $(dtv)|] | otherwise -> fail $ show t' return [(accName, body)] diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Types.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Types.hs new file mode 100644 index 00000000..15e1147d --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Types.hs @@ -0,0 +1,42 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2015 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +module Text.Pandoc.CrossRef.Util.Settings.Types where + +import Text.Pandoc.Definition +import qualified Data.Map as M +import qualified Data.Text as T + +newtype Settings = Settings { unSettings :: Meta } deriving (Eq, Ord, Show) +newtype MetaSetting = MetaSetting MetaValue deriving (Eq, Ord, Show) + +lookupSettings :: T.Text -> Settings -> Maybe MetaValue +lookupSettings k (Settings s) = lookupMeta k s + +instance Semigroup Settings where + (Settings (Meta a)) <> (Settings (Meta b)) = Settings $ Meta $ M.unionWith merge a b + +instance Monoid Settings where + mappend = (<>) + mempty = Settings nullMeta + +merge :: MetaValue -> MetaValue -> MetaValue +merge (MetaMap m1) (MetaMap m2) = MetaMap $ M.unionWith merge m1 m2 +merge x _ = x diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Util.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Util.hs new file mode 100644 index 00000000..0ac912b9 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Settings/Util.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} +module Text.Pandoc.CrossRef.Util.Settings.Util where + +import Text.Pandoc.CrossRef.Util.Settings.Types +import System.IO +import qualified Data.Text as T +import Text.Pandoc +import Text.Pandoc.Walk + +readMd :: T.Text -> IO Pandoc +readMd = handleError . runPure . readMarkdown def{ + readerExtensions=disableExtension Ext_auto_identifiers pandocExtensions + } + +readConfig :: FilePath -> IO Settings +readConfig path = do + h <- openFile path ReadMode + hSetEncoding h utf8 + yaml <- hGetContents h + Pandoc meta' _ <- readMd $ T.pack $ unlines ["---", yaml, "---"] + return . normalizeSpaces $ Settings meta' + +normalizeSpaces :: Settings -> Settings +normalizeSpaces (Settings s) = Settings $ walk walkInlines s + where + walkInlines :: Inline -> Inline + walkInlines (Span ("",["s"],[]) []) = Space + walkInlines x = x diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Template.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Template.hs index 513e84ae..e7ef4f29 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/Template.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Template.hs @@ -18,52 +18,114 @@ with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} -{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE RecordWildCards, TypeFamilies, OverloadedStrings #-} + module Text.Pandoc.CrossRef.Util.Template ( Template - , makeTemplate + , RefTemplate + , BlockTemplate + , MakeTemplate(..) , applyTemplate - , applyTemplate' + , applyRefTemplate + , applyBlockTemplate ) where import Text.Pandoc.Definition import Text.Pandoc.Builder import Text.Pandoc.Generic -import qualified Data.Map as M hiding (toList, fromList, singleton) import Text.Pandoc.CrossRef.Util.Meta -import Control.Applicative -import Text.Read +import Text.Pandoc.CrossRef.Util.Template.Types +import Control.Applicative hiding (many, optional) +import Data.Char (isAlphaNum, isUpper, toLower, isDigit) +import Control.Monad ((<=<)) +import Data.Data (Data) +import Text.ParserCombinators.ReadP import qualified Data.Text as T +import qualified Data.Text.Read as T + +data PRVar = PRVar { prvName :: T.Text + , prvIdx :: [IdxT] + } deriving Show +data IdxT = IdxVar [PRVar] | IdxStr T.Text | IdxNum T.Text deriving Show +data Sfx = SfxVar [PRVar] | SfxLit T.Text deriving Show +data ParseRes = ParseRes { prVar :: [PRVar] + , prPfx :: [Sfx] + , prSfx :: [Sfx] + } deriving Show -type VarFunc = T.Text -> Maybe MetaValue -newtype Template = Template (VarFunc -> [Inline]) +isVariableSym :: Char -> Bool +isVariableSym '.' = True +isVariableSym '_' = True +isVariableSym c = isAlphaNum c -makeTemplate :: Meta -> [Inline] -> Template -makeTemplate dtv xs' = Template $ \vf -> scan (\var -> vf var <|> lookupMeta var dtv) xs' +parse :: ReadP ParseRes +parse = uncurry <$> (ParseRes <$> var) <*> option ([], []) ps <* eof where - scan = bottomUp . go - go vf (x@(Math DisplayMath var):xs) - | (vn, idxBr) <- T.span (/='[') var - , not (T.null idxBr) - , T.last idxBr == ']' - = let idxVar = T.drop 1 $ T.takeWhile (/=']') idxBr - idx = readMaybe . T.unpack . toString ("index variable " <> idxVar) =<< vf idxVar - arr = do - i <- idx - v <- lookupMeta vn dtv - getList i v - in toList $ fromList (replaceVar var arr [x]) <> fromList xs - | otherwise = toList $ fromList (replaceVar var (vf var) [x]) <> fromList xs - go _ (x:xs) = toList $ singleton x <> fromList xs - go _ [] = [] - replaceVar var val def' = maybe def' (toInlines ("variable " <> var)) val + var = sepBy1 (PRVar <$> varName <*> many varIdx) (char '?') + varName = T.pack <$> munch1 isVariableSym + varIdx = between (char '[') (char ']') (IdxVar <$> var <|> IdxStr <$> litStr <|> IdxNum <$> litNum) + litStr = T.pack <$> between (char '"') (char '"') (many (satisfy (/='"'))) + litNum = T.pack <$> many (satisfy isDigit) + prefix = char '#' *> many (sfx '%') + suffix = char '%' *> many (sfx '#') + sfx stop = between (char '`') (char '`') (SfxVar <$> var) + +++ (SfxLit . T.pack <$> munch1 (`notElem` ['`', stop])) + ps = (flip (,) <$> suffix <*> option [] prefix) + +++ ((,) <$> prefix <*> option [] suffix) + +instance MakeTemplate Template where + type ElemT Template = Inlines + makeTemplate xs' = Template (genTemplate xs') -applyTemplate' :: M.Map T.Text [Inline] -> Template -> [Inline] -applyTemplate' vars (Template g) = g internalVars +instance MakeTemplate BlockTemplate where + type ElemT BlockTemplate = Blocks + makeTemplate xs' = BlockTemplate (genTemplate xs') + +instance MakeTemplate RefTemplate where + type ElemT RefTemplate = Inlines + makeTemplate xs' = RefTemplate $ \vars cap -> g (vf vars cap) + where Template g = makeTemplate xs' + vf :: VarFunc -> Bool -> VarFunc + vf vars cap vt + | Just (vc, vs) <- T.uncons vt + = let var = toLower vc `T.cons` vs + in if isUpper vc && cap + then capitalize vars var + else vars var + | otherwise = error "Empty variable name" + +genTemplate :: (Data a) => Many a -> VarFunc -> Many a +genTemplate xs' vf = fromList $ scan vf $ toList xs' + +scan :: (Data a) => VarFunc -> [a] -> [a] +scan = bottomUp . go where - internalVars x | Just v <- M.lookup x vars = Just $ MetaInlines v - internalVars _ = Nothing + go vf (Math DisplayMath var:xs) + | ParseRes{..} <- fst . head $ readP_to_S parse $ T.unpack var + = let replaceVar = replaceVar' ((<> handleSfx prSfx) . (handleSfx prPfx <>)) + replaceVar' m = maybe mempty (m . toInlines ("variable" <> var)) + handleSfx = mconcat . map oneSfx + oneSfx (SfxVar vars) = replaceVar' id (tryVars vars) + oneSfx (SfxLit txt) = text txt + tryVar PRVar{..} = + case prvIdx of + [] -> vf prvName + idxVars -> + let + idxs :: Maybe [T.Text] + idxs = mapM (Just . toString ("index variables " <> T.pack (show idxVars)) <=< tryIdxs) idxVars + arr = foldr (\i a -> getObjOrList i =<< a) (vf prvName) . reverse =<< idxs + getObjOrList :: T.Text -> MetaValue -> Maybe MetaValue + getObjOrList i x = getObj i x <|> tryGetList + where tryGetList | Right (ii, "") <- T.decimal i = getList ii x + | otherwise = Nothing + in arr + tryIdxs (IdxVar vars) = tryVars vars + tryIdxs (IdxStr s) = Just $ MetaString s + tryIdxs (IdxNum n) = Just $ MetaString n + tryVars = foldr ((<|>) . tryVar) Nothing -applyTemplate :: [Inline] -> [Inline] -> Template -> [Inline] -applyTemplate i t = - applyTemplate' (M.fromDistinctAscList [("i", i), ("t", t)]) + in toList $ replaceVar (tryVars prVar) <> fromList xs + go _ (x:xs) = toList $ singleton x <> fromList xs + go _ [] = [] diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Template/Types.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Template/Types.hs new file mode 100644 index 00000000..0366a9de --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Template/Types.hs @@ -0,0 +1,36 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2019 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE TypeFamilies #-} + +module Text.Pandoc.CrossRef.Util.Template.Types where + +import Text.Pandoc.Definition +import Text.Pandoc.Builder +import qualified Data.Text as T + +type VarFunc = T.Text -> Maybe MetaValue +newtype Template = Template { applyTemplate :: VarFunc -> Inlines } +newtype RefTemplate = RefTemplate { applyRefTemplate :: VarFunc -> Bool -> Inlines } +newtype BlockTemplate = BlockTemplate { applyBlockTemplate :: VarFunc -> Blocks } + +class MakeTemplate a where + type ElemT a + makeTemplate :: ElemT a -> a diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/Util.hs b/lib-internal/Text/Pandoc/CrossRef/Util/Util.hs index a7b7592f..adff0aa2 100644 --- a/lib-internal/Text/Pandoc/CrossRef/Util/Util.hs +++ b/lib-internal/Text/Pandoc/CrossRef/Util/Util.hs @@ -18,26 +18,20 @@ with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} -{-# LANGUAGE RankNTypes, OverloadedStrings, CPP #-} -module Text.Pandoc.CrossRef.Util.Util - ( module Text.Pandoc.CrossRef.Util.Util - , module Data.Generics - ) where +{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} +module Text.Pandoc.CrossRef.Util.Util where -import Text.Pandoc.CrossRef.References.Types +import Text.Pandoc.CrossRef.References.Types.Ref import Text.Pandoc.Definition -import Text.Pandoc.Builder hiding ((<>)) import Text.Pandoc.Class import Data.Char (toUpper, toLower, isUpper) -import Data.Maybe (fromMaybe) -import Data.Generics import Text.Pandoc.Writers.LaTeX import Data.Default -import Data.Version -import Data.List (find) -import Text.ParserCombinators.ReadP (readP_to_S) import qualified Data.Text as T +import qualified Data.Accessor.Basic as Accessor +import qualified Control.Monad.State as State + intercalate' :: (Eq a, Monoid a, Foldable f) => a -> f a -> a intercalate' s xs | null xs = mempty @@ -66,52 +60,6 @@ isFirstUpper xs | Just (x, _) <- T.uncons xs = isUpper x | otherwise = False -chapPrefix :: [Inline] -> Index -> [Inline] -chapPrefix delim = toList - . intercalate' (fromList delim) - . map str - . filter (not . T.null) - . map (uncurry (fromMaybe . T.pack . show)) - -data ReplacedResult a = Replaced Bool a | NotReplaced Bool -type GenRR m = forall a. Data a => (a -> m (ReplacedResult a)) -newtype RR m a = RR {unRR :: a -> m (ReplacedResult a)} - -runReplace :: (Monad m) => GenRR m -> GenericM m -runReplace f x = do - res <- f x - case res of - Replaced True x' -> gmapM (runReplace f) x' - Replaced False x' -> return x' - NotReplaced True -> gmapM (runReplace f) x - NotReplaced False -> return x - -mkRR :: (Monad m, Typeable a, Typeable b) - => (b -> m (ReplacedResult b)) - -> (a -> m (ReplacedResult a)) -mkRR = extRR (const noReplaceRecurse) - -extRR :: ( Monad m, Typeable a, Typeable b) - => (a -> m (ReplacedResult a)) - -> (b -> m (ReplacedResult b)) - -> (a -> m (ReplacedResult a)) -extRR def' ext = unRR (RR def' `ext0` RR ext) - -replaceRecurse :: Monad m => a -> m (ReplacedResult a) -replaceRecurse = return . Replaced True - -replaceNoRecurse :: Monad m => a -> m (ReplacedResult a) -replaceNoRecurse = return . Replaced False - -noReplace :: Monad m => Bool -> m (ReplacedResult a) -noReplace recurse = return $ NotReplaced recurse - -noReplaceRecurse :: Monad m => m (ReplacedResult a) -noReplaceRecurse = noReplace True - -noReplaceNoRecurse :: Monad m => m (ReplacedResult a) -noReplaceNoRecurse = noReplace False - mkLaTeXLabel :: T.Text -> T.Text mkLaTeXLabel l | T.null l = "" @@ -123,25 +71,6 @@ mkLaTeXLabel' l = runPure (writeLaTeX def $ Pandoc nullMeta [Div (l, [], []) []]) in T.takeWhile (/='}') . T.drop 1 . T.dropWhile (/='{') $ ll -escapeLaTeX :: T.Text -> T.Text -escapeLaTeX l = - let ll = either (error . show) id $ - runPure (writeLaTeX def $ Pandoc nullMeta [Plain [Str l]]) - pv = fmap fst . find (null . snd) . readP_to_S parseVersion $ VERSION_pandoc - mv = makeVersion [2,11,0,1] - cond = maybe False (mv >=) pv - in if cond then ll else l - -getRefLabel :: T.Text -> [Inline] -> Maybe T.Text -getRefLabel _ [] = Nothing -getRefLabel tag ils - | Str attr <- last ils - , all (==Space) (init ils) - , "}" `T.isSuffixOf` attr - , ("{#"<>tag<>":") `T.isPrefixOf` attr - = T.init `fmap` T.stripPrefix "{#" attr -getRefLabel _ _ = Nothing - isSpace :: Inline -> Bool isSpace = (||) <$> (==Space) <*> (==SoftBreak) @@ -149,3 +78,39 @@ isLaTeXRawBlockFmt :: Format -> Bool isLaTeXRawBlockFmt (Format "latex") = True isLaTeXRawBlockFmt (Format "tex") = True isLaTeXRawBlockFmt _ = False + +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead x = Just $ head x + +unhierarchicalize :: [Block] -> [Block] +unhierarchicalize + (Div (dident, "section":dcls, dkvs) (Header level (hident,hcls,hkvs) ils : xs) : ys) + | T.null hident, dkvs == hkvs, dcls == hcls = Header level (dident, hcls, hkvs) ils : unhierarchicalize xs <> unhierarchicalize ys +unhierarchicalize (x:xs) = x : unhierarchicalize xs +unhierarchicalize [] = [] + +newScope :: RefRec -> Scope -> Scope +newScope = (:) + +-- * accessors in the form of actions in the state monad + +set :: (State.MonadState r s) => Accessor.T r a -> a -> s () +set f x = State.modify (Accessor.set f x) + +get :: (State.MonadState r s) => Accessor.T r a -> s a +get f = State.gets (Accessor.get f) + +modify :: (State.MonadState r s) => Accessor.T r a -> (a -> a) -> s () +modify f g = State.modify (Accessor.modify f g) + +simpleTable :: [Alignment] -> [Double] -> [[[Block]]] -> Block +simpleTable align width bod = Table nullAttr noCaption (zip align $ map ColWidth width) + noTableHead [mkBody bod] noTableFoot + where + mkBody xs = TableBody nullAttr (RowHeadColumns 0) [] (map mkRow xs) + mkRow xs = Row nullAttr (map mkCell xs) + mkCell xs = Cell nullAttr AlignDefault (RowSpan 0) (ColSpan 0) xs + noCaption = Caption Nothing mempty + noTableHead = TableHead nullAttr [] + noTableFoot = TableFoot nullAttr [] diff --git a/lib-internal/Text/Pandoc/CrossRef/Util/VarFunction.hs b/lib-internal/Text/Pandoc/CrossRef/Util/VarFunction.hs new file mode 100644 index 00000000..3c5f07c5 --- /dev/null +++ b/lib-internal/Text/Pandoc/CrossRef/Util/VarFunction.hs @@ -0,0 +1,49 @@ +{- +pandoc-crossref is a pandoc filter for numbering figures, +equations, tables and cross-references to them. +Copyright (C) 2019 Nikolay Yakimov + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +-} + +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} + +module Text.Pandoc.CrossRef.Util.VarFunction where + +import Control.Applicative +import Text.Pandoc.Definition +import qualified Text.Pandoc.Builder as B + +import qualified Data.Text as T +import Text.Pandoc.CrossRef.References.Types +import Text.Pandoc.CrossRef.Util.Prefixes.Types + +defaultVarFunc :: (RefRec -> T.Text -> Maybe MetaValue) + -> RefRec -> T.Text -> Maybe MetaValue +defaultVarFunc self RefRec{..} x = case x of + "idx" -> Just $ MetaString $ T.pack $ show refIndex + "ri" | null refIxInlRaw -> Nothing + | otherwise -> Just $ MetaInlines $ B.toList refIxInlRaw + "i" -> Just $ MetaInlines $ B.toList refIxInl + "t" -> Just $ MetaInlines $ B.toList refTitle + "lvl" -> Just $ MetaString $ T.pack $ show refLevel + "lbl" -> Just $ MetaString refLabel + "pfx" -> Just $ MetaString refPfx + _ | Just y <- T.stripPrefix "s." x + , Just rs <- refScope + -> self rs y + _ | Just y <- T.stripPrefix "def." x + -> prefixDef refPfxRec y + _ -> refAttrs x <|> prefixDef refPfxRec x diff --git a/lib/Text/Pandoc/CrossRef.hs b/lib/Text/Pandoc/CrossRef.hs index 10757502..4dd55eba 100644 --- a/lib/Text/Pandoc/CrossRef.hs +++ b/lib/Text/Pandoc/CrossRef.hs @@ -76,73 +76,65 @@ module Text.Pandoc.CrossRef ( , runCrossRefIO , module SG , defaultMeta - , CrossRefM + , CrossRef , CrossRefEnv(..) + , WSException(..) + , Settings(..) ) where import Control.Monad.State -import qualified Control.Monad.Reader as R -import Text.Pandoc +import Control.Monad.Except +import Control.Monad.Writer as W +import Control.Monad.Reader as R +import Text.Pandoc as P +import qualified Data.Text as T +import qualified Data.Text.IO as T +import System.IO import Text.Pandoc.CrossRef.References import Text.Pandoc.CrossRef.Util.Settings -import Text.Pandoc.CrossRef.Util.Options as O -import Text.Pandoc.CrossRef.Util.CodeBlockCaptions import Text.Pandoc.CrossRef.Util.ModifyMeta import Text.Pandoc.CrossRef.Util.Settings.Gen as SG --- | Enviromnent for 'CrossRefM' -data CrossRefEnv = CrossRefEnv { - creSettings :: Meta -- ^Metadata settings - , creOptions :: Options -- ^Internal pandoc-crossref options - } - --- | Essentially a reader monad for basic pandoc-crossref environment -type CrossRefM a = R.Reader CrossRefEnv a - {- | Walk over blocks, while inserting cross-references, list-of, etc. Works in 'CrossRefM' monad. -} -crossRefBlocks :: [Block] -> CrossRefM [Block] -crossRefBlocks blocks = do - opts <- R.asks creOptions - let - doWalk = - bottomUpM (mkCodeBlockCaptions opts) blocks - >>= replaceAll opts - >>= bottomUpM (replaceRefs opts) - >>= bottomUpM (listOf opts) - (result, st) = runState doWalk def - st `seq` return result +crossRefBlocks :: [Block] -> CrossRef [Block] +crossRefBlocks blocks = CrossRef $ do + (res, st) <- flip runStateT def $ unWS doWalk + st `seq` return res + where doWalk = + replaceAll blocks + >>= bottomUpM replaceRefs + >>= bottomUpM listOf {- | Modifies metadata for LaTeX output, adding header-includes instructions -to setup custom and builtin environments. +to setup custom and builtin environments, and adds current pandoc-crossref +settings to metadata. -Note, that if output format is not "latex", this function does nothing. +Note, that if output format is not "latex", this function not modify +header-includes. Works in 'CrossRefM' monad. -} -crossRefMeta :: CrossRefM Meta -crossRefMeta = do - opts <- R.asks creOptions - dtv <- R.asks creSettings - return $ modifyMeta opts dtv +crossRefMeta :: Meta -> CrossRef Meta +crossRefMeta = modifyMeta {- | Combines 'crossRefMeta' and 'crossRefBlocks' Works in 'CrossRefM' monad. -} -defaultCrossRefAction :: Pandoc -> CrossRefM Pandoc -defaultCrossRefAction (Pandoc _ bs) = do - meta' <- crossRefMeta +defaultCrossRefAction :: Pandoc -> CrossRef Pandoc +defaultCrossRefAction (Pandoc meta bs) = do + meta' <- crossRefMeta meta bs' <- crossRefBlocks bs return $ Pandoc meta' bs' {- | Run an action in 'CrossRefM' monad with argument, and return pure result. This is primary function to work with 'CrossRefM' -} -runCrossRef :: forall a b. Meta -> Maybe Format -> (a -> CrossRefM b) -> a -> b -runCrossRef meta fmt action arg = R.runReader (action arg) env +runCrossRef :: forall b. Settings -> Maybe Format -> CrossRef b -> (Either WSException b, [T.Text]) +runCrossRef metaset fmt = flip runReader env . runWriterT . runExceptT . unCrossRef where - settings = defaultMeta <> meta + settings = metaset <> defaultMeta metaset env = CrossRefEnv { creSettings = settings , creOptions = getOptions settings fmt @@ -152,12 +144,9 @@ runCrossRef meta fmt action arg = R.runReader (action arg) env This function will attempt to read pandoc-crossref settings from settings file specified by crossrefYaml metadata field. -} -runCrossRefIO :: forall a b. Meta -> Maybe Format -> (a -> CrossRefM b) -> a -> IO b -runCrossRefIO meta fmt action arg = do - settings <- getSettings fmt meta - let - env = CrossRefEnv { - creSettings = settings - , creOptions = getOptions settings fmt - } - return $ R.runReader (action arg) env +runCrossRefIO :: forall b. Meta -> Maybe Format -> CrossRef b -> IO b +runCrossRefIO meta fmt action = do + metaset <- readSettings fmt meta + let (res, lg) = runCrossRef metaset fmt action + mapM_ (T.hPutStrLn stderr) lg + return $ either (error . T.unpack . pretty) id res diff --git a/package.yaml b/package.yaml index b53d8270..56d9d3ca 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: pandoc-crossref -version: '0.3.10.0' +version: '0.4.0.0' synopsis: Pandoc filter for cross-references description: pandoc-crossref is a pandoc filter for numbering figures, equations, tables and cross-references to them. @@ -12,6 +12,7 @@ github: lierdakil/pandoc-crossref extra-source-files: - test/*.inc - CHANGELOG.md +- settings/* data-files: - docs/demo/demo.md - docs/index.md @@ -31,6 +32,7 @@ library: - mtl >=1.1 && <2.3 internal-libraries: pandoc-crossref-internal: + ghc-options: -Wall source-dirs: lib-internal dependencies: - mtl >=1.1 && <2.3 @@ -45,6 +47,7 @@ internal-libraries: - directory >=1 && <1.4 - filepath >=1.1 && <1.5 - template-haskell >=2.7.0.0 && <3.0.0.0 + - bytestring flags: enable_flaky_tests: description: Some tests rely on specific behaviour of pandoc, which diff --git a/pandoc-crossref.cabal b/pandoc-crossref.cabal index 91f74d03..1f080bfb 100644 --- a/pandoc-crossref.cabal +++ b/pandoc-crossref.cabal @@ -4,10 +4,10 @@ cabal-version: 2.0 -- -- see: https://github.com/sol/hpack -- --- hash: ab0ef9726844411ecb162895e5b7a5f58bb220f7af9f678463fa8ec333c55787 +-- hash: 031e4b85f89a0c982d26b289cc24dc3f6810e028780b70f70b9e08556bb67223 name: pandoc-crossref -version: 0.3.10.0 +version: 0.4.0.0 synopsis: Pandoc filter for cross-references description: pandoc-crossref is a pandoc filter for numbering figures, equations, tables and cross-references to them. category: Text @@ -19,72 +19,74 @@ license: GPL-2 license-file: LICENSE build-type: Simple extra-source-files: - test/demo-chapters.inc test/demo.inc CHANGELOG.md + settings/chapters.yaml + settings/default.yaml + settings/numberSections.yaml + settings/subfigures.yaml + settings/titleSections.yaml data-files: docs/demo/demo.md docs/index.md + test/m2m/capitalization/expect.md + test/m2m/capitalization/input.md test/m2m/chapDelim/expect.md - test/m2m/chapDelim/expect.tex test/m2m/chapDelim/input.md + test/m2m/custom-prefixes/expect.md + test/m2m/custom-prefixes/input.md test/m2m/delim/expect.md - test/m2m/delim/expect.tex test/m2m/delim/input.md test/m2m/emptyChapterLabels/expect.md - test/m2m/emptyChapterLabels/expect.tex test/m2m/emptyChapterLabels/input.md test/m2m/equations-auto/expect.md - test/m2m/equations-auto/expect.tex test/m2m/equations-auto/input.md - test/m2m/equations-tables-auto/expect.md - test/m2m/equations-tables-auto/expect.tex - test/m2m/equations-tables-auto/input.md - test/m2m/equations-tables/expect.md - test/m2m/equations-tables/expect.tex - test/m2m/equations-tables/input.md test/m2m/equations/expect.md - test/m2m/equations/expect.tex test/m2m/equations/input.md test/m2m/label-precedence/expect.md - test/m2m/label-precedence/expect.tex test/m2m/label-precedence/input.md test/m2m/links-names/expect.md - test/m2m/links-names/expect.tex test/m2m/links-names/input.md test/m2m/links/expect.md - test/m2m/links/expect.tex test/m2m/links/input.md + test/m2m/list-of/expect.md + test/m2m/list-of/input.md test/m2m/listing-captions-ids/expect.md - test/m2m/listing-captions-ids/expect.tex test/m2m/listing-captions-ids/input.md test/m2m/listings-code-block-caption-278/expect.md - test/m2m/listings-code-block-caption-278/expect.tex test/m2m/listings-code-block-caption-278/input.md test/m2m/multiple-eqn-same-para/expect.md - test/m2m/multiple-eqn-same-para/expect.tex test/m2m/multiple-eqn-same-para/input.md + test/m2m/numbering-parts/expect.md + test/m2m/numbering-parts/input.md + test/m2m/ref-attrs/expect.md + test/m2m/ref-attrs/input.md + test/m2m/regresssion-219/expect.md + test/m2m/regresssion-219/input.md + test/m2m/scoping/expect.md + test/m2m/scoping/input.md test/m2m/secLabels/expect.md - test/m2m/secLabels/expect.tex test/m2m/secLabels/input.md test/m2m/secLevelLabels/expect.md - test/m2m/secLevelLabels/expect.tex test/m2m/secLevelLabels/input.md test/m2m/section-template/expect.md - test/m2m/section-template/expect.tex test/m2m/section-template/input.md test/m2m/setLabelAttribute/expect.md - test/m2m/setLabelAttribute/expect.tex test/m2m/setLabelAttribute/input.md test/m2m/subfigures-ccsDelim/expect.md - test/m2m/subfigures-ccsDelim/expect.tex test/m2m/subfigures-ccsDelim/input.md test/m2m/subfigures-grid/expect.md - test/m2m/subfigures-grid/expect.tex test/m2m/subfigures-grid/input.md + test/m2m/subfigures-template-collect/expect.md + test/m2m/subfigures-template-collect/input.md test/m2m/subfigures/expect.md - test/m2m/subfigures/expect.tex test/m2m/subfigures/input.md + test/m2m/template-objects/expect.md + test/m2m/template-objects/input.md + test/m2m/template-options/expect.md + test/m2m/template-options/input.md + test/m2m/undefined-prefix/expect.md + test/m2m/undefined-prefix/input.md source-repository head type: git @@ -118,23 +120,38 @@ library pandoc-crossref-internal Text.Pandoc.CrossRef.References.Blocks Text.Pandoc.CrossRef.References.List Text.Pandoc.CrossRef.References.Refs + Text.Pandoc.CrossRef.References.Subfigures Text.Pandoc.CrossRef.References.Types + Text.Pandoc.CrossRef.References.Types.Monad + Text.Pandoc.CrossRef.References.Types.Ref Text.Pandoc.CrossRef.Util.CodeBlockCaptions Text.Pandoc.CrossRef.Util.CustomLabels Text.Pandoc.CrossRef.Util.Meta Text.Pandoc.CrossRef.Util.ModifyMeta Text.Pandoc.CrossRef.Util.Options + Text.Pandoc.CrossRef.Util.Options.Types + Text.Pandoc.CrossRef.Util.Prefixes + Text.Pandoc.CrossRef.Util.Prefixes.Types + Text.Pandoc.CrossRef.Util.Replace Text.Pandoc.CrossRef.Util.Settings + Text.Pandoc.CrossRef.Util.Settings.Embed Text.Pandoc.CrossRef.Util.Settings.Gen + Text.Pandoc.CrossRef.Util.Settings.LiftPandoc Text.Pandoc.CrossRef.Util.Settings.Template + Text.Pandoc.CrossRef.Util.Settings.Types + Text.Pandoc.CrossRef.Util.Settings.Util Text.Pandoc.CrossRef.Util.Template + Text.Pandoc.CrossRef.Util.Template.Types Text.Pandoc.CrossRef.Util.Util + Text.Pandoc.CrossRef.Util.VarFunction other-modules: Paths_pandoc_crossref hs-source-dirs: lib-internal + ghc-options: -Wall build-depends: base >=4.11 && <5 + , bytestring , containers >=0.1 && <0.7 , data-accessor >=0.2.2.6 && <0.3.0.0 , data-accessor-template >=0.2.1.12 && <0.3.0.0 diff --git a/settings/chapters.yaml b/settings/chapters.yaml new file mode 100644 index 00000000..46c2acb2 --- /dev/null +++ b/settings/chapters.yaml @@ -0,0 +1,8 @@ +captionIndexTemplate: $$s.i%.$$$$ri$$ +scope: sec +prefixes: + sec: + title: Chapter + sub: + title: Section + referenceIndexTemplate: $$i$$$$suf$$ diff --git a/settings/default.yaml b/settings/default.yaml new file mode 100644 index 00000000..e1b92559 --- /dev/null +++ b/settings/default.yaml @@ -0,0 +1,45 @@ +codeBlockCaptions: False +adjustSectionIdentifiers: False +autoSectionLabels: sec +titleDelim: ":[]{.s}" +listItemNumberDelim: ".[]{.s}" +rangeDelim: "-" +pairDelim: ",[]{.s}" +lastDelim: ",[]{.s}" +refDelim: ",[]{.s}" +crossrefYaml: "pandoc-crossref.yaml" +linkReferences: False +nameInLink: False +collectedCaptionDelim: ",[]{.s}" +collectedCaptionItemDelim: "[]{.s}--[]{.s}" +# these are merely the defaults, can (and will) be overridden in prefix configs +captionTemplate: "$$title%\u00a0$$$$i$$$$titleDelim$$$$t$$" +captionIndexTemplate: $$ri$$ +referenceTemplate: "$$Ref[n]%\u00a0$$$$rs$$" +listItemTemplate: $$i$$$$listItemNumberDelim$$$$t$$ +collectedCaptionTemplate: $$i$$$$collectedCaptionItemDelim$$$$t$$ +referenceIndexTemplate: $$i$$$$suf$$ +listOfTitle: | + # List of $$title$$s +numbering: arabic +prefixes: + eq: + ref: ["eq.", "eqns."] + captionTemplate: "$$t$$\\\\qquad($$i$$)" + title: Equation + fig: + ref: ["fig.", "figs."] + title: Figure + lst: + ref: ["lst.", "lsts."] + title: Listing + captionPosition: above + tbl: + ref: ["tbl.", "tbls."] + title: Table + sec: + ref: ["sec.", "secs."] + title: Section + captionTemplate: $$t$$ + scope: sec + referenceIndexTemplate: $$s.refi%.$$$$i$$$$suf$$ diff --git a/settings/numberSections.yaml b/settings/numberSections.yaml new file mode 100644 index 00000000..29036137 --- /dev/null +++ b/settings/numberSections.yaml @@ -0,0 +1,8 @@ +chapDelim: . +prefixes: + sec: + captionTemplate: $$i$$ $$t$$ + captionIndexTemplate: $$ri$$ + referenceIndexTemplate: $$i$$$$suf$$ + sub: + captionIndexTemplate: $$s.i$$$$ri#`chapDelim`$$ diff --git a/settings/subfigures.yaml b/settings/subfigures.yaml new file mode 100644 index 00000000..fa3a9f38 --- /dev/null +++ b/settings/subfigures.yaml @@ -0,0 +1,10 @@ +prefixes: + fig: + subcaptions: True + sub: + numbering: alpha a + referenceIndexTemplate: $$s.i$$($$i$$) + listItemTemplate: $$s.i$$($$i$$)$$listItemNumberDelim$$$$t$$ + captionTemplate: $$i$$ + scope: fig + captionIndexTemplate: $$ri$$ diff --git a/settings/titleSections.yaml b/settings/titleSections.yaml new file mode 100644 index 00000000..11ee2fa7 --- /dev/null +++ b/settings/titleSections.yaml @@ -0,0 +1,3 @@ +prefixes: + sec: + captionTemplate: $$title$$ $$i$$. $$t$$ diff --git a/src/pandoc-crossref.hs b/src/pandoc-crossref.hs index 388f0c05..930274a4 100644 --- a/src/pandoc-crossref.hs +++ b/src/pandoc-crossref.hs @@ -92,7 +92,7 @@ run = do , "instead." ] toJSONFilter (f fmt) - f fmt p@(Pandoc meta _) = runCrossRefIO meta (Format . T.pack <$> fmt) defaultCrossRefAction p + f fmt p@(Pandoc meta _) = runCrossRefIO meta (Format . T.pack <$> fmt) $ defaultCrossRefAction p main :: IO () main = join $ execParser opts diff --git a/test/Native.hs b/test/Native.hs index bf16e0f4..dcd79ac1 100644 --- a/test/Native.hs +++ b/test/Native.hs @@ -23,9 +23,7 @@ module Native where import Text.Pandoc.Definition -demo, demochapters :: [Block] +demo :: [Block] demo = #include "demo.inc" -demochapters = -#include "demo-chapters.inc" diff --git a/test/demo-chapters.inc b/test/demo-chapters.inc deleted file mode 100644 index a8c1aa21..00000000 --- a/test/demo-chapters.inc +++ /dev/null @@ -1,114 +0,0 @@ - [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "demo",Space,Str "file",Space,Str "for",Space,Str "pandoc-crossref.",Space,Str "With",Space,Str "this",Space,Str "filter,",Space,Str "you",Space,Str "can",Space,Str "cross-reference",Space,Str "figures",Space,Str "(see",Space,Str "figs.\160\&1.1-1.3),",Space,Str "display",Space,Str "equations",Space,Str "(see",Space,Str "eq.\160\&2.1),",Space,Str "tables",Space,Str "(see",Space,Str "tbl.\160\&3.1)",Space,Str "and",Space,Str "sections",Space,Str "(",Str "secs.\160\&1,",Space,Str "2,",Space,Str "4.1-4.3)"] - ,Para [Str "For",Space,Str "immediate",Space,Str "example,",Space,Str "see",Space,Str "fig.\160\&1"] - ,Para [Image ("fig:figure0",[],[]) [Str "Figure",Space,Str "#",Space,Str "1:",Space,Str "A",Space,Str "figure"] ("img1.jpg","fig:")] - ,Para [Str "There",Space,Str "is",Space,Str "also",Space,Str "support",Space,Str "for",Space,Str "code",Space,Str "blocks,",Space,Str "for",Space,Str "example,",Space,Str "lsts.\160\&4.1-4.3"] - ,Para [Str "It\8217s",Space,Str "possible",Space,Str "to",Space,Str "capitalize",Space,Str "reference",Space,Str "prefixes,",Space,Str "like",Space,Str "this:",Space,Str "Fig.\160\&1.1."] - ,Para [Str "In",Space,Str "case",Space,Str "of",Space,Str "multiple",Space,Str "references,",Space,Str "capitalization",Space,Str "is",Space,Str "determined",Space,Str "by",Space,Str "first",Space,Str "reference.",Space,Str "Figs.\160\&1.1,",Space,Str "1.2",Space,Str "is",Space,Str "capitalized,",Space,Str "while",Space,Str "figs.\160\&1.1,",Space,Str "1.2",Space,Str "is",Space,Str "not."] - ,Para [Str "It",Space,Str "is",Space,Str "also",Space,Str "possible",Space,Str "to",Space,Str "mix",Space,Str "different",Space,Str "references,",Space,Str "like",Space,Str "fig.\160\&1.1,",Space,Str "tbl.\160\&3.1,",Space,Str "lsts.\160\&4.1,",Space,Str "4.2,",Space,Str "figs.\160\&1.2,",Space,Str "1.3,",Space,Str "which",Space,Str "will",Space,Str "be",Space,Str "grouped",Space,Str "in",Space,Str "order",Space,Str "they",Space,Str "are",Space,Str "specified.",Space,Str "You",Space,Str "can",Space,Str "even",Space,Str "intermix",Space,Str "this",Space,Str "with",Space,Str "regular",Space,Str "citations,",Space,Str "although",Space,Str "it\8217s",Space,Str "not",Space,Str "recommended:",Space,Str "fig.\160\&1.1,",Space,Str "tbl.\160\&3.1,",Space,Cite [Citation {citationId = "unprocessedCitation", citationPrefix = [], citationSuffix = [], citationMode = NormalCitation, citationNoteNum = 11, citationHash = 0}] [Str "[@unprocessedCitation]"]] - ,Para [Str "You",Space,Str "can",Space,Str "also",Space,Str "have",Space,Str "custom",Space,Str "chapter",Space,Str "reference",Space,Str "labels,",Space,Str "like",Space,Str "sec.\160AppA.CustLab"] - ,Para [Str "Subfigures",Space,Str "are",Space,Str "supported,",Space,Str "see",Space,Str "figs.\160\&1.4,",Space,Str "1.4",Space,Str "(b)"] - ,Header 1 ("sec:sec1",[],[]) [Str "Chapter",Space,Str "1.",Space,Str "Figures"] - ,Para [Image ("fig:figure1",[],[]) [Str "Figure",Space,Str "#",Space,Str "1.1:",Space,Str "First",Space,Str "figure"] ("img1.jpg","fig:")] - ,Para [Image ("fig:figure2",[],[]) [Str "Figure",Space,Str "#",Space,Str "1.2:",Space,Str "Second",Space,Str "figure"] ("img2.jpg","fig:")] - ,Para [Image ("fig:figure3",[],[]) [Str "Figure",Space,Str "#",Space,Str "1.3:",Space,Str "Third",Space,Str "figure"] ("img3.jpg","fig:")] - ,Para [Image ("",[],[]) [Str "Unlabelled",Space,Str "image"] ("img1.jpg","fig:")] - ,Div ("fig:subfigures",["subfigures"],[]) - [Para [Image ("",[],[]) [Str "a"] ("img1.jpg","fig:")] - ,Para [Image ("fig:subfigureB",[],[]) [Str "b"] ("img1.jpg","fig:")] - ,Para [Str "Figure",Space,Str "#",Space,Str "1.4:",Space,Str "Subfigures",Space,Str "caption.",Space,Str "a",Space,Str "\8212",Space,Str "Subfigure",Space,Str "a,",Space,Str "b",Space,Str "\8212",Space,Str "Subfigure",Space,Str "b"]] - ,Header 1 ("sec:sec2",[],[]) [Str "Chapter",Space,Str "2.",Space,Str "Equations"] - ,Para [Str "Display",Space,Str "equations",Space,Str "are",Space,Str "labelled",Space,Str "and",Space,Str "numbered"] - ,Para [Span ("eq:eqn1",[],[]) [Math DisplayMath " P_i(x) = \\sum_i a_i x^i \\qquad(2.1)"]] - ,Para [Str "Since",Space,Str "0.1.6.0",Space,Str "those",Space,Str "can",Space,Str "also",Space,Str "appear",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Str "of",Space,Str "paragraph",SoftBreak,Span ("eq:quadr",[],[]) [Math DisplayMath "a x^2 + b x^2 + c = 0\\qquad(2.2)"],Space,Str "like",Space,Str "this."] - ,Header 1 ("sec:chapter-3.-tables",[],[]) [Str "Chapter",Space,Str "3.",Space,Str "Tables"] - ,Div ("tbl:table1",[],[]) - [Table ("",[],[]) (Caption Nothing - [Plain [Emph [Str "Table",Space,Str "3.1"],Str ":",Space,Str "Table",Space,Str "example"]]) - [(AlignLeft,ColWidthDefault) - ,(AlignLeft,ColWidthDefault)] - (TableHead ("",[],[]) - [Row ("",[],[]) - [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "First",Space,Str "Header"]] - ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Second",Space,Str "Header"]]]]) - [(TableBody ("",[],[]) (RowHeadColumns 0) - [] - [Row ("",[],[]) - [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]] - ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]]] - ,Row ("",[],[]) - [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]] - ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]]]])] - (TableFoot ("",[],[]) - [])] - ,Para [Str "Table",Space,Str "without",Space,Str "caption:"] - ,Table ("",[],[]) (Caption Nothing - []) - [(AlignLeft,ColWidthDefault) - ,(AlignLeft,ColWidthDefault)] - (TableHead ("",[],[]) - [Row ("",[],[]) - [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "First",Space,Str "Header"]] - ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Second",Space,Str "Header"]]]]) - [(TableBody ("",[],[]) (RowHeadColumns 0) - [] - [Row ("",[],[]) - [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]] - ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]]] - ,Row ("",[],[]) - [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]] - ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) - [Plain [Str "Content",Space,Str "Cell"]]]])] - (TableFoot ("",[],[]) - []) - ,Header 1 ("sec:chapter-4.-code-blocks",[],[]) [Str "Chapter",Space,Str "4.",Space,Str "Code",Space,Str "blocks"] - ,Para [Str "There",Space,Str "are",Space,Str "a",Space,Str "couple",Space,Str "options",Space,Str "for",Space,Str "code",Space,Str "block",Space,Str "labels.",Space,Str "Those",Space,Str "work",Space,Str "only",Space,Str "if",Space,Str "code",Space,Str "block",Space,Str "id",Space,Str "starts",Space,Str "with",Space,Code ("",[],[]) "lst:",Str ",",Space,Str "e.g.\160",Code ("",[],[]) "{#lst:label}"] - ,Header 2 ("sec:caption-attr",[],[]) [Code ("",[],[]) "caption",Space,Str "attribute"] - ,Para [Code ("",[],[]) "caption",Space,Str "attribute",Space,Str "will",Space,Str "be",Space,Str "treated",Space,Str "as",Space,Str "code",Space,Str "block",Space,Str "caption.",Space,Str "If",Space,Str "code",Space,Str "block",Space,Str "has",Space,Str "both",Space,Str "id",Space,Str "and",Space,Code ("",[],[]) "caption",Space,Str "attributes,",Space,Str "it",Space,Str "will",Space,Str "be",Space,Str "treated",Space,Str "as",Space,Str "numbered",Space,Str "code",Space,Str "block."] - ,Div ("lst:captionAttr",["listing","haskell"],[]) - [Para [Str "Listing",Space,Str "4.1:",Space,Str "Listing",Space,Str "caption"] - ,CodeBlock ("",["haskell"],[]) "main :: IO ()\nmain = putStrLn \"Hello World!\""] - ,RawBlock (Format "tex") "\\pagebreak" - ,Header 2 ("sec:table-capts",[],[]) [Str "Table-style",Space,Str "captions"] - ,Para [Str "Enabled",Space,Str "with",Space,Code ("",[],[]) "codeBlockCaptions",Space,Str "metadata",Space,Str "option.",Space,Str "If",Space,Str "code",Space,Str "block",Space,Str "is",Space,Str "immediately",SoftBreak,Str "adjacent",Space,Str "to",Space,Str "paragraph,",Space,Str "starting",Space,Str "with",Space,Code ("",[],[]) "Listing:",Space,Str "or",Space,Code ("",[],[]) ":",Str ",",Space,Str "said",Space,Str "paragraph",Space,Str "will",Space,Str "be",SoftBreak,Str "treated",Space,Str "as",Space,Str "code",Space,Str "block",Space,Str "caption."] - ,Div ("lst:tableCaption",["listing","haskell"],[]) - [Para [Str "Listing",Space,Str "4.2:",Space,Str "Listing",Space,Str "caption"] - ,CodeBlock ("",["haskell"],[]) "main :: IO ()\nmain = putStrLn \"Hello World!\""] - ,Header 2 ("sec:wrapping-div",[],[]) [Str "Wrapping",Space,Str "div"] - ,Para [Str "Wrapping",Space,Str "code",Space,Str "block",Space,Str "without",Space,Str "label",Space,Str "in",Space,Str "a",Space,Str "div",Space,Str "with",Space,Str "id",Space,Code ("",[],[]) "lst:...",Space,Str "and",Space,Str "class,",Space,Str "starting",Space,Str "with",Space,Code ("",[],[]) "listing",Str ",",Space,Str "and",Space,Str "adding",Space,Str "paragraph",Space,Str "before",Space,Str "code",Space,Str "block,",Space,Str "but",Space,Str "inside",Space,Str "div,",Space,Str "will",Space,Str "treat",Space,Str "said",Space,Str "paragraph",Space,Str "as",Space,Str "code",Space,Str "block",Space,Str "caption."] - ,Div ("lst:wrappingDiv",["listing","haskell"],[]) - [Para [Str "Listing",Space,Str "4.3:",Space,Str "Listing",Space,Str "caption"] - ,CodeBlock ("",["haskell"],[]) "main :: IO ()\nmain = putStrLn \"Hello World!\""] - ,Header 1 ("sec:unnumbered-chapter.",["unnumbered"],[]) [Str "Unnumbered",Space,Str "chapter."] - ,Para [Str "This",Space,Str "chapter",Space,Str "doesn\8217t",Space,Str "change",Space,Str "chapter",Space,Str "prefix",Space,Str "of",Space,Str "referenced",Space,Str "elements,",Space,Str "instead",Space,Str "keeping",Space,Str "number",Space,Str "of",Space,Str "previous",Space,Str "chapter,",Space,Str "e.g.",SoftBreak,Span ("eq:eqn2",[],[]) [Math DisplayMath " S(x) = \\int_{x_1}^{x_2} a x+b \\ \\mathrm{d}x \\qquad(4.1)"]] - ,Header 1 ("sec:chapter-5.-reference-lists",[],[]) [Str "Chapter",Space,Str "5.",Space,Str "Reference",Space,Str "lists"] - ,Para [Str "It\8217s",Space,Str "also",Space,Str "possible",Space,Str "to",Space,Str "show",Space,Str "lists",Space,Str "of",Space,Str "figures",Space,Str "and",Space,Str "tables,",Space,Str "like",Space,Str "this:"] - ,Header 2 ("list-of-figures",[],[]) [Str "List",Space,Str "of",Space,Str "Figures"] - ,Div ("",["list"],[]) - [Para [Str "1",Space,Str "A",Space,Str "figure"] - ,Para [Str "1.1",Space,Str "First",Space,Str "figure"] - ,Para [Str "1.2",Space,Str "Second",Space,Str "figure"] - ,Para [Str "1.3",Space,Str "Third",Space,Str "figure"] - ,Para [Str "1.4",Space,Str "Subfigure",Space,Str "a"] - ,Para [Str "1.4",Space,Str "Subfigure",Space,Str "b"] - ,Para [Str "1.4",Space,Str "Subfigures",Space,Str "caption"]] - ,Header 2 ("list-of-tables",[],[]) [Str "List",Space,Str "of",Space,Str "Tables"] - ,Div ("",["list"],[]) - [Para [Str "3.1",Space,Str "Table",Space,Str "example"]] - ,Header 1 ("",[],[]) [Str "List",Space,Str "of",Space,Str "Listings"] - ,Div ("",["list"],[]) - [Para [Str "4.1",Space,Str "Listing",Space,Str "caption"] - ,Para [Str "4.2",Space,Str "Listing",Space,Str "caption"] - ,Para [Str "4.3",Space,Str "Listing",Space,Str "caption"]] - ,Header 1 ("sec:appendix-a.-custom-labels",[],[("label","AppA")]) [Str "Appendix",Space,Str "A.",Space,Str "Custom",Space,Str "labels"] - ,Header 2 ("sec:custlabs",[],[("label","CustLab")]) [Str "This",Space,Str "section",Space,Str "will",Space,Str "have",Space,Str "custom",Space,Str "label"]] diff --git a/test/demo.inc b/test/demo.inc index 9fea08b4..21eb1696 100644 --- a/test/demo.inc +++ b/test/demo.inc @@ -1,29 +1,44 @@ - [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "demo",Space,Str "file",Space,Str "for",Space,Str "pandoc-crossref.",Space,Str "With",Space,Str "this",Space,Str "filter,",Space,Str "you",Space,Str "can",Space,Str "cross-reference",Space,Str "figures",Space,Str "(see",Space,Str "figs.\160\&2-4),",Space,Str "display",Space,Str "equations",Space,Str "(see",Space,Str "eq.\160\&1),",Space,Str "tables",Space,Str "(see",Space,Str "tbl.\160\&1)",Space,Str "and",Space,Str "sections",Space,Str "(",Str "secs.\160\&1,",Space,Str "2,",Space,Str "4.1-4.3)"] + [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "demo",Space,Str "file",Space,Str "for",Space,Str "pandoc-crossref.",Space,Str "With",Space,Str "this",Space,Str "filter,",Space,Str "you",Space,Str "can",Space,Str "cross-reference",Space,Str "figures",Space,Str "(see",Space,Str "figs.\160\&1.1-1.3),",Space,Str "display",Space,Str "equations",Space,Str "(see",Space,Str "eq.\160\&2.1),",Space,Str "tables",Space,Str "(see",Space,Str "tbl.\160\&3.1)",Space,Str "and",Space,Str "sections",Space,Str "(",Str "secs.\160\&1,",Space,Str "2,",Space,Str "secs.\160\&4.1-4.3)"] ,Para [Str "For",Space,Str "immediate",Space,Str "example,",Space,Str "see",Space,Str "fig.\160\&1"] - ,Para [Image ("fig:figure0",[],[]) [Str "Figure",Space,Str "#",Space,Str "1:",Space,Str "A",Space,Str "figure"] ("img1.jpg","fig:")] - ,Para [Str "There",Space,Str "is",Space,Str "also",Space,Str "support",Space,Str "for",Space,Str "code",Space,Str "blocks,",Space,Str "for",Space,Str "example,",Space,Str "lsts.\160\&1-3"] - ,Para [Str "It\8217s",Space,Str "possible",Space,Str "to",Space,Str "capitalize",Space,Str "reference",Space,Str "prefixes,",Space,Str "like",Space,Str "this:",Space,Str "Fig.\160\&2."] - ,Para [Str "In",Space,Str "case",Space,Str "of",Space,Str "multiple",Space,Str "references,",Space,Str "capitalization",Space,Str "is",Space,Str "determined",Space,Str "by",Space,Str "first",Space,Str "reference.",Space,Str "Figs.\160\&2,",Space,Str "3",Space,Str "is",Space,Str "capitalized,",Space,Str "while",Space,Str "figs.\160\&2,",Space,Str "3",Space,Str "is",Space,Str "not."] - ,Para [Str "It",Space,Str "is",Space,Str "also",Space,Str "possible",Space,Str "to",Space,Str "mix",Space,Str "different",Space,Str "references,",Space,Str "like",Space,Str "fig.\160\&2,",Space,Str "tbl.\160\&1,",Space,Str "lsts.\160\&1,",Space,Str "2,",Space,Str "figs.\160\&3,",Space,Str "4,",Space,Str "which",Space,Str "will",Space,Str "be",Space,Str "grouped",Space,Str "in",Space,Str "order",Space,Str "they",Space,Str "are",Space,Str "specified.",Space,Str "You",Space,Str "can",Space,Str "even",Space,Str "intermix",Space,Str "this",Space,Str "with",Space,Str "regular",Space,Str "citations,",Space,Str "although",Space,Str "it\8217s",Space,Str "not",Space,Str "recommended:",Space,Str "fig.\160\&2,",Space,Str "tbl.\160\&1,",Space,Cite [Citation {citationId = "unprocessedCitation", citationPrefix = [], citationSuffix = [], citationMode = NormalCitation, citationNoteNum = 11, citationHash = 0}] [Str "[@unprocessedCitation]"]] - ,Para [Str "You",Space,Str "can",Space,Str "also",Space,Str "have",Space,Str "custom",Space,Str "chapter",Space,Str "reference",Space,Str "labels,",Space,Str "like",Space,Str "sec.\160AppA.CustLab"] - ,Para [Str "Subfigures",Space,Str "are",Space,Str "supported,",Space,Str "see",Space,Str "figs.\160\&5,",Space,Str "5",Space,Str "(b)"] + ,Para [Image ("fig:figure0",[],[]) [Str "Figure\160\&1:",Space,Str "A",Space,Str "figure"] ("img1.jpg","fig:")] + ,Para [Str "There",Space,Str "is",Space,Str "also",Space,Str "support",Space,Str "for",Space,Str "code",Space,Str "blocks,",Space,Str "for",Space,Str "example,",Space,Str "lsts.\160\&4.1.1,",Space,Str "4.2.1,",Space,Str "4.3.1"] + ,Para [Str "It\8217s",Space,Str "possible",Space,Str "to",Space,Str "capitalize",Space,Str "reference",Space,Str "prefixes,",Space,Str "like",Space,Str "this:",Space,Str "Fig.\160\&1.1."] + ,Para [Str "In",Space,Str "case",Space,Str "of",Space,Str "multiple",Space,Str "references,",Space,Str "capitalization",Space,Str "is",Space,Str "determined",Space,Str "by",Space,Str "first",Space,Str "reference.",Space,Str "Figs.\160\&1.1,",Space,Str "1.2",Space,Str "is",Space,Str "capitalized,",Space,Str "while",Space,Str "figs.\160\&1.1,",Space,Str "1.2",Space,Str "is",Space,Str "not."] + ,Para [Str "It",Space,Str "is",Space,Str "also",Space,Str "possible",Space,Str "to",Space,Str "mix",Space,Str "different",Space,Str "references,",Space,Str "like",Space,Str "fig.\160\&1.1,",Space,Str "tbl.\160\&3.1,",Space,Str "lsts.\160\&4.1.1,",Space,Str "4.2.1,",Space,Str "figs.\160\&1.2,",Space,Str "1.3,",Space,Str "which",Space,Str "will",Space,Str "be",Space,Str "grouped",Space,Str "in",Space,Str "order",Space,Str "they",Space,Str "are",Space,Str "specified.",Space,Str "You",Space,Str "can",Space,Str "even",Space,Str "intermix",Space,Str "this",Space,Str "with",Space,Str "regular",Space,Str "citations,",Space,Str "although",Space,Str "it\8217s",Space,Str "not",Space,Str "recommended:",Space,Str "fig.\160\&1.1,",Space,Str "tbl.\160\&3.1,",Space,Cite [Citation {citationId = "unprocessedCitation", citationPrefix = [], citationSuffix = [], citationMode = NormalCitation, citationNoteNum = 11, citationHash = 0}] [Str "[@unprocessedCitation]"]] + ,Para [Str "You",Space,Str "can",Space,Str "also",Space,Str "have",Space,Str "custom",Space,Str "chapter",Space,Str "reference",Space,Str "labels,",Space,Str "like",Space,Str "sec.\160A.I"] + ,Para [Str "Subfigures",Space,Str "are",Space,Str "supported,",Space,Str "see",Space,Str "fig.\160\&1.5,",Space,Str "fig.\160\&1.5(b)"] ,Header 1 ("sec:sec1",[],[]) [Str "Chapter",Space,Str "1.",Space,Str "Figures"] - ,Para [Image ("fig:figure1",[],[]) [Str "Figure",Space,Str "#",Space,Str "2:",Space,Str "First",Space,Str "figure"] ("img1.jpg","fig:")] - ,Para [Image ("fig:figure2",[],[]) [Str "Figure",Space,Str "#",Space,Str "3:",Space,Str "Second",Space,Str "figure"] ("img2.jpg","fig:")] - ,Para [Image ("fig:figure3",[],[]) [Str "Figure",Space,Str "#",Space,Str "4:",Space,Str "Third",Space,Str "figure"] ("img3.jpg","fig:")] - ,Para [Image ("",[],[]) [Str "Unlabelled",Space,Str "image"] ("img1.jpg","fig:")] - ,Div ("fig:subfigures",["subfigures"],[]) - [Para [Image ("",[],[]) [Str "a"] ("img1.jpg","fig:")] - ,Para [Image ("fig:subfigureB",[],[]) [Str "b"] ("img1.jpg","fig:")] - ,Para [Str "Figure",Space,Str "#",Space,Str "5:",Space,Str "Subfigures",Space,Str "caption.",Space,Str "a",Space,Str "\8212",Space,Str "Subfigure",Space,Str "a,",Space,Str "b",Space,Str "\8212",Space,Str "Subfigure",Space,Str "b"]] + ,Para [Image ("fig:figure1",[],[]) [Str "Figure\160\&1.1:",Space,Str "First",Space,Str "figure"] ("img1.jpg","fig:")] + ,Para [Image ("fig:figure2",[],[]) [Str "Figure\160\&1.2:",Space,Str "Second",Space,Str "figure"] ("img2.jpg","fig:")] + ,Para [Image ("fig:figure3",[],[]) [Str "Figure\160\&1.3:",Space,Str "Third",Space,Str "figure"] ("img3.jpg","fig:")] + ,Para [Image ("",[],[]) [Str "Figure\160\&1.4:",Space,Str "Unlabelled",Space,Str "image"] ("img1.jpg","fig:")] + ,Div ("fig:subfigures",["subcaption"],[]) + [Table ("",[],[]) (Caption Nothing + []) + [(AlignCenter,ColWidth 0.99)] + (TableHead ("",[],[]) + []) + [(TableBody ("",[],[]) (RowHeadColumns 0) + [] + [Row ("",[],[]) + [Cell ("",[],[]) AlignDefault (RowSpan 0) (ColSpan 0) + [Div ("",[],[]) + [Para [Image ("",[],[("width","100%")]) [Str "a"] ("img1.jpg","fig:")]]]] + ,Row ("",[],[]) + [Cell ("",[],[]) AlignDefault (RowSpan 0) (ColSpan 0) + [Div ("",[],[]) + [Para [Image ("fig:subfigureB",[],[("width","100%")]) [Str "b"] ("img1.jpg","fig:")]]]]])] + (TableFoot ("",[],[]) + []) + ,Para [Str "Figure\160\&1.5:",Space,Str "Subfigures",Space,Str "caption.",Space,Span ("",[],[]) [Str "a",Space,Str "\8211",Space,Str "Subfigure",Space,Str "a,",Space,Str "b",Space,Str "\8211",Space,Str "Subfigure",Space,Str "b"]]] ,Header 1 ("sec:sec2",[],[]) [Str "Chapter",Space,Str "2.",Space,Str "Equations"] ,Para [Str "Display",Space,Str "equations",Space,Str "are",Space,Str "labelled",Space,Str "and",Space,Str "numbered"] - ,Para [Span ("eq:eqn1",[],[]) [Math DisplayMath " P_i(x) = \\sum_i a_i x^i \\qquad(1)"]] - ,Para [Str "Since",Space,Str "0.1.6.0",Space,Str "those",Space,Str "can",Space,Str "also",Space,Str "appear",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Str "of",Space,Str "paragraph",SoftBreak,Span ("eq:quadr",[],[]) [Math DisplayMath "a x^2 + b x^2 + c = 0\\qquad(2)"],Space,Str "like",Space,Str "this."] - ,Header 1 ("sec:chapter-3.-tables",[],[]) [Str "Chapter",Space,Str "3.",Space,Str "Tables"] + ,Para [Span ("eq:eqn1",[],[]) [Math DisplayMath " P_i(x) = \\sum_i a_i x^i \\qquad(2.1)"]] + ,Para [Str "Since",Space,Str "0.1.6.0",Space,Str "those",Space,Str "can",Space,Str "also",Space,Str "appear",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Str "of",Space,Str "paragraph",SoftBreak,Span ("eq:quadr",[],[]) [Math DisplayMath "a x^2 + b x^2 + c = 0\\qquad(2.2)"],Space,Str "like",Space,Str "this."] + ,Header 1 ("sec:tables",[],[]) [Str "Chapter",Space,Str "3.",Space,Str "Tables"] ,Div ("tbl:table1",[],[]) [Table ("",[],[]) (Caption Nothing - [Plain [Emph [Str "Table",Space,Str "1"],Str ":",Space,Str "Table",Space,Str "example"]]) + [Plain [Str "Table\160\&3.1:",Space,Str "Table",Space,Str "example"]]) [(AlignLeft,ColWidthDefault) ,(AlignLeft,ColWidthDefault)] (TableHead ("",[],[]) @@ -71,44 +86,45 @@ [Plain [Str "Content",Space,Str "Cell"]]]])] (TableFoot ("",[],[]) []) - ,Header 1 ("sec:chapter-4.-code-blocks",[],[]) [Str "Chapter",Space,Str "4.",Space,Str "Code",Space,Str "blocks"] + ,Header 1 ("sec:code-blocks",[],[]) [Str "Chapter",Space,Str "4.",Space,Str "Code",Space,Str "blocks"] ,Para [Str "There",Space,Str "are",Space,Str "a",Space,Str "couple",Space,Str "options",Space,Str "for",Space,Str "code",Space,Str "block",Space,Str "labels.",Space,Str "Those",Space,Str "work",Space,Str "only",Space,Str "if",Space,Str "code",Space,Str "block",Space,Str "id",Space,Str "starts",Space,Str "with",Space,Code ("",[],[]) "lst:",Str ",",Space,Str "e.g.\160",Code ("",[],[]) "{#lst:label}"] - ,Header 2 ("sec:caption-attr",[],[]) [Code ("",[],[]) "caption",Space,Str "attribute"] + ,Header 2 ("sec:caption-attr",[],[]) [Str "Section",Space,Str "4.1.",Space,Code ("",[],[]) "caption",Space,Str "attribute"] ,Para [Code ("",[],[]) "caption",Space,Str "attribute",Space,Str "will",Space,Str "be",Space,Str "treated",Space,Str "as",Space,Str "code",Space,Str "block",Space,Str "caption.",Space,Str "If",Space,Str "code",Space,Str "block",Space,Str "has",Space,Str "both",Space,Str "id",Space,Str "and",Space,Code ("",[],[]) "caption",Space,Str "attributes,",Space,Str "it",Space,Str "will",Space,Str "be",Space,Str "treated",Space,Str "as",Space,Str "numbered",Space,Str "code",Space,Str "block."] - ,Div ("lst:captionAttr",["listing","haskell"],[]) - [Para [Str "Listing",Space,Str "1:",Space,Str "Listing",Space,Str "caption"] + ,Div ("lst:captionAttr",[],[]) + [Para [Str "Listing\160\&4.1.1:",Space,Str "Listing",Space,Str "caption"] ,CodeBlock ("",["haskell"],[]) "main :: IO ()\nmain = putStrLn \"Hello World!\""] ,RawBlock (Format "tex") "\\pagebreak" - ,Header 2 ("sec:table-capts",[],[]) [Str "Table-style",Space,Str "captions"] + ,Header 2 ("sec:table-capts",[],[]) [Str "Section",Space,Str "4.2.",Space,Str "Table-style",Space,Str "captions"] ,Para [Str "Enabled",Space,Str "with",Space,Code ("",[],[]) "codeBlockCaptions",Space,Str "metadata",Space,Str "option.",Space,Str "If",Space,Str "code",Space,Str "block",Space,Str "is",Space,Str "immediately",SoftBreak,Str "adjacent",Space,Str "to",Space,Str "paragraph,",Space,Str "starting",Space,Str "with",Space,Code ("",[],[]) "Listing:",Space,Str "or",Space,Code ("",[],[]) ":",Str ",",Space,Str "said",Space,Str "paragraph",Space,Str "will",Space,Str "be",SoftBreak,Str "treated",Space,Str "as",Space,Str "code",Space,Str "block",Space,Str "caption."] - ,Div ("lst:tableCaption",["listing","haskell"],[]) - [Para [Str "Listing",Space,Str "2:",Space,Str "Listing",Space,Str "caption"] - ,CodeBlock ("",["haskell"],[]) "main :: IO ()\nmain = putStrLn \"Hello World!\""] - ,Header 2 ("sec:wrapping-div",[],[]) [Str "Wrapping",Space,Str "div"] - ,Para [Str "Wrapping",Space,Str "code",Space,Str "block",Space,Str "without",Space,Str "label",Space,Str "in",Space,Str "a",Space,Str "div",Space,Str "with",Space,Str "id",Space,Code ("",[],[]) "lst:...",Space,Str "and",Space,Str "class,",Space,Str "starting",Space,Str "with",Space,Code ("",[],[]) "listing",Str ",",Space,Str "and",Space,Str "adding",Space,Str "paragraph",Space,Str "before",Space,Str "code",Space,Str "block,",Space,Str "but",Space,Str "inside",Space,Str "div,",Space,Str "will",Space,Str "treat",Space,Str "said",Space,Str "paragraph",Space,Str "as",Space,Str "code",Space,Str "block",Space,Str "caption."] - ,Div ("lst:wrappingDiv",["listing","haskell"],[]) - [Para [Str "Listing",Space,Str "3:",Space,Str "Listing",Space,Str "caption"] + ,Div ("lst:tableCaption",[],[]) + [Para [Str "Listing\160\&4.2.1:",Space,Str "Listing",Space,Str "caption"] ,CodeBlock ("",["haskell"],[]) "main :: IO ()\nmain = putStrLn \"Hello World!\""] + ,Header 2 ("sec:wrapping-div",[],[]) [Str "Section",Space,Str "4.3.",Space,Str "Wrapping",Space,Str "div"] + ,Para [Str "Wrapping",Space,Str "code",Space,Str "block",Space,Str "without",Space,Str "label",Space,Str "in",Space,Str "a",Space,Str "div",Space,Str "with",Space,Str "id",Space,Code ("",[],[]) "lst:...",Space,Str "and",Space,Str "class,",Space,Str "starting",Space,Str "with",Space,Code ("",[],[]) "listing",Str ",",Space,Str "and",Space,Str "adding",Space,Str "paragraph",Space,Str "after",Space,Str "code",Space,Str "block,",Space,Str "but",Space,Str "inside",Space,Str "div,",Space,Str "starting",Space,Str "with",Space,Code ("",[],[]) ":",Space,Str "will",Space,Str "treat",Space,Str "said",Space,Str "paragraph",Space,Str "as",Space,Str "code",Space,Str "block",Space,Str "caption."] + ,Div ("lst:wrappingDiv",["listing"],[]) + [Para [Str "Listing\160\&4.3.1:",Space,Str "Listing",Space,Str "caption"] + ,CodeBlock ("",["listing","haskell"],[]) "main :: IO ()\nmain = putStrLn \"Hello World!\""] ,Header 1 ("sec:unnumbered-chapter.",["unnumbered"],[]) [Str "Unnumbered",Space,Str "chapter."] - ,Para [Str "This",Space,Str "chapter",Space,Str "doesn\8217t",Space,Str "change",Space,Str "chapter",Space,Str "prefix",Space,Str "of",Space,Str "referenced",Space,Str "elements,",Space,Str "instead",Space,Str "keeping",Space,Str "number",Space,Str "of",Space,Str "previous",Space,Str "chapter,",Space,Str "e.g.",SoftBreak,Span ("eq:eqn2",[],[]) [Math DisplayMath " S(x) = \\int_{x_1}^{x_2} a x+b \\ \\mathrm{d}x \\qquad(3)"]] - ,Header 1 ("sec:chapter-5.-reference-lists",[],[]) [Str "Chapter",Space,Str "5.",Space,Str "Reference",Space,Str "lists"] + ,Para [Str "This",Space,Str "chapter",Space,Str "doesn\8217t",Space,Str "change",Space,Str "chapter",Space,Str "prefix",Space,Str "of",Space,Str "referenced",Space,Str "elements,",Space,Str "instead",Space,Str "keeping",Space,Str "number",Space,Str "of",Space,Str "previous",Space,Str "chapter,",Space,Str "e.g.",SoftBreak,Span ("eq:eqn2",[],[]) [Math DisplayMath " S(x) = \\int_{x_1}^{x_2} a x+b \\ \\mathrm{d}x \\qquad(1)"]] + ,Header 1 ("sec:reference-lists",[],[]) [Str "Chapter",Space,Str "5.",Space,Str "Reference",Space,Str "lists"] ,Para [Str "It\8217s",Space,Str "also",Space,Str "possible",Space,Str "to",Space,Str "show",Space,Str "lists",Space,Str "of",Space,Str "figures",Space,Str "and",Space,Str "tables,",Space,Str "like",Space,Str "this:"] - ,Header 2 ("list-of-figures",[],[]) [Str "List",Space,Str "of",Space,Str "Figures"] - ,OrderedList (1,DefaultStyle,DefaultDelim) - [[Plain [Str "A",Space,Str "figure"]] - ,[Plain [Str "First",Space,Str "figure"]] - ,[Plain [Str "Second",Space,Str "figure"]] - ,[Plain [Str "Third",Space,Str "figure"]] - ,[Plain [Str "Subfigure",Space,Str "a"]] - ,[Plain [Str "Subfigure",Space,Str "b"]] - ,[Plain [Str "Subfigures",Space,Str "caption"]]] - ,Header 2 ("list-of-tables",[],[]) [Str "List",Space,Str "of",Space,Str "Tables"] - ,OrderedList (1,DefaultStyle,DefaultDelim) - [[Plain [Str "Table",Space,Str "example"]]] + ,Header 1 ("",[],[]) [Str "List",Space,Str "of",Space,Str "Figures"] + ,Div ("",["list"],[]) + [Para [Str "1.",Space,Str "A",Space,Str "figure"] + ,Para [Str "1.1.",Space,Str "First",Space,Str "figure"] + ,Para [Str "1.2.",Space,Str "Second",Space,Str "figure"] + ,Para [Str "1.3.",Space,Str "Third",Space,Str "figure"] + ,Para [Str "1.4.",Space,Str "Unlabelled",Space,Str "image"] + ,Para [Str "1.5.",Space,Str "Subfigures",Space,Str "caption.",Space,Span ("",[],[]) []] + ,Para [Str "1.5(a).",Space,Str "Subfigure",Space,Str "a"] + ,Para [Str "1.5(b).",Space,Str "Subfigure",Space,Str "b"]] + ,Header 1 ("",[],[]) [Str "List",Space,Str "of",Space,Str "Tables"] + ,Div ("",["list"],[]) + [Para [Str "3.1.",Space,Str "Table",Space,Str "example"]] ,Header 1 ("",[],[]) [Str "List",Space,Str "of",Space,Str "Listings"] - ,OrderedList (1,DefaultStyle,DefaultDelim) - [[Plain [Str "Listing",Space,Str "caption"]] - ,[Plain [Str "Listing",Space,Str "caption"]] - ,[Plain [Str "Listing",Space,Str "caption"]]] - ,Header 1 ("sec:appendix-a.-custom-labels",[],[("label","AppA")]) [Str "Appendix",Space,Str "A.",Space,Str "Custom",Space,Str "labels"] - ,Header 2 ("sec:custlabs",[],[("label","CustLab")]) [Str "This",Space,Str "section",Space,Str "will",Space,Str "have",Space,Str "custom",Space,Str "label"]] + ,Div ("",["list"],[]) + [Para [Str "4.1.1.",Space,Str "Listing",Space,Str "caption"] + ,Para [Str "4.2.1.",Space,Str "Listing",Space,Str "caption"] + ,Para [Str "4.3.1.",Space,Str "Listing",Space,Str "caption"]] + ,Header 1 ("sec:custom-labels",[],[("label","A"),("title","Appendix")]) [Str "Appendix",Space,Str "A.",Space,Str "Custom",Space,Str "labels"] + ,Header 2 ("sec:custlabs",[],[("label","I")]) [Str "Section",Space,Str "A.I.",Space,Str "This",Space,Str "section",Space,Str "will",Space,Str "have",Space,Str "custom",Space,Str "label"]] diff --git a/test/m2m/capitalization/expect.md b/test/m2m/capitalization/expect.md new file mode 100644 index 00000000..b223145e --- /dev/null +++ b/test/m2m/capitalization/expect.md @@ -0,0 +1,19 @@ +[$$eqn\qquad(1)$$]{#eq:1} + +![Figure 1: Image](img.png){#fig:1} + +::: {#tbl:1} + a b + --- --- + c d + + : Table 1: Table +::: + +eq. 1, Eq. 1, fig. 1, Fig. 1, tbl. 1, Tbl. 1 + +eq. 1, Eq. 1, fig. 1, Fig. 1, tbl. 1, Tbl. 1 + +eqs. 1, figs. 1, tbls. 1 + +Eqs. 1, Figs. 1, Tbls. 1 diff --git a/test/m2m/capitalization/input.md b/test/m2m/capitalization/input.md new file mode 100644 index 00000000..1ac6ea1a --- /dev/null +++ b/test/m2m/capitalization/input.md @@ -0,0 +1,25 @@ +--- +prefixes: + eq: + ref: + - eq. + - eqs. +--- + +$$eqn$${#eq:1} + +![Image](img.png){#fig:1} + +| a | b | +|:--|:--| +| c | d | + +: Table {#tbl:1} + +@eq:1, @Eq:1, @fig:1, @Fig:1, @tbl:1, @Tbl:1 + +[@eq:1], [@Eq:1], [@fig:1], [@Fig:1], [@tbl:1], [@Tbl:1] + +[@eq:1; @Eq:1; @fig:1; @Fig:1; @tbl:1; @Tbl:1] + +[@Eq:1; @eq:1; @Fig:1; @fig:1; @Tbl:1; @tbl:1] diff --git a/test/m2m/chapDelim/expect.md b/test/m2m/chapDelim/expect.md index 8d4367b3..2445e73b 100644 --- a/test/m2m/chapDelim/expect.md +++ b/test/m2m/chapDelim/expect.md @@ -6,4 +6,4 @@ # 2 Section {#sec:section-1} -### 2delim1delim1 Subsubsection {#sec:subsubsection-1} +### 2delim1 Subsubsection {#sec:subsubsection-1} diff --git a/test/m2m/chapDelim/expect.tex b/test/m2m/chapDelim/expect.tex deleted file mode 100644 index b815448b..00000000 --- a/test/m2m/chapDelim/expect.tex +++ /dev/null @@ -1,14 +0,0 @@ -\hypertarget{sec:section}{% -\section{1 Section}\label{sec:section}} - -\hypertarget{sec:subsection}{% -\subsection{1delim1 Subsection}\label{sec:subsection}} - -\hypertarget{sec:subsubsection}{% -\subsubsection{1delim1delim1 Subsubsection}\label{sec:subsubsection}} - -\hypertarget{sec:section-1}{% -\section{2 Section}\label{sec:section-1}} - -\hypertarget{sec:subsubsection-1}{% -\subsubsection{2delim1delim1 Subsubsection}\label{sec:subsubsection-1}} diff --git a/test/m2m/chapDelim/input.md b/test/m2m/chapDelim/input.md index 6ba1e39b..c6ecbe67 100644 --- a/test/m2m/chapDelim/input.md +++ b/test/m2m/chapDelim/input.md @@ -1,8 +1,8 @@ --- -chapDelim: "delim" -numberSections: true -sectionsDepth: -1 -autoSectionLabels: true +defaultOption: +- numberSections +adjustSectionIdentifiers: true +chapDelim: delim ... # Section diff --git a/test/m2m/custom-prefixes/expect.md b/test/m2m/custom-prefixes/expect.md new file mode 100644 index 00000000..39407cb2 --- /dev/null +++ b/test/m2m/custom-prefixes/expect.md @@ -0,0 +1,11 @@ +::: {#dfn:ring} +A *ring* is a triple $(R,+,*)$ satisfying: + +1. [1: $+$ is an abelian group]{#cl:addgp} +2. [2: $*$ is a monoid]{#cl:multmon} +3. [3: $*$ distributes over $+$]{#cl:distrib} + +Definition 1: +::: + +cl. 1, cl. 3, dfn. 1 diff --git a/test/m2m/custom-prefixes/input.md b/test/m2m/custom-prefixes/input.md new file mode 100644 index 00000000..5d80ab8f --- /dev/null +++ b/test/m2m/custom-prefixes/input.md @@ -0,0 +1,19 @@ +--- +prefixes: + dfn: + ref: ["dfn.", "dfns."] + title: "Definition" + cl: + ref: ["cl.", "cls."] + scope: "dfn" +... + +
+A _ring_ is a triple $(R,+,*)$ satisfying: + +#. [$+$ is an abelian group]{#cl:addgp} +#. [$*$ is a monoid]{#cl:multmon} +#. [$*$ distributes over $+$]{#cl:distrib} +
+ +@cl:addgp, @cl:distrib, @dfn:ring diff --git a/test/m2m/delim/expect.md b/test/m2m/delim/expect.md index 597d23b6..444cb491 100644 --- a/test/m2m/delim/expect.md +++ b/test/m2m/delim/expect.md @@ -34,7 +34,7 @@ Or in groups eqns. 1ref2last4 Groups will be compacted eqns. 1range4 -Unknown references will print labels eqns. **¿eq:none?**ref1ref3last4 +Unknown references will print labels eq. 1, [@eq:none], eqns. 3pair4 Reference prefix will override default prefix Equation 1, eqns. 3pair4 diff --git a/test/m2m/delim/expect.tex b/test/m2m/delim/expect.tex deleted file mode 100644 index 50f9eeb8..00000000 --- a/test/m2m/delim/expect.tex +++ /dev/null @@ -1,51 +0,0 @@ -This is a test file with some referenced equations, line \[ this \] - -Some equations might be inside of text, \[ for example \] this one. - -Some equations might be on start of paragraphs: - -\[ start \] of paragraph. - -Other might be on separate paragraphs of their own: - -\[ separate \] - -Some of those can be labelled: - -This is a test file with some referenced equations, line -\begin{equation}\protect\hypertarget{eq:0}{}{ this }\label{eq:0}\end{equation} - -Some equations might be inside of text, -\begin{equation}\protect\hypertarget{eq:1}{}{ for example }\label{eq:1}\end{equation} -this one. - -Some equations might be on start of paragraphs: - -\begin{equation}\protect\hypertarget{eq:2}{}{ start }\label{eq:2}\end{equation} -of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}\protect\hypertarget{eq:3}{}{ separate }\label{eq:3}\end{equation} - -Then they can be referenced: - -Individually eq.~\ref{eq:0}, eq.~\ref{eq:1}, eq.~\ref{eq:2}, -eq.~\ref{eq:3} - -Or in groups eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3} - -Groups will be compacted -eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3}, \ref{eq:2} - -Unknown references will print labels -eqns.~\ref{eq:0}, \ref{eq:none}, \ref{eq:3}, \ref{eq:2} - -Reference prefix will override default prefix Equation \ref{eq:0}, -eqns.~\ref{eq:3}, \ref{eq:2} - -References with \texttt{-} prepended won't have prefix at all: -\ref{eq:0}, \ref{eq:1}, eqns.~\ref{eq:2}, \ref{eq:3} - -References with suffix will have suffix printed after index -(configurable): eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:2} diff --git a/test/m2m/emptyChapterLabels/expect.md b/test/m2m/emptyChapterLabels/expect.md index 663ab382..aaefd8b0 100644 --- a/test/m2m/emptyChapterLabels/expect.md +++ b/test/m2m/emptyChapterLabels/expect.md @@ -2,13 +2,13 @@ ## 1 Subsection {#sec:subsection label=""} -![Figure 1: Figure1](./image.png){#fig:figure1} +![Figure 1: Figure1](./image.png){#fig:figure1} ### 1.1 Subsubsection {#sec:subsubsection} # 2 Section {#sec:section-1} -### 2.1.1 Subsubsection {#sec:subsubsection-1} +### 2.1 Subsubsection {#sec:subsubsection-1} sec. 1.1 diff --git a/test/m2m/emptyChapterLabels/expect.tex b/test/m2m/emptyChapterLabels/expect.tex deleted file mode 100644 index 1248bcf5..00000000 --- a/test/m2m/emptyChapterLabels/expect.tex +++ /dev/null @@ -1,26 +0,0 @@ -\hypertarget{sec:section}{% -\section{1 Section}\label{sec:section}} - -\hypertarget{sec:subsection}{% -\subsection{1 Subsection}\label{sec:subsection}} - -\begin{figure} -\hypertarget{fig:figure1}{% -\centering -\includegraphics{./image.png} -\caption{Figure1}\label{fig:figure1} -} -\end{figure} - -\hypertarget{sec:subsubsection}{% -\subsubsection{1.1 Subsubsection}\label{sec:subsubsection}} - -\hypertarget{sec:section-1}{% -\section{2 Section}\label{sec:section-1}} - -\hypertarget{sec:subsubsection-1}{% -\subsubsection{2.1.1 Subsubsection}\label{sec:subsubsection-1}} - -sec.~\ref{sec:subsubsection} - -fig.~\ref{fig:figure1} diff --git a/test/m2m/emptyChapterLabels/input.md b/test/m2m/emptyChapterLabels/input.md index dc090c0f..a3cbaa99 100644 --- a/test/m2m/emptyChapterLabels/input.md +++ b/test/m2m/emptyChapterLabels/input.md @@ -1,7 +1,7 @@ --- -numberSections: true -sectionsDepth: -1 -autoSectionLabels: true +defaultOption: +- numberSections +adjustSectionIdentifiers: true ... # Section diff --git a/test/m2m/equations-auto/expect.tex b/test/m2m/equations-auto/expect.tex deleted file mode 100644 index c47f7b33..00000000 --- a/test/m2m/equations-auto/expect.tex +++ /dev/null @@ -1,41 +0,0 @@ -This is a test file with some referenced equations, line -\begin{equation}{ this }\end{equation} - -Some equations might be inside of text, -\begin{equation}{ for example }\end{equation} this one. - -Some equations might be on start of paragraphs: - -\begin{equation}{ start }\end{equation} of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}{ separate }\end{equation} - -Some of those can be labelled: - -This is a test file with some referenced equations, line -\begin{equation}\protect\hypertarget{eq:0}{}{ this }\label{eq:0}\end{equation} - -Some equations might be inside of text, -\begin{equation}\protect\hypertarget{eq:1}{}{ for example }\label{eq:1}\end{equation} -this one. - -Some equations might be on start of paragraphs: - -\begin{equation}\protect\hypertarget{eq:2}{}{ start }\label{eq:2}\end{equation} -of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}\protect\hypertarget{eq:3}{}{ separate }\label{eq:3}\end{equation} - -Then they can be referenced: - -Individually eq.~\ref{eq:0}, eq.~\ref{eq:1}, eq.~\ref{eq:2}, -eq.~\ref{eq:3} - -Or in groups eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3} - -Groups will be compacted -eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3}, \ref{eq:2} diff --git a/test/m2m/equations-auto/input.md b/test/m2m/equations-auto/input.md index dc9cd6e9..302c77ce 100644 --- a/test/m2m/equations-auto/input.md +++ b/test/m2m/equations-auto/input.md @@ -1,5 +1,5 @@ --- -autoEqnLabels: true +autoEqnLabels: eq ... This is a test file with some referenced equations, line $$ this $$ diff --git a/test/m2m/equations-tables-auto/expect.md b/test/m2m/equations-tables-auto/expect.md deleted file mode 100644 index 2144a630..00000000 --- a/test/m2m/equations-tables-auto/expect.md +++ /dev/null @@ -1,97 +0,0 @@ -This is a test file with some referenced equations, line - -
- - --------------------------------------------------------------- --------- - $$ this $$ $$(1)$$ - - --------------------------------------------------------------- --------- - -
- -Some equations might be inside of text, - -
- - --------------------------------------------------------------- --------- - $$ for example $$ $$(2)$$ - - --------------------------------------------------------------- --------- - -
- -this one. - -Some equations might be on start of paragraphs: - -
- - --------------------------------------------------------------- --------- - $$ start $$ $$(3)$$ - - --------------------------------------------------------------- --------- - -
- -of paragraph. - -Other might be on separate paragraphs of their own: - -
- - --------------------------------------------------------------- --------- - $$ separate $$ $$(4)$$ - - --------------------------------------------------------------- --------- - -
- -Some of those can be labelled: - -This is a test file with some referenced equations, line - -::: {#eq:0} - --------------------------------------------------------------- --------- - $$ this $$ $$(5)$$ - - --------------------------------------------------------------- --------- -::: - -Some equations might be inside of text, - -::: {#eq:1} - --------------------------------------------------------------- --------- - $$ for example $$ $$(6)$$ - - --------------------------------------------------------------- --------- -::: - -this one. - -Some equations might be on start of paragraphs: - -::: {#eq:2} - --------------------------------------------------------------- --------- - $$ start $$ $$(7)$$ - - --------------------------------------------------------------- --------- -::: - -of paragraph. - -Other might be on separate paragraphs of their own: - -::: {#eq:3} - --------------------------------------------------------------- --------- - $$ separate $$ $$(8)$$ - - --------------------------------------------------------------- --------- -::: - -Then they can be referenced: - -Individually eq. 5, eq. 6, eq. 7, eq. 8 - -Or in groups eqns. 5, 6, 8 - -Groups will be compacted eqns. 5-8 diff --git a/test/m2m/equations-tables-auto/expect.tex b/test/m2m/equations-tables-auto/expect.tex deleted file mode 100644 index c47f7b33..00000000 --- a/test/m2m/equations-tables-auto/expect.tex +++ /dev/null @@ -1,41 +0,0 @@ -This is a test file with some referenced equations, line -\begin{equation}{ this }\end{equation} - -Some equations might be inside of text, -\begin{equation}{ for example }\end{equation} this one. - -Some equations might be on start of paragraphs: - -\begin{equation}{ start }\end{equation} of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}{ separate }\end{equation} - -Some of those can be labelled: - -This is a test file with some referenced equations, line -\begin{equation}\protect\hypertarget{eq:0}{}{ this }\label{eq:0}\end{equation} - -Some equations might be inside of text, -\begin{equation}\protect\hypertarget{eq:1}{}{ for example }\label{eq:1}\end{equation} -this one. - -Some equations might be on start of paragraphs: - -\begin{equation}\protect\hypertarget{eq:2}{}{ start }\label{eq:2}\end{equation} -of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}\protect\hypertarget{eq:3}{}{ separate }\label{eq:3}\end{equation} - -Then they can be referenced: - -Individually eq.~\ref{eq:0}, eq.~\ref{eq:1}, eq.~\ref{eq:2}, -eq.~\ref{eq:3} - -Or in groups eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3} - -Groups will be compacted -eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3}, \ref{eq:2} diff --git a/test/m2m/equations-tables-auto/input.md b/test/m2m/equations-tables-auto/input.md deleted file mode 100644 index 311526d7..00000000 --- a/test/m2m/equations-tables-auto/input.md +++ /dev/null @@ -1,38 +0,0 @@ ---- -tableEqns: true -autoEqnLabels: true -... - -This is a test file with some referenced equations, line $$ this $$ - -Some equations might be inside of text, $$ for example $$ this one. - -Some equations might be on start of paragraphs: - -$$ start $$ of paragraph. - -Other might be on separate paragraphs of their own: - -$$ separate $$ - -Some of those can be labelled: - -This is a test file with some referenced equations, line $$ this $${#eq:0} - -Some equations might be inside of text, $$ for example $${#eq:1} this one. - -Some equations might be on start of paragraphs: - -$$ start $${#eq:2} of paragraph. - -Other might be on separate paragraphs of their own: - -$$ separate $${#eq:3} - -Then they can be referenced: - -Individually @eq:0, @eq:1, @eq:2, @eq:3 - -Or in groups [@eq:0; @eq:1; @eq:3] - -Groups will be compacted [@eq:0; @eq:1; @eq:3; @eq:2] diff --git a/test/m2m/equations-tables/expect.md b/test/m2m/equations-tables/expect.md deleted file mode 100644 index 16a779ec..00000000 --- a/test/m2m/equations-tables/expect.md +++ /dev/null @@ -1,61 +0,0 @@ -This is a test file with some referenced equations, line $$ this $$ - -Some equations might be inside of text, $$ for example $$ this one. - -Some equations might be on start of paragraphs: - -$$ start $$ of paragraph. - -Other might be on separate paragraphs of their own: - -$$ separate $$ - -Some of those can be labelled: - -This is a test file with some referenced equations, line - -::: {#eq:0} - --------------------------------------------------------------- --------- - $$ this $$ $$(1)$$ - - --------------------------------------------------------------- --------- -::: - -Some equations might be inside of text, - -::: {#eq:1} - --------------------------------------------------------------- --------- - $$ for example $$ $$(2)$$ - - --------------------------------------------------------------- --------- -::: - -this one. - -Some equations might be on start of paragraphs: - -::: {#eq:2} - --------------------------------------------------------------- --------- - $$ start $$ $$(3)$$ - - --------------------------------------------------------------- --------- -::: - -of paragraph. - -Other might be on separate paragraphs of their own: - -::: {#eq:3} - --------------------------------------------------------------- --------- - $$ separate $$ $$(4)$$ - - --------------------------------------------------------------- --------- -::: - -Then they can be referenced: - -Individually eq. 1, eq. 2, eq. 3, eq. 4 - -Or in groups eqns. 1, 2, 4 - -Groups will be compacted eqns. 1-4 diff --git a/test/m2m/equations-tables/expect.tex b/test/m2m/equations-tables/expect.tex deleted file mode 100644 index bd8cc471..00000000 --- a/test/m2m/equations-tables/expect.tex +++ /dev/null @@ -1,39 +0,0 @@ -This is a test file with some referenced equations, line \[ this \] - -Some equations might be inside of text, \[ for example \] this one. - -Some equations might be on start of paragraphs: - -\[ start \] of paragraph. - -Other might be on separate paragraphs of their own: - -\[ separate \] - -Some of those can be labelled: - -This is a test file with some referenced equations, line -\begin{equation}\protect\hypertarget{eq:0}{}{ this }\label{eq:0}\end{equation} - -Some equations might be inside of text, -\begin{equation}\protect\hypertarget{eq:1}{}{ for example }\label{eq:1}\end{equation} -this one. - -Some equations might be on start of paragraphs: - -\begin{equation}\protect\hypertarget{eq:2}{}{ start }\label{eq:2}\end{equation} -of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}\protect\hypertarget{eq:3}{}{ separate }\label{eq:3}\end{equation} - -Then they can be referenced: - -Individually eq.~\ref{eq:0}, eq.~\ref{eq:1}, eq.~\ref{eq:2}, -eq.~\ref{eq:3} - -Or in groups eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3} - -Groups will be compacted -eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3}, \ref{eq:2} diff --git a/test/m2m/equations-tables/input.md b/test/m2m/equations-tables/input.md deleted file mode 100644 index f44b85a2..00000000 --- a/test/m2m/equations-tables/input.md +++ /dev/null @@ -1,37 +0,0 @@ ---- -tableEqns: true -... - -This is a test file with some referenced equations, line $$ this $$ - -Some equations might be inside of text, $$ for example $$ this one. - -Some equations might be on start of paragraphs: - -$$ start $$ of paragraph. - -Other might be on separate paragraphs of their own: - -$$ separate $$ - -Some of those can be labelled: - -This is a test file with some referenced equations, line $$ this $${#eq:0} - -Some equations might be inside of text, $$ for example $${#eq:1} this one. - -Some equations might be on start of paragraphs: - -$$ start $${#eq:2} of paragraph. - -Other might be on separate paragraphs of their own: - -$$ separate $${#eq:3} - -Then they can be referenced: - -Individually @eq:0, @eq:1, @eq:2, @eq:3 - -Or in groups [@eq:0; @eq:1; @eq:3] - -Groups will be compacted [@eq:0; @eq:1; @eq:3; @eq:2] diff --git a/test/m2m/equations/expect.md b/test/m2m/equations/expect.md index 6585dc43..190153d8 100644 --- a/test/m2m/equations/expect.md +++ b/test/m2m/equations/expect.md @@ -34,7 +34,7 @@ Or in groups eqns. 1, 2, 4 Groups will be compacted eqns. 1-4 -Unknown references will print labels eqns. **¿eq:none?**, 1, 3, 4 +Unknown references will print labels eq. 1, [@eq:none], eqns. 3, 4 Reference prefix will override default prefix Equation 1, eqns. 3, 4 diff --git a/test/m2m/equations/expect.tex b/test/m2m/equations/expect.tex deleted file mode 100644 index 50f9eeb8..00000000 --- a/test/m2m/equations/expect.tex +++ /dev/null @@ -1,51 +0,0 @@ -This is a test file with some referenced equations, line \[ this \] - -Some equations might be inside of text, \[ for example \] this one. - -Some equations might be on start of paragraphs: - -\[ start \] of paragraph. - -Other might be on separate paragraphs of their own: - -\[ separate \] - -Some of those can be labelled: - -This is a test file with some referenced equations, line -\begin{equation}\protect\hypertarget{eq:0}{}{ this }\label{eq:0}\end{equation} - -Some equations might be inside of text, -\begin{equation}\protect\hypertarget{eq:1}{}{ for example }\label{eq:1}\end{equation} -this one. - -Some equations might be on start of paragraphs: - -\begin{equation}\protect\hypertarget{eq:2}{}{ start }\label{eq:2}\end{equation} -of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}\protect\hypertarget{eq:3}{}{ separate }\label{eq:3}\end{equation} - -Then they can be referenced: - -Individually eq.~\ref{eq:0}, eq.~\ref{eq:1}, eq.~\ref{eq:2}, -eq.~\ref{eq:3} - -Or in groups eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3} - -Groups will be compacted -eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3}, \ref{eq:2} - -Unknown references will print labels -eqns.~\ref{eq:0}, \ref{eq:none}, \ref{eq:3}, \ref{eq:2} - -Reference prefix will override default prefix Equation \ref{eq:0}, -eqns.~\ref{eq:3}, \ref{eq:2} - -References with \texttt{-} prepended won't have prefix at all: -\ref{eq:0}, \ref{eq:1}, eqns.~\ref{eq:2}, \ref{eq:3} - -References with suffix will have suffix printed after index -(configurable): eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:2} diff --git a/test/m2m/label-precedence/expect.md b/test/m2m/label-precedence/expect.md index f67b628e..b2e85555 100644 --- a/test/m2m/label-precedence/expect.md +++ b/test/m2m/label-precedence/expect.md @@ -2,13 +2,13 @@ text -![Figure α: A figure](image.png){#fig:fig1} +![Figure α: A figure](image.png){#fig:fig1} ## \*.A Subsection {#subsection} other text -![Figure +: A figure with custom label](image.png){#fig:fig2 label="+"} +![Figure +: A figure with custom label](image.png){#fig:fig2 label="+"} ### \*.A.A Subsubsection {#subsubsection} diff --git a/test/m2m/label-precedence/expect.tex b/test/m2m/label-precedence/expect.tex deleted file mode 100644 index aee86c73..00000000 --- a/test/m2m/label-precedence/expect.tex +++ /dev/null @@ -1,30 +0,0 @@ -\hypertarget{first-section}{% -\section{* First Section}\label{first-section}} - -text - -\begin{figure} -\hypertarget{fig:fig1}{% -\centering -\includegraphics{image.png} -\caption{A figure}\label{fig:fig1} -} -\end{figure} - -\hypertarget{subsection}{% -\subsection{*.A Subsection}\label{subsection}} - -other text - -\begin{figure} -\hypertarget{fig:fig2}{% -\centering -\includegraphics{image.png} -\caption{A figure with custom label}\label{fig:fig2} -} -\end{figure} - -\hypertarget{subsubsection}{% -\subsubsection{*.A.A Subsubsection}\label{subsubsection}} - -text text text diff --git a/test/m2m/label-precedence/input.md b/test/m2m/label-precedence/input.md index d292ecf3..2bd140c6 100644 --- a/test/m2m/label-precedence/input.md +++ b/test/m2m/label-precedence/input.md @@ -1,10 +1,14 @@ --- -numberSections: true -sectionsDepth: -1 -secLabels: roman -secLevelLabels: - - alpha A -figLabels: alpha α +defaultOption: + - numberSections +prefixes: + sec: + numbering: roman + captionIndexTemplate: $$s.i%.$$$$ri$$ + sub: + numbering: alpha A + fig: + numbering: alpha α --- # First Section {label="*"} diff --git a/test/m2m/links-names/expect.md b/test/m2m/links-names/expect.md index 5077c43b..88388a0e 100644 --- a/test/m2m/links-names/expect.md +++ b/test/m2m/links-names/expect.md @@ -35,8 +35,8 @@ Or in groups eqns. [1](#eq:0), [2](#eq:1), [4](#eq:3) Groups will be compacted eqns. [1](#eq:0)-[4](#eq:3) -Unknown references will print labels eqns. **¿eq:none?**, [1](#eq:0), -[3](#eq:2), [4](#eq:3) +Unknown references will print labels [eq. 1](#eq:0), [@eq:none], +eqns. [3](#eq:2), [4](#eq:3) Reference prefix will override default prefix [Equation 1](#eq:0), eqns. [3](#eq:2), [4](#eq:3) diff --git a/test/m2m/links-names/expect.tex b/test/m2m/links-names/expect.tex deleted file mode 100644 index 50f9eeb8..00000000 --- a/test/m2m/links-names/expect.tex +++ /dev/null @@ -1,51 +0,0 @@ -This is a test file with some referenced equations, line \[ this \] - -Some equations might be inside of text, \[ for example \] this one. - -Some equations might be on start of paragraphs: - -\[ start \] of paragraph. - -Other might be on separate paragraphs of their own: - -\[ separate \] - -Some of those can be labelled: - -This is a test file with some referenced equations, line -\begin{equation}\protect\hypertarget{eq:0}{}{ this }\label{eq:0}\end{equation} - -Some equations might be inside of text, -\begin{equation}\protect\hypertarget{eq:1}{}{ for example }\label{eq:1}\end{equation} -this one. - -Some equations might be on start of paragraphs: - -\begin{equation}\protect\hypertarget{eq:2}{}{ start }\label{eq:2}\end{equation} -of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}\protect\hypertarget{eq:3}{}{ separate }\label{eq:3}\end{equation} - -Then they can be referenced: - -Individually eq.~\ref{eq:0}, eq.~\ref{eq:1}, eq.~\ref{eq:2}, -eq.~\ref{eq:3} - -Or in groups eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3} - -Groups will be compacted -eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3}, \ref{eq:2} - -Unknown references will print labels -eqns.~\ref{eq:0}, \ref{eq:none}, \ref{eq:3}, \ref{eq:2} - -Reference prefix will override default prefix Equation \ref{eq:0}, -eqns.~\ref{eq:3}, \ref{eq:2} - -References with \texttt{-} prepended won't have prefix at all: -\ref{eq:0}, \ref{eq:1}, eqns.~\ref{eq:2}, \ref{eq:3} - -References with suffix will have suffix printed after index -(configurable): eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:2} diff --git a/test/m2m/links/expect.md b/test/m2m/links/expect.md index fc9b0d1f..fe31332a 100644 --- a/test/m2m/links/expect.md +++ b/test/m2m/links/expect.md @@ -35,8 +35,8 @@ Or in groups eqns. [1](#eq:0), [2](#eq:1), [4](#eq:3) Groups will be compacted eqns. [1](#eq:0)-[4](#eq:3) -Unknown references will print labels eqns. **¿eq:none?**, [1](#eq:0), -[3](#eq:2), [4](#eq:3) +Unknown references will print labels eq. [1](#eq:0), [@eq:none], +eqns. [3](#eq:2), [4](#eq:3) Reference prefix will override default prefix Equation [1](#eq:0), eqns. [3](#eq:2), [4](#eq:3) diff --git a/test/m2m/links/expect.tex b/test/m2m/links/expect.tex deleted file mode 100644 index 50f9eeb8..00000000 --- a/test/m2m/links/expect.tex +++ /dev/null @@ -1,51 +0,0 @@ -This is a test file with some referenced equations, line \[ this \] - -Some equations might be inside of text, \[ for example \] this one. - -Some equations might be on start of paragraphs: - -\[ start \] of paragraph. - -Other might be on separate paragraphs of their own: - -\[ separate \] - -Some of those can be labelled: - -This is a test file with some referenced equations, line -\begin{equation}\protect\hypertarget{eq:0}{}{ this }\label{eq:0}\end{equation} - -Some equations might be inside of text, -\begin{equation}\protect\hypertarget{eq:1}{}{ for example }\label{eq:1}\end{equation} -this one. - -Some equations might be on start of paragraphs: - -\begin{equation}\protect\hypertarget{eq:2}{}{ start }\label{eq:2}\end{equation} -of paragraph. - -Other might be on separate paragraphs of their own: - -\begin{equation}\protect\hypertarget{eq:3}{}{ separate }\label{eq:3}\end{equation} - -Then they can be referenced: - -Individually eq.~\ref{eq:0}, eq.~\ref{eq:1}, eq.~\ref{eq:2}, -eq.~\ref{eq:3} - -Or in groups eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3} - -Groups will be compacted -eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:3}, \ref{eq:2} - -Unknown references will print labels -eqns.~\ref{eq:0}, \ref{eq:none}, \ref{eq:3}, \ref{eq:2} - -Reference prefix will override default prefix Equation \ref{eq:0}, -eqns.~\ref{eq:3}, \ref{eq:2} - -References with \texttt{-} prepended won't have prefix at all: -\ref{eq:0}, \ref{eq:1}, eqns.~\ref{eq:2}, \ref{eq:3} - -References with suffix will have suffix printed after index -(configurable): eqns.~\ref{eq:0}, \ref{eq:1}, \ref{eq:2} diff --git a/test/m2m/list-of/expect.md b/test/m2m/list-of/expect.md new file mode 100644 index 00000000..4597c180 --- /dev/null +++ b/test/m2m/list-of/expect.md @@ -0,0 +1,69 @@ +[$$eqn1\qquad(1)$$]{#eq:1} [$$eqn2\qquad(2)$$]{#eq:2} +[$$eqn3\qquad(3)$$]{#eq:3} + +![Figure 1: Image 1](img.png){#fig:1} + +![Figure 2: Image 2](img.png){#fig:2} + +![Figure 3: Image 3](img.png){#fig:3} + +::: {#tbl:1} + a b + --- --- + c d + + : Table 1: Table 1 +::: + +::: {#tbl:2} + a b + --- --- + c d + + : Table 2: Table 2 +::: + +::: {#tbl:3} + a b + --- --- + c d + + : Table 3: Table 3 +::: + +# List of Figures + +::: {.list} +1\. Image 1 + +2\. Image 2 + +3\. Image 3 +::: + +# List of Equations + +::: {.list} +1\. $$eqn1$$ + +2\. $$eqn2$$ + +3\. $$eqn3$$ +::: + +# List of Tables + +::: {.list} +1\. Table 1 + +2\. Table 2 + +3\. Table 3 +::: + +```{=tex} +\listoffigures +``` +```{=tex} +\listoftables +``` diff --git a/test/m2m/list-of/input.md b/test/m2m/list-of/input.md new file mode 100644 index 00000000..b341d4fc --- /dev/null +++ b/test/m2m/list-of/input.md @@ -0,0 +1,37 @@ +$$eqn1$${#eq:1} +$$eqn2$${#eq:2} +$$eqn3$${#eq:3} + +![Image 1](img.png){#fig:1} + +![Image 2](img.png){#fig:2} + +![Image 3](img.png){#fig:3} + +| a | b | +|:--|:--| +| c | d | + +: Table 1 {#tbl:1} + +| a | b | +|:--|:--| +| c | d | + +: Table 2 {#tbl:2} + +| a | b | +|:--|:--| +| c | d | + +: Table 3 {#tbl:3} + +\listof{fig} + +\listof{eq} + +\listof{tbl} + +\listoffigures + +\listoftables diff --git a/test/m2m/listing-captions-ids/expect.md b/test/m2m/listing-captions-ids/expect.md index fd498753..287a2e6c 100644 --- a/test/m2m/listing-captions-ids/expect.md +++ b/test/m2m/listing-captions-ids/expect.md @@ -1,7 +1,7 @@ After code block -::: {#lst:code1 .listing .haskell} -Listing 1: Listing caption 1 +::: {#lst:code1} +Listing 1: Listing caption 1 ``` {.haskell} main :: IO () @@ -9,8 +9,8 @@ main = putStrLn "Hello World!" ``` ::: -::: {#lst:code2 .listing .haskell} -Listing 2: Listing caption 2 +::: {#lst:code2} +Listing 2: Listing caption 2 ``` {.haskell} main :: IO () @@ -18,8 +18,8 @@ main = putStrLn "Hello World!" ``` ::: -::: {#lst:code3 .listing .haskell} -Listing 3: Listing caption 3 +::: {#lst:code3} +Listing 3: Listing caption 3 ``` {.haskell} main :: IO () @@ -27,8 +27,8 @@ main = putStrLn "Hello World!" ``` ::: -::: {#lst:code4 .listing .haskell} -Listing 4: Listing caption 4 +::: {#lst:code4} +Listing 4: Listing caption 4 ``` {.haskell} main :: IO () @@ -52,8 +52,8 @@ main = putStrLn "Hello World!" Before code block -::: {#lst:code11 .listing .haskell} -Listing 5: Listing caption 11 +::: {#lst:code11} +Listing 5: Listing caption 11 ``` {.haskell} main :: IO () @@ -61,8 +61,8 @@ main = putStrLn "Hello World!" ``` ::: -::: {#lst:code12 .listing .haskell} -Listing 6: Listing caption 12 +::: {#lst:code12} +Listing 6: Listing caption 12 ``` {.haskell} main :: IO () @@ -70,8 +70,8 @@ main = putStrLn "Hello World!" ``` ::: -::: {#lst:code13 .listing .haskell} -Listing 7: Listing caption 13 +::: {#lst:code13} +Listing 7: Listing caption 13 ``` {.haskell} main :: IO () @@ -79,8 +79,8 @@ main = putStrLn "Hello World!" ``` ::: -::: {#lst:code14 .listing .haskell} -Listing 8: Listing caption 14 +::: {#lst:code14} +Listing 8: Listing caption 14 ``` {.haskell} main :: IO () diff --git a/test/m2m/listing-captions-ids/expect.tex b/test/m2m/listing-captions-ids/expect.tex deleted file mode 100644 index dab5aa63..00000000 --- a/test/m2m/listing-captions-ids/expect.tex +++ /dev/null @@ -1,161 +0,0 @@ -After code block - -\begin{codelisting} - -\caption{Listing caption 1} - -\hypertarget{lst:code1}{% -\label{lst:code1}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{codelisting} - -\caption{Listing caption 2} - -\hypertarget{lst:code2}{% -\label{lst:code2}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{codelisting} - -\caption{Listing caption 3} - -\hypertarget{lst:code3}{% -\label{lst:code3}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{codelisting} - -\caption{Listing caption 4} - -\hypertarget{lst:code4}{% -\label{lst:code4}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -: Listing caption 5 (invalid) - -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -: Listing caption 6 (invalid) - -Before code block - -\begin{codelisting} - -\caption{Listing caption 11} - -\hypertarget{lst:code11}{% -\label{lst:code11}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{codelisting} - -\caption{Listing caption 12} - -\hypertarget{lst:code12}{% -\label{lst:code12}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{codelisting} - -\caption{Listing caption 13} - -\hypertarget{lst:code13}{% -\label{lst:code13}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{codelisting} - -\caption{Listing caption 14} - -\hypertarget{lst:code14}{% -\label{lst:code14}}% -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -\end{codelisting} - -\begin{center}\rule{0.5\linewidth}{0.5pt}\end{center} - -: Listing caption 15 (invalid) - -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} - -: Listing caption 16 (invalid) - -\begin{Shaded} -\begin{Highlighting}[] -\OtherTok{main ::} \DataTypeTok{IO}\NormalTok{ ()} -\NormalTok{main }\OtherTok{=} \FunctionTok{putStrLn} \StringTok{"Hello World!"} -\end{Highlighting} -\end{Shaded} diff --git a/test/m2m/listings-code-block-caption-278/expect.md b/test/m2m/listings-code-block-caption-278/expect.md index 21d6f2c0..81d293bc 100644 --- a/test/m2m/listings-code-block-caption-278/expect.md +++ b/test/m2m/listings-code-block-caption-278/expect.md @@ -1,5 +1,5 @@ This is \#278 regression test -::: {#lst:some_listing .listing} -Listing 1: some_listing +::: {#lst:some_listing} +Listing 1: some_listing ::: diff --git a/test/m2m/listings-code-block-caption-278/expect.tex b/test/m2m/listings-code-block-caption-278/expect.tex deleted file mode 100644 index 956e5e5e..00000000 --- a/test/m2m/listings-code-block-caption-278/expect.tex +++ /dev/null @@ -1,4 +0,0 @@ -This is \#278 regression test - -\begin{lstlisting}[caption={some\_listing}, label=lst:some_listing] -\end{lstlisting} diff --git a/test/m2m/multiple-eqn-same-para/expect.tex b/test/m2m/multiple-eqn-same-para/expect.tex deleted file mode 100644 index 7d91119d..00000000 --- a/test/m2m/multiple-eqn-same-para/expect.tex +++ /dev/null @@ -1,5 +0,0 @@ -Simple test -\begin{equation}\protect\hypertarget{eq:1}{}{x=y}\label{eq:1}\end{equation} -\begin{equation}\protect\hypertarget{eq:2}{}{x=y}\label{eq:2}\end{equation} - -eqns.~\ref{eq:1}, \ref{eq:2} diff --git a/test/m2m/numbering-parts/expect.md b/test/m2m/numbering-parts/expect.md new file mode 100644 index 00000000..33412ae6 --- /dev/null +++ b/test/m2m/numbering-parts/expect.md @@ -0,0 +1,27 @@ +# I. First part {#prt:prt1} + +## 1. First chapter {#sec:cha1} + +## 2. Second chapter {#sec:cha2} + +### 2.1. A section {#sec:sec21} + +### 2.2. Another section {#sec:sec22} + +# II. Second part {#prt:prt2} + +## 3. Third chapter {#sec:cha3} + +prt. I; + +chp. 1; + +chp. 2; + +sec. 2.1; + +sec. 2.2; + +prt. II; + +chp. 3; diff --git a/test/m2m/numbering-parts/input.md b/test/m2m/numbering-parts/input.md new file mode 100644 index 00000000..02191d13 --- /dev/null +++ b/test/m2m/numbering-parts/input.md @@ -0,0 +1,45 @@ +--- +prefixes: + prt: + from: sec + title: Part + ref: ["prt.", "prts."] + numbering: roman + sec: + captionTemplate: '$$i$$$$titleDelim$$ $$t$$' # show part/etc numbers + titleDelim: '.' + numbering: arabic + title: Chapter + ref: ["chp.", "chps."] + sub: + # sub-sections can override any settings from parent + # Here we want to have sections scoped to chapters, so + scope: sec + title: Section + ref: ["sec.", "secs."] + # We also want to show parent scope number in reference and title + captionIndexTemplate: '$$s.i$$.$$ri$$' + referenceIndexTemplate: '$$s.i$$.$$ri$$' +... + +# First part {#prt:prt1} +## First chapter {#sec:cha1} +## Second chapter {#sec:cha2} +### A section {#sec:sec21} +### Another section {#sec:sec22} +# Second part {#prt:prt2} +## Third chapter {#sec:cha3} + +@prt:prt1; + +@sec:cha1; + +@sec:cha2; + +@sec:sec21; + +@sec:sec22; + +@prt:prt2; + +@sec:cha3; diff --git a/test/m2m/ref-attrs/expect.md b/test/m2m/ref-attrs/expect.md new file mode 100644 index 00000000..d94e3dd7 --- /dev/null +++ b/test/m2m/ref-attrs/expect.md @@ -0,0 +1,31 @@ +![Test1 1: Image 1](img.png){#fig:1 ref="img." ref="imgs." +title="Test1"} + +![Test2 2: Image 2](img.png){#fig:2 ref="img." ref="imgs." +title="Test2"} + +![Figure 3: Image 3](img.png){#fig:3} + +This should have custom prefix: img. 1 + +This should have custom prefix: img. 2 + +This should have normal prefix: fig. 3 + +This should have custom prefix: imgs. 1, 2 + +This should have custom prefix: imgs. 1-3 + +This should have normal prefix: figs. 1-3 + +This should have custom prefix (capitalized): Img. 1 + +This should have custom prefix (capitalized): Img. 2 + +This should have normal prefix (capitalized): Fig. 3 + +This should have custom prefix (capitalized): Imgs. 1, 2 + +This should have custom prefix (capitalized): Imgs. 1-3 + +This should have normal prefix (capitalized): Figs. 1-3 diff --git a/test/m2m/ref-attrs/input.md b/test/m2m/ref-attrs/input.md new file mode 100644 index 00000000..383aaa50 --- /dev/null +++ b/test/m2m/ref-attrs/input.md @@ -0,0 +1,29 @@ +![Image 1](img.png){#fig:1 ref="img." ref="imgs." title="Test1"} + +![Image 2](img.png){#fig:2 ref="img." ref="imgs." title="Test2"} + +![Image 3](img.png){#fig:3} + +This should have custom prefix: @fig:1 + +This should have custom prefix: @fig:2 + +This should have normal prefix: @fig:3 + +This should have custom prefix: [@fig:1; @fig:2] + +This should have custom prefix: [@fig:1; @fig:2; @fig:3] + +This should have normal prefix: [@fig:3; @fig:1; @fig:2] + +This should have custom prefix (capitalized): @Fig:1 + +This should have custom prefix (capitalized): @Fig:2 + +This should have normal prefix (capitalized): @Fig:3 + +This should have custom prefix (capitalized): [@Fig:1; @Fig:2] + +This should have custom prefix (capitalized): [@Fig:1; @Fig:2; @Fig:3] + +This should have normal prefix (capitalized): [@Fig:3; @Fig:1; @Fig:2] diff --git a/test/m2m/regresssion-219/expect.md b/test/m2m/regresssion-219/expect.md new file mode 100644 index 00000000..cef12d79 --- /dev/null +++ b/test/m2m/regresssion-219/expect.md @@ -0,0 +1,2 @@ +A citation starting with "fig", like @Figueroa2012-tu should not be +interpreted as a reference. diff --git a/test/m2m/regresssion-219/input.md b/test/m2m/regresssion-219/input.md new file mode 100644 index 00000000..cef12d79 --- /dev/null +++ b/test/m2m/regresssion-219/input.md @@ -0,0 +1,2 @@ +A citation starting with "fig", like @Figueroa2012-tu should not be +interpreted as a reference. diff --git a/test/m2m/scoping/expect.md b/test/m2m/scoping/expect.md new file mode 100644 index 00000000..9fa7be83 --- /dev/null +++ b/test/m2m/scoping/expect.md @@ -0,0 +1,44 @@ +# Chapter 1. Section 1 {#sec:1} + +## Section 1.1. Section 1.1 {#sec:11} + +::: {#dfn:group} +A *group* is a pair $(R,*)$ satisfying: + +1. [1: $*$ is a monoid]{#cl:grpmul} + +Definition 1: +::: + +# Chapter 2. Section 2 {#sec:2} + +## Section 2.1. Section 2.1 {#sec:21} + +### Paragraph 2.1.1. Section 2.1.1 {#sec:211} + +### Paragraph 2.1.2. Section 2.1.2 {#sec:212} + +::: {#dfn:ring} +A *ring* is a triple $(R,+,*)$ satisfying: + +1. [1: $+$ is an abelian group]{#cl:addgp} +2. [2: $*$ is a monoid]{#cl:multmon} +3. [3: $*$ distributes over $+$]{#cl:distrib} + +Definition 1: +::: + +# Chapter 3. Section 3 {#section-3} + +- chp. 1 +- sec. 1.1 (chp. 1) +- dfn. 1 (sec. 1.1 (chp. 1)) +- cl. 1 (dfn. 1 (sec. 1.1 (chp. 1))) + +------------------------------------------------------------------------ + +- chp. 2 +- dfn. 1 (par. 2.1.2 (sec. 2.1 (chp. 2))) +- cl. 1 (dfn. 1 (par. 2.1.2 (sec. 2.1 (chp. 2)))) +- Cl. 2 (dfn. 1 (par. 2.1.2 (sec. 2.1 (chp. 2)))) +- Cl. 3 (dfn. 1 (par. 2.1.2 (sec. 2.1 (chp. 2)))) diff --git a/test/m2m/scoping/input.md b/test/m2m/scoping/input.md new file mode 100644 index 00000000..ac6f819e --- /dev/null +++ b/test/m2m/scoping/input.md @@ -0,0 +1,68 @@ +--- +prefixes: + dfn: + ref: ["dfn.", "dfns."] + title: "Definition" + scope: "sec" + referenceIndexTemplate: "$$i$$$$s.ref# (%)$$" + cl: + ref: ["cl.", "cls."] + scope: "dfn" + referenceIndexTemplate: "$$i$$$$s.ref# (%)$$" + sec: + captionTemplate: '$$title% $$$$i$$$$titleDelim$$ $$t$$' + captionIndexTemplate: '$$s.i%.$$$$ri$$' + referenceIndexTemplate: '$$i$$$$s.ref# (%)$$' + scope: sec + titleDelim: '.' + title: Chapter + ref: ["chp.", "chps."] + sub: + title: Section + ref: ["sec.", "secs."] + sub: + title: Paragraph + ref: ["par.", "pars."] +chapters: false +... + +# Section 1 {#sec:1} + +## Section 1.1 {#sec:11} + +
+A _group_ is a pair $(R,*)$ satisfying: + +#. [$*$ is a monoid]{#cl:grpmul} +
+ +# Section 2 {#sec:2} + +## Section 2.1 {#sec:21} + +### Section 2.1.1 {#sec:211} + +### Section 2.1.2 {#sec:212} + +
+A _ring_ is a triple $(R,+,*)$ satisfying: + +#. [$+$ is an abelian group]{#cl:addgp} +#. [$*$ is a monoid]{#cl:multmon} +#. [$*$ distributes over $+$]{#cl:distrib} +
+ +# Section 3 + +- @sec:1 +- @sec:11 +- @dfn:group +- @cl:grpmul + +--- + +- @sec:2 +- @dfn:ring +- @cl:addgp +- @Cl:multmon +- @Cl:distrib diff --git a/test/m2m/secLabels/expect.md b/test/m2m/secLabels/expect.md index 19a6c533..31a7a8eb 100644 --- a/test/m2m/secLabels/expect.md +++ b/test/m2m/secLabels/expect.md @@ -2,7 +2,7 @@ ## a.a Second Level Section {#second-level-section} -![Figure a: my figure](myfig.png){#fig:myfig} +![Figure a: my figure](myfig.png){#fig:myfig} ## a.b Other Second Level Section {#other-second-level-section} @@ -12,5 +12,5 @@ 1 2 3 4 5 6 - : Table I: My table + : Table I: My table ::: diff --git a/test/m2m/secLabels/expect.tex b/test/m2m/secLabels/expect.tex deleted file mode 100644 index 63536043..00000000 --- a/test/m2m/secLabels/expect.tex +++ /dev/null @@ -1,33 +0,0 @@ -\hypertarget{first-level-section}{% -\section{a First Level Section}\label{first-level-section}} - -\hypertarget{second-level-section}{% -\subsection{a.a Second Level Section}\label{second-level-section}} - -\begin{figure} -\hypertarget{fig:myfig}{% -\centering -\includegraphics{myfig.png} -\caption{my figure}\label{fig:myfig} -} -\end{figure} - -\hypertarget{other-second-level-section}{% -\subsection{a.b Other Second Level -Section}\label{other-second-level-section}} - -\hypertarget{tbl:mytable}{} -\begin{longtable}[]{@{}lll@{}} -\caption{\label{tbl:mytable}My table}\tabularnewline -\toprule -a & b & c \\ -\midrule -\endfirsthead -\toprule -a & b & c \\ -\midrule -\endhead -1 & 2 & 3 \\ -4 & 5 & 6 \\ -\bottomrule -\end{longtable} diff --git a/test/m2m/secLabels/input.md b/test/m2m/secLabels/input.md index c7e71ca0..80fd4230 100644 --- a/test/m2m/secLabels/input.md +++ b/test/m2m/secLabels/input.md @@ -1,9 +1,14 @@ --- -numberSections: true -sectionsDepth: -1 -secLabels: alpha a -figLabels: alpha a -tblLabels: roman +defaultOption: + - numberSections +prefixes: + sec: + numbering: alpha a + captionIndexTemplate: $$s.i%.$$$$ri$$ + fig: + numbering: alpha a + tbl: + numbering: roman --- # First Level Section diff --git a/test/m2m/secLevelLabels/expect.md b/test/m2m/secLevelLabels/expect.md index 5b8a7de5..43d3c0ee 100644 --- a/test/m2m/secLevelLabels/expect.md +++ b/test/m2m/secLevelLabels/expect.md @@ -1,11 +1,11 @@ -# A. First Section {#first-section} +# First Section text -## A.1) Subsection {#subsection} +## Subsection other text -### A.1.i Subsubsection {#subsubsection} +### Subsubsection text text text diff --git a/test/m2m/secLevelLabels/expect.tex b/test/m2m/secLevelLabels/expect.tex deleted file mode 100644 index b1ceae12..00000000 --- a/test/m2m/secLevelLabels/expect.tex +++ /dev/null @@ -1,14 +0,0 @@ -\hypertarget{first-section}{% -\section{A. First Section}\label{first-section}} - -text - -\hypertarget{subsection}{% -\subsection{A.1) Subsection}\label{subsection}} - -other text - -\hypertarget{subsubsection}{% -\subsubsection{A.1.i Subsubsection}\label{subsubsection}} - -text text text diff --git a/test/m2m/section-template/expect.tex b/test/m2m/section-template/expect.tex deleted file mode 100644 index 101c9178..00000000 --- a/test/m2m/section-template/expect.tex +++ /dev/null @@ -1,19 +0,0 @@ -\hypertarget{first-level-section}{% -\section{Chapter 1. First Level Section}\label{first-level-section}} - -\hypertarget{second-level-section}{% -\subsection{Section 1.1. Second Level -Section}\label{second-level-section}} - -\hypertarget{thrid-level-section}{% -\subsubsection{Paragraph 1.1.1. Thrid Level -Section}\label{thrid-level-section}} - -\hypertarget{fourth-level-section}{% -\paragraph{1.1.1.1. Fourth Level Section}\label{fourth-level-section}} - -\hypertarget{fifth-level-section}{% -\subparagraph{1.1.1.1.1. Fifth Level -Section}\label{fifth-level-section}} - -1.1.1.1.1.1. Sixth Level Section diff --git a/test/m2m/section-template/input.md b/test/m2m/section-template/input.md index 4a9d6063..2fa390da 100644 --- a/test/m2m/section-template/input.md +++ b/test/m2m/section-template/input.md @@ -1,12 +1,14 @@ --- -secHeaderTemplate: $$secHeaderPrefix[n]$$$$i$$. $$t$$ -secHeaderPrefix: - - "Chapter " - - "Section " - - "Paragraph " - - "" -sectionsDepth: -1 -numberSections: true +prefixes: + sec: + captionTemplate: $$titleName[lvl]$$$$i$$. $$t$$ + captionIndexTemplate: '$$s.i%.$$$$ri$$' + scope: sec + titleName: + - "Chapter " + - "Section " + - "Paragraph " + - "" --- # First Level Section diff --git a/test/m2m/setLabelAttribute/expect.md b/test/m2m/setLabelAttribute/expect.md index 7328b745..21380107 100644 --- a/test/m2m/setLabelAttribute/expect.md +++ b/test/m2m/setLabelAttribute/expect.md @@ -1,23 +1,21 @@ # Section {#section label="1"} -![Figure 1.1: Figure](./image.png){#fig:1 label="1.1"} +![Figure 1.1: Figure](./image.png){#fig:1 label="1"} -[$$equation\qquad(1.1)$$]{#eq:1 label="1.1"} +[$$equation\qquad(1.1)$$]{#eq:1 label="1"} -::: {#tbl:1 label="1.1"} +::: {#tbl:1 label="1"} a b --- --- 1 2 - : Table 1.1: Table + : Table 1.1: Table ::: -::: {#lst:1 .listing} -Listing 1.1: Code Listing +::: {#lst:1 label="1"} +Listing 1.1: Code Listing -``` {label="1.1"} -code -``` + code ::: -## Section {#section-1 label="1.customLabel"} +## Section {#section-1 label="customLabel"} diff --git a/test/m2m/setLabelAttribute/expect.tex b/test/m2m/setLabelAttribute/expect.tex deleted file mode 100644 index a9cff37c..00000000 --- a/test/m2m/setLabelAttribute/expect.tex +++ /dev/null @@ -1,42 +0,0 @@ -\hypertarget{section}{% -\section{Section}\label{section}} - -\begin{figure} -\hypertarget{fig:1}{% -\centering -\includegraphics{./image.png} -\caption{Figure}\label{fig:1} -} -\end{figure} - -\begin{equation}\protect\hypertarget{eq:1}{}{equation}\label{eq:1}\end{equation} - -\hypertarget{tbl:1}{} -\begin{longtable}[]{@{}ll@{}} -\caption{\label{tbl:1}Table}\tabularnewline -\toprule -a & b \\ -\midrule -\endfirsthead -\toprule -a & b \\ -\midrule -\endhead -1 & 2 \\ -\bottomrule -\end{longtable} - -\begin{codelisting} - -\caption{Code Listing} - -\hypertarget{lst:1}{% -\label{lst:1}}% -\begin{verbatim} -code -\end{verbatim} - -\end{codelisting} - -\hypertarget{section-1}{% -\subsection{Section}\label{section-1}} diff --git a/test/m2m/setLabelAttribute/input.md b/test/m2m/setLabelAttribute/input.md index 97bffa32..ad7804c0 100644 --- a/test/m2m/setLabelAttribute/input.md +++ b/test/m2m/setLabelAttribute/input.md @@ -1,7 +1,8 @@ --- +defaultOption: +- chapters setLabelAttribute: true codeBlockCaptions: true -chapters: true ... # Section diff --git a/test/m2m/subfigures-ccsDelim/expect.md b/test/m2m/subfigures-ccsDelim/expect.md index f30cef33..b1844c93 100644 --- a/test/m2m/subfigures-ccsDelim/expect.md +++ b/test/m2m/subfigures-ccsDelim/expect.md @@ -1,20 +1,17 @@ You can define subfigures: -::: {#fig:subfigures .subfigures} -![a](fig1.png "fig:"){#fig:subfig1} ![b](fig2.png "fig:"){#fig:subfig2} -![c](fig3.png "fig:") +::: {#fig:subfigures .subcaption} +![a](fig1.png "fig:"){#fig:subfig1}![b](fig2.png "fig:"){#fig:subfig2}![c](fig3.png "fig:") -![d](fig4.png "fig:"){#fig:subfig4} ![e](fig5.png "fig:") -![f](fig6.png "fig:"){#fig:subfig6} +![d](fig4.png "fig:"){#fig:subfig4}![e](fig5.png "fig:")![f](fig6.png "fig:"){#fig:subfig6} -![g](fig7.png "fig:"){#fig:subfig7} ![h](fig8.png "fig:") -![i](fig9.png "fig:"){#fig:subfig9} +![g](fig7.png "fig:"){#fig:subfig7}![h](fig8.png "fig:")![i](fig9.png "fig:"){#fig:subfig9} -Figure 1: Caption. a --- 1; b --- 2; c --- 3; d --- 4; e --- 5; f --- -6; g --- 7; h --- 8; i --- 9 +Figure 1: Caption. a -- 1; b -- 2; c -- 3; d -- 4; e -- 5; f -- 6; g -- +7; h -- 8; i -- 9 ::: -::: {#fig:subfigures2 .subfigures} +::: {#fig:subfigures2 .subcaption} ![a](fig1.png){#fig:subfig21} ![b](fig2.png){#fig:subfig22} @@ -33,8 +30,8 @@ Figure 1: Caption. a --- 1; b --- 2; c --- 3; d --- 4; e --- 5; f --- ![i](fig9.png){#fig:subfig29} -Figure 2: Caption. a --- 1; b --- 2; c --- 3; d --- 4; e --- 5; f --- -6; g --- 7; h --- 8; i --- 9 +Figure 2: Caption. a -- 1; b -- 2; c -- 3; d -- 4; e -- 5; f -- 6; g -- +7; h -- 8; i -- 9 ::: Figures themselves can be referenced fig. 2, as well as individual diff --git a/test/m2m/subfigures-ccsDelim/expect.tex b/test/m2m/subfigures-ccsDelim/expect.tex deleted file mode 100644 index 9481106e..00000000 --- a/test/m2m/subfigures-ccsDelim/expect.tex +++ /dev/null @@ -1,51 +0,0 @@ -You can define subfigures: - -\begin{pandoccrossrefsubfigures} - -\subfloat[1]{\includegraphics{fig1.png}\label{fig:subfig1}} -\subfloat[2]{\includegraphics{fig2.png}\label{fig:subfig2}} -\subfloat[3]{\includegraphics{fig3.png}} - -\subfloat[4]{\includegraphics{fig4.png}\label{fig:subfig4}} -\subfloat[5]{\includegraphics{fig5.png}} -\subfloat[6]{\includegraphics{fig6.png}\label{fig:subfig6}} - -\subfloat[7]{\includegraphics{fig7.png}\label{fig:subfig7}} -\subfloat[8]{\includegraphics{fig8.png}} -\subfloat[9]{\includegraphics{fig9.png}\label{fig:subfig9}} - -\caption[{Caption}]{Caption} - -\label{fig:subfigures} - -\end{pandoccrossrefsubfigures} - -\begin{pandoccrossrefsubfigures} - -\subfloat[1]{\includegraphics{fig1.png}\label{fig:subfig21}} - -\subfloat[2]{\includegraphics{fig2.png}\label{fig:subfig22}} - -\subfloat[3]{\includegraphics{fig3.png}} - -\subfloat[4]{\includegraphics{fig4.png}\label{fig:subfig24}} - -\subfloat[5]{\includegraphics{fig5.png}} - -\subfloat[6]{\includegraphics{fig6.png}\label{fig:subfig26}} - -\subfloat[7]{\includegraphics{fig7.png}\label{fig:subfig27}} - -\subfloat[8]{\includegraphics{fig8.png}} - -\subfloat[9]{\includegraphics{fig9.png}\label{fig:subfig29}} - -\caption[{Caption}]{Caption} - -\label{fig:subfigures2} - -\end{pandoccrossrefsubfigures} - -Figures themselves can be referenced fig.~\ref{fig:subfigures2}, as well -as individual subfigures: -figs.~\ref{fig:subfig1}, \ref{fig:subfig2}, \ref{fig:subfig29} diff --git a/test/m2m/subfigures-ccsDelim/input.md b/test/m2m/subfigures-ccsDelim/input.md index c57c276f..cb6a4b80 100644 --- a/test/m2m/subfigures-ccsDelim/input.md +++ b/test/m2m/subfigures-ccsDelim/input.md @@ -1,6 +1,16 @@ --- -ccsDelim: "; " -... +autoFigLabels: fig +prefixes: + fig: + subcaptions: true + subcaptionsGrid: false + collectedCaptionDelim: "; " + sub: + numbering: alpha a + referenceIndexTemplate: $$s.i$$ ($$i$$) + captionTemplate: $$i$$ + scope: "fig" +--- You can define subfigures: @@ -17,7 +27,7 @@ You can define subfigures: ![8](fig8.png) ![9](fig9.png){#fig:subfig9} - Caption + : Caption. []{}
@@ -39,7 +49,7 @@ You can define subfigures: ![9](fig9.png){#fig:subfig29} - Caption + \: Caption. []{}
Figures themselves can be referenced @fig:subfigures2, as well as individual subfigures: [@fig:subfig1; @fig:subfig2; @fig:subfig29] diff --git a/test/m2m/subfigures-grid/expect.md b/test/m2m/subfigures-grid/expect.md index a1144029..951bab35 100644 --- a/test/m2m/subfigures-grid/expect.md +++ b/test/m2m/subfigures-grid/expect.md @@ -1,47 +1,95 @@ You can define subfigures: -::: {#fig:subfigures .subfigures} +::: {#fig:subfigures .subcaption} +:------------------:+:------------------:+:------------------:+ +|
|
|
| +| | | | | ![a](fig1 | ![b](fig2 | ![c](fig3. | | .png){#fig:subfig1 | .png){#fig:subfig2 | png){width="100%"} | | width="100%"} | width="100%"} | | +| | |
| +|
|
| | +--------------------+--------------------+--------------------+ +|
|
|
| +| | | | | ![d](fig4 | ![e](fig5. | ![f](fig6 | | .png){#fig:subfig4 | png){width="100%"} | .png){#fig:subfig6 | | width="100%"} | | width="100%"} | +| |
| | +|
| |
| +--------------------+--------------------+--------------------+ +|
|
|
| +| | | | | ![g](fig7 | ![h](fig8. | ![i](fig9 | | .png){#fig:subfig7 | png){width="100%"} | .png){#fig:subfig9 | | width="100%"} | | width="100%"} | +| |
| | +|
| |
| +--------------------+--------------------+--------------------+ -Figure 1: Caption. a --- 1, b --- 2, c --- 3, d --- 4, e --- 5, f --- 6, -g --- 7, h --- 8, i --- 9 +Figure 1: Caption. a -- 1, b -- 2, c -- 3, d -- 4, e -- 5, f -- 6, g -- +7, h -- 8, i -- 9 ::: -::: {#fig:subfigures2 .subfigures} +::: {#fig:subfigures2 .subcaption} +:--------------------------------------------------------------------:+ +|
| +| | | ![a](fig1.png){#fig:subfig21 width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![b](fig2.png){#fig:subfig22 width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![c](fig3.png){width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![d](fig4.png){#fig:subfig24 width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![e](fig5.png){width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![f](fig6.png){#fig:subfig26 width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![g](fig7.png){#fig:subfig27 width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![h](fig8.png){width="100%"} | +| | +|
| +----------------------------------------------------------------------+ +|
| +| | | ![i](fig9.png){#fig:subfig29 width="100%"} | +| | +|
| +----------------------------------------------------------------------+ -Figure 2: Caption. a --- 1, b --- 2, c --- 3, d --- 4, e --- 5, f --- 6, -g --- 7, h --- 8, i --- 9 +Figure 2: Caption. a -- 1, b -- 2, c -- 3, d -- 4, e -- 5, f -- 6, g -- +7, h -- 8, i -- 9 ::: Figures themselves can be referenced fig. 2, as well as individual diff --git a/test/m2m/subfigures-grid/expect.tex b/test/m2m/subfigures-grid/expect.tex deleted file mode 100644 index dab218fe..00000000 --- a/test/m2m/subfigures-grid/expect.tex +++ /dev/null @@ -1,51 +0,0 @@ -You can define subfigures: - -\begin{pandoccrossrefsubfigures} - -\subfloat[1]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig1.png}\label{fig:subfig1}} -\subfloat[2]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig2.png}\label{fig:subfig2}} -\subfloat[3]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig3.png}} - -\subfloat[4]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig4.png}\label{fig:subfig4}} -\subfloat[5]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig5.png}} -\subfloat[6]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig6.png}\label{fig:subfig6}} - -\subfloat[7]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig7.png}\label{fig:subfig7}} -\subfloat[8]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig8.png}} -\subfloat[9]{\includegraphics[width=0.3\textwidth,height=\textheight]{fig9.png}\label{fig:subfig9}} - -\caption[{Caption}]{Caption} - -\label{fig:subfigures} - -\end{pandoccrossrefsubfigures} - -\begin{pandoccrossrefsubfigures} - -\subfloat[1]{\includegraphics{fig1.png}\label{fig:subfig21}} - -\subfloat[2]{\includegraphics{fig2.png}\label{fig:subfig22}} - -\subfloat[3]{\includegraphics{fig3.png}} - -\subfloat[4]{\includegraphics{fig4.png}\label{fig:subfig24}} - -\subfloat[5]{\includegraphics{fig5.png}} - -\subfloat[6]{\includegraphics{fig6.png}\label{fig:subfig26}} - -\subfloat[7]{\includegraphics{fig7.png}\label{fig:subfig27}} - -\subfloat[8]{\includegraphics{fig8.png}} - -\subfloat[9]{\includegraphics{fig9.png}\label{fig:subfig29}} - -\caption[{Caption}]{Caption} - -\label{fig:subfigures2} - -\end{pandoccrossrefsubfigures} - -Figures themselves can be referenced fig.~\ref{fig:subfigures2}, as well -as individual subfigures: -figs.~\ref{fig:subfig1}, \ref{fig:subfig2}, \ref{fig:subfig29} diff --git a/test/m2m/subfigures-grid/input.md b/test/m2m/subfigures-grid/input.md index 09bc9939..21bf5ce1 100644 --- a/test/m2m/subfigures-grid/input.md +++ b/test/m2m/subfigures-grid/input.md @@ -1,6 +1,15 @@ --- -subfigGrid: true -... +autoFigLabels: fig +prefixes: + fig: + subcaptions: true + subcaptionsGrid: true + sub: + numbering: alpha a + referenceIndexTemplate: $$s.i$$ ($$i$$) + captionTemplate: $$i$$ + scope: "fig" +--- You can define subfigures: @@ -17,7 +26,7 @@ You can define subfigures: ![8](fig8.png){width=30%} ![9](fig9.png){#fig:subfig9 width=30%} - Caption + : Caption. []{}
@@ -39,7 +48,7 @@ You can define subfigures: ![9](fig9.png){#fig:subfig29} - Caption + \: Caption. []{}
Figures themselves can be referenced @fig:subfigures2, as well as individual subfigures: [@fig:subfig1; @fig:subfig2; @fig:subfig29] diff --git a/test/m2m/subfigures-template-collect/expect.md b/test/m2m/subfigures-template-collect/expect.md new file mode 100644 index 00000000..ec760644 --- /dev/null +++ b/test/m2m/subfigures-template-collect/expect.md @@ -0,0 +1,38 @@ +You can define subfigures: + +::: {#fig:subfigures .subcaption} +![a](fig1.png "fig:"){#fig:subfig1}![b](fig2.png "fig:"){#fig:subfig2}![c](fig3.png "fig:") + +![d](fig4.png "fig:"){#fig:subfig4}![e](fig5.png "fig:")![f](fig6.png "fig:"){#fig:subfig6} + +![g](fig7.png "fig:"){#fig:subfig7}![h](fig8.png "fig:")![i](fig9.png "fig:"){#fig:subfig9} + +Figure 1: Caption. a -- 1, b -- 2, c -- 3, d -- 4, e -- 5, f -- 6, g -- +7, h -- 8, i -- 9 +::: + +::: {#fig:subfigures2 .subcaption} +![a](fig1.png){#fig:subfig21} + +![b](fig2.png){#fig:subfig22} + +![c](fig3.png) + +![d](fig4.png){#fig:subfig24} + +![e](fig5.png) + +![f](fig6.png){#fig:subfig26} + +![g](fig7.png){#fig:subfig27} + +![h](fig8.png) + +![i](fig9.png){#fig:subfig29} + +Figure 2: Caption. a -- 1, b -- 2, c -- 3, d -- 4, e -- 5, f -- 6, g -- +7, h -- 8, i -- 9 +::: + +Figures themselves can be referenced fig. 2, as well as individual +subfigures: figs. 1 (a), 1 (b), 2 (i) diff --git a/test/m2m/subfigures-template-collect/input.md b/test/m2m/subfigures-template-collect/input.md new file mode 100644 index 00000000..8548675f --- /dev/null +++ b/test/m2m/subfigures-template-collect/input.md @@ -0,0 +1,55 @@ +--- +autoFigLabels: fig +prefixes: + fig: + subcaptions: true + subcaptionsGrid: false + captionTemplate: '$$title% $$$$i$$$$titleDelim$$$$t$$. []{}' + sub: + numbering: alpha a + referenceIndexTemplate: $$s.i$$ ($$i$$) + captionTemplate: $$i$$ + scope: "fig" +--- + +You can define subfigures: + +
+ ![1](fig1.png){#fig:subfig1} + ![2](fig2.png){#fig:subfig2} + ![3](fig3.png) + + ![4](fig4.png){#fig:subfig4} + ![5](fig5.png) + ![6](fig6.png){#fig:subfig6} + + ![7](fig7.png){#fig:subfig7} + ![8](fig8.png) + ![9](fig9.png){#fig:subfig9} + + : Caption +
+ +
+ ![1](fig1.png){#fig:subfig21} + + ![2](fig2.png){#fig:subfig22} + + ![3](fig3.png) + + ![4](fig4.png){#fig:subfig24} + + ![5](fig5.png) + + ![6](fig6.png){#fig:subfig26} + + ![7](fig7.png){#fig:subfig27} + + ![8](fig8.png) + + ![9](fig9.png){#fig:subfig29} + + \: Caption +
+ +Figures themselves can be referenced @fig:subfigures2, as well as individual subfigures: [@fig:subfig1; @fig:subfig2; @fig:subfig29] diff --git a/test/m2m/subfigures/expect.md b/test/m2m/subfigures/expect.md index 70b86f41..ec760644 100644 --- a/test/m2m/subfigures/expect.md +++ b/test/m2m/subfigures/expect.md @@ -1,20 +1,17 @@ You can define subfigures: -::: {#fig:subfigures .subfigures} -![a](fig1.png "fig:"){#fig:subfig1} ![b](fig2.png "fig:"){#fig:subfig2} -![c](fig3.png "fig:") +::: {#fig:subfigures .subcaption} +![a](fig1.png "fig:"){#fig:subfig1}![b](fig2.png "fig:"){#fig:subfig2}![c](fig3.png "fig:") -![d](fig4.png "fig:"){#fig:subfig4} ![e](fig5.png "fig:") -![f](fig6.png "fig:"){#fig:subfig6} +![d](fig4.png "fig:"){#fig:subfig4}![e](fig5.png "fig:")![f](fig6.png "fig:"){#fig:subfig6} -![g](fig7.png "fig:"){#fig:subfig7} ![h](fig8.png "fig:") -![i](fig9.png "fig:"){#fig:subfig9} +![g](fig7.png "fig:"){#fig:subfig7}![h](fig8.png "fig:")![i](fig9.png "fig:"){#fig:subfig9} -Figure 1: Caption. a --- 1, b --- 2, c --- 3, d --- 4, e --- 5, f --- 6, -g --- 7, h --- 8, i --- 9 +Figure 1: Caption. a -- 1, b -- 2, c -- 3, d -- 4, e -- 5, f -- 6, g -- +7, h -- 8, i -- 9 ::: -::: {#fig:subfigures2 .subfigures} +::: {#fig:subfigures2 .subcaption} ![a](fig1.png){#fig:subfig21} ![b](fig2.png){#fig:subfig22} @@ -33,8 +30,8 @@ g --- 7, h --- 8, i --- 9 ![i](fig9.png){#fig:subfig29} -Figure 2: Caption. a --- 1, b --- 2, c --- 3, d --- 4, e --- 5, f --- 6, -g --- 7, h --- 8, i --- 9 +Figure 2: Caption. a -- 1, b -- 2, c -- 3, d -- 4, e -- 5, f -- 6, g -- +7, h -- 8, i -- 9 ::: Figures themselves can be referenced fig. 2, as well as individual diff --git a/test/m2m/subfigures/expect.tex b/test/m2m/subfigures/expect.tex deleted file mode 100644 index 9481106e..00000000 --- a/test/m2m/subfigures/expect.tex +++ /dev/null @@ -1,51 +0,0 @@ -You can define subfigures: - -\begin{pandoccrossrefsubfigures} - -\subfloat[1]{\includegraphics{fig1.png}\label{fig:subfig1}} -\subfloat[2]{\includegraphics{fig2.png}\label{fig:subfig2}} -\subfloat[3]{\includegraphics{fig3.png}} - -\subfloat[4]{\includegraphics{fig4.png}\label{fig:subfig4}} -\subfloat[5]{\includegraphics{fig5.png}} -\subfloat[6]{\includegraphics{fig6.png}\label{fig:subfig6}} - -\subfloat[7]{\includegraphics{fig7.png}\label{fig:subfig7}} -\subfloat[8]{\includegraphics{fig8.png}} -\subfloat[9]{\includegraphics{fig9.png}\label{fig:subfig9}} - -\caption[{Caption}]{Caption} - -\label{fig:subfigures} - -\end{pandoccrossrefsubfigures} - -\begin{pandoccrossrefsubfigures} - -\subfloat[1]{\includegraphics{fig1.png}\label{fig:subfig21}} - -\subfloat[2]{\includegraphics{fig2.png}\label{fig:subfig22}} - -\subfloat[3]{\includegraphics{fig3.png}} - -\subfloat[4]{\includegraphics{fig4.png}\label{fig:subfig24}} - -\subfloat[5]{\includegraphics{fig5.png}} - -\subfloat[6]{\includegraphics{fig6.png}\label{fig:subfig26}} - -\subfloat[7]{\includegraphics{fig7.png}\label{fig:subfig27}} - -\subfloat[8]{\includegraphics{fig8.png}} - -\subfloat[9]{\includegraphics{fig9.png}\label{fig:subfig29}} - -\caption[{Caption}]{Caption} - -\label{fig:subfigures2} - -\end{pandoccrossrefsubfigures} - -Figures themselves can be referenced fig.~\ref{fig:subfigures2}, as well -as individual subfigures: -figs.~\ref{fig:subfig1}, \ref{fig:subfig2}, \ref{fig:subfig29} diff --git a/test/m2m/subfigures/input.md b/test/m2m/subfigures/input.md index 5b59461d..e87a0d64 100644 --- a/test/m2m/subfigures/input.md +++ b/test/m2m/subfigures/input.md @@ -1,3 +1,16 @@ +--- +autoFigLabels: fig +prefixes: + fig: + subcaptions: true + subcaptionsGrid: false + sub: + numbering: alpha a + referenceIndexTemplate: $$s.i$$ ($$i$$) + captionTemplate: $$i$$ + scope: "fig" +--- + You can define subfigures:
@@ -13,7 +26,7 @@ You can define subfigures: ![8](fig8.png) ![9](fig9.png){#fig:subfig9} - Caption + : Caption. []{}
@@ -35,7 +48,7 @@ You can define subfigures: ![9](fig9.png){#fig:subfig29} - Caption + \: Caption. []{}
Figures themselves can be referenced @fig:subfigures2, as well as individual subfigures: [@fig:subfig1; @fig:subfig2; @fig:subfig29] diff --git a/test/m2m/template-objects/expect.md b/test/m2m/template-objects/expect.md new file mode 100644 index 00000000..68160462 --- /dev/null +++ b/test/m2m/template-objects/expect.md @@ -0,0 +1,31 @@ +# Section 1 {#sec:1} + +## Section 1.1 {#sec:11} + +# Section 2 {#sec:2 type="cha"} + +## Section 2.1 {#sec:21} + +### Section 2.1.1 {#sec:211} + +### Section 2.1.2 {#sec:212 type="par"} + +# Section 3 + +# List of Sections + +::: {.list} +1\. Section 1 + +2\. Section 1.1 + +3\. Chapter: Section 2 + +4\. Section 2.1 + +5\. Section 2.1.1 + +6\. Paragraph: Section 2.1.2 + +7\. Section 3 +::: diff --git a/test/m2m/template-objects/input.md b/test/m2m/template-objects/input.md new file mode 100644 index 00000000..6eacc7ac --- /dev/null +++ b/test/m2m/template-objects/input.md @@ -0,0 +1,19 @@ +--- +prefixes: + sec: + listItemTemplate: '$$idx$$$$listItemNumberDelim$$$$sectionType[type]%: $$$$t$$' + sectionType: + cha: "Chapter" + sec: "Section" + par: "Paragraph" +... + +# Section 1 {#sec:1} +## Section 1.1 {#sec:11} +# Section 2 {#sec:2 type="cha"} +## Section 2.1 {#sec:21} +### Section 2.1.1 {#sec:211} +### Section 2.1.2 {#sec:212 type="par"} +# Section 3 + +\listof{sec} diff --git a/test/m2m/template-options/expect.md b/test/m2m/template-options/expect.md new file mode 100644 index 00000000..f366d101 --- /dev/null +++ b/test/m2m/template-options/expect.md @@ -0,0 +1,31 @@ +# Section 1 {#sec:1} + +## Section 1.1 {#sec:11} + +# Section 2 {#sec:2 shortCaption="Sec. 2" shortCaption2="Won't actually show"} + +## Section 2.1 {#sec:21} + +### Section 2.1.1 {#sec:211} + +### Section 2.1.2 {#sec:212 shortCaption2="Sec. 2.1.2"} + +# Section 3 + +# List of Sections + +::: {.list} +1\. Section 1 + +2\. Section 1.1 + +3\. Sec. 2 + +4\. Section 2.1 + +5\. Section 2.1.1 + +6\. Sec. 2.1.2 + +7\. Section 3 +::: diff --git a/test/m2m/template-options/input.md b/test/m2m/template-options/input.md new file mode 100644 index 00000000..a5dcac21 --- /dev/null +++ b/test/m2m/template-options/input.md @@ -0,0 +1,15 @@ +--- +prefixes: + sec: + listItemTemplate: '$$idx$$$$listItemNumberDelim$$$$shortCaption?shortCaption2?t$$' +... + +# Section 1 {#sec:1} +## Section 1.1 {#sec:11} +# Section 2 {#sec:2 shortCaption="Sec. 2" shortCaption2="Won't actually show"} +## Section 2.1 {#sec:21} +### Section 2.1.1 {#sec:211} +### Section 2.1.2 {#sec:212 shortCaption2="Sec. 2.1.2"} +# Section 3 + +\listof{sec} diff --git a/test/m2m/undefined-prefix/expect.md b/test/m2m/undefined-prefix/expect.md new file mode 100644 index 00000000..e2b890f3 --- /dev/null +++ b/test/m2m/undefined-prefix/expect.md @@ -0,0 +1,2 @@ +Crossref shouldn't error out when it sees something that looks like a +reference, but with unknown prefix, like [@nonexistent:ref] diff --git a/test/m2m/undefined-prefix/input.md b/test/m2m/undefined-prefix/input.md new file mode 100644 index 00000000..3e837f65 --- /dev/null +++ b/test/m2m/undefined-prefix/input.md @@ -0,0 +1,2 @@ +Crossref shouldn't error out when it sees something that looks like +a reference, but with unknown prefix, like [@nonexistent:ref] diff --git a/test/test-integrative.hs b/test/test-integrative.hs index 9331d31d..e955c1a6 100644 --- a/test/test-integrative.hs +++ b/test/test-integrative.hs @@ -45,17 +45,10 @@ m2m dir , writerHighlightStyle=Just pygments , writerListings = dir `elem` listingsDirs } p@(Pandoc meta _) <- runIO $ either (error . show) id <$> P.runIO (readMarkdown ro $ T.pack input) - let actual_md = either (fail . show) T.unpack $ runPure $ writeMarkdown wo $ runCrossRef meta (Just $ Format "markdown") defaultCrossRefAction p + let actual_md = either (fail . show) T.unpack $ runPure $ writeMarkdown wo . evalCrossRefRes . runCrossRef (Settings meta) (Just $ Format "markdown") $ defaultCrossRefAction p it "Markdown" $ do zipWithM_ shouldBe (lines' actual_md) (lines' expect_md) length' (lines' actual_md) `shouldBe` length' (lines' expect_md) -#ifdef FLAKY - expect_tex <- runIO $ readFile ("test" "m2m" dir "expect.tex") - let actual_tex = either (fail . show) T.unpack $ runPure $ writeLaTeX wo $ runCrossRef meta (Just $ Format "latex") defaultCrossRefAction p - it "LaTeX" $ do - zipWithM_ shouldBe (lines' actual_tex) (lines' expect_tex) - length' (lines' actual_tex) `shouldBe` length' (lines' expect_tex) -#endif where lines' = zip [(1 :: Int)..] . lines length' = length . filter (not . null . snd) @@ -78,3 +71,6 @@ flaky = [ "equations-tables" , "subfigures-grid" ] #endif + +evalCrossRefRes :: Show a => (Either a c, b) -> c +evalCrossRefRes = either (error . show) id . fst diff --git a/test/test-pandoc-crossref.hs b/test/test-pandoc-crossref.hs index 109ce28e..ea1f4387 100644 --- a/test/test-pandoc-crossref.hs +++ b/test/test-pandoc-crossref.hs @@ -18,30 +18,36 @@ with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} -{-# LANGUAGE FlexibleContexts, CPP, OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleContexts, CPP, OverloadedStrings + , FlexibleInstances, StandaloneDeriving #-} import Test.Hspec -import Text.Pandoc hiding (getDataFileName) +import Text.Pandoc hiding (getDataFileName, Template) import Text.Pandoc.Builder import Control.Monad.State import Data.List +import Data.Maybe import Control.Arrow import qualified Data.Map as M -import qualified Data.Text as T -import qualified Data.Default as Df import Text.Pandoc.CrossRef import Text.Pandoc.CrossRef.Util.Options +import Text.Pandoc.CrossRef.Util.Prefixes import Text.Pandoc.CrossRef.Util.Util import Text.Pandoc.CrossRef.References.Types +import Text.Pandoc.CrossRef.Util.Template.Types import Data.Accessor hiding ((=:)) import qualified Text.Pandoc.CrossRef.References.Blocks as References.Blocks import qualified Text.Pandoc.CrossRef.References.Refs as References.Refs import qualified Text.Pandoc.CrossRef.References.List as References.List import qualified Text.Pandoc.CrossRef.Util.Template as Util.Template import qualified Text.Pandoc.CrossRef.Util.CodeBlockCaptions as Util.CodeBlockCaptions +import qualified Data.Text as T +#ifdef FLAKY import qualified Native import Paths_pandoc_crossref +#endif import Prelude @@ -49,35 +55,43 @@ main :: IO () main = hspec $ do describe "References.Blocks.replaceInlines" $ do it "Labels equations" $ - testAll (equation' "a^2+b^2=c^2" "equation") - (spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" ""), - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + testAll (plain $ equation' "a^2+b^2=c^2" "equation") + (plain $ spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" ""), + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels equations in the middle of text" $ - testAll ( + testAll (plain $ text "This is an equation: " <> equation' "a^2+b^2=c^2" "equation" <> text " it should be labeled") - ( + (plain $ text "This is an equation: " <> spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" "") <> text " it should be labeled", - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels equations in the beginning of text" $ - testAll ( + testAll (plain $ equation' "a^2+b^2=c^2" "equation" <> text " it should be labeled") - ( + (plain $ spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" "") <> text " it should be labeled", - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels equations in the end of text" $ - testAll ( + testAll (plain $ text "This is an equation: " <> equation' "a^2+b^2=c^2" "equation") - ( + (plain $ text "This is an equation: " <> spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" ""), - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) -- TODO: -- describe "References.Blocks.spanInlines" @@ -86,62 +100,81 @@ main = hspec $ do describe "References.Blocks.replaceBlocks" $ do it "Labels images" $ testAll (figure "test.jpg" "" "Test figure" "figure") - (figure "test.jpg" "" "Figure 1: Test figure" "figure", - imgRefs =: M.fromList $ refRec' "fig:figure" 1 "Test figure") - it "Labels subfigures" $ - testAll ( - divWith ("fig:subfigure",[],[]) ( - para (figure' "fig:" "test1.jpg" "" "Test figure 1" "figure1") - <>para (figure' "fig:" "test2.jpg" "" "Test figure 2" "figure2") - <>para (text "figure caption") - ) <> - divWith ("fig:subfigure2",[],[]) ( - para (figure' "fig:" "test21.jpg" "" "Test figure 21" "figure21") - <>para (figure' "fig:" "test22.jpg" "" "Test figure 22" "figure22") - <>para (text "figure caption 2") - ) + (figure "test.jpg" "" "Figure\160\&1: Test figure" "figure", + (referenceData =: M.fromList [refRec' "fig:figure" 1 "Test figure" "Figure 1: Test figure"]) . + (pfxCounter =: M.singleton "fig" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) ) - ( - divWith ("fig:subfigure",["subfigures"],[]) ( - para (figure' "fig:" "test1.jpg" "" "a" "figure1") - <> para (figure' "fig:" "test2.jpg" "" "b" "figure2") - <> para (text "Figure 1: figure caption. a — Test figure 1, b — Test figure 2") - ) <> - divWith ("fig:subfigure2",["subfigures"],[]) ( - para (figure' "fig:" "test21.jpg" "" "a" "figure21") - <> para (figure' "fig:" "test22.jpg" "" "b" "figure22") - <> para (text "Figure 2: figure caption 2. a — Test figure 21, b — Test figure 22") - ) - , imgRefs =: M.fromList [("fig:figure1",RefRec { - refIndex = [(1,Nothing)], - refTitle = [Str "Test",Space,Str "figure",Space,Str "1"], - refSubfigure = Just [(1, Just "a")]}), - ("fig:figure2",RefRec { - refIndex = [(1,Nothing)], - refTitle = [Str "Test",Space,Str "figure",Space,Str "2"], - refSubfigure = Just [(2, Just "b")]}), - ("fig:subfigure",RefRec { - refIndex = [(1,Nothing)], - refTitle = [Str "figure",Space,Str "caption"], - refSubfigure = Nothing}), - ("fig:figure21",RefRec { - refIndex = [(2,Nothing)], - refTitle = [Str "Test",Space,Str "figure",Space,Str "21"], - refSubfigure = Just [(1, Just "a")]}), - ("fig:figure22",RefRec { - refIndex = [(2,Nothing)], - refTitle = [Str "Test",Space,Str "figure",Space,Str "22"], - refSubfigure = Just [(2, Just "b")]}), - ("fig:subfigure2",RefRec { - refIndex = [(2,Nothing)], - refTitle = [Str "figure",Space,Str "caption",Space,Str "2"], - refSubfigure = Nothing}) - ] - ) + -- it "Labels subfigures" $ + -- testAll ( + -- divWith ("fig:subfigure",[],[]) ( + -- para (figure' "fig:" "test1.jpg" [] "Test figure 1" "figure1") + -- <>para (figure' "fig:" "test2.jpg" [] "Test figure 2" "figure2") + -- <>para (text "figure caption") + -- ) <> + -- divWith ("fig:subfigure2",[],[]) ( + -- para (figure' "fig:" "test21.jpg" [] "Test figure 21" "figure21") + -- <>para (figure' "fig:" "test22.jpg" [] "Test figure 22" "figure22") + -- <>para (text "figure caption 2") + -- ) + -- ) + -- ( + -- divWith ("fig:subfigure",["subfigures"],[]) ( + -- para (figure' "fig:" "test1.jpg" [] "a" "figure1") + -- <> para (figure' "fig:" "test2.jpg" [] "b" "figure2") + -- <> para (text "Figure 1: figure caption. a — Test figure 1, b — Test figure 2") + -- ) <> + -- divWith ("fig:subfigure2",["subfigures"],[]) ( + -- para (figure' "fig:" "test21.jpg" [] "a" "figure21") + -- <> para (figure' "fig:" "test22.jpg" [] "b" "figure22") + -- <> para (text "Figure 2: figure caption 2. a — Test figure 21, b — Test figure 22") + -- ) + -- , (referenceData =: M.fromList [("fig:figure1",RefRec { + -- refIndex = [(1,"1")], + -- refTitle = fromList [Str "Test",Space,Str "figure",Space,Str "1"], + -- refScope = Nothing, + -- refLabel = "fig:figure1", + -- refSubfigure = Just [(1, "a")]}), + -- ("fig:figure2",RefRec { + -- refIndex = [(1,"1")], + -- refTitle = fromList [Str "Test",Space,Str "figure",Space,Str "2"], + -- refScope = Nothing, + -- refLabel = "fig:figure2", + -- refSubfigure = Just [(2, "b")]}), + -- ("fig:subfigure",RefRec { + -- refIndex = [(1,"1")], + -- refTitle = fromList [Str "figure",Space,Str "caption"], + -- refScope = Nothing, + -- refLabel = "fig:subfigure", + -- refSubfigure = Nothing}), + -- ("fig:figure21",RefRec { + -- refIndex = [(2,"2")], + -- refTitle = fromList [Str "Test",Space,Str "figure",Space,Str "21"], + -- refScope = Nothing, + -- refLabel = "fig:figure21", + -- refSubfigure = Just [(1, "a")]}), + -- ("fig:figure22",RefRec { + -- refIndex = [(2,"2")], + -- refTitle = fromList [Str "Test",Space,Str "figure",Space,Str "22"], + -- refScope = Nothing, + -- refLabel = "fig:figure22", + -- refSubfigure = Just [(2, "b")]}), + -- ("fig:subfigure2",RefRec { + -- refIndex = [(2,"2")], + -- refTitle = fromList [Str "figure",Space,Str "caption",Space,Str "2"], + -- refScope = Nothing, + -- refLabel = "fig:subfigure2", + -- refSubfigure = Nothing}) + -- ] + -- ) . + -- (pfxCounter =: M.singleton "fig" 2) . + -- (curChap =: M.singleton "fig" "fig:subfigure2") + -- ) it "Labels equations" $ testAll (equation "a^2+b^2=c^2" "equation") (para $ spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" ""), - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels equations in the middle of text" $ testAll (para $ text "This is an equation: " @@ -151,7 +184,9 @@ main = hspec $ do text "This is an equation: " <> spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" "") <> text " it should be labeled", - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels equations in the beginning of text" $ testAll (para $ equation' "a^2+b^2=c^2" "equation" @@ -159,7 +194,9 @@ main = hspec $ do (para $ spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" "") <> text " it should be labeled", - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels equations in the end of text" $ testAll (para $ text "This is an equation: " @@ -167,84 +204,100 @@ main = hspec $ do (para $ text "This is an equation: " <> spanWith ("eq:equation", [], []) (equation' "a^2+b^2=c^2\\qquad(1)" ""), - eqnRefs =: M.fromList $ refRec'' "eq:equation" 1) + (referenceData =: M.fromList [refRec' "eq:equation" 1 (math "a^2+b^2=c^2") "1"]) . + (pfxCounter =: M.singleton "eq" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels tables" $ testAll (table' "Test table" "table") - (divWith ("tbl:table", [], []) $ table' "Table 1: Test table" "", - tblRefs =: M.fromList $ refRec' "tbl:table" 1 "Test table") + (divWith ("tbl:table", [], []) $ table' "Table\160\&1: Test table" "", + (referenceData =: M.fromList [refRec' "tbl:table" 1 "Test table" "Table 1: Test table"]) . + (pfxCounter =: M.singleton "tbl" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels code blocks" $ testAll (codeBlock' "Test code block" "codeblock") - (codeBlockDiv "Listing 1: Test code block" "codeblock", - lstRefs =: M.fromList $ refRec' "lst:codeblock" 1 "Test code block") + (codeBlockDiv' "Listing\160\&1: Test code block" "codeblock", + (referenceData =: M.fromList [refRec' "lst:codeblock" 1 "Test code block" "Listing\160\&1: Test code block"]) . + (pfxCounter =: M.singleton "lst" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels code block divs" $ testAll (codeBlockDiv "Test code block" "codeblock") - (codeBlockDiv "Listing 1: Test code block" "codeblock", - lstRefs =: M.fromList $ refRec' "lst:codeblock" 1 "Test code block") + (codeBlockDiv' "Listing\160\&1: Test code block" "codeblock", + (referenceData =: M.fromList [refRec' "lst:codeblock" 1 "Test code block" "Listing\160\&1: Test code block"]) . + (pfxCounter =: M.singleton "lst" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) it "Labels sections divs" $ testAll (section "Section Header" 1 "section") (section "Section Header" 1 "section", - secRefs ^= M.fromList (refRec' "sec:section" 1 "Section Header") - $ curChap =: [(1,Nothing)]) + (referenceData ^= M.fromList [refRec' "sec:section" 1 "Section Header" ""]) + . (pfxCounter =: M.singleton "sec" $ CounterRec {crIndex = 1, crIndexInScope = M.singleton Nothing 1}) + ) describe "References.Refs.replaceRefs" $ do it "References one image" $ - testRefs' "fig:" [1] [4] imgRefs "fig.\160\&4" + testRefs' "fig:" [1] [4] referenceData "fig.\160\&4" it "References multiple images" $ - testRefs' "fig:" [1..3] [4..6] imgRefs "figs.\160\&4-6" + testRefs' "fig:" [1..3] [4..6] referenceData "figs.\160\&4-6" it "References one equation" $ - testRefs' "eq:" [1] [4] eqnRefs "eq.\160\&4" + testRefs' "eq:" [1] [4] referenceData "eq.\160\&4" it "References multiple equations" $ - testRefs' "eq:" [1..3] [4..6] eqnRefs "eqns.\160\&4-6" + testRefs' "eq:" [1..3] [4..6] referenceData "eqns.\160\&4-6" it "References one table" $ - testRefs' "tbl:" [1] [4] tblRefs "tbl.\160\&4" + testRefs' "tbl:" [1] [4] referenceData "tbl.\160\&4" it "References multiple tables" $ - testRefs' "tbl:" [1..3] [4..6] tblRefs "tbls.\160\&4-6" + testRefs' "tbl:" [1..3] [4..6] referenceData "tbls.\160\&4-6" it "References one listing" $ - testRefs' "lst:" [1] [4] lstRefs "lst.\160\&4" + testRefs' "lst:" [1] [4] referenceData "lst.\160\&4" it "References multiple listings" $ - testRefs' "lst:" [1..3] [4..6] lstRefs "lsts.\160\&4-6" + testRefs' "lst:" [1..3] [4..6] referenceData "lsts.\160\&4-6" it "References one section" $ - testRefs' "sec:" [1] [4] secRefs "sec.\160\&4" + testRefs' "sec:" [1] [4] referenceData "sec.\160\&4" it "References multiple sections" $ - testRefs' "sec:" [1..3] [4..6] secRefs "secs.\160\&4-6" + testRefs' "sec:" [1..3] [4..6] referenceData "secs.\160\&4-6" it "Separates references to different chapter items by a comma" $ - testRefs'' "lst:" [1..6] (zip [1,1..] [4..6] <> zip [2,2..] [7..9]) lstRefs "lsts.\160\&1.4-1.6, 2.7-2.9" + let p = "lst:" + cites = citeGen p [1..6] + chap1 = snd $ refRec' "sec:1" 1 "Section 1" "Section 1" + chap2 = snd $ refRec' "sec:2" 2 "Section 2" "Section 2" + refs1 = M.map (\r -> r{refScope = Just chap1}) $ refGen p [1..3] [4..6] + refs2 = M.map (\r -> r{refScope = Just chap2}) $ refGen p [4..6] [7..9] + res = "lsts.\160\&4-6, 7-9" + in testRefs (para cites) (setVal referenceData (refs1 <> refs2) def) (para $ text res) describe "References.Refs.replaceRefs capitalization" $ do it "References one image" $ - testRefs' "Fig:" [1] [4] imgRefs "Fig.\160\&4" + testRefs' "Fig:" [1] [4] referenceData "Fig.\160\&4" it "References multiple images" $ - testRefs' "Fig:" [1..3] [4..6] imgRefs "Figs.\160\&4-6" + testRefs' "Fig:" [1..3] [4..6] referenceData "Figs.\160\&4-6" it "References one equation" $ - testRefs' "Eq:" [1] [4] eqnRefs "Eq.\160\&4" + testRefs' "Eq:" [1] [4] referenceData "Eq.\160\&4" it "References multiple equations" $ - testRefs' "Eq:" [1..3] [4..6] eqnRefs "Eqns.\160\&4-6" + testRefs' "Eq:" [1..3] [4..6] referenceData "Eqns.\160\&4-6" it "References one table" $ - testRefs' "Tbl:" [1] [4] tblRefs "Tbl.\160\&4" + testRefs' "Tbl:" [1] [4] referenceData "Tbl.\160\&4" it "References multiple tables" $ - testRefs' "Tbl:" [1..3] [4..6] tblRefs "Tbls.\160\&4-6" + testRefs' "Tbl:" [1..3] [4..6] referenceData "Tbls.\160\&4-6" it "References one listing" $ - testRefs' "Lst:" [1] [4] lstRefs "Lst.\160\&4" + testRefs' "Lst:" [1] [4] referenceData "Lst.\160\&4" it "References multiple listings" $ - testRefs' "Lst:" [1..3] [4..6] lstRefs "Lsts.\160\&4-6" + testRefs' "Lst:" [1..3] [4..6] referenceData "Lsts.\160\&4-6" it "References one listing" $ - testRefs' "Sec:" [1] [4] secRefs "Sec.\160\&4" + testRefs' "Sec:" [1] [4] referenceData "Sec.\160\&4" it "References multiple listings" $ - testRefs' "Sec:" [1..3] [4..6] secRefs "Secs.\160\&4-6" + testRefs' "Sec:" [1..3] [4..6] referenceData "Secs.\160\&4-6" describe "References.List.listOf" $ do it "Generates list of tables" $ - testList (rawBlock "latex" "\\listoftables") - (tblRefs =: M.fromList $ refRec' "tbl:1" 4 "4" <> refRec' "tbl:2" 5 "5" <> refRec' "tbl:3" 6 "6") - (header 1 (text "List of Tables") <> orderedList ((plain . str . T.pack . show) `map` [4..6 :: Int])) + testList (rawBlock "latex" "\\listof{tbl}") + (referenceData =: M.fromList [let l = "tbl:" <> T.pack (show i); n = i + 3; sn = str . T.pack $ show n in refRec' l n sn ("Table " <> sn <> ": " <> sn) | i <- [1..3]]) + (header 1 (text "List of Tables") <> divWith ("",["list"],[]) (mconcat $ map (\i -> let n = T.pack (show i) in para $ text (n <> ". " <> n) ) [4..6 :: Int])) it "Generates list of figures" $ - testList (rawBlock "latex" "\\listoffigures") - (imgRefs =: M.fromList $ refRec' "fig:1" 4 "4" <> refRec' "fig:2" 5 "5" <> refRec' "fig:3" 6 "6") - (header 1 (text "List of Figures") <> orderedList ((plain . str . T.pack . show) `map` [4..6 :: Int])) + testList (rawBlock "latex" "\\listof{fig}") + (referenceData =: M.fromList [let l = "fig:" <> T.pack (show i); n = i + 3; sn = str . T.pack $ show n in refRec' l n sn ("Figure " <> sn <> ": " <> sn) | i <- [1..3]]) + (header 1 (text "List of Figures") <> divWith ("",["list"],[]) (mconcat $ map (\i -> let n = T.pack (show i) in para $ text (n <> ". " <> n) ) [4..6 :: Int])) describe "Util.CodeBlockCaptions" $ it "Transforms table-style codeBlock captions to codeblock divs" $ do - let t x = testCBCaptions x (codeBlockDiv' "Code Block" "cb") + let t x = testCBCaptions x (codeBlockDiv "Code Block" "cb") t (codeBlockForTable "cb" <> paraText ": Code Block") t (codeBlockForTable "cb" <> paraText "Listing: Code Block") t (paraText ": Code Block" <> codeBlockForTable "cb") @@ -252,9 +305,14 @@ main = hspec $ do describe "Util.Template" $ it "Applies templates" $ - let template=Util.Template.makeTemplate defaultMeta (toList $ displayMath "figureTitle" <> displayMath "i" <> displayMath "t") - in Util.Template.applyTemplate [Str "1"] [Str "title"] template `shouldBe` - toList (str "Figure" <> str "1" <> str "title") + let template=Util.Template.makeTemplate + (displayMath "figureTitle" <> displayMath "i" <> displayMath "t") + vf "i" = Just $ MetaInlines $ toList $ text "1" + vf "t" = Just $ MetaInlines $ toList $ text "title" + vf "figureTitle" = Just $ toMetaValue $ text "Figure" + vf _ = Nothing + in Util.Template.applyTemplate template vf `shouldBe` + (str "Figure" <> str "1" <> str "title") describe "Citation groups shouldn't be separated (#22 regression test)" $ do it "Should not separate citation groups" $ do @@ -277,99 +335,76 @@ main = hspec $ do it "demo.md matches demo.native" $ do demomd <- readFile =<< getDataFileName "docs/demo/demo.md" Pandoc m b <- handleError $ runPure $ readMarkdown def {readerExtensions = pandocExtensions} $ T.pack demomd - runCrossRef m Nothing crossRefBlocks b `shouldBe` Native.demo - - it "demo.md with chapters matches demo-chapters.native" $ do - demomd <- readFile =<< getDataFileName "docs/demo/demo.md" - Pandoc m b <- handleError $ runPure $ readMarkdown def {readerExtensions = pandocExtensions} $ T.pack demomd - let m' = setMeta "chapters" True m - runCrossRef m' Nothing crossRefBlocks b `shouldBe` Native.demochapters -#endif - - describe "LaTeX" $ do - let test = test' nullMeta - infixr 5 `test` - test' m i o = getLatex m i `shouldBe` o - getLatex m i = either (fail . show) T.unpack (runPure $ writeLaTeX def (Pandoc m $ runCrossRef m (Just $ Format "latex") crossRefBlocks (toList i))) - - describe "Labels" $ do - - it "Section labels" $ - headerWith ("sec:section_label1", [], []) 1 (text "Section") - <> para (citeGen "sec:section_label" [1]) - `test` "\\hypertarget{sec:section_label1}{%\n\\section{Section}\\label{sec:section_label1}}\n\nsec.~\\ref{sec:section_label1}" - - it "Image labels" $ - figure "img.png" "" "Title" "figure_label1" - <> para (citeGen "fig:figure_label" [1]) - `test` "\\begin{figure}\n\\hypertarget{fig:figure_label1}{%\n\\centering\n\\includegraphics{img.png}\n\\caption{Title}\\label{fig:figure_label1}\n}\n\\end{figure}\n\nfig.~\\ref{fig:figure_label1}" - - it "Eqn labels" $ - equation "x^2" "some_equation1" - <> para (citeGen "eq:some_equation" [1]) - `test` "\\begin{equation}\\protect\\hypertarget{eq:some_equation1}{}{x^2}\\label{eq:some_equation1}\\end{equation}\n\neq.~\\ref{eq:some_equation1}" - -#ifdef FLAKY - it "Tbl labels" $ - table' "A table" "some_table1" - <> para (citeGen "tbl:some_table" [1]) - `test` "\\hypertarget{tbl:some_table1}{}\n\\begin{longtable}[]{@{}@{}}\n\\caption{\\label{tbl:some_table1}A table}\\tabularnewline\n\\toprule\n\\endhead\n \\\\\n\\bottomrule\n\\end{longtable}\n\ntbl.~\\ref{tbl:some_table1}" + let (res, _warn) = runCrossRef (Settings m) Nothing $ crossRefBlocks b + res `shouldBe` Right Native.demo #endif - it "Code block labels" $ do - codeBlock' "A code block" "some_codeblock1" - <> para (citeGen "lst:some_codeblock" [1]) - `test` "\\begin{codelisting}\n\n\\caption{A code block}\n\n\\hypertarget{lst:some_codeblock1}{%\n\\label{lst:some_codeblock1}}%\n\\begin{Shaded}\n\\begin{Highlighting}[]\n\\OtherTok{main ::} \\DataTypeTok{IO}\\NormalTok{ ()}\n\\end{Highlighting}\n\\end{Shaded}\n\n\\end{codelisting}\n\nlst.~\\ref{lst:some_codeblock1}" - codeBlock' "A code block with under_score" "some_codeblock1" - <> para (citeGen "lst:some_codeblock" [1]) - `test` "\\begin{codelisting}\n\n\\caption{A code block with under\\_score}\n\n\\hypertarget{lst:some_codeblock1}{%\n\\label{lst:some_codeblock1}}%\n\\begin{Shaded}\n\\begin{Highlighting}[]\n\\OtherTok{main ::} \\DataTypeTok{IO}\\NormalTok{ ()}\n\\end{Highlighting}\n\\end{Shaded}\n\n\\end{codelisting}\n\nlst.~\\ref{lst:some_codeblock1}" - let test1 = test' $ setMeta "codeBlockCaptions" True nullMeta - infixr 5 `test1` - codeBlockForTable "some_codeblock1" <> paraText ": A code block" - <> para (citeGen "lst:some_codeblock" [1]) - `test1` "\\begin{codelisting}\n\n\\caption{A code block}\n\n\\hypertarget{lst:some_codeblock1}{%\n\\label{lst:some_codeblock1}}%\n\\begin{Shaded}\n\\begin{Highlighting}[]\n\\OtherTok{main ::} \\DataTypeTok{IO}\\NormalTok{ ()}\n\\end{Highlighting}\n\\end{Shaded}\n\n\\end{codelisting}\n\nlst.~\\ref{lst:some_codeblock1}" - citeGen :: T.Text -> [Int] -> Inlines citeGen p l = cite (mconcat $ map (cit . (p<>) . T.pack . show) l) $ text $ "[" <> T.intercalate "; " (map (("@"<>) . (p<>) . T.pack . show) l) <> "]" refGen :: T.Text -> [Int] -> [Int] -> M.Map T.Text RefRec -refGen p l1 l2 = M.fromList $ mconcat $ zipWith refRec'' (((uncapitalizeFirst p<>) . T.pack . show) `map` l1) l2 - -refGen' :: T.Text -> [Int] -> [(Int, Int)] -> M.Map T.Text RefRec -refGen' p l1 l2 = M.fromList $ mconcat $ zipWith refRec''' (((uncapitalizeFirst p<>) . T.pack . show) `map` l1) l2 - -refRec' :: T.Text -> Int -> T.Text -> [(T.Text, RefRec)] -refRec' ref i tit = [(ref, RefRec{refIndex=[(i,Nothing)],refTitle=toList $ text tit,refSubfigure=Nothing})] +refGen p l1 l2 = M.fromList $ zipWith (\r i -> refRec' r i mempty mempty) (((uncapitalizeFirst p<>) . T.pack . show) `map` l1) l2 + +refRec' :: T.Text -> Int -> Inlines -> Inlines -> (T.Text, RefRec) +refRec' ref i tit cap = + let pfx = T.takeWhile (/=':') ref + pfxRec = fromJust $ M.lookup pfx defaultPrefixes + in ( ref + , RefRec + { refIndex=i + , refIxInl = str . T.pack $ show i + , refIxInlRaw = str . T.pack $ show i + , refCaption= cap + , refTitle=tit + , refScope=Nothing + , refLevel=0 + , refPfx=pfx + , refLabel=ref + , refAttrs = const Nothing + , refPfxRec = pfxRec + , refCaptionPosition = Below + } + ) -refRec'' :: T.Text -> Int -> [(T.Text, RefRec)] -refRec'' ref i = refRec' ref i "" - -refRec''' :: T.Text -> (Int, Int) -> [(T.Text, RefRec)] -refRec''' ref (c,i) = [(ref, RefRec{refIndex=[(c,Nothing), (i,Nothing)],refTitle=toList $ text "",refSubfigure=Nothing})] +testRefs :: Blocks -> References -> Blocks -> Expectation +testRefs bs st rbs = testState (bottomUpM References.Refs.replaceRefs) st bs (rbs, id) testRefs' :: T.Text -> [Int] -> [Int] -> Accessor References (M.Map T.Text RefRec) -> T.Text -> Expectation testRefs' p l1 l2 prop res = testRefs (para $ citeGen p l1) (setVal prop (refGen p l1 l2) def) (para $ text res) -testRefs'' :: T.Text -> [Int] -> [(Int, Int)] -> Accessor References (M.Map T.Text RefRec) -> T.Text -> Expectation -testRefs'' p l1 l2 prop res = testRefs (para $ citeGen p l1) (setVal prop (refGen' p l1 l2) def) (para $ text res) - -testAll :: (Eq a, Data a, Show a) => Many a -> (Many a, References) -> Expectation -testAll = testState f def - where f = References.Blocks.replaceAll defaultOptions - -testState :: (Eq s, Eq a1, Show s, Show a1, Df.Default s) => - ([a] -> State s [a1]) -> s -> Many a -> (Many a1, s) -> Expectation -testState f init' arg res = runState (f $ toList arg) init' `shouldBe` first toList res - -testRefs :: Blocks -> References -> Blocks -> Expectation -testRefs bs st rbs = testState (bottomUpM (References.Refs.replaceRefs defaultOptions)) st bs (rbs, st) +testAll :: Many Block -> (Many Block, References -> References) -> Expectation +testAll = testState References.Blocks.replaceAll def + +evalCrossRefM :: CrossRefM c -> c +evalCrossRefM = evalCrossRefRes . runCrossRef (defaultMeta mempty) Nothing . CrossRef + +evalCrossRefRes :: (Either WSException c, b) -> c +evalCrossRefRes = either (error . show) id . fst + +instance Show Prefix where + show _ = "Prefix{}" +instance Show Template where + show _ = "Template{}" +instance Show (T.Text -> Maybe MetaValue) where + show _ = "T.Text -> Maybe MetaValue" +deriving instance Show RefRec +deriving instance Show CaptionPosition +deriving instance Show CounterRec +deriving instance Eq CounterRec +deriving instance Show References +deriving instance Eq References +deriving instance Eq WSException + +testState :: (Eq a1, Show a1) => ([a] -> WS [a1]) -> References -> Many a -> (Many a1, References -> References) -> Expectation +testState f init' arg (r, s) = evalCrossRefM $ + (`shouldBe` (toList r, s init')) <$> runStateT (unWS . f $ toList arg) init' testCBCaptions :: Blocks -> Blocks -> Expectation -testCBCaptions bs res = runState (bottomUpM (Util.CodeBlockCaptions.mkCodeBlockCaptions defaultOptions{Text.Pandoc.CrossRef.Util.Options.codeBlockCaptions=True}) (toList bs)) def `shouldBe` (toList res,def) +testCBCaptions bs res = bottomUp (Util.CodeBlockCaptions.mkCodeBlockCaptions defaultOptions{Text.Pandoc.CrossRef.Util.Options.codeBlockCaptions=True}) (toList bs) `shouldBe` toList res -testList :: Blocks -> References -> Blocks -> Expectation -testList bs st res = runState (bottomUpM (References.List.listOf defaultOptions) (toList bs)) st `shouldBe` (toList res,st) +testList :: Blocks -> (References -> References) -> Blocks -> Expectation +testList bs st res = testState (bottomUpM References.List.listOf) (st def) bs (res, st) figure :: T.Text -> T.Text -> T.Text -> T.Text -> Blocks figure = (((para .) .) .) . figure' "fig:" @@ -404,13 +439,12 @@ paraText :: T.Text -> Blocks paraText s = para $ text s codeBlockDiv :: T.Text -> T.Text -> Blocks -codeBlockDiv title ref = divWith ("lst:"<>ref, ["listing","haskell"],[]) $ - para (text title) <> - codeBlockWith - ("",["haskell"],[]) "main :: IO ()" +codeBlockDiv title ref = divWith ("lst:"<>ref, [], []) $ + codeBlockWith ("",["haskell"],[]) "main :: IO ()" + <> para (text $ ": " <> title) codeBlockDiv' :: T.Text -> T.Text -> Blocks -codeBlockDiv' title ref = divWith ("lst:"<>ref, ["listing"],[]) $ +codeBlockDiv' title ref = divWith ("lst:"<>ref, [],[]) $ para (text title) <> codeBlockWith ("",["haskell"],[]) "main :: IO ()" @@ -420,7 +454,7 @@ ref' p n | T.null n = mempty | otherwise = space <> str ("{#"<>p<>":"<>n<>"}") defaultOptions :: Options -defaultOptions = getOptions defaultMeta Nothing +defaultOptions = getOptions (defaultMeta mempty) Nothing defCit :: Citation defCit = Citation{citationId = "" @@ -435,5 +469,8 @@ cit :: T.Text -> [Citation] cit r = [defCit{citationId=r}] infixr 0 =: -(=:) :: Df.Default r => Accessor r a -> a -> r -a =: b = a ^= b $ def +(=:) :: Accessor r a -> a -> r -> r +a =: b = a ^= b + +defaultPrefixes :: Prefixes +defaultPrefixes = getPrefixes Nothing "prefixes" (defaultMeta mempty)