diff --git a/AUTHORS.md b/AUTHORS.md --- a/AUTHORS.md +++ b/AUTHORS.md @@ -35,6 +35,7 @@ - Benoit Schweblin - Bjorn Buckwalter - Blake Eryx +- Bodigrim - Bradley Kuhn - Brent Yorgey - Brian Leung @@ -77,6 +78,7 @@ - Emerson Harkin - Emily Eisenberg - Eric Kow +- Erik Rask - Eric Seidel - Eric Schrijver - Ethan Riley @@ -86,6 +88,7 @@ - Florian Beeres - Florian Eitel - Florian Klink +- Florian Kohrt - Francesco Occhipinti - François Gannaz - Frederik Elwert diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -244,10 +244,17 @@ stack test --test-arguments='-p markdown' -It is often helpful to add `-j4` (run tests in parallel) -and `--hide-successes` (don't clutter output with successes) -to the test arguments as well. +It is often helpful to add `-j4` (run tests in parallel) and +`--hide-successes` (don't clutter output with successes) to the test +arguments as well. Collecting all options in a `cabal.project.local` +file in the project's root directory can help to keep `cabal` +commands short. E.g.: + flags: +embed_data_files + tests: True + test-show-details: direct + test-options: -j4 --hide-successes + If you add a new feature to pandoc, please add tests as well, following the pattern of the existing tests. The test suite code is in `test/test-pandoc.hs`. If you are adding a new reader or writer, it is @@ -311,9 +318,6 @@ stack bench -You can also build `weigh-pandoc` (`stack build pandoc:weigh-pandoc`) -to get some statistics on memory usage. (Eventually this should -be incorporated into the benchmark suite.) Using the REPL -------------- diff --git a/MANUAL.txt b/MANUAL.txt --- a/MANUAL.txt +++ b/MANUAL.txt @@ -1,7 +1,7 @@ --- title: Pandoc User's Guide author: John MacFarlane -date: March 8, 2021 +date: March 20, 2021 --- # Synopsis @@ -4239,6 +4239,22 @@ \let\oldsection\section \renewcommand{\section}[1]{\clearpage\oldsection{#1}} ``` + +Note: the `yaml_metadata_block` extension works with +`commonmark` as well as `markdown` (and it is enabled by default +in `gfm` and `commonmark_x`). However, in these formats the +following restrictions apply: + +- The YAML metadata block must occur at the beginning of the + document (and there can be only one). If multiple files are + given as arguments to pandoc, only the first can be a YAML + metadata block. + +- The leaf nodes of the YAML structure are parsed in isolation from + each other and from the rest of the document. So, for + example, you can't use a reference link in these contexts + if the link definition is somewhere else in the document. + ## Backslash escapes diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -18,12 +18,13 @@ -} import Text.Pandoc import Text.Pandoc.MIME -import Control.Monad (when) +import Control.DeepSeq (force) import Control.Monad.Except (throwError) import qualified Text.Pandoc.UTF8 as UTF8 import qualified Data.ByteString as B import qualified Data.Text as T import Test.Tasty.Bench +-- import Gauge import qualified Data.ByteString.Lazy as BL import Data.Maybe (mapMaybe) import Data.List (sortOn) @@ -31,10 +32,10 @@ readerBench :: Pandoc -> T.Text -> Maybe Benchmark +readerBench _ name + | name `elem` ["bibtex", "biblatex", "csljson"] = Nothing readerBench doc name = either (const Nothing) Just $ runPure $ do - when (name `elem` ["bibtex", "biblatex", "csljson"]) $ - throwError $ PandocSomeError $ name <> " not supported for benchmark" (rdr, rexts) <- getReader name (wtr, wexts) <- getWriter name case (rdr, wtr) of @@ -56,19 +57,19 @@ getImages :: IO [(FilePath, MimeType, BL.ByteString)] getImages = do - ll <- BL.readFile "test/lalune.jpg" - mv <- BL.readFile "test/movie.jpg" - return [("lalune.jpg", "image/jpg", ll) - ,("movie.jpg", "image/jpg", mv)] + ll <- B.readFile "test/lalune.jpg" + mv <- B.readFile "test/movie.jpg" + return [("lalune.jpg", "image/jpg", BL.fromStrict ll) + ,("movie.jpg", "image/jpg", BL.fromStrict mv)] writerBench :: [(FilePath, MimeType, BL.ByteString)] -> Pandoc -> T.Text -> Maybe Benchmark +writerBench _ _ name + | name `elem` ["bibtex", "biblatex", "csljson"] = Nothing writerBench imgs doc name = either (const Nothing) Just $ runPure $ do - when (name `elem` ["bibtex", "biblatex", "csljson"]) $ - throwError $ PandocSomeError $ name <> " not supported for benchmark" (wtr, wexts) <- getWriter name case wtr of TextWriter writerFun -> @@ -90,10 +91,10 @@ main = do inp <- UTF8.toText <$> B.readFile "test/testsuite.txt" let opts = def - let doc = either (error . show) id $ runPure $ readMarkdown opts inp - imgs <- getImages + let doc = either (error . show) force $ runPure $ readMarkdown opts inp defaultMain - [ bgroup "writers" $ mapMaybe (writerBench imgs doc . fst) + [ env getImages $ \imgs -> + bgroup "writers" $ mapMaybe (writerBench imgs doc . fst) (sortOn fst writers :: [(T.Text, Writer PandocPure)]) , bgroup "readers" $ mapMaybe (readerBench doc . fst) diff --git a/cabal.project b/cabal.project --- a/cabal.project +++ b/cabal.project @@ -1,10 +1,6 @@ packages: pandoc.cabal - tests: True - -package pandoc - flags: +embed_data_files - ghc-options: -j +RTS -A256m -RTS +flags: +embed_data_files -- source-repository-package -- type: git diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,155 @@ # Revision history for pandoc +## pandoc 2.13 (2021-03-21) + + * Support `yaml_metadata_block` extension for `commonmark`, `gfm` (#6537). + This supported is a bit more limited than with pandoc's + `markdown`. The YAML block must be the first thing in the input, + and the leaf notes are parsed in isolation from the rest of + the document. So, for example, you can't use reference + links if the references are defined later in the document. + + * Fix fallback to default partials when custom templates are used. + If the directory containing a template does not contain the partial, + it should be sought in the default templates, but this was not + working properly (#7164). + + * Handle `nocite` better with `--biblatex` and `--natbib` (#4585). + Previously the nocite metadata field was ignored with these formats. + Now it populates a `nocite-ids` template variable and causes a + `\nocite` command to be issued. + + * Text.Pandoc.Citeproc: apply `fixLinks` correctly (#7130). This is code + that incorporates a prefix like `https://doi.org/` into a following link + when appropriate. + + * Text.Pandoc.Shared: + + + Remove `backslashEscapes`, `escapeStringUsing` [API change]. Replace + these inefficient association list lookups with more efficient escaping + functions in the writers that used them (for a 10-25% performance boost + in org, haddock, rtf, texinfo writers). + + Remove `ToString`, `ToText` typeclasses [API change]. These were needed + for the transition from String to Text, but they are no longer used and + may clash with other things. + + Simplify `compactDL`. + + * Text.Pandoc.Parsing: + + + Change type of `readWithM` so that it is no longer polymorphic + [API change]. The `ToText` class has been removed, and now that we've + completed the transition to Text we no longer need this to operate + on Strings. + + Remove `F` type synonym [API change]. Muse and Org were defining their + own `F` anyway. + + * Text.Pandoc.Readers.Metadata: + + + Export `yamlMetaBlock` [API change]. + + Make `yamlBsToMeta`, `yamlBsToRefs` polymorphic on the parser state + [API change]. + + * Markdown reader: Fix regression with `tex_math_backslash` (#7155). + + * MediaWiki reader: Allow block-level content in notes (ref) (#7145). + + * Jira reader (Albert Krewinkel): + + + Fixed parsing of autolinks (i.e., of bare URLs in the text). + Previously an autolink would take up the rest of a line, as spaces + were allowed characters in these items. + + Emoji character sequences no longer cause parsing failures. This was + due to missing backtracking when emoji parsing fails. + + Mark divs created from panels with class "panel". + + * RST reader: fix logic for ending comments (#7134). Previously comments + sometimes got extended too far. + + * DocBook writer: include Header attributes as XML attributes on + section (Erik Rask). Attributes with key names that are not allowed + as XML attributes are dropped, as are attributes with invalid values + and `xml:id` (DocBook 5) and `id` (DocBook 4). + + * Docx writer: + + + Make `nsid` in `abstractNum` deterministic. Previously we assigned + a random number, but we don't need random values, so now we just + assign a value based on the list marker. + + Use integral values for `w:tblW` (#7141). + + * Jira writer (Albert Krewinkel): + + + Block quotes are only rendered as `bq.` if they do not contain a + linebreak. + + Jira writer: improve div/panel handling. Include div attributes in + panels, always render divs with class `panel` as panels, and + avoid nesting of panels. + + * HTML writer: Add warnings on duplicate attribute values. + This prevents emitting invalid HTML. Ultimately it would be good to + prevent this in the types themselves, but this is better for now. + + * Org writer: Prevent unintended creation of ordered list items (#7132, + Albert Krewinkel). Adjust line wrapping if default wrapping would cause + a line to be read as an ordered list item. + + * JATS templates: support 'equal-contrib' attrib for authors (Albert + Krewinkel). Authors who contributed equally to a paper may be marked + with `equal-contrib`. + + * reveal.js template: replace JS comment with HTML (#7154, Florian Kohrt). + + * Text.Pandoc.Logging: Add `DuplicateAttribute` constructor to `LogMessage`. + [API change] + + * Use `-j4` for linux release build. This speeds up the build dramatically + on arm. + + * cabal.project: remove ghcoptions. Move flags to top level, so they can + be set differently on the command line. + + * Require latest texmath, skylighting, citeproc, jira-wiki-markup. + (The latest skylighting fixes a bad bug with Haskell syntax highlighting.) + Narrow version bounds for texmath, skylighting, and citeproc, since + the test output depend on them. + + * Use doclayout 0.3.0.2. This significantly reduces the time and memory + needed to compile pandoc. + + * Use `foldl'` instead of `foldl` everywhere. + + * Update bounds for random (#7156, Alexey Kuleshevich). + + * Remove uses of some partial functions. + + * Don't bake in a larger stack size for the executable. + + * Test improvements: + + + Use `getExecutablePath` from base, avoiding the dependency on + `executable-path`. + + Factor out `setupEnvironment` in Helpers, to avoid code duplication. + + Fix finding of data files by setting teh `pandoc_datadir` environment + variable when we shell out to pandoc. This avoids the need to use + `--data-dir` for the tests, which caused problems finding `pandoc.lua` + when compiling without the `embed_data_files` flag (#7163). + + * Benchmark improvements: + + + Build `+RTS -A8m -RTS` into default ghc-options for benchmark. + This is necessary to get accurate benchmark results; otherwise we + are largely measuring garbage collecting, some not related to the + current benchmark. + + Allow specifying BASELINE file in 'make bench' for comparison + (otherwise the latest benchmark is chosen by default). + + Force `readFile` in benchmarks early (Bodigrim). + + * CONTRIBUTING: suggest using a `cabal.project.local` file (#7153, + Albert Krewinkel). + + * Add ghcid-test to Makefile. This loads the test suite in ghcid. + + ## pandoc 2.12 (2021-03-08) * `--resource-path` now accumulates if specified multiple diff --git a/data/templates/article.jats_publishing b/data/templates/article.jats_publishing --- a/data/templates/article.jats_publishing +++ b/data/templates/article.jats_publishing @@ -86,7 +86,7 @@ $if(author)$ $for(author)$ - + $if(author.orcid)$ $author.orcid$ $endif$ diff --git a/data/templates/default.jats_articleauthoring b/data/templates/default.jats_articleauthoring --- a/data/templates/default.jats_articleauthoring +++ b/data/templates/default.jats_articleauthoring @@ -19,7 +19,7 @@ $if(author)$ $for(author)$ - + $if(author.orcid)$ $author.orcid$ $endif$ diff --git a/data/templates/default.latex b/data/templates/default.latex --- a/data/templates/default.latex +++ b/data/templates/default.latex @@ -372,6 +372,9 @@ \addbibresource{$bibliography$} $endfor$ $endif$ +$if(nocite-ids)$ +\nocite{$for(nocite-ids)$$it$$sep$, $endfor$} +$endif$ $if(csl-refs)$ \newlength{\cslhangindent} \setlength{\cslhangindent}{1.5em} diff --git a/data/templates/default.revealjs b/data/templates/default.revealjs --- a/data/templates/default.revealjs +++ b/data/templates/default.revealjs @@ -69,7 +69,7 @@ - // reveal.js plugins + diff --git a/man/pandoc.1 b/man/pandoc.1 --- a/man/pandoc.1 +++ b/man/pandoc.1 @@ -1,7 +1,7 @@ '\" t -.\" Automatically generated by Pandoc 2.12 +.\" Automatically generated by Pandoc 2.12.1 .\" -.TH "Pandoc User\[cq]s Guide" "" "March 8, 2021" "pandoc 2.12" "" +.TH "Pandoc User\[cq]s Guide" "" "March 20, 2021" "pandoc 2.13" "" .hy .SH NAME pandoc - general markup converter diff --git a/pandoc.cabal b/pandoc.cabal --- a/pandoc.cabal +++ b/pandoc.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: pandoc -version: 2.12 +version: 2.13 build-type: Simple license: GPL-2.0-or-later license-file: COPYING.md @@ -398,8 +398,7 @@ common common-options default-language: Haskell2010 - build-depends: base >= 4.9 && < 5, - text >= 1.1.1.0 && < 1.3 + build-depends: base >= 4.9 && < 5 ghc-options: -Wall -fno-warn-unused-do-bind -Wincomplete-record-updates -Wnoncanonical-monad-instances @@ -427,7 +426,7 @@ common common-executable import: common-options build-depends: pandoc - ghc-options: -rtsopts -with-rtsopts=-K16m -threaded + ghc-options: -rtsopts -with-rtsopts=-A8m -threaded library @@ -446,7 +445,7 @@ blaze-markup >= 0.8 && < 0.9, bytestring >= 0.9 && < 0.12, case-insensitive >= 1.2 && < 1.3, - citeproc >= 0.3.0.7 && < 0.4, + citeproc >= 0.3.0.9 && < 0.3.1, commonmark >= 0.1.1.3 && < 0.2, commonmark-extensions >= 0.2.0.4 && < 0.3, commonmark-pandoc >= 0.2 && < 0.3, @@ -455,7 +454,7 @@ data-default >= 0.4 && < 0.8, deepseq >= 1.3 && < 1.5, directory >= 1.2.3 && < 1.4, - doclayout >= 0.3 && < 0.4, + doclayout >= 0.3.0.1 && < 0.4, doctemplates >= 0.9 && < 0.10, emojis >= 0.1 && < 0.2, exceptions >= 0.8 && < 0.11, @@ -470,23 +469,23 @@ http-client-tls >= 0.2.4 && < 0.4, http-types >= 0.8 && < 0.13, ipynb >= 0.1 && < 0.2, - jira-wiki-markup >= 1.3.3 && < 1.4, + jira-wiki-markup >= 1.3.4 && < 1.4, mtl >= 2.2 && < 2.3, network >= 2.6, network-uri >= 2.6 && < 2.7, pandoc-types >= 1.22 && < 1.23, parsec >= 3.1 && < 3.2, process >= 1.2.3 && < 1.7, - random >= 1 && < 1.2, - safe >= 0.3 && < 0.4, + random >= 1 && < 1.3, + safe >= 0.3.18 && < 0.4, scientific >= 0.3 && < 0.4, - skylighting >= 0.10.4 && < 0.11, - skylighting-core >= 0.10.4 && < 0.11, + skylighting >= 0.10.5 && < 0.10.6, + skylighting-core >= 0.10.5 && < 0.10.6, split >= 0.2 && < 0.3, syb >= 0.1 && < 0.8, tagsoup >= 0.14.6 && < 0.15, temporary >= 1.1 && < 1.4, - texmath >= 0.12.1 && < 0.13, + texmath >= 0.12.2 && < 0.12.3, text >= 1.1.1.0 && < 1.3, text-conversions >= 0.3 && < 0.4, time >= 1.5 && < 1.10, @@ -744,13 +743,11 @@ Diff >= 0.2 && < 0.5, Glob >= 0.7 && < 0.11, QuickCheck >= 2.4 && < 2.15, - base64-bytestring >= 0.1 && < 1.3, bytestring >= 0.9 && < 0.12, containers >= 0.4.2.1 && < 0.7, directory >= 1.2.3 && < 1.4, doctemplates >= 0.9 && < 0.10, exceptions >= 0.8 && < 0.11, - executable-path >= 0.0 && < 0.1, filepath >= 1.1 && < 1.5, hslua >= 1.1 && < 1.4, mtl >= 2.2 && < 2.3, @@ -761,7 +758,7 @@ tasty-hunit >= 0.9 && < 0.11, tasty-lua >= 0.2 && < 0.3, tasty-quickcheck >= 0.8 && < 0.11, - temporary >= 1.1 && < 1.4, + text >= 1.1.1.0 && < 1.3, time >= 1.5 && < 1.10, xml >= 1.3.12 && < 1.4, zip-archive >= 0.2.3.4 && < 0.5 @@ -828,7 +825,11 @@ hs-source-dirs: benchmark build-depends: bytestring, containers, - tasty, + -- gauge >= 0.2 && < 0.3, tasty-bench >= 0.2 && <= 0.3, mtl >= 2.2 && < 2.3, - time + text >= 1.1.1.0 && < 1.3, + time, + deepseq + -- we increase heap size to avoid benchmarking garbage collection: + ghc-options: -rtsopts -with-rtsopts=-A8m -threaded diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -31,7 +31,7 @@ defConfig, Indent(..), NumberFormat(..)) import Data.Bifunctor (second) import Data.Char (toLower) -import Data.List (intercalate, sort) +import Data.List (intercalate, sort, foldl') #ifdef _WINDOWS #if MIN_VERSION_base(4,12,0) import Data.List (isPrefixOf) @@ -93,7 +93,7 @@ ("Try " ++ prg ++ " --help for more information.") -- thread option data structure through all supplied option actions - opts <- foldl (>>=) (return defaults) actions + opts <- foldl' (>>=) (return defaults) actions let mbArgs = case args of [] -> Nothing xs -> Just xs diff --git a/src/Text/Pandoc/App/FormatHeuristics.hs b/src/Text/Pandoc/App/FormatHeuristics.hs --- a/src/Text/Pandoc/App/FormatHeuristics.hs +++ b/src/Text/Pandoc/App/FormatHeuristics.hs @@ -15,18 +15,24 @@ ) where import Data.Char (toLower) +import Data.Foldable (asum) import Data.Text (Text) import System.FilePath (takeExtension) --- Determine default format based on file extensions. +-- | Determines default format based on file extensions; uses the format +-- of the first extension that's associated with a format. +-- +-- Examples: +-- +-- > formatFromFilePaths ["text.unknown", "no-extension"] +-- Nothing +-- +-- > formatFromFilePaths ["my.md", "other.rst"] +-- Just "markdown" formatFromFilePaths :: [FilePath] -> Maybe Text -formatFromFilePaths [] = Nothing -formatFromFilePaths (x:xs) = - case formatFromFilePath x of - Just f -> Just f - Nothing -> formatFromFilePaths xs +formatFromFilePaths = asum . map formatFromFilePath --- Determine format based on file extension +-- | Determines format based on file extension. formatFromFilePath :: FilePath -> Maybe Text formatFromFilePath x = case takeExtension (map toLower x) of diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs --- a/src/Text/Pandoc/App/Opt.hs +++ b/src/Text/Pandoc/App/Opt.hs @@ -686,7 +686,8 @@ either (fail . show) return $ runEverything (yamlMap pMetaString m) where pMetaString = pure . MetaString <$> P.manyChar P.anyChar - runEverything p = runPure (P.readWithM p def "") + runEverything p = + runPure (P.readWithM p (def :: P.ParserState) "") >>= fmap (Meta . flip P.runF def) yamlToMeta _ = return mempty diff --git a/src/Text/Pandoc/Citeproc.hs b/src/Text/Pandoc/Citeproc.hs --- a/src/Text/Pandoc/Citeproc.hs +++ b/src/Text/Pandoc/Citeproc.hs @@ -49,7 +49,6 @@ import qualified Data.Text as T import System.FilePath (takeExtension) import Safe (lastMay, initSafe) --- import Debug.Trace as Trace (trace, traceShowId) processCitations :: PandocMonad m => Pandoc -> m Pandoc @@ -91,11 +90,12 @@ _ -> id) $ [] let bibs = mconcat $ map (\(ident, out) -> B.divWith ("ref-" <> ident,["csl-entry"],[]) . B.para . - walk (convertQuotes locale) . insertSpace $ out) + walk (convertQuotes locale) . + insertSpace $ out) (resultBibliography result) let moveNotes = maybe True truish $ lookupMeta "notes-after-punctuation" meta - let cits = map (walk fixLinks . walk (convertQuotes locale)) $ + let cits = map (walk (convertQuotes locale)) $ resultCitations result let fixQuotes = case localePunctuationInQuote locale of @@ -294,7 +294,7 @@ [] -> return (Cite cs ils) (x:xs) -> do put xs - return $ Cite cs (B.toList x) + return $ Cite cs (walk fixLinks $ B.toList x) insertResolvedCitations x = return x getCitations :: Locale @@ -431,7 +431,7 @@ -- move https://doi.org etc. prefix inside link text (#6723): fixLinks :: [Inline] -> [Inline] fixLinks (Str t : Link attr [Str u1] (u2,tit) : xs) - | t <> u1 == u2 + | u2 == t <> u1 = Link attr [Str (t <> u1)] (u2,tit) : fixLinks xs fixLinks (x:xs) = x : fixLinks xs fixLinks [] = [] diff --git a/src/Text/Pandoc/Citeproc/Locator.hs b/src/Text/Pandoc/Citeproc/Locator.hs --- a/src/Text/Pandoc/Citeproc/Locator.hs +++ b/src/Text/Pandoc/Citeproc/Locator.hs @@ -7,6 +7,7 @@ import Citeproc.Types import Data.Text (Text) import qualified Data.Text as T +import Data.List (foldl') import Text.Parsec import Text.Pandoc.Definition import Text.Pandoc.Parsing (romanNumeral) @@ -139,7 +140,7 @@ where except = notFollowedBy pBraces >> p -- outer and inner - surround = foldl (\a (open, close) -> sur open close except <|> a) + surround = foldl' (\a (open, close) -> sur open close except <|> a) except braces diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs --- a/src/Text/Pandoc/Class/PandocMonad.hs +++ b/src/Text/Pandoc/Class/PandocMonad.hs @@ -59,6 +59,7 @@ MonadTrans, lift, when) import Data.Digest.Pure.SHA (sha1, showDigest) import Data.Maybe (fromMaybe) +import Data.List (foldl') import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds, posixSecondsToUTCTime) @@ -612,7 +613,7 @@ -- | Canonicalizes a file path by removing redundant @.@ and @..@. makeCanonical :: FilePath -> FilePath makeCanonical = Posix.joinPath . transformPathParts . splitDirectories - where transformPathParts = reverse . foldl go [] + where transformPathParts = reverse . foldl' go [] go as "." = as go (_:as) ".." = as go as x = x : as diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs --- a/src/Text/Pandoc/Extensions.hs +++ b/src/Text/Pandoc/Extensions.hs @@ -34,6 +34,7 @@ where import Data.Bits (clearBit, setBit, testBit, (.|.)) import Data.Data (Data) +import Data.List (foldl') import qualified Data.Text as T import Data.Typeable (Typeable) import GHC.Generics (Generic) @@ -353,6 +354,7 @@ , Ext_strikeout , Ext_task_lists , Ext_emoji + , Ext_yaml_metadata_block ] getDefaultExtensions "commonmark" = extensionsFromList [Ext_raw_html] @@ -378,6 +380,7 @@ , Ext_raw_attribute , Ext_implicit_header_references , Ext_attributes + , Ext_yaml_metadata_block ] getDefaultExtensions "org" = extensionsFromList [Ext_citations, @@ -510,6 +513,7 @@ , Ext_implicit_header_references , Ext_attributes , Ext_sourcepos + , Ext_yaml_metadata_block ] getAll "commonmark_x" = getAll "commonmark" getAll "org" = autoIdExtensions <> @@ -593,7 +597,7 @@ parseFormatSpec = parse formatSpec "" where formatSpec = do name <- formatName - (extsToEnable, extsToDisable) <- foldl (flip ($)) ([],[]) <$> + (extsToEnable, extsToDisable) <- foldl' (flip ($)) ([],[]) <$> many extMod return (T.pack name, reverse extsToEnable, reverse extsToDisable) formatName = many1 $ noneOf "-+" diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -36,6 +36,7 @@ import GHC.Generics (Generic) import Text.Pandoc.Definition import Text.Parsec.Pos +import Text.Pandoc.Shared (tshow) -- | Verbosity level. data Verbosity = ERROR | WARNING | INFO @@ -101,6 +102,7 @@ | CiteprocWarning Text | ATXHeadingInLHS Int Text | EnvironmentVariableUndefined Text + | DuplicateAttribute Text Text deriving (Show, Eq, Data, Ord, Typeable, Generic) instance ToJSON LogMessage where @@ -232,6 +234,9 @@ ,"contents" .= contents] EnvironmentVariableUndefined var -> ["variable" .= var ] + DuplicateAttribute attr val -> + ["attribute" .= attr + ,"value" .= val] showPos :: SourcePos -> Text showPos pos = Text.pack $ sn ++ "line " ++ @@ -350,6 +355,8 @@ else "" EnvironmentVariableUndefined var -> "Undefined environment variable " <> var <> " in defaults file." + DuplicateAttribute attr val -> + "Ignoring duplicate attribute " <> attr <> "=" <> tshow val <> "." messageVerbosity :: LogMessage -> Verbosity messageVerbosity msg = @@ -397,3 +404,4 @@ CiteprocWarning{} -> WARNING ATXHeadingInLHS{} -> WARNING EnvironmentVariableUndefined{}-> WARNING + DuplicateAttribute{} -> WARNING diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -22,6 +22,7 @@ import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf, showConstr, toConstr, tyconUQname) import Data.Foldable (foldrM) +import Data.List (foldl') import Data.Map (Map) import Data.Maybe (fromMaybe) import Foreign.Lua (Lua, Peekable, Pushable, StackIndex) @@ -204,7 +205,7 @@ walkPandoc :: LuaFilter -> Pandoc -> Lua Pandoc walkPandoc (LuaFilter fnMap) = - case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of + case foldl' mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of Just fn -> \x -> runFilterFunction fn x *> singleElement x Nothing -> return diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -112,7 +112,6 @@ citeKey, Parser, ParserT, - F, Future(..), runF, askF, @@ -229,8 +228,6 @@ newtype Future s a = Future { runDelayed :: Reader s a } deriving (Monad, Applicative, Functor) -type F = Future ParserState - runF :: Future s a -> s -> a runF = runReader . runDelayed @@ -520,7 +517,7 @@ -> ParserT s st m r parseFromString parser str = do oldPos <- getPosition - setPosition $ initialPos "chunk" + setPosition $ initialPos " chunk" oldInput <- getInput setInput $ fromString $ T.unpack str result <- parser @@ -1128,13 +1125,13 @@ --- -- | Removes the ParsecT layer from the monad transformer stack -readWithM :: (Stream s m Char, ToText s) - => ParserT s st m a -- ^ parser +readWithM :: Monad m + => ParserT Text st m a -- ^ parser -> st -- ^ initial state - -> s -- ^ input + -> Text -- ^ input -> m (Either PandocError a) readWithM parser state input = - mapLeft (PandocParsecError $ toText input) `liftM` runParserT parser state "source" input + mapLeft (PandocParsecError input) <$> runParserT parser state "source" input -- | Parse a string with a given parser and state readWith :: Parser Text st a @@ -1169,7 +1166,7 @@ stateInNote :: Bool, -- ^ True if parsing note contents stateNoteNumber :: Int, -- ^ Last note number for citations stateMeta :: Meta, -- ^ Document metadata - stateMeta' :: F Meta, -- ^ Document metadata + stateMeta' :: Future ParserState Meta, -- ^ Document metadata stateCitations :: M.Map Text Text, -- ^ RST-style citations stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used stateIdentifiers :: Set.Set Text, -- ^ Header identifiers used @@ -1348,7 +1345,7 @@ type NoteTable = [(Text, Text)] -type NoteTable' = M.Map Text (SourcePos, F Blocks) +type NoteTable' = M.Map Text (SourcePos, Future ParserState Blocks) -- used in markdown reader newtype Key = Key Text deriving (Show, Read, Eq, Ord) diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -26,13 +26,43 @@ import Text.Pandoc.Builder as B import Text.Pandoc.Options import Text.Pandoc.Error +import Text.Pandoc.Readers.Metadata (yamlMetaBlock) import Control.Monad.Except import Data.Functor.Identity (runIdentity) import Data.Typeable +import Text.Pandoc.Parsing (runParserT, getPosition, sourceLine, + runF, defaultParserState, take1WhileP, option) +import qualified Data.Text as T -- | Parse a CommonMark formatted string into a 'Pandoc' structure. readCommonMark :: PandocMonad m => ReaderOptions -> Text -> m Pandoc readCommonMark opts s + | isEnabled Ext_yaml_metadata_block opts + , "---" `T.isPrefixOf` s = do + let metaValueParser = do + inp <- option "" $ take1WhileP (const True) + case runIdentity + (commonmarkWith (specFor opts) "metadata value" inp) of + Left _ -> mzero + Right (Cm bls :: Cm () Blocks) + -> return $ return $ B.toMetaValue bls + res <- runParserT (do meta <- yamlMetaBlock metaValueParser + pos <- getPosition + return (meta, pos)) + defaultParserState "YAML metadata" s + case res of + Left _ -> readCommonMarkBody opts s + Right (meta, pos) -> do + let dropLines 0 = id + dropLines n = dropLines (n - 1) . T.drop 1 . T.dropWhile (/='\n') + let metaLines = sourceLine pos - 1 + let body = T.replicate metaLines "\n" <> dropLines metaLines s + Pandoc _ bs <- readCommonMarkBody opts body + return $ Pandoc (runF meta defaultParserState) bs + | otherwise = readCommonMarkBody opts s + +readCommonMarkBody :: PandocMonad m => ReaderOptions -> Text -> m Pandoc +readCommonMarkBody opts s | isEnabled Ext_sourcepos opts = case runIdentity (commonmarkWith (specFor opts) "" s) of Left err -> throwError $ PandocParsecError s err diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -18,6 +18,7 @@ import Data.Foldable (asum) import Data.Generics import Data.List (intersperse,elemIndex) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe,mapMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -949,9 +950,8 @@ (x >= '0' && x <= '9') || x == '.') w if n > 0 then Just n else Nothing - let numrows = case bodyrows of - [] -> 0 - xs -> maximum $ map length xs + let numrows = maybe 0 maximum $ nonEmpty + $ map length bodyrows let aligns = case colspecs of [] -> replicate numrows AlignDefault cs -> map toAlignment cs diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -85,6 +85,7 @@ import qualified Text.Pandoc.Class.PandocMonad as P import Text.Pandoc.Error import Text.Pandoc.Logging +import Data.List.NonEmpty (nonEmpty) readDocx :: PandocMonad m => ReaderOptions @@ -648,11 +649,6 @@ cells <- mapM rowToBlocksList rows let width = maybe 0 maximum $ nonEmpty $ map rowLength parts - -- Data.List.NonEmpty is not available with ghc 7.10 so we roll out - -- our own, see - -- https://github.com/jgm/pandoc/pull/4361#issuecomment-365416155 - nonEmpty [] = Nothing - nonEmpty l = Just l rowLength :: Docx.Row -> Int rowLength (Docx.Row c) = length c diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -182,7 +182,7 @@ smushInlines :: [Inlines] -> Inlines smushInlines xs = combineInlines xs' mempty - where xs' = foldl combineInlines mempty xs + where xs' = foldl' combineInlines mempty xs smushBlocks :: [Blocks] -> Blocks -smushBlocks xs = foldl combineBlocks mempty xs +smushBlocks xs = foldl' combineBlocks mempty xs diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -32,6 +32,7 @@ import Data.Default (Default (..), def) import Data.Foldable (for_) import Data.List.Split (splitWhen) +import Data.List (foldl') import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Monoid (First (..)) @@ -360,7 +361,10 @@ terms <- many1 (try $ skipMany nonItem >> pInTags "dt" inline) defs <- many1 (try $ skipMany nonItem >> pInTags "dd" block) skipMany nonItem - let term = foldl1 (\x y -> x <> B.linebreak <> y) $ map trimInlines terms + let term = foldl' (\x y -> if null x + then trimInlines y + else x <> B.linebreak <> trimInlines y) + mempty terms return (term, map (fixPlains True) defs) fixPlains :: Bool -> Blocks -> Blocks diff --git a/src/Text/Pandoc/Readers/HTML/Table.hs b/src/Text/Pandoc/Readers/HTML/Table.hs --- a/src/Text/Pandoc/Readers/HTML/Table.hs +++ b/src/Text/Pandoc/Readers/HTML/Table.hs @@ -17,6 +17,7 @@ import Control.Applicative ((<|>)) import Data.Maybe (fromMaybe) +import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import Text.HTML.TagSoup import Text.Pandoc.Builder (Blocks) @@ -216,7 +217,7 @@ let rows = headRows head' <> concatMap bodyRows bodies <> footRows foot let cellWidth (Cell _ _ _ (ColSpan cs) _) = cs let rowLength = foldr (\cell acc -> cellWidth cell + acc) 0 . rowCells - let ncols = maximum (map rowLength rows) + let ncols = maybe 0 maximum $ nonEmpty $ map rowLength rows let tblType = tableType (map rowCells rows) -- fail on empty table if null rows diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -17,6 +17,7 @@ import Control.Monad.Except (throwError) import Data.List (intersperse) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text, unpack) import qualified Data.Text as T @@ -92,7 +93,7 @@ then ([], map toCells bodyRows) else (toCells (head headerRows), map toCells (tail headerRows ++ bodyRows)) - colspecs = replicate (maximum (map length body)) + colspecs = replicate (maybe 0 maximum (nonEmpty (map length body))) (AlignDefault, ColWidthDefault) in B.table B.emptyCaption colspecs diff --git a/src/Text/Pandoc/Readers/Jira.hs b/src/Text/Pandoc/Readers/Jira.hs --- a/src/Text/Pandoc/Readers/Jira.hs +++ b/src/Text/Pandoc/Readers/Jira.hs @@ -71,10 +71,10 @@ Nothing -> [] in codeBlockWith ("", classes, map paramToPair params) txt --- | Create a pandoc @'Div'@ +-- | Create a pandoc @'Div'@ from a panel. toPandocDiv :: [Jira.Parameter] -> [Jira.Block] -> Blocks toPandocDiv params = - divWith ("", [], map paramToPair params) . foldMap jiraToPandocBlocks + divWith ("", ["panel"], map paramToPair params) . foldMap jiraToPandocBlocks paramToPair :: Jira.Parameter -> (Text, Text) paramToPair (Jira.Parameter key value) = (key, value) diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -69,7 +68,7 @@ listingsLanguage) import Text.Pandoc.Shared import Text.Pandoc.Walk -import Safe +import Data.List.NonEmpty (nonEmpty) -- for debugging: -- import Text.Pandoc.Extensions (getDefaultExtensions) @@ -97,11 +96,7 @@ let doc' = doc bs let headerLevel (Header n _ _) = [n] headerLevel _ = [] -#if MIN_VERSION_safe(0,3,18) - let bottomLevel = minimumBound 1 $ query headerLevel doc' -#else - let bottomLevel = minimumDef 1 $ query headerLevel doc' -#endif + let bottomLevel = maybe 1 minimum $ nonEmpty $ query headerLevel doc' let adjustHeaders m (Header n attr ils) = Header (n+m) attr ils adjustHeaders _ x = x let (Pandoc _ bs') = diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -21,13 +21,13 @@ import Control.Monad import Control.Monad.Except (throwError) import Data.Char (isAlphaNum, isPunctuation, isSpace) -import Data.List (transpose, elemIndex, sortOn) +import Data.List (transpose, elemIndex, sortOn, foldl') +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as M import Data.Maybe import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Lazy as TL import qualified Data.ByteString.Lazy as BL import System.FilePath (addExtension, takeExtension) import Text.HTML.TagSoup hiding (Row) @@ -45,12 +45,13 @@ isCommentTag, isInlineTag, isTextTag) import Text.Pandoc.Readers.LaTeX (applyMacros, rawLaTeXBlock, rawLaTeXInline) import Text.Pandoc.Shared -import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.XML (fromEntities) -import Text.Pandoc.Readers.Metadata (yamlBsToMeta, yamlBsToRefs) +import Text.Pandoc.Readers.Metadata (yamlBsToMeta, yamlBsToRefs, yamlMetaBlock) type MarkdownParser m = ParserT Text ParserState m +type F = Future ParserState + -- | Read markdown from an input string and return a Pandoc document. readMarkdown :: PandocMonad m => ReaderOptions -- ^ Reader options @@ -271,25 +272,13 @@ $ nullMeta updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' } -yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks) -yamlMetaBlock = do +yamlMetaBlock' :: PandocMonad m => MarkdownParser m (F Blocks) +yamlMetaBlock' = do guardEnabled Ext_yaml_metadata_block - try $ do - string "---" - blankline - notFollowedBy blankline -- if --- is followed by a blank it's an HRULE - rawYamlLines <- manyTill anyLine stopLine - -- by including --- and ..., we allow yaml blocks with just comments: - let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."])) - optional blanklines - newMetaF <- yamlBsToMeta (fmap B.toMetaValue <$> parseBlocks) - $ UTF8.fromTextLazy $ TL.fromStrict rawYaml - -- Since `<>` is left-biased, existing values are not touched: - updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF } - return mempty - -stopLine :: PandocMonad m => MarkdownParser m () -stopLine = try $ (string "---" <|> string "...") >> blankline >> return () + newMetaF <- yamlMetaBlock (fmap B.toMetaValue <$> parseBlocks) + -- Since `<>` is left-biased, existing values are not touched: + updateState $ \st -> st{ stateMeta' = stateMeta' st <> newMetaF } + return mempty mmdTitleBlock :: PandocMonad m => MarkdownParser m () mmdTitleBlock = do @@ -357,7 +346,7 @@ addKvs <- option [] $ guardEnabled Ext_mmd_link_attributes >> many (try $ spnl >> keyValAttr) blanklines - let attr' = extractIdClass $ foldl (\x f -> f x) attr addKvs + let attr' = extractIdClass $ foldl' (\x f -> f x) attr addKvs target = (escapeURI $ trimr src, tit) st <- getState let oldkeys = stateKeys st @@ -453,7 +442,7 @@ block = do res <- choice [ mempty <$ blanklines , codeBlockFenced - , yamlMetaBlock + , yamlMetaBlock' -- note: bulletList needs to be before header because of -- the possibility of empty list items: - , bulletList @@ -613,7 +602,7 @@ spnl attrs <- many (attribute <* spnl) char '}' - return $ foldl (\x f -> f x) nullAttr attrs + return $ foldl' (\x f -> f x) nullAttr attrs attribute :: PandocMonad m => MarkdownParser m (Attr -> Attr) attribute = identifierAttr <|> classAttr <|> keyValAttr <|> specialAttr @@ -1364,7 +1353,7 @@ lines' <- many pipeTableRow let lines'' = map (take (length aligns) <$>) lines' let maxlength = maximum $ - map (\x -> T.length . stringify $ runF x def) (heads' : lines'') + fmap (\x -> T.length . stringify $ runF x def) (heads' :| lines'') numColumns <- getOption readerColumns let widths = if maxlength > numColumns then map (\len -> @@ -1503,7 +1492,7 @@ '$' -> math '~' -> strikeout <|> subscript '<' -> autoLink <|> spanHtml <|> rawHtmlInline <|> ltSign - '\\' -> escapedNewline <|> escapedChar <|> rawLaTeXInline' + '\\' -> math <|> escapedNewline <|> escapedChar <|> rawLaTeXInline' '@' -> cite <|> exampleRef '"' -> smart '\'' -> smart diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -112,12 +112,14 @@ isBlockTag' :: Tag Text -> Bool isBlockTag' tag@(TagOpen t _) = (isBlockTag tag || t `elem` newBlockTags) && t `notElem` eitherBlockOrInline +isBlockTag' (TagClose "ref") = True -- needed so 'special' doesn't parse it isBlockTag' tag@(TagClose t) = (isBlockTag tag || t `elem` newBlockTags) && t `notElem` eitherBlockOrInline isBlockTag' tag = isBlockTag tag isInlineTag' :: Tag Text -> Bool isInlineTag' (TagComment _) = True +isInlineTag' (TagClose "ref") = False -- see below inlineTag isInlineTag' t = not (isBlockTag' t) eitherBlockOrInline :: [Text] @@ -554,11 +556,17 @@ contents <- manyTillChar anyChar (try $ string "}}}") return $ "{{{" <> contents <> "}}}" +singleParaToPlain :: Blocks -> Blocks +singleParaToPlain bs = + case B.toList bs of + [Para ils] -> B.fromList [Plain ils] + _ -> bs + inlineTag :: PandocMonad m => MWParser m Inlines inlineTag = do (tag, _) <- lookAhead $ htmlTag isInlineTag' case tag of - TagOpen "ref" _ -> B.note . B.plain <$> inlinesInTags "ref" + TagOpen "ref" _ -> B.note . singleParaToPlain <$> blocksInTags "ref" TagOpen "nowiki" _ -> try $ do (_,raw) <- htmlTag (~== tag) if T.any (== '/') raw diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -14,6 +14,7 @@ module Text.Pandoc.Readers.Metadata ( yamlBsToMeta, yamlBsToRefs, + yamlMetaBlock, yamlMap ) where import Control.Monad @@ -30,11 +31,13 @@ import Text.Pandoc.Error import Text.Pandoc.Parsing hiding (tableWith) import Text.Pandoc.Shared +import qualified Data.Text.Lazy as TL +import qualified Text.Pandoc.UTF8 as UTF8 -yamlBsToMeta :: PandocMonad m - => ParserT Text ParserState m (F MetaValue) +yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st) + => ParserT Text st m (Future st MetaValue) -> BL.ByteString - -> ParserT Text ParserState m (F Meta) + -> ParserT Text st m (Future st Meta) yamlBsToMeta pMetaValue bstr = do case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of Right (YAML.Doc (YAML.Mapping _ _ o):_) @@ -63,11 +66,11 @@ lookupYAML _ _ = Nothing -- Returns filtered list of references. -yamlBsToRefs :: PandocMonad m - => ParserT Text ParserState m (F MetaValue) +yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st) + => ParserT Text st m (Future st MetaValue) -> (Text -> Bool) -- ^ Filter for id -> BL.ByteString - -> ParserT Text ParserState m (F [MetaValue]) + -> ParserT Text st m (Future st [MetaValue]) yamlBsToRefs pMetaValue idpred bstr = case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of Right (YAML.Doc o@YAML.Mapping{}:_) @@ -104,10 +107,10 @@ nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = Just t nodeToKey _ = Nothing -normalizeMetaValue :: PandocMonad m - => ParserT Text ParserState m (F MetaValue) +normalizeMetaValue :: (PandocMonad m, HasLastStrPosition st) + => ParserT Text st m (Future st MetaValue) -> Text - -> ParserT Text ParserState m (F MetaValue) + -> ParserT Text st m (Future st MetaValue) normalizeMetaValue pMetaValue x = -- Note: a standard quoted or unquoted YAML value will -- not end in a newline, but a "block" set off with @@ -129,10 +132,10 @@ | t == T.pack "false" || t == T.pack "False" || t == T.pack "FALSE" = Just False | otherwise = Nothing -yamlToMetaValue :: PandocMonad m - => ParserT Text ParserState m (F MetaValue) +yamlToMetaValue :: (PandocMonad m, HasLastStrPosition st) + => ParserT Text st m (Future st MetaValue) -> YAML.Node YE.Pos - -> ParserT Text ParserState m (F MetaValue) + -> ParserT Text st m (Future st MetaValue) yamlToMetaValue pMetaValue (YAML.Scalar _ x) = case x of YAML.SStr t -> normalizeMetaValue pMetaValue t @@ -152,10 +155,10 @@ fmap MetaMap <$> yamlMap pMetaValue o yamlToMetaValue _ _ = return $ return $ MetaString "" -yamlMap :: PandocMonad m - => ParserT Text ParserState m (F MetaValue) +yamlMap :: (PandocMonad m, HasLastStrPosition st) + => ParserT Text st m (Future st MetaValue) -> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos) - -> ParserT Text ParserState m (F (M.Map Text MetaValue)) + -> ParserT Text st m (Future st (M.Map Text MetaValue)) yamlMap pMetaValue o = do kvs <- forM (M.toList o) $ \(key, v) -> do k <- maybe (throwError $ PandocParseError @@ -171,3 +174,20 @@ return $ do v' <- fv return (k, v') + +-- | Parse a YAML metadata block using the supplied 'MetaValue' parser. +yamlMetaBlock :: (HasLastStrPosition st, PandocMonad m) + => ParserT Text st m (Future st MetaValue) + -> ParserT Text st m (Future st Meta) +yamlMetaBlock parser = try $ do + string "---" + blankline + notFollowedBy blankline -- if --- is followed by a blank it's an HRULE + rawYamlLines <- manyTill anyLine stopLine + -- by including --- and ..., we allow yaml blocks with just comments: + let rawYaml = T.unlines ("---" : (rawYamlLines ++ ["..."])) + optional blanklines + yamlBsToMeta parser $ UTF8.fromTextLazy $ TL.fromStrict rawYaml + +stopLine :: Monad m => ParserT Text st m () +stopLine = try $ (string "---" <|> string "...") >> blankline >> return () diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -36,7 +36,7 @@ import Text.Pandoc.Error (PandocError (PandocParsecError)) import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.Pandoc.Parsing hiding (F) +import Text.Pandoc.Parsing import Text.Pandoc.Shared (crFilter, trimr, tshow) -- | Read Muse from an input string and return a Pandoc document. diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -22,7 +22,7 @@ import Control.Arrow import qualified Control.Category as Cat import Control.Monad - +import Data.List (foldl') import Text.Pandoc.Readers.Odt.Arrows.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible @@ -122,7 +122,7 @@ iterateSL :: (Foldable f, MonadPlus m) => ArrowState s x y -> ArrowState s (f x) (m y) -iterateSL a = ArrowState $ \(s,f) -> foldl a' (s,mzero) f +iterateSL a = ArrowState $ \(s,f) -> foldl' a' (s,mzero) f where a' (s',m) x = second (mplus m.return) $ runArrowState a (s',x) diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -64,12 +64,12 @@ import Data.Text (Text) import Data.Default import Data.Maybe +import Data.List (foldl') import qualified Text.Pandoc.XML.Light as XML import Text.Pandoc.Readers.Odt.Arrows.State import Text.Pandoc.Readers.Odt.Arrows.Utils - import Text.Pandoc.Readers.Odt.Generic.Namespaces import Text.Pandoc.Readers.Odt.Generic.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible @@ -293,7 +293,7 @@ => XMLConverterState nsID extraState -> Maybe (XMLConverterState nsID extraState) extractNSAttrs startState - = foldl (\state d -> state >>= addNS d) + = foldl' (\state d -> state >>= addNS d) (Just startState) nsAttribs where nsAttribs = mapMaybe readNSattr (XML.elAttribs element) diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -44,7 +44,7 @@ import Data.Default import qualified Data.Foldable as F -import Data.List (unfoldr) +import Data.List (unfoldr, foldl') import qualified Data.Map as M import Data.Maybe import Data.Text (Text) @@ -120,7 +120,7 @@ &&& lookupDefaultingAttr NsStyle "font-pitch" )) - >>?^ ( M.fromList . foldl accumLegalPitches [] ) + >>?^ ( M.fromList . foldl' accumLegalPitches [] ) ) `ifFailedDo` returnV (Right M.empty) where accumLegalPitches ls (Nothing,_) = ls accumLegalPitches ls (Just n,p) = (n,p):ls @@ -563,12 +563,13 @@ -- chooseMostSpecificListLevelStyle :: S.Set ListLevelStyle -> Maybe ListLevelStyle -chooseMostSpecificListLevelStyle ls | ls == mempty = Nothing - | otherwise = Just ( F.foldr1 select ls ) +chooseMostSpecificListLevelStyle ls = F.foldr select Nothing ls where - select ( ListLevelStyle t1 p1 s1 f1 b1 ) - ( ListLevelStyle t2 p2 s2 f2 _ ) - = ListLevelStyle (select' t1 t2) (p1 <|> p2) (s1 <|> s2) (selectLinf f1 f2) b1 + select l Nothing = Just l + select ( ListLevelStyle t1 p1 s1 f1 b1 ) + ( Just ( ListLevelStyle t2 p2 s2 f2 _ )) + = Just $ ListLevelStyle (select' t1 t2) (p1 <|> p2) (s1 <|> s2) + (selectLinf f1 f2) b1 select' LltNumbered _ = LltNumbered select' _ LltNumbered = LltNumbered select' _ _ = LltBullet diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -39,6 +39,7 @@ import Data.List (foldl', intersperse) import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Text as T import qualified Text.Pandoc.Builder as B @@ -542,8 +543,7 @@ in case (minlvl >>= safeRead :: Maybe Int) of Nothing -> blks Just lvl -> let levels = Walk.query headerLevel blks - -- CAVE: partial function in else - curMin = if null levels then 0 else minimum levels + curMin = maybe 0 minimum $ nonEmpty levels in Walk.walk (shiftHeader (curMin - lvl)) blks headerLevel :: Block -> [Int] diff --git a/src/Text/Pandoc/Readers/Org/Parsing.hs b/src/Text/Pandoc/Readers/Org/Parsing.hs --- a/src/Text/Pandoc/Readers/Org/Parsing.hs +++ b/src/Text/Pandoc/Readers/Org/Parsing.hs @@ -106,8 +106,8 @@ import Data.Text (Text) import Text.Pandoc.Readers.Org.ParserState -import Text.Pandoc.Parsing hiding (F, anyLine, blanklines, newline, - parseFromString) +import Text.Pandoc.Parsing hiding (anyLine, blanklines, newline, + parseFromString) import qualified Text.Pandoc.Parsing as P import Control.Monad (guard) diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -613,8 +613,9 @@ string ".." skipMany1 spaceChar <|> (() <$ lookAhead newline) -- notFollowedBy' directiveLabel -- comment comes after directive so unnec. - manyTill anyChar blanklines + _ <- anyLine optional indentedBlock + optional blanklines return mempty directiveLabel :: Monad m => RSTParser m Text diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -38,7 +38,8 @@ import Control.Monad (guard, liftM) import Control.Monad.Except (throwError) import Data.Char (digitToInt, isUpper) -import Data.List (intersperse, transpose) +import Data.List (intersperse, transpose, foldl') +import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Text (Text) import qualified Data.Text as T import Text.HTML.TagSoup (Tag (..), fromAttrib) @@ -375,8 +376,9 @@ (toprow:rest) | any (fst . fst) toprow -> (toprow, rest) _ -> (mempty, rawrows) - let nbOfCols = maximum $ map length (headers:rows) - let aligns = map minimum $ transpose $ map (map (snd . fst)) (headers:rows) + let nbOfCols = maximum $ fmap length (headers :| rows) + let aligns = map (maybe AlignDefault minimum . nonEmpty) $ + transpose $ map (map (snd . fst)) (headers:rows) let toRow = Row nullAttr . map B.simpleCell toHeaderRow l = [toRow l | not (null l)] return $ B.table (B.simpleCaption $ B.plain caption) @@ -627,7 +629,7 @@ -- | Html / CSS attributes attributes :: PandocMonad m => ParserT Text ParserState m Attr -attributes = foldl (flip ($)) ("",[],[]) <$> +attributes = foldl' (flip ($)) ("",[],[]) <$> try (do special <- option id specialAttribute attrs <- many attribute return (special : attrs)) diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} {- | Module : Text.Pandoc.Readers.Txt2Tags Copyright : Copyright (C) 2014 Matthew Pickering @@ -19,6 +20,7 @@ import Control.Monad.Reader (Reader, asks, runReader) import Data.Default import Data.List (intercalate, transpose) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -53,14 +55,17 @@ inps <- P.getInputFiles outp <- fromMaybe "" <$> P.getOutputFile curDate <- formatTime defaultTimeLocale "%F" <$> P.getZonedTime - let getModTime = fmap (formatTime defaultTimeLocale "%T") . - P.getModificationTime - curMtime <- case inps of - [] -> formatTime defaultTimeLocale "%T" <$> P.getZonedTime - _ -> catchError - (maximum <$> mapM getModTime inps) - (const (return "")) - return $ T2TMeta (T.pack curDate) (T.pack curMtime) (intercalate ", " inps) outp + curMtime <- catchError + (mapM P.getModificationTime inps >>= + (\case + Nothing -> + formatTime defaultTimeLocale "%T" <$> P.getZonedTime + Just ts -> return $ + formatTime defaultTimeLocale "%T" $ maximum ts) + . nonEmpty) + (const (return "")) + return $ T2TMeta (T.pack curDate) (T.pack curMtime) + (intercalate ", " inps) outp -- | Read Txt2Tags from an input string returning a Pandoc document readTxt2Tags :: PandocMonad m @@ -261,9 +266,9 @@ rows <- many1 (many commentLine *> tableRow) let columns = transpose rows let ncolumns = length columns - let aligns = map (foldr1 findAlign . map fst) columns + let aligns = map (fromMaybe AlignDefault . foldr findAlign Nothing) columns let rows' = map (map snd) rows - let size = maximum (map length rows') + let size = maybe 0 maximum $ nonEmpty $ map length rows' let rowsPadded = map (pad size) rows' let headerPadded = if null tableHeader then mempty else pad size tableHeader let toRow = Row nullAttr . map B.simpleCell @@ -278,10 +283,11 @@ pad n xs = xs ++ replicate (n - length xs) mempty -findAlign :: Alignment -> Alignment -> Alignment -findAlign x y - | x == y = x - | otherwise = AlignDefault +findAlign :: (Alignment, a) -> Maybe Alignment -> Maybe Alignment +findAlign (x,_) (Just y) + | x == y = Just x + | otherwise = Just AlignDefault +findAlign (x,_) Nothing = Just x headerRow :: T2T [(Alignment, Blocks)] headerRow = genericRow (string "||") diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -25,11 +25,7 @@ ordNub, findM, -- * Text processing - ToString (..), - ToText (..), tshow, - backslashEscapes, - escapeStringUsing, elemText, notElemText, stripTrailingNewlines, @@ -109,7 +105,7 @@ import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum, generalCategory, GeneralCategory(NonSpacingMark, SpacingCombiningMark, EnclosingMark, ConnectorPunctuation)) -import Data.List (find, intercalate, intersperse, sortOn) +import Data.List (find, intercalate, intersperse, sortOn, foldl') import qualified Data.Map as M import Data.Maybe (mapMaybe, fromMaybe) import Data.Monoid (Any (..)) @@ -183,38 +179,9 @@ -- Text processing -- -class ToString a where - toString :: a -> String - -instance ToString String where - toString = id - -instance ToString T.Text where - toString = T.unpack - -class ToText a where - toText :: a -> T.Text - -instance ToText String where - toText = T.pack - -instance ToText T.Text where - toText = id - tshow :: Show a => a -> T.Text tshow = T.pack . show --- | Returns an association list of backslash escapes for the --- designated characters. -backslashEscapes :: [Char] -- ^ list of special characters to escape - -> [(Char, T.Text)] -backslashEscapes = map (\ch -> (ch, T.pack ['\\',ch])) - --- | Escape a string of characters, using an association list of --- characters and strings. -escapeStringUsing :: [(Char, T.Text)] -> T.Text -> T.Text -escapeStringUsing tbl = T.concatMap $ \c -> fromMaybe (T.singleton c) $ lookup c tbl - -- | @True@ exactly when the @Char@ appears in the @Text@. elemText :: Char -> T.Text -> Bool elemText c = T.any (== c) @@ -464,23 +431,21 @@ plainToPara (Plain ils) = Para ils plainToPara x = x + -- | Like @compactify@, but acts on items of definition lists. compactifyDL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])] compactifyDL items = - let defs = concatMap snd items - in case reverse (concatMap B.toList defs) of - (Para x:xs) - | not (any isPara xs) -> - let (t,ds) = last items - lastDef = B.toList $ last ds - ds' = init ds ++ - if null lastDef - then [B.fromList lastDef] - else [B.fromList $ init lastDef ++ [Plain x]] - in init items ++ [(t, ds')] - | otherwise -> items - _ -> items + case reverse items of + ((t,ds):ys) -> + case reverse (map (reverse . B.toList) ds) of + ((Para x:xs) : zs) | not (any isPara xs) -> + reverse ys ++ + [(t, reverse (map B.fromList zs) ++ + [B.fromList (reverse (Plain x:xs))])] + _ -> items + _ -> items + -- | Combine a list of lines by adding hard linebreaks. combineLines :: [[Inline]] -> [Inline] combineLines = intercalate [LineBreak] @@ -842,7 +807,7 @@ -- > collapseFilePath "parent/foo/.." == "parent" -- > collapseFilePath "/parent/foo/../../bar" == "/bar" collapseFilePath :: FilePath -> FilePath -collapseFilePath = Posix.joinPath . reverse . foldl go [] . splitDirectories +collapseFilePath = Posix.joinPath . reverse . foldl' go [] . splitDirectories where go rs "." = rs go r@(p:rs) ".." = case p of diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -34,6 +34,7 @@ import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Error +import System.IO.Error (isDoesNotExistError) -- | Wrap a Monad in this if you want partials to -- be taken only from the default data files. @@ -68,6 +69,9 @@ `catchError` (\e -> case e of PandocResourceNotFound _ -> + -- see #5987 on reason for takeFileName + readDataFile ("templates" takeFileName tp) + PandocIOError _ ioe | isDoesNotExistError ioe -> -- see #5987 on reason for takeFileName readDataFile ("templates" takeFileName tp) _ -> throwError e)) diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -22,6 +22,7 @@ import Control.Monad.State.Strict import Data.Char (isPunctuation, isSpace) import Data.List (intercalate, intersperse) +import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (fromMaybe, isJust) import qualified Data.Set as Set import qualified Data.Text as T @@ -104,8 +105,11 @@ -- | Escape special characters for AsciiDoc. escapeString :: Text -> Text -escapeString = escapeStringUsing escs - where escs = backslashEscapes "{" +escapeString t + | T.any (== '{') t = T.concatMap escChar t + | otherwise = t + where escChar '{' = "\\{" + escChar c = T.singleton c -- | Ordered list start parser for use in Para below. olMarker :: Parser Text ParserState Char @@ -274,7 +278,7 @@ let colwidth = if writerWrapText opts == WrapAuto then writerColumns opts else 100000 - let maxwidth = maximum $ map offset (head':rows') + let maxwidth = maximum $ fmap offset (head' :| rows') let body = if maxwidth > colwidth then vsep rows' else vcat rows' let border = separator <> text "===" return $ @@ -495,7 +499,9 @@ | otherwise -> [Str "``"] ++ lst ++ [Str "''"] inlineToAsciiDoc _ (Code _ str) = do isAsciidoctor <- gets asciidoctorVariant - let contents = literal (escapeStringUsing (backslashEscapes "`") str) + let escChar '`' = "\\'" + escChar c = T.singleton c + let contents = literal (T.concatMap escChar str) return $ if isAsciidoctor then text "`+" <> contents <> "+`" diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -16,6 +16,7 @@ import Control.Monad.State.Strict import Data.Char (ord, isDigit) import Data.List (intersperse) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (mapMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -228,8 +229,9 @@ Period -> "stopper=." OneParen -> "stopper=)" TwoParens -> "left=(,stopper=)" - let width = maximum $ map T.length $ take (length contents) - (orderedListMarkers (start, style', delim)) + let width = maybe 0 maximum $ nonEmpty $ map T.length $ + take (length contents) + (orderedListMarkers (start, style', delim)) let width' = (toEnum width + 1) / 2 let width'' = if width' > (1.5 :: Double) then "width=" <> tshow width' <> "em" @@ -432,9 +434,13 @@ put $ st {stNextRef = next + 1} let ref = "url" <> tshow next contents <- inlineListToConTeXt txt + let escChar '#' = "\\#" + escChar '%' = "\\%" + escChar c = T.singleton c + let escContextURL = T.concatMap escChar return $ "\\useURL" <> brackets (literal ref) - <> brackets (literal $ escapeStringUsing [('#',"\\#"),('%',"\\%")] src) + <> brackets (literal $ escContextURL src) <> (if isAutolink then empty else brackets empty <> brackets contents) diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -168,7 +168,7 @@ blockToDocbook _ Null = return empty -- Add ids to paragraphs in divs with ids - this is needed for -- pandoc-citeproc to get link anchors in bibliographies: -blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do +blockToDocbook opts (Div (id',"section":_,_) (Header lvl (_,_,attrs) ils : xs)) = do version <- ask -- Docbook doesn't allow sections with no content, so insert some if needed let bs = if null xs @@ -188,7 +188,10 @@ -- standalone documents will include them in the template. then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")] else [] - attribs = nsAttr <> idAttr + + -- Populate miscAttr with Header.Attr.attributes, filtering out non-valid DocBook section attributes, id, and xml:id + miscAttr = filter (isSectionAttr version) attrs + attribs = nsAttr <> idAttr <> miscAttr title' <- inlinesToDocbook opts ils contents <- blocksToDocbook opts bs return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents @@ -451,3 +454,43 @@ where ident = [("id", id') | not (T.null id')] role = [("role", T.unwords cls) | not (null cls)] + +isSectionAttr :: DocBookVersion -> (Text, Text) -> Bool +isSectionAttr _ ("label",_) = True +isSectionAttr _ ("status",_) = True +isSectionAttr DocBook5 ("annotations",_) = True +isSectionAttr DocBook5 ("dir","ltr") = True +isSectionAttr DocBook5 ("dir","rtl") = True +isSectionAttr DocBook5 ("dir","lro") = True +isSectionAttr DocBook5 ("dir","rlo") = True +isSectionAttr _ ("remap",_) = True +isSectionAttr _ ("revisionflag","changed") = True +isSectionAttr _ ("revisionflag","added") = True +isSectionAttr _ ("revisionflag","deleted") = True +isSectionAttr _ ("revisionflag","off") = True +isSectionAttr _ ("role",_) = True +isSectionAttr DocBook5 ("version",_) = True +isSectionAttr DocBook5 ("xml:base",_) = True +isSectionAttr DocBook5 ("xml:lang",_) = True +isSectionAttr _ ("xreflabel",_) = True +isSectionAttr DocBook5 ("linkend",_) = True +isSectionAttr DocBook5 ("linkends",_) = True +isSectionAttr DocBook5 ("xlink:actuate",_) = True +isSectionAttr DocBook5 ("xlink:arcrole",_) = True +isSectionAttr DocBook5 ("xlink:from",_) = True +isSectionAttr DocBook5 ("xlink:href",_) = True +isSectionAttr DocBook5 ("xlink:label",_) = True +isSectionAttr DocBook5 ("xlink:role",_) = True +isSectionAttr DocBook5 ("xlink:show",_) = True +isSectionAttr DocBook5 ("xlink:title",_) = True +isSectionAttr DocBook5 ("xlink:to",_) = True +isSectionAttr DocBook5 ("xlink:type",_) = True +isSectionAttr DocBook4 ("arch",_) = True +isSectionAttr DocBook4 ("condition",_) = True +isSectionAttr DocBook4 ("conformance",_) = True +isSectionAttr DocBook4 ("lang",_) = True +isSectionAttr DocBook4 ("os",_) = True +isSectionAttr DocBook4 ("revision",_) = True +isSectionAttr DocBook4 ("security",_) = True +isSectionAttr DocBook4 ("vendor",_) = True +isSectionAttr _ (_,_) = False diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -36,7 +36,6 @@ import Data.Time.Clock.POSIX import Data.Digest.Pure.SHA (sha1, showDigest) import Skylighting -import System.Random (randomRs, mkStdGen) import Text.Pandoc.BCP47 (getLang, renderLang) import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang) import qualified Text.Pandoc.Class.PandocMonad as P @@ -695,8 +694,7 @@ mkNumbering :: [ListMarker] -> [Element] mkNumbering lists = elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)] - where elts = zipWith mkAbstractNum (ordNub lists) $ - randomRs (0x10000000, 0xFFFFFFFF) $ mkStdGen 1848 + where elts = map mkAbstractNum (ordNub lists) maxListLevel :: Int maxListLevel = 8 @@ -713,10 +711,10 @@ $ mknode "w:startOverride" [("w:val",tshow start)] ()) [0..maxListLevel] -mkAbstractNum :: ListMarker -> Integer -> Element -mkAbstractNum marker nsid = +mkAbstractNum :: ListMarker -> Element +mkAbstractNum marker = mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)] - $ mknode "w:nsid" [("w:val", T.pack $ printf "%8x" nsid)] () + $ mknode "w:nsid" [("w:val", "A" <> listMarkerToId marker)] () : mknode "w:multiLevelType" [("w:val","multilevel")] () : map (mkLvl marker) [0..maxListLevel] @@ -1031,7 +1029,7 @@ map mkcell cells let textwidth = 7920 -- 5.5 in in twips, 1/20 pt let fullrow = 5000 -- 100% specified in pct - let rowwidth = fullrow * sum widths + let (rowwidth :: Int) = round $ fullrow * sum widths let mkgridcol w = mknode "w:gridCol" [("w:w", tshow (floor (textwidth * w) :: Integer))] () let hasHeader = not $ all null headers diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -27,6 +27,7 @@ import Control.Monad.State.Strict (StateT, evalStateT) import Data.Default (Default (..)) import Data.List (transpose) +import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Class.PandocMonad (PandocMonad, report) @@ -172,7 +173,8 @@ then return [] else zipWithM (tableItemToDokuWiki opts) aligns headers rows' <- mapM (zipWithM (tableItemToDokuWiki opts) aligns) rows - let widths = map (maximum . map T.length) $ transpose (headers':rows') + let widths = map (maybe 0 maximum . nonEmpty . map T.length) + $ transpose (headers':rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -30,9 +30,9 @@ ) where import Control.Monad.State.Strict import Data.Char (ord) -import Data.List (intercalate, intersperse, partition, delete, (\\)) +import Data.List (intercalate, intersperse, partition, delete, (\\), foldl') import Data.List.NonEmpty (NonEmpty((:|))) -import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe) +import Data.Maybe (fromMaybe, isJust, isNothing) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T @@ -544,30 +544,35 @@ addAttrs :: PandocMonad m => WriterOptions -> Attr -> Html -> StateT WriterState m Html -addAttrs opts attr h = foldl (!) h <$> attrsToHtml opts attr +addAttrs opts attr h = foldl' (!) h <$> attrsToHtml opts attr toAttrs :: PandocMonad m => [(Text, Text)] -> StateT WriterState m [Attribute] toAttrs kvs = do html5 <- gets stHtml5 mbEpubVersion <- gets stEPUBVersion - return $ mapMaybe (\(x,y) -> - if html5 - then - if x `Set.member` (html5Attributes <> rdfaAttributes) - || T.any (== ':') x -- e.g. epub: namespace - || "data-" `T.isPrefixOf` x - || "aria-" `T.isPrefixOf` x - then Just $ customAttribute (textTag x) (toValue y) - else Just $ customAttribute (textTag ("data-" <> x)) - (toValue y) - else - if mbEpubVersion == Just EPUB2 && - not (x `Set.member` (html4Attributes <> rdfaAttributes) || - "xml:" `T.isPrefixOf` x) - then Nothing - else Just $ customAttribute (textTag x) (toValue y)) - kvs + reverse . snd <$> foldM (go html5 mbEpubVersion) (Set.empty, []) kvs + where + go html5 mbEpubVersion (keys, attrs) (k,v) = do + if k `Set.member` keys + then do + report $ DuplicateAttribute k v + return (keys, attrs) + else return (Set.insert k keys, addAttr html5 mbEpubVersion k v attrs) + addAttr html5 mbEpubVersion x y + | html5 + = if x `Set.member` (html5Attributes <> rdfaAttributes) + || T.any (== ':') x -- e.g. epub: namespace + || "data-" `T.isPrefixOf` x + || "aria-" `T.isPrefixOf` x + then (customAttribute (textTag x) (toValue y) :) + else (customAttribute (textTag ("data-" <> x)) (toValue y) :) + | mbEpubVersion == Just EPUB2 + , not (x `Set.member` (html4Attributes <> rdfaAttributes) || + "xml:" `T.isPrefixOf` x) + = id + | otherwise + = (customAttribute (textTag x) (toValue y) :) attrsToHtml :: PandocMonad m => WriterOptions -> Attr -> StateT WriterState m [Attribute] @@ -921,7 +926,7 @@ numstyle'] else []) l <- ordList opts contents - return $ foldl (!) l attribs + return $ foldl' (!) l attribs blockToHtml opts (DefinitionList lst) = do contents <- mapM (\(term, defs) -> do term' <- liftM H.dt $ inlineListToHtml opts term @@ -1402,7 +1407,7 @@ Just "audio" -> mediaTag H5.audio "Audio" Just _ -> (H5.embed, []) _ -> imageTag - return $ foldl (!) tag $ attributes ++ specAttrs + return $ foldl' (!) tag $ attributes ++ specAttrs -- note: null title included, as in Markdown.pl (Note contents) -> do notes <- gets stNotes diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -15,6 +15,7 @@ -} module Text.Pandoc.Writers.Haddock (writeHaddock) where import Control.Monad.State.Strict +import Data.Char (isAlphaNum) import Data.Default import Data.Text (Text) import qualified Data.Text as T @@ -71,8 +72,18 @@ -- | Escape special characters for Haddock. escapeString :: Text -> Text -escapeString = escapeStringUsing haddockEscapes - where haddockEscapes = backslashEscapes "\\/'`\"@<" +escapeString t + | T.all isAlphaNum t = t + | otherwise = T.concatMap escChar t + where + escChar '\\' = "\\\\" + escChar '/' = "\\/" + escChar '\'' = "\\'" + escChar '`' = "\\`" + escChar '"' = "\\\"" + escChar '@' = "\\@" + escChar '<' = "\\<" + escChar c = T.singleton c -- | Convert Pandoc block element to haddock. blockToHaddock :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs --- a/src/Text/Pandoc/Writers/Jira.hs +++ b/src/Text/Pandoc/Writers/Jira.hs @@ -39,11 +39,17 @@ writeJira opts = runDefaultConverter (writerWrapText opts) (pandocToJira opts) -- | State to keep track of footnotes. -newtype ConverterState = ConverterState { stNotes :: [Text] } +data ConverterState = ConverterState + { stNotes :: [Text] -- ^ Footnotes to be appended to the end of the text + , stInPanel :: Bool -- ^ whether we are in a @{panel}@ block + } -- | Initial converter state. startState :: ConverterState -startState = ConverterState { stNotes = [] } +startState = ConverterState + { stNotes = [] + , stInPanel = False + } -- | Converter monad type JiraConverter m = ReaderT WrapOption (StateT ConverterState m) @@ -126,14 +132,20 @@ -> Text -> JiraConverter m [Jira.Block] toJiraCode (ident, classes, _attribs) code = do - let addAnchor b = if T.null ident - then b - else [Jira.Para (singleton (Jira.Anchor ident))] <> b - return . addAnchor . singleton $ + return . addAnchor ident . singleton $ case find (\c -> T.toLower c `elem` knownLanguages) classes of Nothing -> Jira.NoFormat mempty code Just l -> Jira.Code (Jira.Language l) mempty code +-- | Prepends an anchor with the given identifier. +addAnchor :: Text -> [Jira.Block] -> [Jira.Block] +addAnchor ident = + if T.null ident + then id + else \case + Jira.Para xs : bs -> (Jira.Para (Jira.Anchor ident : xs) : bs) + bs -> (Jira.Para (singleton (Jira.Anchor ident)) : bs) + -- | Creates a Jira definition list toJiraDefinitionList :: PandocMonad m => [([Inline], [[Block]])] @@ -149,11 +161,16 @@ toJiraPanel :: PandocMonad m => Attr -> [Block] -> JiraConverter m [Jira.Block] -toJiraPanel attr blocks = do - jiraBlocks <- toJiraBlocks blocks - return $ if attr == nullAttr - then jiraBlocks - else singleton (Jira.Panel [] jiraBlocks) +toJiraPanel (ident, classes, attribs) blocks = do + inPanel <- gets stInPanel + if inPanel || ("panel" `notElem` classes && null attribs) + then addAnchor ident <$> toJiraBlocks blocks + else do + modify $ \st -> st{ stInPanel = True } + jiraBlocks <- toJiraBlocks blocks + modify $ \st -> st{ stInPanel = inPanel } + let params = map (uncurry Jira.Parameter) attribs + return $ singleton (Jira.Panel params $ addAnchor ident jiraBlocks) -- | Creates a Jira header toJiraHeader :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -145,6 +146,11 @@ let dirs = query (extract "dir") blocks + let nociteIds = query (\case + Cite cs _ -> map citationId cs + _ -> []) + $ lookupMetaInlines "nocite" meta + let context = defField "toc" (writerTableOfContents options) $ defField "toc-depth" (tshow (writerTOCDepth options - @@ -177,9 +183,11 @@ else id) $ (case writerCiteMethod options of Natbib -> defField "biblio-title" biblioTitle . - defField "natbib" True + defField "natbib" True . + defField "nocite-ids" nociteIds Biblatex -> defField "biblio-title" biblioTitle . - defField "biblatex" True + defField "biblatex" True . + defField "nocite-ids" nociteIds _ -> id) $ defField "colorlinks" (any hasStringValue ["citecolor", "urlcolor", "linkcolor", "toccolor", @@ -817,7 +825,19 @@ let chr = case "!\"'()*,-./:;?@" \\ T.unpack str of (c:_) -> c [] -> '!' - let str' = escapeStringUsing (backslashEscapes "\\{}%~_&#^") str + let isEscapable '\\' = True + isEscapable '{' = True + isEscapable '}' = True + isEscapable '%' = True + isEscapable '~' = True + isEscapable '_' = True + isEscapable '&' = True + isEscapable '#' = True + isEscapable '^' = True + isEscapable _ = False + let escChar c | isEscapable c = T.pack ['\\',c] + | otherwise = T.singleton c + let str' = T.concatMap escChar str -- we always put lstinline in a dummy 'passthrough' command -- (defined in the default template) so that we don't have -- to change the way we escape characters depending on whether diff --git a/src/Text/Pandoc/Writers/LaTeX/Caption.hs b/src/Text/Pandoc/Writers/LaTeX/Caption.hs --- a/src/Text/Pandoc/Writers/LaTeX/Caption.hs +++ b/src/Text/Pandoc/Writers/LaTeX/Caption.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Writers.LaTeX.Caption Copyright : Copyright (C) 2006-2021 John MacFarlane diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -16,6 +16,7 @@ module Text.Pandoc.Writers.Man ( writeMan ) where import Control.Monad.State.Strict import Data.List (intersperse) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -175,8 +176,7 @@ return (vcat contents) blockToMan opts (OrderedList attribs items) = do let markers = take (length items) $ orderedListMarkers attribs - let indent = 1 + - maximum (map T.length markers) + let indent = 1 + maybe 0 maximum (nonEmpty (map T.length markers)) contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $ zip markers items return (vcat contents) diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -24,6 +24,7 @@ import Control.Monad.State.Strict import Data.Default import Data.List (intersperse, sortOn, transpose) +import Data.List.NonEmpty (nonEmpty, NonEmpty(..)) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Set as Set @@ -492,19 +493,20 @@ | isEnabled Ext_fenced_code_blocks opts -> tildes <> attrs <> cr <> literal str <> cr <> tildes <> blankline _ -> nest (writerTabStop opts) (literal str) <> blankline - where endline c = literal $ case [T.length ln - | ln <- map trim (T.lines str) - , T.pack [c,c,c] `T.isPrefixOf` ln - , T.all (== c) ln] of - [] -> T.replicate 3 $ T.singleton c - xs -> T.replicate (maximum xs + 1) $ T.singleton c - backticks = endline '`' - tildes = endline '~' - attrs = if isEnabled Ext_fenced_code_attributes opts - then nowrap $ " " <> attrsToMarkdown attribs - else case attribs of - (_,cls:_,_) -> " " <> literal cls - _ -> empty + where + endlineLen c = maybe 3 ((+1) . maximum) $ nonEmpty $ + [T.length ln + | ln <- map trim (T.lines str) + , T.pack [c,c,c] `T.isPrefixOf` ln + , T.all (== c) ln] + endline c = literal $ T.replicate (endlineLen c) $ T.singleton c + backticks = endline '`' + tildes = endline '~' + attrs = if isEnabled Ext_fenced_code_attributes opts + then nowrap $ " " <> attrsToMarkdown attribs + else case attribs of + (_,cls:_,_) -> " " <> literal cls + _ -> empty blockToMarkdown' opts (BlockQuote blocks) = do variant <- asks envVariant -- if we're writing literate haskell, put a space before the bird tracks @@ -517,7 +519,7 @@ return $ prefixed leader contents <> blankline blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot - let numcols = maximum (length aligns : length widths : + let numcols = maximum (length aligns :| length widths : map length (headers:rows)) caption' <- inlineListToMarkdown opts caption let caption'' @@ -619,7 +621,8 @@ blockFor AlignCenter x y = cblock (x + 2) (sp <> y <> sp) <> lblock 0 empty blockFor AlignRight x y = rblock (x + 2) (y <> sp) <> lblock 0 empty blockFor _ x y = lblock (x + 2) (sp <> y) <> lblock 0 empty - let widths = map (max 3 . maximum . map offset) $ transpose (rawHeaders : rawRows) + let widths = map (max 3 . maybe 3 maximum . nonEmpty . map offset) $ + transpose (rawHeaders : rawRows) let torow cs = nowrap $ literal "|" <> hcat (intersperse (literal "|") $ zipWith3 blockFor aligns widths (map chomp cs)) @@ -653,11 +656,11 @@ -- Number of characters per column necessary to output every cell -- without requiring a line break. -- The @+2@ is needed for specifying the alignment. - let numChars = (+ 2) . maximum . map offset + let numChars = (+ 2) . maybe 0 maximum . nonEmpty . map offset -- Number of characters per column necessary to output every cell -- without requiring a line break *inside a word*. -- The @+2@ is needed for specifying the alignment. - let minNumChars = (+ 2) . maximum . map minOffset + let minNumChars = (+ 2) . maybe 0 maximum . nonEmpty . map minOffset let columns = transpose (rawHeaders : rawRows) -- minimal column width without wrapping a single word let relWidth w col = diff --git a/src/Text/Pandoc/Writers/Markdown/Inline.hs b/src/Text/Pandoc/Writers/Markdown/Inline.hs --- a/src/Text/Pandoc/Writers/Markdown/Inline.hs +++ b/src/Text/Pandoc/Writers/Markdown/Inline.hs @@ -17,6 +17,7 @@ import Control.Monad.State.Strict import Data.Char (isAlphaNum, isDigit) import Data.List (find, intersperse) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -383,9 +384,7 @@ else "“" <> contents <> "”" inlineToMarkdown opts (Code attr str) = do let tickGroups = filter (T.any (== '`')) $ T.group str - let longest = if null tickGroups - then 0 - else maximum $ map T.length tickGroups + let longest = maybe 0 maximum $ nonEmpty $ map T.length tickGroups let marker = T.replicate (longest + 1) "`" let spacer = if longest == 0 then "" else " " let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr @@ -438,9 +437,7 @@ (texMathToInlines DisplayMath str >>= inlineListToMarkdown opts) inlineToMarkdown opts il@(RawInline f str) = do let tickGroups = filter (T.any (== '`')) $ T.group str - let numticks = if null tickGroups - then 1 - else 1 + maximum (map T.length tickGroups) + let numticks = 1 + maybe 0 maximum (nonEmpty (map T.length tickGroups)) variant <- asks envVariant let Format fmt = f let rawAttribInline = return $ diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -23,6 +23,7 @@ import Control.Monad.State.Strict import Data.Char (isLower, isUpper, ord) import Data.List (intercalate, intersperse) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as Map import Data.Maybe (catMaybes) import Data.Text (Text) @@ -274,8 +275,7 @@ return (vcat contents) blockToMs opts (OrderedList attribs items) = do let markers = take (length items) $ orderedListMarkers attribs - let indent = 2 + - maximum (map T.length markers) + let indent = 2 + maybe 0 maximum (nonEmpty (map T.length markers)) contents <- mapM (\(num, item) -> orderedListItemToMs opts num indent item) $ zip markers items setFirstPara diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -31,6 +31,7 @@ import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit, isSpace) import Data.Default import Data.List (intersperse, transpose) +import Data.List.NonEmpty (nonEmpty, NonEmpty(..)) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text (Text) @@ -158,7 +159,8 @@ caption' <- inlineListToMuse caption headers' <- mapM blockListToMuse headers rows' <- mapM (mapM blockListToMuse) rows - let widthsInChars = maximum . map offset <$> transpose (headers' : rows') + let widthsInChars = maybe 0 maximum . nonEmpty . map offset <$> + transpose (headers' : rows') let hpipeBlocks sep blocks = hcat $ intersperse sep' blocks where sep' = lblock (T.length sep) $ literal sep let makeRow sep = hpipeBlocks sep . zipWith lblock widthsInChars @@ -238,7 +240,7 @@ label' <- local (\env -> env { envOneLine = True, envAfterSpace = True }) $ inlineListToMuse' label let ind = offset' label' -- using Text.DocLayout.offset results in round trip failures hang ind (nowrap label') . vcat <$> mapM descriptionToMuse defs - where offset' d = maximum (0: map T.length + where offset' d = maximum (0 :| map T.length (T.lines $ render Nothing d)) descriptionToMuse :: PandocMonad m => [Block] @@ -269,7 +271,8 @@ (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot blocksToDoc opts blocks = local (\env -> env { envOptions = opts }) $ blockListToMuse blocks - numcols = maximum (length aligns : length widths : map length (headers:rows)) + numcols = maximum + (length aligns :| length widths : map length (headers:rows)) isSimple = onlySimpleTableCells (headers : rows) && all (== 0) widths blockToMuse (Div _ bs) = flatBlockListToMuse bs blockToMuse Null = return empty diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -17,8 +17,9 @@ -} module Text.Pandoc.Writers.Org (writeOrg) where import Control.Monad.State.Strict -import Data.Char (isAlphaNum) +import Data.Char (isAlphaNum, isDigit) import Data.List (intersect, intersperse, partition, transpose) +import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Class.PandocMonad (PandocMonad, report) @@ -83,12 +84,15 @@ -- | Escape special characters for Org. escapeString :: Text -> Text -escapeString = escapeStringUsing - [ ('\x2014',"---") - , ('\x2013',"--") - , ('\x2019',"'") - , ('\x2026',"...") - ] +escapeString t + | T.all (\c -> c < '\x2013' || c > '\x2026') t = t + | otherwise = T.concatMap escChar t + where + escChar '\x2013' = "--" + escChar '\x2014' = "---" + escChar '\x2019' = "'" + escChar '\x2026' = "..." + escChar c = T.singleton c isRawFormat :: Format -> Bool isRawFormat f = @@ -163,7 +167,7 @@ else "#+caption: " <> caption'' headers' <- mapM blockListToOrg headers rawRows <- mapM (mapM blockListToOrg) rows - let numChars = maximum . map offset + let numChars = maybe 0 maximum . nonEmpty . map offset -- FIXME: width is not being used. let widthsInChars = map numChars $ transpose (headers' : rawRows) @@ -198,7 +202,7 @@ x -> x let markers = take (length items) $ orderedListMarkers (start, Decimal, delim') - let maxMarkerLength = maximum $ map T.length markers + let maxMarkerLength = maybe 0 maximum . nonEmpty $ map T.length markers let markers' = map (\m -> let s = maxMarkerLength - T.length m in m <> T.replicate s " ") markers contents <- zipWithM orderedListItemToOrg markers' items @@ -347,16 +351,20 @@ => [Inline] -> Org m (Doc Text) inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst) - where fixMarkers [] = [] -- prevent note refs and list markers from wrapping, see #4171 + where -- Prevent note refs and list markers from wrapping, see #4171 + -- and #7132. + fixMarkers [] = [] fixMarkers (Space : x : rest) | shouldFix x = Str " " : x : fixMarkers rest fixMarkers (SoftBreak : x : rest) | shouldFix x = Str " " : x : fixMarkers rest fixMarkers (x : rest) = x : fixMarkers rest - shouldFix Note{} = True -- Prevent footnotes + shouldFix Note{} = True -- Prevent footnotes shouldFix (Str "-") = True -- Prevent bullet list items - -- TODO: prevent ordered list items + shouldFix (Str x) -- Prevent ordered list items + | Just (cs, c) <- T.unsnoc x = T.all isDigit cs && + (c == '.' || c == ')') shouldFix _ = False -- | Convert Pandoc inline element to Org. diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -50,6 +50,7 @@ import Text.Pandoc.Writers.Powerpoint.Presentation import Text.Pandoc.Shared (tshow) import Skylighting (fromColor) +import Data.List.NonEmpty (nonEmpty) -- |The 'EMU' type is used to specify sizes in English Metric Units. type EMU = Integer @@ -474,15 +475,16 @@ linkReg <- gets stLinkIds mediaReg <- gets stMediaIds hasSpeakerNotes <- curSlideHasSpeakerNotes - let maxLinkId = case M.lookup curSlideId linkReg of - Just mp -> case M.keys mp of - [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks - Nothing -> if hasSpeakerNotes then 2 else 1 - maxMediaId = case M.lookup curSlideId mediaReg of - Just [] -> if hasSpeakerNotes then 2 else 1 - Just mInfos -> maximum $ map mInfoLocalId mInfos - Nothing -> if hasSpeakerNotes then 2 else 1 + let maxLinkId = case M.lookup curSlideId linkReg >>= nonEmpty . M.keys of + Just xs -> maximum xs + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 + maxMediaId = case M.lookup curSlideId mediaReg >>= nonEmpty of + Just mInfos -> maximum $ fmap mInfoLocalId mInfos + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 maxId = max maxLinkId maxMediaId slideLinks = case M.lookup curSlideId linkReg of Just mp -> M.insert (maxId + 1) link mp @@ -497,20 +499,19 @@ mediaReg <- gets stMediaIds globalIds <- gets stMediaGlobalIds hasSpeakerNotes <- curSlideHasSpeakerNotes - let maxLinkId = case M.lookup curSlideId linkReg of - Just mp -> case M.keys mp of - [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks - Nothing -> if hasSpeakerNotes then 2 else 1 - maxMediaId = case M.lookup curSlideId mediaReg of - Just [] -> if hasSpeakerNotes then 2 else 1 - Just mInfos -> maximum $ map mInfoLocalId mInfos - Nothing -> if hasSpeakerNotes then 2 else 1 + let maxLinkId = case M.lookup curSlideId linkReg >>= nonEmpty . M.keys of + Just ks -> maximum ks + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 + maxMediaId = case M.lookup curSlideId mediaReg >>= nonEmpty of + Just mInfos -> maximum $ fmap mInfoLocalId mInfos + Nothing + | hasSpeakerNotes -> 2 + | otherwise -> 1 maxLocalId = max maxLinkId maxMediaId - maxGlobalId = case M.elems globalIds of - [] -> 0 - ids -> maximum ids + maxGlobalId = maybe 0 maximum $ nonEmpty $ M.elems globalIds (imgBytes, mbMt) <- P.fetchItem $ T.pack fp let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ "." <> x)) @@ -1427,11 +1428,8 @@ -- all relWithoutSlide rels (unless they're 1) -- 3. If we have a notesmaster slide, we make space for that as well. - let minRelNotOne = case filter (1<) $ map relId relsWeKeep of - [] -> 0 -- doesn't matter in this case, since - -- there will be nothing to map the - -- function over - l -> minimum l + let minRelNotOne = maybe 0 minimum $ nonEmpty + $ filter (1 <) $ map relId relsWeKeep modifyRelNum :: Int -> Int modifyRelNum 1 = 1 diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -45,6 +45,7 @@ import Control.Monad.Reader import Control.Monad.State import Data.List (intercalate) +import Data.List.NonEmpty (nonEmpty) import Data.Default import Text.Pandoc.Definition import Text.Pandoc.ImageSize @@ -363,9 +364,7 @@ then return [] else do notes <- gets stNoteIds - let maxNoteId = case M.keys notes of - [] -> 0 - lst -> maximum lst + let maxNoteId = maybe 0 maximum $ nonEmpty $ M.keys notes curNoteId = maxNoteId + 1 modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes } local (\env -> env{envRunProps = (envRunProps env){rLink = Just $ InternalTarget endNotesSlideId}}) $ diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -16,7 +16,8 @@ module Text.Pandoc.Writers.RST ( writeRST, flatten ) where import Control.Monad.State.Strict import Data.Char (isSpace) -import Data.List (transpose, intersperse) +import Data.List (transpose, intersperse, foldl') +import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text (Text) @@ -335,7 +336,7 @@ then replicate (length items) "#." else take (length items) $ orderedListMarkers (start, style', delim) - let maxMarkerLength = maximum $ map T.length markers + let maxMarkerLength = maybe 0 maximum $ NE.nonEmpty $ map T.length markers let markers' = map (\m -> let s = maxMarkerLength - T.length m in m <> T.replicate s " ") markers contents <- zipWithM orderedListItemToRST markers' items @@ -509,7 +510,7 @@ | null contents = [outer] | otherwise = combineAll contents where contents = dropInlineParent outer - combineAll = foldl combine [] + combineAll = foldl' combine [] combine :: [Inline] -> Inline -> [Inline] combine f i = @@ -537,11 +538,15 @@ collapse f i = appendToLast f $ dropInlineParent i appendToLast :: [Inline] -> [Inline] -> [Inline] - appendToLast [] toAppend = [setInlineChildren outer toAppend] - appendToLast flattened toAppend - | isOuter lastFlat = init flattened <> [appendTo lastFlat toAppend] - | otherwise = flattened <> [setInlineChildren outer toAppend] - where lastFlat = last flattened + appendToLast flattened toAppend = + case NE.nonEmpty flattened of + Nothing -> [setInlineChildren outer toAppend] + Just xs -> + if isOuter lastFlat + then NE.init xs <> [appendTo lastFlat toAppend] + else flattened <> [setInlineChildren outer toAppend] + where + lastFlat = NE.last xs appendTo o i = mapNested (<> i) o isOuter i = emptyParent i == emptyParent outer emptyParent i = setInlineChildren i [] @@ -761,8 +766,7 @@ then return [] else fixEmpties <$> mapM (blocksToDoc opts) headers rowDocs <- mapM (fmap fixEmpties . mapM (blocksToDoc opts)) rows - let numChars [] = 0 - numChars xs = maximum . map offset $ xs + let numChars = maybe 0 maximum . NE.nonEmpty . map offset let colWidths = map numChars $ transpose (headerDocs : rowDocs) let toRow = mconcat . intersperse (lblock 1 " ") . zipWith lblock colWidths let hline = nowrap $ hsep (map (\n -> literal (T.replicate n "=")) colWidths) diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -16,7 +16,7 @@ import Control.Monad.Except (catchError, throwError) import Control.Monad import qualified Data.ByteString as B -import Data.Char (chr, isDigit, ord) +import Data.Char (chr, isDigit, ord, isAlphaNum) import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T @@ -137,15 +137,21 @@ -- | Escape special characters. escapeSpecial :: Text -> Text -escapeSpecial = escapeStringUsing $ - [ ('\t',"\\tab ") - , ('\8216',"\\u8216'") - , ('\8217',"\\u8217'") - , ('\8220',"\\u8220\"") - , ('\8221',"\\u8221\"") - , ('\8211',"\\u8211-") - , ('\8212',"\\u8212-") - ] <> backslashEscapes "{\\}" +escapeSpecial t + | T.all isAlphaNum t = t + | otherwise = T.concatMap escChar t + where + escChar '\t' = "\\tab " + escChar '\8216' = "\\u8216'" + escChar '\8217' = "\\u8217'" + escChar '\8220' = "\\u8220\"" + escChar '\8221' = "\\u8221\"" + escChar '\8211' = "\\u8211-" + escChar '\8212' = "\\u8212-" + escChar '{' = "\\{" + escChar '}' = "\\}" + escChar '\\' = "\\\\" + escChar c = T.singleton c -- | Escape strings as needed for rich text format. stringToRTF :: Text -> Text diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -44,6 +44,7 @@ import Data.Aeson (ToJSON (..), encode) import Data.Char (chr, ord, isSpace) import Data.List (groupBy, intersperse, transpose, foldl') +import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Text.Conversions (FromText(..)) import qualified Data.Map as M import qualified Data.Text as T @@ -224,7 +225,7 @@ -> m (Doc a) gridTable opts blocksToDoc headless aligns widths headers rows = do -- the number of columns will be used in case of even widths - let numcols = maximum (length aligns : length widths : + let numcols = maximum (length aligns :| length widths : map length (headers:rows)) let officialWidthsInChars widths' = map ( (\x -> if x < 1 then 1 else x) . @@ -253,8 +254,7 @@ let handleFullWidths widths' = do rawHeaders' <- mapM (blocksToDoc opts) headers rawRows' <- mapM (mapM (blocksToDoc opts)) rows - let numChars [] = 0 - numChars xs = maximum . map offset $ xs + let numChars = maybe 0 maximum . nonEmpty . map offset let minWidthsInChars = map numChars $ transpose (rawHeaders' : rawRows') let widthsInChars' = zipWith max diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -14,8 +14,9 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where import Control.Monad.Except (throwError) import Control.Monad.State.Strict -import Data.Char (chr, ord) -import Data.List (maximumBy, transpose) +import Data.Char (chr, ord, isAlphaNum) +import Data.List (maximumBy, transpose, foldl') +import Data.List.NonEmpty (nonEmpty) import Data.Ord (comparing) import qualified Data.Set as Set import Data.Text (Text) @@ -84,16 +85,18 @@ -- | Escape things as needed for Texinfo. stringToTexinfo :: Text -> Text -stringToTexinfo = escapeStringUsing texinfoEscapes - where texinfoEscapes = [ ('{', "@{") - , ('}', "@}") - , ('@', "@@") - , ('\160', "@ ") - , ('\x2014', "---") - , ('\x2013', "--") - , ('\x2026', "@dots{}") - , ('\x2019', "'") - ] +stringToTexinfo t + | T.all isAlphaNum t = t + | otherwise = T.concatMap escChar t + where escChar '{' = "@{" + escChar '}' = "@}" + escChar '@' = "@@" + escChar '\160' = "@ " + escChar '\x2014' = "---" + escChar '\x2013' = "--" + escChar '\x2026' = "@dots{}" + escChar '\x2019' = "'" + escChar c = T.singleton c escapeCommas :: PandocMonad m => TI m (Doc Text) -> TI m (Doc Text) escapeCommas parser = do @@ -238,9 +241,13 @@ colDescriptors <- if all (== 0) widths then do -- use longest entry instead of column widths - cols <- mapM (mapM (liftM (T.unpack . render Nothing . hcat) . mapM blockToTexinfo)) $ + cols <- mapM (mapM (fmap (T.unpack . render Nothing . hcat) . + mapM blockToTexinfo)) $ transpose $ heads : rows - return $ concatMap ((\x -> "{"++x++"} ") . maximumBy (comparing length)) cols + return $ concatMap + ((\x -> "{"++x++"} ") . + maybe "" (maximumBy (comparing length)) . nonEmpty) + cols else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths let tableBody = text ("@multitable " ++ colDescriptors) $$ headers $$ @@ -271,7 +278,7 @@ -> [[Block]] -> TI m (Doc Text) tableAnyRowToTexinfo itemtype aligns cols = - (literal itemtype $$) . foldl (\row item -> row $$ + (literal itemtype $$) . foldl' (\row item -> row $$ (if isEmpty row then empty else text " @tab ") <> item) empty <$> zipWithM alignedBlock aligns cols alignedBlock :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -20,6 +20,7 @@ import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Default (Default (..)) import Data.List (transpose) +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as Map import Text.DocLayout (render, literal) import Data.Maybe (fromMaybe) @@ -143,7 +144,8 @@ then zipWithM (tableItemToZimWiki opts) aligns (head rows) else mapM (inlineListToZimWiki opts . removeFormatting)headers -- emphasis, links etc. are not allowed in table headers rows' <- mapM (zipWithM (tableItemToZimWiki opts) aligns) rows - let widths = map (maximum . map T.length) $ transpose (headers':rows') + let widths = map (maybe 0 maximum . nonEmpty . map T.length) $ + transpose (headers':rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> diff --git a/src/Text/Pandoc/XML/Light/Proc.hs b/src/Text/Pandoc/XML/Light/Proc.hs --- a/src/Text/Pandoc/XML/Light/Proc.hs +++ b/src/Text/Pandoc/XML/Light/Proc.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.XML.Light.Proc Copyright : Copyright (C) 2007 Galois, Inc., 2021 John MacFarlane diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -2,14 +2,20 @@ pandoc: trypandoc: false embed_data_files: true + QuickCheck: + old-random: false packages: - '.' extra-deps: - hslua-1.3.0 - hslua-module-path-0.1.0 -#- citeproc: -# git: https://github.com/jgm/citeproc.git -# commit: feb3b7580c6738eec3b23921f7c1739cfba611aa +- jira-wiki-markup-1.3.4 +- skylighting-core-0.10.5 +- skylighting-0.10.5 +- doclayout-0.3.0.2 +- citeproc-0.3.0.9 +- texmath-0.12.2 +- random-1.2.0 ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules resolver: lts-17.5 diff --git a/test/Tests/Command.hs b/test/Tests/Command.hs --- a/test/Tests/Command.hs +++ b/test/Tests/Command.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TupleSections #-} {- | Module : Tests.Command Copyright : © 2006-2021 John MacFarlane @@ -14,14 +13,13 @@ where import Data.Algorithm.Diff -import System.Environment.Executable (getExecutablePath) +import System.Environment (getExecutablePath) import qualified Data.ByteString as BS import qualified Data.Text as T import Data.List (isSuffixOf) import System.Directory -import qualified System.Environment as Env import System.Exit -import System.FilePath (takeDirectory, ()) +import System.FilePath (()) import System.IO (hPutStr, stderr) import System.IO.Unsafe (unsafePerformIO) import System.Process @@ -38,15 +36,7 @@ -> String -- ^ Input text -> IO (ExitCode, String) -- ^ Exit code and actual output execTest testExePath cmd inp = do - mldpath <- Env.lookupEnv "LD_LIBRARY_PATH" - mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH" - let env' = ("PATH",takeDirectory testExePath) : - ("TMP",".") : - ("LANG","en_US.UTF-8") : - ("HOME", "./") : - ("pandoc_datadir", "..") : - maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath ++ - maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath + env' <- setupEnvironment testExePath let pr = (shell (pandocToEmulate True cmd)){ env = Just env' } (ec, out', err') <- readCreateProcessWithExitCode pr inp -- filter \r so the tests will work on Windows machines diff --git a/test/Tests/Helpers.hs b/test/Tests/Helpers.hs --- a/test/Tests/Helpers.hs +++ b/test/Tests/Helpers.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleInstances #-} {- | Module : Tests.Helpers @@ -13,6 +14,7 @@ -} module Tests.Helpers ( test , TestResult(..) + , setupEnvironment , showDiff , (=?>) , purely @@ -25,6 +27,8 @@ import qualified Data.Map as M import Data.Text (Text, unpack) import System.Exit +import System.FilePath (takeDirectory) +import qualified System.Environment as Env import Test.Tasty import Test.Tasty.HUnit import Text.Pandoc.Builder (Blocks, Inlines, doc, plain) @@ -56,6 +60,25 @@ diff = getDiff expected' actual' dashes "" = replicate 72 '-' dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---" + +-- | Set up environment for pandoc command tests. +setupEnvironment :: FilePath -> IO [(String, String)] +setupEnvironment testExePath = do + mldpath <- Env.lookupEnv "LD_LIBRARY_PATH" + mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH" + mpdd <- Env.lookupEnv "pandoc_datadir" + -- Note that Cabal sets the pandoc_datadir environment variable + -- to point to the source directory, since otherwise getDataFilename + -- will look in the data directory into which pandoc will be installed + -- (but has not yet been). So when we spawn a new process with + -- pandoc, we need to make sure this environment variable is set. + return $ ("PATH",takeDirectory testExePath) : + ("TMP",".") : + ("LANG","en_US.UTF-8") : + ("HOME", "./") : + maybe [] ((:[]) . ("pandoc_datadir",)) mpdd ++ + maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath ++ + maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath data TestResult = TestPassed | TestError ExitCode diff --git a/test/Tests/Old.hs b/test/Tests/Old.hs --- a/test/Tests/Old.hs +++ b/test/Tests/Old.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TupleSections #-} {- | Module : Tests.Old Copyright : © 2006-2021 John MacFarlane @@ -15,8 +14,7 @@ import Data.Algorithm.Diff import System.Exit import System.FilePath ((<.>), ()) -import qualified System.Environment as Env -import System.Environment.Executable (getExecutablePath) +import System.Environment (getExecutablePath) import Text.Pandoc.Process (pipeProcess) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Golden.Advanced (goldenTest) @@ -319,14 +317,7 @@ (compareValues norm options) updateGolden where getExpected = normalizer <$> readFile' norm getActual = do - mldpath <- Env.lookupEnv "LD_LIBRARY_PATH" - mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH" - let env = ("TMP",".") : - ("LANG","en_US.UTF-8") : - ("HOME", "./") : - maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath ++ - maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath - + env <- setupEnvironment pandocPath (ec, out) <- pipeProcess (Just env) pandocPath ("--emulate":options) mempty if ec == ExitSuccess @@ -335,7 +326,7 @@ -- filter \r so the tests will work on Windows machines else fail $ "Pandoc failed with error code " ++ show ec updateGolden = UTF8.writeFile norm . T.pack - options = ["--data-dir=../data","--quiet"] ++ [inp] ++ opts + options = ["--quiet"] ++ [inp] ++ opts compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String) compareValues norm options expected actual = do diff --git a/test/Tests/Readers/Jira.hs b/test/Tests/Readers/Jira.hs --- a/test/Tests/Readers/Jira.hs +++ b/test/Tests/Readers/Jira.hs @@ -96,6 +96,12 @@ simpleTable [para "Name"] [[para "Test"]] ] + , testGroup "panel" + [ "simple panel" =: + "{panel}\nInterviewer: Jane Doe{panel}\n" =?> + divWith ("", ["panel"], []) (para "Interviewer: Jane Doe") + ] + , testGroup "inlines" [ "emphasis" =: "*quid pro quo*" =?> diff --git a/test/Tests/Writers/Docbook.hs b/test/Tests/Writers/Docbook.hs --- a/test/Tests/Writers/Docbook.hs +++ b/test/Tests/Writers/Docbook.hs @@ -11,9 +11,14 @@ docbook :: (ToPandoc a) => a -> String docbook = docbookWithOpts def{ writerWrapText = WrapNone } +docbook5 :: (ToPandoc a) => a -> String +docbook5 = docbook5WithOpts def{ writerWrapText = WrapNone } + docbookWithOpts :: ToPandoc a => WriterOptions -> a -> String docbookWithOpts opts = unpack . purely (writeDocbook4 opts) . toPandoc +docbook5WithOpts :: ToPandoc a => WriterOptions -> a -> String +docbook5WithOpts opts = unpack . purely (writeDocbook5 opts) . toPandoc {- "my test" =: X =?> Y @@ -366,4 +371,36 @@ ] ] ] + , testGroup "section attributes" $ + let + headers = headerWith ("myid1",[],[("role","internal"),("xml:id","anotherid"),("dir","rtl")]) 1 "header1" + <> headerWith ("myid2",[],[("invalidname","value"),("arch","linux"),("dir","invaliddir")]) 1 "header2" + in + [ test docbook5 "sections with attributes (db5)" $ + headers =?> + unlines [ "
" + , " header1" + , " " + , " " + , "
" + , "
" + , " header2" + , " " + , " " + , "
" + ] + , test docbook "sections with attributes (db4)" $ + headers =?> + unlines [ "" + , " header1" + , " " + , " " + , "" + , "" + , " header2" + , " " + , " " + , "" + ] + ] ] diff --git a/test/Tests/Writers/Jira.hs b/test/Tests/Writers/Jira.hs --- a/test/Tests/Writers/Jira.hs +++ b/test/Tests/Writers/Jira.hs @@ -79,4 +79,34 @@ "{noformat}\npreformatted\n text.\n{noformat}" ] ] + + , testGroup "blocks" + [ testGroup "div" + [ "empty attributes" =: + divWith nullAttr (para "interesting text") =?> + "interesting text" + + , "just identifier" =: + divWith ("a", [], []) (para "interesting text") =?> + "{anchor:a}interesting text" + + , "with class 'panel'" =: + divWith ("", ["panel"], []) (para "Contents!") =?> + "{panel}\nContents\\!\n{panel}\n" + + , "panel with id" =: + divWith ("b", ["panel"], []) (para "text") =?> + "{panel}\n{anchor:b}text\n{panel}\n" + + , "title attribute" =: + divWith ("", [], [("title", "Gimme!")]) (para "Contents!") =?> + "{panel:title=Gimme!}\nContents\\!\n{panel}\n" + + , "nested panels" =: + let panelAttr = ("", ["panel"], []) + in divWith panelAttr (para "hi" <> + divWith panelAttr (para "wassup?")) =?> + "{panel}\nhi\n\nwassup?\n{panel}\n" + ] + ] ] diff --git a/test/command/7132.md b/test/command/7132.md new file mode 100644 --- /dev/null +++ b/test/command/7132.md @@ -0,0 +1,10 @@ +``` +% pandoc -f markdown -t org --columns=72 +- This line has exactly the wrong number of characters before the number 5. +- Long line ending with a number (this time it is in parentheses and a 23) +^D +- This line has exactly the wrong number of characters before the + number 5. +- Long line ending with a number (this time it is in parentheses and + a 23) +``` diff --git a/test/command/7134.md b/test/command/7134.md new file mode 100644 --- /dev/null +++ b/test/command/7134.md @@ -0,0 +1,16 @@ +``` +% pandoc -f rst -t native +This is a paragraph. + + This is a block quote. + +.. + + This should be a second block quote. +^D +[Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "paragraph."] +,BlockQuote + [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "block",Space,Str "quote."]] +,BlockQuote + [Para [Str "This",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "second",Space,Str "block",Space,Str "quote."]]] +``` diff --git a/test/command/7145.md b/test/command/7145.md new file mode 100644 --- /dev/null +++ b/test/command/7145.md @@ -0,0 +1,12 @@ +``` +% pandoc -f mediawiki -t native +Maecenas at sapien tempor, pretium turpis ut, imperdiet augue.This is a multiline + +reference +with +empty + +linebreaks Nulla ut massa eget ex venenatis lobortis id in eros. +^D +[Para [Str "Maecenas",Space,Str "at",Space,Str "sapien",Space,Str "tempor,",Space,Str "pretium",Space,Str "turpis",Space,Str "ut,",Space,Str "imperdiet",Space,Str "augue.",Note [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "multiline"],Para [Str "reference",SoftBreak,RawInline (Format "html") "",Str "with",RawInline (Format "html") "",SoftBreak,Str "empty"],Para [Str "linebreaks"]],Space,Str "Nulla",Space,Str "ut",Space,Str "massa",Space,Str "eget",Space,Str "ex",Space,Str "venenatis",Space,Str "lobortis",Space,Str "id",Space,Str "in",Space,Str "eros."]] +``` diff --git a/test/command/7155.md b/test/command/7155.md new file mode 100644 --- /dev/null +++ b/test/command/7155.md @@ -0,0 +1,15 @@ +``` +% pandoc -f markdown+tex_math_single_backslash -t native +\(x\) \[x\] +\\(x\\) \\[x\\] +^D +[Para [Math InlineMath "x",Space,Math DisplayMath "x",SoftBreak,Str "\\(x\\)",Space,Str "\\[x\\]"]] +``` + +``` +% pandoc -f markdown+tex_math_double_backslash -t native +\(x\) \[x\] +\\(x\\) \\[x\\] +^D +[Para [Str "(x)",Space,Str "[x]",SoftBreak,Math InlineMath "x",Space,Math DisplayMath "x"]] +``` diff --git a/test/command/duplicate_attributes.md b/test/command/duplicate_attributes.md new file mode 100644 --- /dev/null +++ b/test/command/duplicate_attributes.md @@ -0,0 +1,7 @@ +``` +% pandoc +[span]{.foobar style="color:blue" class="zip" style="color:red"} +^D +[WARNING] Ignoring duplicate attribute style="color:red". +

span

+``` diff --git a/test/docx/golden/block_quotes.docx b/test/docx/golden/block_quotes.docx Binary files a/test/docx/golden/block_quotes.docx and b/test/docx/golden/block_quotes.docx differ diff --git a/test/docx/golden/codeblock.docx b/test/docx/golden/codeblock.docx Binary files a/test/docx/golden/codeblock.docx and b/test/docx/golden/codeblock.docx differ diff --git a/test/docx/golden/comments.docx b/test/docx/golden/comments.docx Binary files a/test/docx/golden/comments.docx and b/test/docx/golden/comments.docx differ diff --git a/test/docx/golden/custom_style_no_reference.docx b/test/docx/golden/custom_style_no_reference.docx Binary files a/test/docx/golden/custom_style_no_reference.docx and b/test/docx/golden/custom_style_no_reference.docx differ diff --git a/test/docx/golden/custom_style_preserve.docx b/test/docx/golden/custom_style_preserve.docx Binary files a/test/docx/golden/custom_style_preserve.docx and b/test/docx/golden/custom_style_preserve.docx differ diff --git a/test/docx/golden/custom_style_reference.docx b/test/docx/golden/custom_style_reference.docx Binary files a/test/docx/golden/custom_style_reference.docx and b/test/docx/golden/custom_style_reference.docx differ diff --git a/test/docx/golden/definition_list.docx b/test/docx/golden/definition_list.docx Binary files a/test/docx/golden/definition_list.docx and b/test/docx/golden/definition_list.docx differ diff --git a/test/docx/golden/document-properties-short-desc.docx b/test/docx/golden/document-properties-short-desc.docx Binary files a/test/docx/golden/document-properties-short-desc.docx and b/test/docx/golden/document-properties-short-desc.docx differ diff --git a/test/docx/golden/document-properties.docx b/test/docx/golden/document-properties.docx Binary files a/test/docx/golden/document-properties.docx and b/test/docx/golden/document-properties.docx differ diff --git a/test/docx/golden/headers.docx b/test/docx/golden/headers.docx Binary files a/test/docx/golden/headers.docx and b/test/docx/golden/headers.docx differ diff --git a/test/docx/golden/image.docx b/test/docx/golden/image.docx Binary files a/test/docx/golden/image.docx and b/test/docx/golden/image.docx differ diff --git a/test/docx/golden/inline_code.docx b/test/docx/golden/inline_code.docx Binary files a/test/docx/golden/inline_code.docx and b/test/docx/golden/inline_code.docx differ diff --git a/test/docx/golden/inline_formatting.docx b/test/docx/golden/inline_formatting.docx Binary files a/test/docx/golden/inline_formatting.docx and b/test/docx/golden/inline_formatting.docx differ diff --git a/test/docx/golden/inline_images.docx b/test/docx/golden/inline_images.docx Binary files a/test/docx/golden/inline_images.docx and b/test/docx/golden/inline_images.docx differ diff --git a/test/docx/golden/link_in_notes.docx b/test/docx/golden/link_in_notes.docx Binary files a/test/docx/golden/link_in_notes.docx and b/test/docx/golden/link_in_notes.docx differ diff --git a/test/docx/golden/links.docx b/test/docx/golden/links.docx Binary files a/test/docx/golden/links.docx and b/test/docx/golden/links.docx differ diff --git a/test/docx/golden/lists.docx b/test/docx/golden/lists.docx Binary files a/test/docx/golden/lists.docx and b/test/docx/golden/lists.docx differ diff --git a/test/docx/golden/lists_continuing.docx b/test/docx/golden/lists_continuing.docx Binary files a/test/docx/golden/lists_continuing.docx and b/test/docx/golden/lists_continuing.docx differ diff --git a/test/docx/golden/lists_multiple_initial.docx b/test/docx/golden/lists_multiple_initial.docx Binary files a/test/docx/golden/lists_multiple_initial.docx and b/test/docx/golden/lists_multiple_initial.docx differ diff --git a/test/docx/golden/lists_restarting.docx b/test/docx/golden/lists_restarting.docx Binary files a/test/docx/golden/lists_restarting.docx and b/test/docx/golden/lists_restarting.docx differ diff --git a/test/docx/golden/nested_anchors_in_header.docx b/test/docx/golden/nested_anchors_in_header.docx Binary files a/test/docx/golden/nested_anchors_in_header.docx and b/test/docx/golden/nested_anchors_in_header.docx differ diff --git a/test/docx/golden/notes.docx b/test/docx/golden/notes.docx Binary files a/test/docx/golden/notes.docx and b/test/docx/golden/notes.docx differ diff --git a/test/docx/golden/raw-blocks.docx b/test/docx/golden/raw-blocks.docx Binary files a/test/docx/golden/raw-blocks.docx and b/test/docx/golden/raw-blocks.docx differ diff --git a/test/docx/golden/raw-bookmarks.docx b/test/docx/golden/raw-bookmarks.docx Binary files a/test/docx/golden/raw-bookmarks.docx and b/test/docx/golden/raw-bookmarks.docx differ diff --git a/test/docx/golden/table_one_row.docx b/test/docx/golden/table_one_row.docx Binary files a/test/docx/golden/table_one_row.docx and b/test/docx/golden/table_one_row.docx differ diff --git a/test/docx/golden/table_with_list_cell.docx b/test/docx/golden/table_with_list_cell.docx Binary files a/test/docx/golden/table_with_list_cell.docx and b/test/docx/golden/table_with_list_cell.docx differ diff --git a/test/docx/golden/tables.docx b/test/docx/golden/tables.docx Binary files a/test/docx/golden/tables.docx and b/test/docx/golden/tables.docx differ diff --git a/test/docx/golden/track_changes_deletion.docx b/test/docx/golden/track_changes_deletion.docx Binary files a/test/docx/golden/track_changes_deletion.docx and b/test/docx/golden/track_changes_deletion.docx differ diff --git a/test/docx/golden/track_changes_insertion.docx b/test/docx/golden/track_changes_insertion.docx Binary files a/test/docx/golden/track_changes_insertion.docx and b/test/docx/golden/track_changes_insertion.docx differ diff --git a/test/docx/golden/track_changes_move.docx b/test/docx/golden/track_changes_move.docx Binary files a/test/docx/golden/track_changes_move.docx and b/test/docx/golden/track_changes_move.docx differ diff --git a/test/docx/golden/track_changes_scrubbed_metadata.docx b/test/docx/golden/track_changes_scrubbed_metadata.docx Binary files a/test/docx/golden/track_changes_scrubbed_metadata.docx and b/test/docx/golden/track_changes_scrubbed_metadata.docx differ diff --git a/test/docx/golden/unicode.docx b/test/docx/golden/unicode.docx Binary files a/test/docx/golden/unicode.docx and b/test/docx/golden/unicode.docx differ diff --git a/test/docx/golden/verbatim_subsuper.docx b/test/docx/golden/verbatim_subsuper.docx Binary files a/test/docx/golden/verbatim_subsuper.docx and b/test/docx/golden/verbatim_subsuper.docx differ diff --git a/test/epub/features.native b/test/epub/features.native --- a/test/epub/features.native +++ b/test/epub/features.native @@ -65,12 +65,12 @@ ,Div ("content-mathml-001.xhtml#mathml-025",["section","ctest"],[]) [Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],SoftBreak,Span ("",["test-id"],[]) [Str "mathml-025"],Str "Testing",Space,Code ("",[],[]) "mtable",Space,Str "with",Space,Code ("",[],[]) "colspan",Space,Str "and",Space,Code ("",[],[]) "rowspan",Space,Str "attributes,",Space,Str "Hebrew",Space,Str "and",Space,Str "Script",Space,Str "fonts"] ,Para [Str "Tests",Space,Str "whether",Space,Code ("",[],[]) "mtable",Space,Str "with",Space,Code ("",[],[]) "colspan",Space,Str "and",Space,Code ("",[],[]) "mspace",Space,Str "attributes",Space,Str "(column",Space,Str "and",Space,Str "row",Space,Str "spanning)",Space,Str "are",Space,Str "supported;",Space,Str "uses",Space,Str "Hebrew",Space,Str "and",Space,Str "Script",Space,Str "alphabets."] - ,Plain [Math DisplayMath "\\begin{matrix}\n & {\\operatorname{cov}\\left( \\mathcal{L} \\right)} & \\longrightarrow & {\\operatorname{non}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{cof}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{cof}\\left( \\mathcal{L} \\right)} & \\longrightarrow & 2^{\\aleph_{0}} \\\\\n & \\uparrow & & \\uparrow & & \\uparrow & & \\uparrow & & \\\\\n & {\\mathfrak{b}} & \\longrightarrow & {\\mathfrak{d}} & & & & & & \\\\\n & \\uparrow & & \\uparrow & & & & & & \\\\\n\\aleph_{1} & \\longrightarrow & {\\operatorname{add}\\left( \\mathcal{L} \\right)} & \\longrightarrow & {\\operatorname{add}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{cov}\\left( \\mathcal{K} \\right)} & \\longrightarrow & {\\operatorname{non}\\left( \\mathcal{L} \\right)} & \\\\\n\\end{matrix}"] + ,Plain [Math DisplayMath "\\begin{matrix}\n & {\\operatorname{cov}(\\mathcal{L})} & \\longrightarrow & {\\operatorname{non}(\\mathcal{K})} & \\longrightarrow & {\\operatorname{cof}(\\mathcal{K})} & \\longrightarrow & {\\operatorname{cof}(\\mathcal{L})} & \\longrightarrow & 2^{\\aleph_{0}} \\\\\n & \\uparrow & & \\uparrow & & \\uparrow & & \\uparrow & & \\\\\n & {\\mathfrak{b}} & \\longrightarrow & {\\mathfrak{d}} & & & & & & \\\\\n & \\uparrow & & \\uparrow & & & & & & \\\\\n\\aleph_{1} & \\longrightarrow & {\\operatorname{add}(\\mathcal{L})} & \\longrightarrow & {\\operatorname{add}(\\mathcal{K})} & \\longrightarrow & {\\operatorname{cov}(\\mathcal{K})} & \\longrightarrow & {\\operatorname{non}(\\mathcal{L})} & \\\\\n\\end{matrix}"] ,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Link ("",[],[]) [Str "Cicho\324's",Space,Str "Diagram"] ("http://en.wikipedia.org/wiki/Cicho%C5%84's_diagram",""),Str ":",Space,Str "."]] ,Div ("content-mathml-001.xhtml#mathml-026",["section","ctest"],[]) [Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],SoftBreak,Span ("",["test-id"],[]) [Str "mathml-026"],Str "BiDi,",Space,Str "RTL",Space,Str "and",Space,Str "Arabic",Space,Str "alphabets"] ,Para [Str "Tests",Space,Str "whether",Space,Str "right-to-left",Space,Str "and",Space,Str "Arabic",Space,Str "alphabets",Space,Str "are",Space,Str "supported."] - ,Plain [Math DisplayMath "{\1583\\left( \1587 \\right)} = \\left\\{ \\begin{matrix}\n{\\sum\\limits_{\1646 = 1}^{\1589}\1587^{\1646}} & {\\text{\1573\1584\1575\1603\1575\1606}\1587 > 0} \\\\\n{\\int_{1}^{\1589}{\1587^{\1646}\1569\1587}} & {\\text{\1573\1584\1575\1603\1575\1606}\1587 \\in \1605} \\\\\n{{\1591\1575}\\pi} & {\\text{\1594\1610\1585\1584\1604\1603}\\left( \\text{\1605\1593}\\pi \\simeq 3,141 \\right)} \\\\\n\\end{matrix} \\right."] + ,Plain [Math DisplayMath "{\1583(\1587)} = \\left\\{ \\begin{matrix}\n{\\sum\\limits_{\1646 = 1}^{\1589}\1587^{\1646}} & {\\text{\1573\1584\1575\1603\1575\1606}\1587 > 0} \\\\\n{\\int_{1}^{\1589}{\1587^{\1646}\1569\1587}} & {\\text{\1573\1584\1575\1603\1575\1606}\1587 \\in \1605} \\\\\n{{\1591\1575}\\pi} & {\\text{\1594\1610\1585\1584\1604\1603}\\left( \\text{\1605\1593}\\pi \\simeq 3,141 \\right)} \\\\\n\\end{matrix} \\right."] ,Para [Str "The",Space,Str "test",Space,Str "passes",Space,Str "if",Space,Str "the",Space,Str "rendering",Space,Str "looks",Space,Str "like",Space,Str "the",Space,Str "following",Space,Str "image:"]] ,Div ("content-mathml-001.xhtml#mathml-027",["section","ctest"],[]) [Header 2 ("",[],[]) [Span ("",["nature"],[]) [Str "[REQUIRED]"],SoftBreak,Span ("",["test-id"],[]) [Str "mathml-027"],Str "Elementary",Space,Str "math:",Space,Str "long",Space,Str "division",Space,Str "notation"] diff --git a/test/jira-reader.native b/test/jira-reader.native --- a/test/jira-reader.native +++ b/test/jira-reader.native @@ -164,7 +164,7 @@ ,Para [Str "[Not",Space,Str "a",Space,Str "link|not",Space,Str "a",Space,Str "URL]."] ,Header 2 ("",[],[]) [Str "Reference"] ,Para [Str "With",Space,Link ("",[],[]) [Str "embedded",Space,Str "[brackets]"] ("https://example.net/url/",""),Str "."] -,Para [Link ("",[],[]) [Str "https://pandoc.org by itself should be a link."] ("https://pandoc.org by itself should be a link.","")] +,Para [Link ("",[],[]) [Str "https://pandoc.org"] ("https://pandoc.org",""),Space,Str "by",Space,Str "itself",Space,Str "should",Space,Str "be",Space,Str "a",Space,Str "link."] ,Header 2 ("",[],[]) [Str "With",Space,Str "ampersands"] ,Para [Str "Here\8217s",Space,Str "a",Space,Link ("",[],[]) [Str "link",Space,Str "with",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "the",Space,Str "URL"] ("http://example.com/?foo=1&bar=2",""),Str "."] ,Para [Str "Here\8217s",Space,Str "a",Space,Str "link",Space,Str "with",Space,Str "an",Space,Str "ampersand",Space,Str "in",Space,Str "the",Space,Str "link",Space,Str "text:",Space,Link ("",[],[]) [Str "AT&T"] ("http://att.com/",""),Str "."] diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs --- a/test/test-pandoc.hs +++ b/test/test-pandoc.hs @@ -2,12 +2,11 @@ module Main where -import System.Environment (getArgs) +import System.Environment (getArgs, getExecutablePath) import qualified Control.Exception as E import Text.Pandoc.App (convertWithOpts, defaultOpts, options, parseOptionsFromArgs) import Text.Pandoc.Error (handleError) -import System.Environment.Executable (getExecutablePath) import GHC.IO.Encoding import Test.Tasty import qualified Tests.Command diff --git a/test/writer.jats_archiving b/test/writer.jats_archiving --- a/test/writer.jats_archiving +++ b/test/writer.jats_archiving @@ -694,7 +694,7 @@

Here’s some display math: - ddxf(x)=limh→0f(x+h)−f(x)h

+ ddxf(x)=limh→0f(x+h)−f(x)h

Here’s one that has a line break in it: diff --git a/test/writer.jats_articleauthoring b/test/writer.jats_articleauthoring --- a/test/writer.jats_articleauthoring +++ b/test/writer.jats_articleauthoring @@ -676,7 +676,7 @@

Here’s some display math: - ddxf(x)=limh→0f(x+h)−f(x)h

+ ddxf(x)=limh→0f(x+h)−f(x)h

Here’s one that has a line break in it: diff --git a/test/writer.jats_publishing b/test/writer.jats_publishing --- a/test/writer.jats_publishing +++ b/test/writer.jats_publishing @@ -694,7 +694,7 @@

Here’s some display math: - ddxf(x)=limh→0f(x+h)−f(x)h

+ ddxf(x)=limh→0f(x+h)−f(x)h

Here’s one that has a line break in it: diff --git a/test/writer.jira b/test/writer.jira --- a/test/writer.jira +++ b/test/writer.jira @@ -45,8 +45,7 @@ Nested block quotes: bq. nested -bq. nested -{quote} +bq. nested{quote} This should not be a block quote: 2 > 1. And a following paragraph. diff --git a/test/writer.ms b/test/writer.ms --- a/test/writer.ms +++ b/test/writer.ms @@ -700,7 +700,7 @@ .IP \[bu] 3 Here\[cq]s some display math: .EQ -d over {d x} f ( x ) = lim sub {h -> 0} {f ( x + h ) \[u2212] f ( x )} over h +d over {d x} f left ( x right ) = lim sub {h -> 0} {f left ( x + h right ) \[u2212] f left ( x right )} over h .EN .IP \[bu] 3 Here\[cq]s one that has a line break in it: @alpha + omega times x sup 2@.