pandoc 2.11.4 → 2.12
raw patch · 264 files changed
+8384/−6139 lines, 264 filesdep +hslua-module-pathdep +tasty-benchdep +xml-conduitdep −criteriondep −weighdep ~basedep ~base64-bytestringdep ~citeprocPVP ok
version bump matches the API change (PVP)
Dependencies added: hslua-module-path, tasty-bench, xml-conduit
Dependencies removed: criterion, weigh
Dependency ranges changed: base, base64-bytestring, citeproc, jira-wiki-markup, skylighting, skylighting-core, tasty, text, wai-extra
API changes (from Hackage documentation)
- Text.Pandoc.Readers.HTML: class NamedTag a
- Text.Pandoc.Readers.HTML: getTagName :: NamedTag a => a -> Maybe Text
- Text.Pandoc.Readers.HTML: instance Text.Pandoc.Readers.HTML.NamedTag (Text.HTML.TagSoup.Type.Tag Data.Text.Internal.Text)
- Text.Pandoc.Readers.HTML: instance Text.Pandoc.Readers.HTML.NamedTag (Text.HTML.TagSoup.Type.Tag GHC.Base.String)
- Text.Pandoc.Readers.LaTeX: tokenize :: SourceName -> Text -> [Tok]
- Text.Pandoc.Readers.LaTeX: untokenize :: [Tok] -> Text
- Text.Pandoc.Readers.LaTeX.Types: Arg :: Int -> TokType
- Text.Pandoc.Readers.LaTeX.Types: ArgNum :: Int -> ArgSpec
- Text.Pandoc.Readers.LaTeX.Types: Comment :: TokType
- Text.Pandoc.Readers.LaTeX.Types: CtrlSeq :: Text -> TokType
- Text.Pandoc.Readers.LaTeX.Types: Esc1 :: TokType
- Text.Pandoc.Readers.LaTeX.Types: Esc2 :: TokType
- Text.Pandoc.Readers.LaTeX.Types: ExpandWhenDefined :: ExpansionPoint
- Text.Pandoc.Readers.LaTeX.Types: ExpandWhenUsed :: ExpansionPoint
- Text.Pandoc.Readers.LaTeX.Types: Macro :: ExpansionPoint -> [ArgSpec] -> Maybe [Tok] -> [Tok] -> Macro
- Text.Pandoc.Readers.LaTeX.Types: Newline :: TokType
- Text.Pandoc.Readers.LaTeX.Types: Pattern :: [Tok] -> ArgSpec
- Text.Pandoc.Readers.LaTeX.Types: Spaces :: TokType
- Text.Pandoc.Readers.LaTeX.Types: Symbol :: TokType
- Text.Pandoc.Readers.LaTeX.Types: Tok :: SourcePos -> TokType -> Text -> Tok
- Text.Pandoc.Readers.LaTeX.Types: Word :: TokType
- Text.Pandoc.Readers.LaTeX.Types: data ArgSpec
- Text.Pandoc.Readers.LaTeX.Types: data ExpansionPoint
- Text.Pandoc.Readers.LaTeX.Types: data Macro
- Text.Pandoc.Readers.LaTeX.Types: data SourcePos
- Text.Pandoc.Readers.LaTeX.Types: data Tok
- Text.Pandoc.Readers.LaTeX.Types: data TokType
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Classes.Eq Text.Pandoc.Readers.LaTeX.Types.ExpansionPoint
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Classes.Eq Text.Pandoc.Readers.LaTeX.Types.Tok
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Classes.Eq Text.Pandoc.Readers.LaTeX.Types.TokType
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Classes.Ord Text.Pandoc.Readers.LaTeX.Types.ExpansionPoint
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Classes.Ord Text.Pandoc.Readers.LaTeX.Types.Tok
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Classes.Ord Text.Pandoc.Readers.LaTeX.Types.TokType
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Show.Show Text.Pandoc.Readers.LaTeX.Types.ArgSpec
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Show.Show Text.Pandoc.Readers.LaTeX.Types.ExpansionPoint
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Show.Show Text.Pandoc.Readers.LaTeX.Types.Macro
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Show.Show Text.Pandoc.Readers.LaTeX.Types.Tok
- Text.Pandoc.Readers.LaTeX.Types: instance GHC.Show.Show Text.Pandoc.Readers.LaTeX.Types.TokType
- Text.Pandoc.Shared: defaultUserDataDirs :: IO [FilePath]
- Text.Pandoc.Shared: splitByIndices :: [Int] -> [a] -> [[a]]
- Text.Pandoc.Shared: splitStringByIndices :: [Int] -> [Char] -> [[Char]]
- Text.Pandoc.Shared: substitute :: Eq a => [a] -> [a] -> [a] -> [a]
- Text.Pandoc.Shared: underlineSpan :: Inlines -> Inlines
- Text.Pandoc.Writers.LaTeX: instance GHC.Classes.Eq Text.Pandoc.Writers.LaTeX.StringContext
- Text.Pandoc.Writers.Markdown: instance Data.Default.Class.Default Text.Pandoc.Writers.Markdown.WriterEnv
- Text.Pandoc.Writers.Markdown: instance Data.Default.Class.Default Text.Pandoc.Writers.Markdown.WriterState
- Text.Pandoc.Writers.Markdown: instance GHC.Classes.Eq Text.Pandoc.Writers.Markdown.MarkdownVariant
- Text.Pandoc.Writers.Markdown: instance GHC.Show.Show Text.Pandoc.Writers.Markdown.MarkdownVariant
+ Text.Pandoc.App: [optBibliography] :: Opt -> [FilePath]
+ Text.Pandoc.App: [optCSL] :: Opt -> Maybe FilePath
+ Text.Pandoc.App: [optCitationAbbreviations] :: Opt -> Maybe FilePath
+ Text.Pandoc.App: parseOptionsFromArgs :: [OptDescr (Opt -> IO Opt)] -> Opt -> String -> [String] -> IO Opt
+ Text.Pandoc.Class: getTimestamp :: PandocMonad m => m UTCTime
+ Text.Pandoc.Error: PandocUnsupportedCharsetError :: Text -> PandocError
+ Text.Pandoc.Error: PandocXMLError :: Text -> Text -> PandocError
+ Text.Pandoc.Error: renderError :: PandocError -> Text
+ Text.Pandoc.Logging: EnvironmentVariableUndefined :: Text -> LogMessage
+ Text.Pandoc.MIME: getCharset :: MimeType -> Maybe Text
+ Text.Pandoc.Shared: defaultUserDataDir :: IO FilePath
+ Text.Pandoc.Shared: handleTaskListItem :: ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
- Text.Pandoc.App: Opt :: Int -> Bool -> Bool -> Maybe Text -> Maybe Text -> Bool -> Int -> Maybe FilePath -> Context Text -> Meta -> [FilePath] -> Maybe FilePath -> Maybe [FilePath] -> Bool -> [Int] -> Bool -> Bool -> Bool -> Bool -> Maybe Text -> [FilePath] -> TopLevelDivision -> HTMLMathMethod -> Maybe FilePath -> Maybe FilePath -> String -> Maybe FilePath -> [FilePath] -> Int -> Maybe FilePath -> Int -> Bool -> Bool -> Verbosity -> Bool -> Maybe FilePath -> Bool -> Bool -> ReferenceLocation -> Int -> WrapOption -> Int -> [Filter] -> ObfuscationMethod -> Text -> Bool -> [Text] -> Maybe FilePath -> CiteMethod -> Bool -> Maybe String -> [String] -> Maybe Int -> Bool -> Bool -> Text -> Maybe FilePath -> TrackChanges -> Bool -> Maybe Text -> [FilePath] -> IpynbOutput -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [(Text, Text)] -> Bool -> LineEnding -> Bool -> Opt
+ Text.Pandoc.App: Opt :: Int -> Bool -> Bool -> Maybe Text -> Maybe Text -> Bool -> Int -> Maybe FilePath -> Context Text -> Meta -> [FilePath] -> Maybe FilePath -> Maybe [FilePath] -> Bool -> [Int] -> Bool -> Bool -> Bool -> Bool -> Maybe Text -> [FilePath] -> TopLevelDivision -> HTMLMathMethod -> Maybe FilePath -> Maybe FilePath -> String -> Maybe FilePath -> [FilePath] -> Int -> Maybe FilePath -> Int -> Bool -> Bool -> Verbosity -> Bool -> Maybe FilePath -> Bool -> Bool -> ReferenceLocation -> Int -> WrapOption -> Int -> [Filter] -> ObfuscationMethod -> Text -> Bool -> [Text] -> Maybe FilePath -> CiteMethod -> Bool -> Maybe String -> [String] -> Maybe Int -> Bool -> Bool -> Text -> Maybe FilePath -> TrackChanges -> Bool -> Maybe Text -> [FilePath] -> IpynbOutput -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [(Text, Text)] -> Bool -> LineEnding -> Bool -> Maybe FilePath -> [FilePath] -> Maybe FilePath -> Opt
- Text.Pandoc.Readers.HTML: isBlockTag :: NamedTag (Tag a) => Tag a -> Bool
+ Text.Pandoc.Readers.HTML: isBlockTag :: Tag Text -> Bool
- Text.Pandoc.Readers.HTML: isCommentTag :: Tag a -> Bool
+ Text.Pandoc.Readers.HTML: isCommentTag :: Tag Text -> Bool
- Text.Pandoc.Readers.HTML: isInlineTag :: NamedTag (Tag a) => Tag a -> Bool
+ Text.Pandoc.Readers.HTML: isInlineTag :: Tag Text -> Bool
- Text.Pandoc.Readers.HTML: isTextTag :: Tag a -> Bool
+ Text.Pandoc.Readers.HTML: isTextTag :: Tag Text -> Bool
- Text.Pandoc.UTF8: getContents :: IO String
+ Text.Pandoc.UTF8: getContents :: IO Text
- Text.Pandoc.UTF8: hGetContents :: Handle -> IO String
+ Text.Pandoc.UTF8: hGetContents :: Handle -> IO Text
- Text.Pandoc.UTF8: hPutStr :: Handle -> String -> IO ()
+ Text.Pandoc.UTF8: hPutStr :: Handle -> Text -> IO ()
- Text.Pandoc.UTF8: hPutStrLn :: Handle -> String -> IO ()
+ Text.Pandoc.UTF8: hPutStrLn :: Handle -> Text -> IO ()
- Text.Pandoc.UTF8: hPutStrLnWith :: Newline -> Handle -> String -> IO ()
+ Text.Pandoc.UTF8: hPutStrLnWith :: Newline -> Handle -> Text -> IO ()
- Text.Pandoc.UTF8: hPutStrWith :: Newline -> Handle -> String -> IO ()
+ Text.Pandoc.UTF8: hPutStrWith :: Newline -> Handle -> Text -> IO ()
- Text.Pandoc.UTF8: putStr :: String -> IO ()
+ Text.Pandoc.UTF8: putStr :: Text -> IO ()
- Text.Pandoc.UTF8: putStrLn :: String -> IO ()
+ Text.Pandoc.UTF8: putStrLn :: Text -> IO ()
- Text.Pandoc.UTF8: putStrLnWith :: Newline -> String -> IO ()
+ Text.Pandoc.UTF8: putStrLnWith :: Newline -> Text -> IO ()
- Text.Pandoc.UTF8: putStrWith :: Newline -> String -> IO ()
+ Text.Pandoc.UTF8: putStrWith :: Newline -> Text -> IO ()
- Text.Pandoc.UTF8: readFile :: FilePath -> IO String
+ Text.Pandoc.UTF8: readFile :: FilePath -> IO Text
- Text.Pandoc.UTF8: writeFile :: FilePath -> String -> IO ()
+ Text.Pandoc.UTF8: writeFile :: FilePath -> Text -> IO ()
- Text.Pandoc.UTF8: writeFileWith :: Newline -> FilePath -> String -> IO ()
+ Text.Pandoc.UTF8: writeFileWith :: Newline -> FilePath -> Text -> IO ()
- Text.Pandoc.Writers.OOXML: elemName :: NameSpaces -> String -> String -> QName
+ Text.Pandoc.Writers.OOXML: elemName :: NameSpaces -> Text -> Text -> QName
- Text.Pandoc.Writers.OOXML: isElem :: NameSpaces -> String -> String -> Element -> Bool
+ Text.Pandoc.Writers.OOXML: isElem :: NameSpaces -> Text -> Text -> Element -> Bool
- Text.Pandoc.Writers.OOXML: mknode :: Node t => String -> [(String, String)] -> t -> Element
+ Text.Pandoc.Writers.OOXML: mknode :: Node t => Text -> [(Text, Text)] -> t -> Element
- Text.Pandoc.Writers.OOXML: mktnode :: String -> [(String, String)] -> Text -> Element
+ Text.Pandoc.Writers.OOXML: mktnode :: Text -> [(Text, Text)] -> Text -> Element
- Text.Pandoc.Writers.OOXML: nodename :: String -> QName
+ Text.Pandoc.Writers.OOXML: nodename :: Text -> QName
- Text.Pandoc.Writers.OOXML: type NameSpaces = [(String, String)]
+ Text.Pandoc.Writers.OOXML: type NameSpaces = [(Text, Text)]
Files
- AUTHORS.md +6/−0
- CONTRIBUTING.md +8/−8
- COPYING.md +1/−1
- COPYRIGHT +3/−3
- INSTALL.md +14/−15
- MANUAL.txt +83/−17
- README.md +6/−6
- app/pandoc.hs +0/−2
- benchmark/benchmark-pandoc.hs +58/−78
- benchmark/weigh-pandoc.hs +0/−50
- cabal.project +2/−2
- changelog.md +494/−2
- data/odt/styles.xml +1/−1
- data/templates/article.jats_publishing +5/−3
- data/templates/default.biblatex +10/−0
- data/templates/default.bibtex +10/−0
- data/templates/default.jats_articleauthoring +2/−0
- data/templates/default.latex +15/−15
- data/templates/default.revealjs +4/−0
- man/pandoc.1 +102/−25
- man/pandoc.1.after +1/−1
- pandoc.cabal +73/−141
- src/Text/Pandoc/App.hs +44/−15
- src/Text/Pandoc/App/CommandLineOptions.hs +52/−23
- src/Text/Pandoc/App/Opt.hs +143/−56
- src/Text/Pandoc/App/OutputSettings.hs +2/−2
- src/Text/Pandoc/CSV.hs +1/−2
- src/Text/Pandoc/Citeproc.hs +1/−1
- src/Text/Pandoc/Citeproc/BibTeX.hs +42/−59
- src/Text/Pandoc/Citeproc/MetaValue.hs +5/−3
- src/Text/Pandoc/Class/IO.hs +3/−3
- src/Text/Pandoc/Class/PandocMonad.hs +19/−2
- src/Text/Pandoc/Error.hs +79/−33
- src/Text/Pandoc/Extensions.hs +2/−2
- src/Text/Pandoc/ImageSize.hs +7/−5
- src/Text/Pandoc/Logging.hs +6/−0
- src/Text/Pandoc/Lua/Init.hs +14/−4
- src/Text/Pandoc/Lua/Marshaling/AST.hs +77/−79
- src/Text/Pandoc/Lua/Module/MediaBag.hs +14/−13
- src/Text/Pandoc/Lua/Module/Pandoc.hs +20/−19
- src/Text/Pandoc/Lua/Packages.hs +9/−26
- src/Text/Pandoc/Lua/PandocLua.hs +19/−12
- src/Text/Pandoc/MIME.hs +15/−2
- src/Text/Pandoc/PDF.hs +18/−13
- src/Text/Pandoc/Parsing.hs +1/−1
- src/Text/Pandoc/Readers/DocBook.hs +65/−67
- src/Text/Pandoc/Readers/Docx/Parse.hs +94/−100
- src/Text/Pandoc/Readers/Docx/Parse/Styles.hs +32/−25
- src/Text/Pandoc/Readers/Docx/Util.hs +21/−26
- src/Text/Pandoc/Readers/EPUB.hs +44/−36
- src/Text/Pandoc/Readers/FB2.hs +52/−49
- src/Text/Pandoc/Readers/HTML.hs +155/−112
- src/Text/Pandoc/Readers/JATS.hs +25/−46
- src/Text/Pandoc/Readers/LaTeX.hs +1263/−2434
- src/Text/Pandoc/Readers/LaTeX/Citation.hs +210/−0
- src/Text/Pandoc/Readers/LaTeX/Inline.hs +397/−0
- src/Text/Pandoc/Readers/LaTeX/Lang.hs +78/−2
- src/Text/Pandoc/Readers/LaTeX/Macro.hs +153/−0
- src/Text/Pandoc/Readers/LaTeX/Math.hs +221/−0
- src/Text/Pandoc/Readers/LaTeX/Parsing.hs +132/−47
- src/Text/Pandoc/Readers/LaTeX/SIunitx.hs +14/−7
- src/Text/Pandoc/Readers/LaTeX/Table.hs +378/−0
- src/Text/Pandoc/Readers/Markdown.hs +211/−183
- src/Text/Pandoc/Readers/OPML.hs +13/−32
- src/Text/Pandoc/Readers/Odt.hs +28/−25
- src/Text/Pandoc/Readers/Odt/ContentReader.hs +7/−6
- src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs +2/−1
- src/Text/Pandoc/Readers/Odt/Generic/Utils.hs +9/−24
- src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +11/−12
- src/Text/Pandoc/Readers/Odt/Namespaces.hs +6/−5
- src/Text/Pandoc/Readers/Odt/StyleReader.hs +13/−10
- src/Text/Pandoc/Readers/Org/Blocks.hs +39/−2
- src/Text/Pandoc/Readers/Org/Inlines.hs +1/−1
- src/Text/Pandoc/Readers/RST.hs +7/−6
- src/Text/Pandoc/Readers/Textile.hs +1/−1
- src/Text/Pandoc/Shared.hs +34/−56
- src/Text/Pandoc/Templates.hs +0/−2
- src/Text/Pandoc/UTF8.hs +20/−23
- src/Text/Pandoc/Writers/BibTeX.hs +16/−3
- src/Text/Pandoc/Writers/CslJson.hs +5/−5
- src/Text/Pandoc/Writers/Docx.hs +131/−134
- src/Text/Pandoc/Writers/EPUB.hs +223/−209
- src/Text/Pandoc/Writers/FB2.hs +60/−76
- src/Text/Pandoc/Writers/JATS/References.hs +6/−3
- src/Text/Pandoc/Writers/Jira.hs +8/−6
- src/Text/Pandoc/Writers/LaTeX.hs +18/−555
- src/Text/Pandoc/Writers/LaTeX/Citation.hs +181/−0
- src/Text/Pandoc/Writers/LaTeX/Lang.hs +191/−0
- src/Text/Pandoc/Writers/LaTeX/Util.hs +274/−0
- src/Text/Pandoc/Writers/Markdown.hs +7/−588
- src/Text/Pandoc/Writers/Markdown/Inline.hs +601/−0
- src/Text/Pandoc/Writers/Markdown/Types.hs +81/−0
- src/Text/Pandoc/Writers/ODT.hs +24/−19
- src/Text/Pandoc/Writers/OOXML.hs +21/−21
- src/Text/Pandoc/Writers/Org.hs +13/−3
- src/Text/Pandoc/Writers/Powerpoint/Output.hs +106/−99
- src/Text/Pandoc/XML.hs +13/−17
- src/Text/Pandoc/XML/Light.hs +89/−0
- src/Text/Pandoc/XML/Light/Output.hs +234/−0
- src/Text/Pandoc/XML/Light/Proc.hs +140/−0
- src/Text/Pandoc/XML/Light/Types.hs +193/−0
- stack.yaml +6/−18
- test/Tests/Command.hs +36/−34
- test/Tests/Helpers.hs +1/−35
- test/Tests/Lua.hs +0/−2
- test/Tests/Lua/Module.hs +2/−0
- test/Tests/Old.hs +16/−21
- test/Tests/Readers/Creole.hs +0/−2
- test/Tests/Readers/Docx.hs +0/−2
- test/Tests/Readers/DokuWiki.hs +0/−2
- test/Tests/Readers/EPUB.hs +0/−2
- test/Tests/Readers/FB2.hs +0/−2
- test/Tests/Readers/HTML.hs +0/−2
- test/Tests/Readers/JATS.hs +1/−2
- test/Tests/Readers/Jira.hs +7/−1
- test/Tests/Readers/LaTeX.hs +1/−20
- test/Tests/Readers/Man.hs +0/−1
- test/Tests/Readers/Markdown.hs +0/−2
- test/Tests/Readers/Muse.hs +0/−2
- test/Tests/Readers/Odt.hs +0/−2
- test/Tests/Readers/Org/Block.hs +0/−2
- test/Tests/Readers/Org/Block/CodeBlock.hs +0/−2
- test/Tests/Readers/Org/Block/Figure.hs +0/−2
- test/Tests/Readers/Org/Block/Header.hs +0/−2
- test/Tests/Readers/Org/Block/List.hs +13/−2
- test/Tests/Readers/Org/Block/Table.hs +0/−2
- test/Tests/Readers/Org/Directive.hs +0/−2
- test/Tests/Readers/Org/Inline.hs +0/−2
- test/Tests/Readers/Org/Inline/Citation.hs +40/−2
- test/Tests/Readers/Org/Inline/Note.hs +0/−2
- test/Tests/Readers/Org/Inline/Smart.hs +0/−2
- test/Tests/Readers/Org/Meta.hs +0/−2
- test/Tests/Readers/Org/Shared.hs +0/−2
- test/Tests/Readers/RST.hs +0/−2
- test/Tests/Readers/Txt2Tags.hs +0/−2
- test/Tests/Shared.hs +0/−2
- test/Tests/Writers/AnnotatedTable.hs +0/−1
- test/Tests/Writers/AsciiDoc.hs +0/−2
- test/Tests/Writers/ConTeXt.hs +0/−2
- test/Tests/Writers/Docbook.hs +0/−2
- test/Tests/Writers/Docx.hs +0/−2
- test/Tests/Writers/FB2.hs +0/−2
- test/Tests/Writers/HTML.hs +0/−2
- test/Tests/Writers/JATS.hs +0/−2
- test/Tests/Writers/Jira.hs +18/−1
- test/Tests/Writers/LaTeX.hs +0/−2
- test/Tests/Writers/Markdown.hs +0/−2
- test/Tests/Writers/Ms.hs +0/−2
- test/Tests/Writers/Muse.hs +0/−1
- test/Tests/Writers/Native.hs +0/−2
- test/Tests/Writers/OOXML.hs +2/−3
- test/Tests/Writers/Org.hs +46/−13
- test/Tests/Writers/Plain.hs +0/−2
- test/Tests/Writers/Powerpoint.hs +0/−2
- test/Tests/Writers/RST.hs +0/−2
- test/Tests/Writers/TEI.hs +0/−2
- test/command/5321.md +2/−2
- test/command/5686.md +1/−1
- test/command/7058.md +6/−0
- test/command/7064.md +32/−0
- test/command/7067.md +90/−0
- test/command/7080.md +8/−0
- test/command/7092.md +8/−0
- test/command/7099.md +18/−0
- test/command/7112.md +15/−0
- test/command/7129.md +27/−0
- test/command/biblatex-baez-article.md +1/−1
- test/command/biblatex-baez-online.md +1/−1
- test/command/biblatex-cotton.md +3/−3
- test/command/biblatex-itzhaki.md +1/−1
- test/command/biblatex-murray.md +3/−2
- test/command/biblatex-wassenberg.md +1/−1
- test/command/biblatex-wilde.md +1/−1
- test/docbook-reader.docbook +6/−1
- test/docx/golden/block_quotes.docx binary
- test/docx/golden/codeblock.docx binary
- test/docx/golden/comments.docx binary
- test/docx/golden/custom_style_no_reference.docx binary
- test/docx/golden/custom_style_preserve.docx binary
- test/docx/golden/custom_style_reference.docx binary
- test/docx/golden/definition_list.docx binary
- test/docx/golden/document-properties-short-desc.docx binary
- test/docx/golden/document-properties.docx binary
- test/docx/golden/headers.docx binary
- test/docx/golden/image.docx binary
- test/docx/golden/inline_code.docx binary
- test/docx/golden/inline_formatting.docx binary
- test/docx/golden/inline_images.docx binary
- test/docx/golden/link_in_notes.docx binary
- test/docx/golden/links.docx binary
- test/docx/golden/lists.docx binary
- test/docx/golden/lists_continuing.docx binary
- test/docx/golden/lists_multiple_initial.docx binary
- test/docx/golden/lists_restarting.docx binary
- test/docx/golden/nested_anchors_in_header.docx binary
- test/docx/golden/notes.docx binary
- test/docx/golden/raw-blocks.docx binary
- test/docx/golden/raw-bookmarks.docx binary
- test/docx/golden/table_one_row.docx binary
- test/docx/golden/table_with_list_cell.docx binary
- test/docx/golden/tables.docx binary
- test/docx/golden/track_changes_deletion.docx binary
- test/docx/golden/track_changes_insertion.docx binary
- test/docx/golden/track_changes_move.docx binary
- test/docx/golden/track_changes_scrubbed_metadata.docx binary
- test/docx/golden/unicode.docx binary
- test/docx/golden/verbatim_subsuper.docx binary
- test/jats-reader.native +1/−1
- test/jats-reader.xml +1/−0
- test/lhs-test.latex +3/−3
- test/lhs-test.latex+lhs +3/−3
- test/lua/module/pandoc-path.lua +44/−0
- test/pptx/code-custom.pptx binary
- test/pptx/code-custom_templated.pptx binary
- test/pptx/code.pptx binary
- test/pptx/code_templated.pptx binary
- test/pptx/document-properties-short-desc.pptx binary
- test/pptx/document-properties-short-desc_templated.pptx binary
- test/pptx/document-properties.pptx binary
- test/pptx/document-properties_templated.pptx binary
- test/pptx/endnotes.pptx binary
- test/pptx/endnotes_templated.pptx binary
- test/pptx/endnotes_toc.pptx binary
- test/pptx/endnotes_toc_templated.pptx binary
- test/pptx/images.pptx binary
- test/pptx/images_templated.pptx binary
- test/pptx/inline_formatting.pptx binary
- test/pptx/inline_formatting_templated.pptx binary
- test/pptx/lists.pptx binary
- test/pptx/lists_templated.pptx binary
- test/pptx/raw_ooxml.pptx binary
- test/pptx/raw_ooxml_templated.pptx binary
- test/pptx/remove_empty_slides.pptx binary
- test/pptx/remove_empty_slides_templated.pptx binary
- test/pptx/slide_breaks.pptx binary
- test/pptx/slide_breaks_slide_level_1.pptx binary
- test/pptx/slide_breaks_slide_level_1_templated.pptx binary
- test/pptx/slide_breaks_templated.pptx binary
- test/pptx/slide_breaks_toc.pptx binary
- test/pptx/slide_breaks_toc_templated.pptx binary
- test/pptx/speaker_notes.pptx binary
- test/pptx/speaker_notes_after_metadata.pptx binary
- test/pptx/speaker_notes_after_metadata_templated.pptx binary
- test/pptx/speaker_notes_afterheader.pptx binary
- test/pptx/speaker_notes_afterheader_templated.pptx binary
- test/pptx/speaker_notes_afterseps.pptx binary
- test/pptx/speaker_notes_afterseps_templated.pptx binary
- test/pptx/speaker_notes_templated.pptx binary
- test/pptx/start_numbering_at.pptx binary
- test/pptx/start_numbering_at_templated.pptx binary
- test/pptx/tables.pptx binary
- test/pptx/tables_templated.pptx binary
- test/pptx/two_column.pptx binary
- test/pptx/two_column_templated.pptx binary
- test/test-pandoc.hs +19/−8
- test/txt2tags.native +1/−1
- test/txt2tags.t2t +1/−1
- test/writer.jats_archiving +1/−1
- test/writer.jats_publishing +1/−1
- test/writer.jira +22/−33
- test/writer.latex +3/−3
- test/writers-lang-and-dir.latex +6/−6
- trypandoc/index.html +1/−1
- trypandoc/trypandoc.hs +2/−7
AUTHORS.md view
@@ -62,11 +62,13 @@ - Daniele D'Orazio - David A Roberts - David Lazar+- David Martschenko - David Röthlisberger - Denis Laxalde - Denis Maier - Derek Chen-Becker - Diego Balseiro+- Dimitri Sabadie - Dmitry Pogodin - Dmitry Volodin - Douglas Calvert@@ -161,6 +163,8 @@ - Leif Metcalf - Leonard Rosenthol - Lila+- Loïc Grobol+- Lorenzo - Lucas Escot - Luke Plant - Marc Schreiber@@ -194,10 +198,12 @@ - Nathan Gass - Neil Mayhew - Nick Bart+- Nick Berendsen - Nick Fleisher - Nicolas Kaiser - Nikolay Yakimov - Nils Carlson+- Nixon Enraght-Moony - Nokome Bentley - Ole Martin Ruud - Oliver Matthews
CONTRIBUTING.md view
@@ -372,7 +372,7 @@ -------- Pandoc has a publicly accessible git repository on-GitHub: <http://github.com/jgm/pandoc>. To get a local copy of the source:+GitHub: <https://github.com/jgm/pandoc>. To get a local copy of the source: git clone https://github.com/jgm/pandoc.git @@ -382,7 +382,7 @@ The modules `Text.Pandoc.Definition`, `Text.Pandoc.Builder`, and `Text.Pandoc.Generic` are in a separate library `pandoc-types`. The code can-be found in <http://github.com/jgm/pandoc-types>.+be found in <https://github.com/jgm/pandoc-types>. To build pandoc, you will need a working installation of the [Haskell platform].@@ -445,14 +445,14 @@ [closed issues]: https://github.com/jgm/pandoc/issues?q=is%3Aissue+is%3Aclosed [latest released version]: https://github.com/jgm/pandoc/releases/latest [Nightly builds]: https://github.com/jgm/pandoc/actions?query=workflow%3ANightly-[pandoc-discuss]: http://groups.google.com/group/pandoc-discuss+[pandoc-discuss]: https://groups.google.com/group/pandoc-discuss [issue tracker]: https://github.com/jgm/pandoc/issues-[User's Guide]: http://pandoc.org/MANUAL.html-[FAQs]: http://pandoc.org/faqs.html-[EditorConfig]: http://editorconfig.org/-[Haskell platform]: http://www.haskell.org/platform/+[User's Guide]: https://pandoc.org/MANUAL.html+[FAQs]: https://pandoc.org/faqs.html+[EditorConfig]: https://editorconfig.org/+[Haskell platform]: https://www.haskell.org/platform/ [hlint]: https://hackage.haskell.org/package/hlint-[hsb2hs]: http://hackage.haskell.org/package/hsb2hs+[hsb2hs]: https://hackage.haskell.org/package/hsb2hs [pre-commit hook]: https://git-scm.com/book/en/v2/Customizing-Git-Git-Hooks [GitHub labels]: https://github.com/jgm/pandoc/labels [good first issue]:https://github.com/jgm/pandoc/labels/good%20first%20issue
COPYING.md view
@@ -357,5 +357,5 @@ you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the [GNU Lesser General Public-License](http://www.gnu.org/licenses/lgpl.html) instead of this+License](https://www.gnu.org/licenses/lgpl.html) instead of this License.
COPYRIGHT view
@@ -22,11 +22,11 @@ the source distribution. On Debian systems, the complete text of the GPL can be found in `/usr/share/common-licenses/GPL`. -[GPL]: http://www.gnu.org/copyleft/gpl.html+[GPL]: https://www.gnu.org/copyleft/gpl.html Pandoc's complete source code is available from the [Pandoc home page]. -[Pandoc home page]: http://pandoc.org+[Pandoc home page]: https://pandoc.org Pandoc includes some code with different copyrights, or subject to different licenses. The copyright and license statements for these sources are included@@ -176,7 +176,7 @@ ---------------------------------------------------------------------- The dzslides template contains JavaScript and CSS from Paul Rouget's dzslides template.-http://github.com/paulrouget/dzslides+https://github.com/paulrouget/dzslides Released under the Do What the Fuck You Want To Public License.
INSTALL.md view
@@ -45,7 +45,7 @@ and running it with `perl uninstall-pandoc.pl`. Alternatively, you can install pandoc using-[Homebrew](http://brew.sh):+[Homebrew](https://brew.sh): brew install pandoc @@ -116,7 +116,7 @@ you can install it with `apt-get install haskell-platform`. For PDF output, you'll need LaTeX. We recommend installing-[TeX Live](http://www.tug.org/texlive/) via your package+[TeX Live](https://www.tug.org/texlive/) via your package manager. (On Debian/Ubuntu, `apt-get install texlive`.) ## Chrome OS@@ -238,7 +238,7 @@ pandoc --help - [Not sure where `$CABALDIR` is?](http://www.haskell.org/haskellwiki/Cabal-Install#The_cabal-install_configuration_file)+ [Not sure where `$CABALDIR` is?](https://wiki.haskell.org/Cabal-Install#The_cabal-install_configuration_file) 5. By default `pandoc` uses the "i;unicode-casemap" method to sort bibliography entries (RFC 5051). If you would like to@@ -383,30 +383,29 @@ [Arch]: https://www.archlinux.org/packages/community/x86_64/pandoc/-[Cabal User's Guide]: http://www.haskell.org/cabal/release/latest/doc/users-guide/builders.html#setup-configure-paths+[Cabal User's Guide]: https://cabal.readthedocs.io/ [Debian]: https://packages.debian.org/pandoc [Fedora]: https://apps.fedoraproject.org/packages/pandoc-[FreeBSD ports]: http://www.freshports.org/textproc/hs-pandoc/-[GHC]: http://www.haskell.org/ghc/-[GPL]: http://www.gnu.org/copyleft/gpl.html-[Haskell platform]: http://hackage.haskell.org/platform/-[MacPorts]: http://trac.macports.org/browser/trunk/dports/textproc/pandoc/Portfile+[FreeBSD ports]: https://www.freshports.org/textproc/hs-pandoc/+[GHC]: https://www.haskell.org/ghc/+[Haskell platform]: https://hackage.haskell.org/platform/+[MacPorts]: https://trac.macports.org/browser/trunk/dports/textproc/pandoc/Portfile [MacTeX]: https://tug.org/mactex/-[BasicTeX]: http://www.tug.org/mactex/morepackages.html+[BasicTeX]: https://www.tug.org/mactex/morepackages.html [LaTeX]: https://www.latex-project.org-[MiKTeX]: http://miktex.org/+[MiKTeX]: https://miktex.org/ [librsvg]: https://wiki.gnome.org/Projects/LibRsvg [Python]: https://www.python.org-[NetBSD]: http://pkgsrc.se/wip/pandoc+[NetBSD]: https://pkgsrc.se/wip/pandoc [NixOS]: https://nixos.org/nixos/packages.html [Slackware]: https://www.slackbuilds.org/result/?search=pandoc&sv= [Ubuntu]: https://packages.ubuntu.com/pandoc [download page]: https://github.com/jgm/pandoc/releases/latest-[gentoo]: http://packages.gentoo.org/package/app-text/pandoc+[gentoo]: https://packages.gentoo.org/package/app-text/pandoc [haskell repository]: https://wiki.archlinux.org/index.php/Haskell_Package_Guidelines#.5Bhaskell.5D [openSUSE]: https://software.opensuse.org/package/pandoc-[source tarball]: http://hackage.haskell.org/package/pandoc+[source tarball]: https://hackage.haskell.org/package/pandoc [stack]: https://docs.haskellstack.org/en/stable/install_and_upgrade.html-[cabal-install]: http://hackage.haskell.org/package/cabal-install+[cabal-install]: https://hackage.haskell.org/package/cabal-install [Void]: https://voidlinux.org/ [uninstaller]: https://raw.githubusercontent.com/jgm/pandoc/master/macos/uninstall-pandoc.pl
MANUAL.txt view
@@ -1,7 +1,7 @@ --- title: Pandoc User's Guide author: John MacFarlane-date: January 21, 2021+date: March 8, 2021 --- # Synopsis@@ -136,7 +136,7 @@ When using LaTeX, the following packages need to be available (they are included with all recent versions of [TeX Live]): [`amsfonts`], [`amsmath`], [`lm`], [`unicode-math`],-[`ifxetex`], [`ifluatex`], [`listings`] (if the+[`iftex`], [`listings`] (if the `--listings` option is used), [`fancyvrb`], [`longtable`], [`booktabs`], [`graphicx`] (if the document contains images), [`hyperref`], [`xcolor`],@@ -180,8 +180,7 @@ [`graphicx`]: https://ctan.org/pkg/graphicx [`grffile`]: https://ctan.org/pkg/grffile [`hyperref`]: https://ctan.org/pkg/hyperref-[`ifluatex`]: https://ctan.org/pkg/ifluatex-[`ifxetex`]: https://ctan.org/pkg/ifxetex+[`iftex`]: https://ctan.org/pkg/iftex [`listings`]: https://ctan.org/pkg/listings [`lm`]: https://ctan.org/pkg/lm [`longtable`]: https://ctan.org/pkg/longtable@@ -362,15 +361,15 @@ will be used. On \*nix and macOS systems this will be the `pandoc` subdirectory of the XDG data directory (by default, `$HOME/.local/share`, overridable by setting the `XDG_DATA_HOME`- environment variable). If that directory does not exist,- `$HOME/.pandoc` will be used (for backwards compatibility).- In Windows the default user data directory is+ environment variable). If that directory does not exist and+ `$HOME/.pandoc` exists, it will be used (for backwards compatibility).+ On Windows the default user data directory is `C:\Users\USERNAME\AppData\Roaming\pandoc`. You can find the default user data directory on your system by looking at the output of `pandoc --version`.- A `reference.odt`, `reference.docx`, `epub.css`, `templates`,- `slidy`, `slideous`, or `s5` directory- placed in this directory will override pandoc's normal defaults.+ Data files placed in this directory (for example, `reference.odt`,+ `reference.docx`, `epub.css`, `templates`) will override+ pandoc's normal defaults. `-d` *FILE*, `--defaults=`*FILE* @@ -487,7 +486,7 @@ [Emacs Org mode]: https://orgmode.org [AsciiDoc]: https://www.methods.co.nz/asciidoc/ [AsciiDoctor]: https://asciidoctor.org/-[DZSlides]: http://paulrouget.com/dzslides/+[DZSlides]: https://paulrouget.com/dzslides/ [Word docx]: https://en.wikipedia.org/wiki/Office_Open_XML [PDF]: https://www.adobe.com/pdf/ [reveal.js]: https://revealjs.com/@@ -692,9 +691,9 @@ system default, use `pandoc --print-default-data-file=abbreviations`. The only use pandoc makes of this list is in the Markdown reader.- Strings ending in a period that are found in this list will- be followed by a nonbreaking space, so that the period will- not produce sentence-ending space in formats like LaTeX.+ Strings found in this list will be followed by a nonbreaking+ space, and the period will not produce sentence-ending space+ in formats like LaTeX. The strings may not contain spaces. [`pandocfilters`]: https://github.com/jgm/pandocfilters [PHP]: https://github.com/vinai/pandocfilters-php@@ -892,6 +891,11 @@ will not be searched. For example: `--resource-path=.:test` will search the working directory and the `test` subdirectory, in that order.+ This option can be used repeatedly. Search path components+ that come later on the command line will be searched before+ those that come earlier, so+ `--resource-path foo:bar --resource-path baz:bim` is+ equivalent to `--resource-path baz:bim:foo:bar`. `--request-header=`*NAME*`:`*VAL* @@ -1465,6 +1469,7 @@ 24 PandocCiteprocError 31 PandocEpubSubdirectoryError 43 PandocPDFError+ 44 PandocXMLError 47 PandocPDFProgramNotFoundError 61 PandocHttpError 62 PandocShouldNeverHappenError@@ -1477,6 +1482,7 @@ 91 PandocMacroLoop 92 PandocUTF8DecodingError 93 PandocIpynbDecodingError+ 94 PandocUnsupportedCharsetError 97 PandocCouldNotFindDataFileError 99 PandocResourceNotFound ----- ------------------------------------@@ -1568,8 +1574,11 @@ verbosity: INFO log-file: log.json -# citeproc, natbib, or biblatex+# citeproc, natbib, or biblatex. This only affects LaTeX+# output. If you want to use citeproc to format citations,+# you should also set 'citeproc: true' (see above). cite-method: citeproc+ # part, chapter, section, or default: top-level-division: chapter abbreviations:@@ -1668,6 +1677,34 @@ verbosity: INFO ``` +In fields that expect a file path (or list of file paths), the+following syntax may be used to interpolate environment variables:++``` yaml+csl: ${HOME}/mycsldir/special.csl+```++`${USERDATA}` may also be used; this will always resolve to the+user data directory that is current when the defaults file is+parsed, regardless of the setting of the environment+variable `USERDATA`.++`${.}` will resolve to the directory containing the default+file itself. This allows you to refer to resources contained+in that directory:++``` yaml+epub-cover-image: ${.}/cover.jpg+epub-metadata: ${.}/meta.xml+resource-path:+- . # the working directory from which pandoc is run+- ${.}/images # the images subdirectory of the directory+ # containing this defaults file+```++This environment variable interpolation syntax *only* works in+fields that expect file paths.+ Default files can be placed in the `defaults` subdirectory of the user data directory and used from any directory. For example, one could create a file specifying defaults for writing@@ -1895,7 +1932,8 @@ ``` (If a partial is not found in the directory of the-template, it will also be sought in the `templates`+template and the template path is given as a relative +path, it will also be sought in the `templates` subdirectory of the user data directory.) Partials may optionally be applied to variables using@@ -3477,6 +3515,9 @@ | 200 Main St. | Berkeley, CA 94718 +Inline formatting (such as emphasis) is allowed in the content,+but not block-level formatting (such as block quotes or lists).+ This syntax is borrowed from [reStructuredText]. ## Lists@@ -4356,7 +4397,8 @@ them and they won't be treated as math delimiters. For display math, use `$$` delimiters. (In this case, the delimiters-may be separated from the formula by whitespace.)+may be separated from the formula by whitespace. However, there can be+no blank lines betwen the opening and closing `$$` delimiters.) TeX math will be printed in all output formats. How it is rendered depends on the output format:@@ -5929,7 +5971,16 @@ `rights` ~ A string value.+ +`belongs-to-collection`+ ~ A string value. identifies the name of a collection to which+ the EPUB Publication belongs. +`group-position`+ ~ The `group-position` field indicates the numeric position in which+ the EPUB Publication belongs relative to other works belonging to+ the same `belongs-to-collection` field.+ `cover-image` ~ A string value (path to cover image). @@ -6295,6 +6346,21 @@ subdirectory of your user data directory (see [Templates]). [Lua]: https://www.lua.org++# Reproducible builds++Some of the document formats pandoc targets (such as EPUB,+docx, and ODT) include build timestamps in the generated document.+That means that the files generated on successive builds will+differ, even if the source does not. To avoid this, set the+`SOURCE_DATE_EPOCH` environment variable, and the timestamp will+be taken from it instead of the current time.+`SOURCE_DATE_EPOCH` should contain an integer unix timestamp+(specifying the number of second since midnight UTC January 1, 1970).++Some document formats also include a unique identifier. For+EPUB, this can be set explicitly by setting the `identifier`+metadata field (see [EPUB Metadata], above). # A note on security
README.md view
@@ -8,10 +8,10 @@ [](https://github.com/jgm/pandoc/releases) [](http://hackage.haskell.org/package/pandoc)-[](http://brewformulas.org/Pandoc)+release](https://img.shields.io/hackage/v/pandoc.svg?label=hackage)](https://hackage.haskell.org/package/pandoc)+[](https://formulae.brew.sh/formula/pandoc) [](http://stackage.org/lts/package/pandoc)+package](https://stackage.org/package/pandoc/badge/lts)](https://www.stackage.org/lts/package/pandoc-types) [](https://github.com/jgm/pandoc/actions) [](https://www.gnu.org/licenses/gpl.html)@@ -20,7 +20,7 @@ ## The universal markup converter -Pandoc is a [Haskell](http://haskell.org) library for converting from+Pandoc is a [Haskell](https://haskell.org) library for converting from one markup format to another, and a command-line tool that uses this library. It can convert *from* @@ -175,7 +175,7 @@ and JavaScript slide show) - `slidy` ([Slidy](https://www.w3.org/Talks/Tools/Slidy2/) HTML and JavaScript slide show)-- `dzslides` ([DZSlides](http://paulrouget.com/dzslides/) HTML5 ++- `dzslides` ([DZSlides](https://paulrouget.com/dzslides/) HTML5 + JavaScript slide show), - `revealjs` ([reveal.js](https://revealjs.com/) HTML5 + JavaScript slide show)@@ -239,6 +239,6 @@ ## License © 2006-2021 John MacFarlane (jgm@berkeley.edu). Released under the-[GPL](http://www.gnu.org/copyleft/gpl.html "GNU General Public License"),+[GPL](https://www.gnu.org/licenses/old-licenses/gpl-2.0.html "GNU General Public License"), version 2 or greater. This software carries no warranty of any kind. (See COPYRIGHT for full copyright and warranty notices.)
app/pandoc.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {- | Module : Main Copyright : Copyright (C) 2006-2021 John MacFarlane@@ -12,7 +11,6 @@ writers. -} module Main where-import Prelude import qualified Control.Exception as E import Text.Pandoc.App (convertWithOpts, defaultOpts, options, parseOptions) import Text.Pandoc.Error (handleError)
benchmark/benchmark-pandoc.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2012-2021 John MacFarlane <jgm@berkeley.edu>@@ -17,52 +16,43 @@ along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -}-import Prelude import Text.Pandoc import Text.Pandoc.MIME-import Control.Monad.Except (throwError, liftIO)+import Control.Monad (when)+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 Criterion.Main-import Criterion.Types (Config(..))-import Data.List (intersect)-import Data.Maybe (mapMaybe, catMaybes)-import System.Environment (getArgs)+import Test.Tasty.Bench import qualified Data.ByteString.Lazy as BL--data Input = InputText {unInputText :: T.Text}- | InputBS {unInputBS :: BL.ByteString}+import Data.Maybe (mapMaybe)+import Data.List (sortOn) readerBench :: Pandoc -> T.Text- -> IO (Maybe Benchmark)-readerBench doc name = do- let (rdr, rexts) = either (error . show) id . runPure $ getReader name- res <- runIO $ do- (wtr, wexts) <- getWriter name- case (rdr, wtr) of- (TextReader r, TextWriter w) -> do- setResourcePath ["./test"]- inp <- w def{ writerWrapText = WrapAuto- , writerExtensions = wexts } doc- return (r def{ readerExtensions = rexts } . unInputText, InputText inp)- (ByteStringReader r, ByteStringWriter w) -> do- setResourcePath ["./test"]- tmpl <- Just <$> compileDefaultTemplate name- inp <- w def{ writerWrapText = WrapAuto- , writerExtensions = wexts- , writerTemplate = tmpl } doc- liftIO $ BL.writeFile "/tmp/test.odt" inp- return (r def{ readerExtensions = rexts } . unInputBS, InputBS inp)- _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: "- <> name- return $ case res of- Right (readerFun, inp) ->- Just $ bench (T.unpack $ name <> " reader")- $ nf (\i -> either (error . show) id $ runPure (readerFun i))- inp- Left _ -> Nothing+ -> Maybe Benchmark+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+ (TextReader r, TextWriter w) -> do+ inp <- w def{ writerWrapText = WrapAuto+ , writerExtensions = wexts } doc+ return $ bench (T.unpack name) $+ nf (either (error . show) id . runPure . r def) inp+ (ByteStringReader r, ByteStringWriter w) -> do+ tmpl <- Just <$> compileDefaultTemplate name+ inp <- w def{ writerWrapText = WrapAuto+ , writerExtensions = wexts+ , writerTemplate = tmpl } doc+ return $ bench (T.unpack name) $+ nf (either (error . show) id .+ runPure . r def{readerExtensions = rexts}) inp+ _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: "+ <> name getImages :: IO [(FilePath, MimeType, BL.ByteString)] getImages = do@@ -71,52 +61,42 @@ return [("lalune.jpg", "image/jpg", ll) ,("movie.jpg", "image/jpg", mv)] -writerBench :: Pandoc+writerBench :: [(FilePath, MimeType, BL.ByteString)]+ -> Pandoc -> T.Text -> Maybe Benchmark-writerBench doc name =- case res of- Right writerFun ->- Just $ env getImages $ \imgs ->- bench (T.unpack $ name <> " writer")+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 ->+ return $ bench (T.unpack name) $ nf (\d -> either (error . show) id $- runPure (do mapM_- (\(fp, mt, bs) ->- insertMedia fp (Just mt) bs)- imgs- writerFun d)) doc- Left _ -> Nothing- where res = runPure $ do- (wtr, wexts) <- getWriter name- case wtr of- TextWriter w ->- return $ w def{ writerExtensions = wexts }- _ -> throwError $ PandocSomeError- $ "could not get text writer for " <> name+ runPure $ do+ mapM_ (\(fp,mt,bs) -> insertMedia fp (Just mt) bs) imgs+ writerFun def{ writerExtensions = wexts} d)+ doc+ ByteStringWriter writerFun ->+ return $ bench (T.unpack name)+ $ nf (\d -> either (error . show) id $+ runPure $ do+ mapM_ (\(fp,mt,bs) -> insertMedia fp (Just mt) bs) imgs+ writerFun def{ writerExtensions = wexts} d)+ doc main :: IO () main = do- args <- filter (\x -> T.take 1 x /= "-") . fmap T.pack <$> getArgs- print args- let matchReader (n, _) =- null args || ("reader" `elem` args && n `elem` args)- matchWriter (n, TextWriter _) =- null args || ("writer" `elem` args && n `elem` args)- matchWriter _ = False- allWriters = map fst (writers :: [(T.Text, Writer PandocPure)])- matchedReaders = map fst (filter matchReader readers- :: [(T.Text, Reader PandocPure)])- matchedWriters = map fst (filter matchWriter writers- :: [(T.Text, Writer PandocPure)]) inp <- UTF8.toText <$> B.readFile "test/testsuite.txt" let opts = def let doc = either (error . show) id $ runPure $ readMarkdown opts inp- readerBs <- fmap catMaybes- $ mapM (readerBench doc)- $ filter (/="haddock")- (matchedReaders `intersect` allWriters)- -- we need the corresponding writer to generate- -- input for the reader- let writerBs = mapMaybe (writerBench doc) matchedWriters- defaultMainWith defaultConfig{ timeLimit = 6.0 }- (writerBs ++ readerBs)+ imgs <- getImages+ defaultMain+ [ bgroup "writers" $ mapMaybe (writerBench imgs doc . fst)+ (sortOn fst+ writers :: [(T.Text, Writer PandocPure)])+ , bgroup "readers" $ mapMaybe (readerBench doc . fst)+ (sortOn fst+ readers :: [(T.Text, Reader PandocPure)])+ ]
− benchmark/weigh-pandoc.hs
@@ -1,50 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{- |- Module : Main- Copyright : © 2016-2021 John MacFarlane <jgm@berkeley.edu>- License : GNU GPL, version 2 or above-- Maintainer : John MacFarlane <jgm@berkeley.edu>- Stability : alpha- Portability : portable--Benchmarks to determine resource use of readers and writers.--}-import Prelude-import Weigh-import Text.Pandoc-import Data.Text (Text, unpack)--main :: IO ()-main = do- doc <- read <$> readFile "test/testsuite.native"- mainWith $ do- func "Pandoc document" id doc- mapM_- (\(n,r) -> weighReader doc n (either (error . show) id . runPure . r def{readerExtensions = pandocExtensions}))- [("markdown", readMarkdown)- ,("html", readHtml)- ,("docbook", readDocBook)- ,("latex", readLaTeX)- ,("commonmark", readCommonMark)- ]- mapM_- (\(n,w) -> weighWriter doc n (either (error . show) id . runPure . w def))- [("markdown", writeMarkdown)- ,("html", writeHtml5String)- ,("docbook", writeDocbook5)- ,("latex", writeLaTeX)- ,("commonmark", writeCommonMark)- ]--weighWriter :: Pandoc -> String -> (Pandoc -> Text) -> Weigh ()-weighWriter doc name writer = func (name ++ " writer") writer doc--weighReader :: Pandoc -> Text -> (Text -> Pandoc) -> Weigh ()-weighReader doc name reader =- case lookup name writers of- Just (TextWriter writer) ->- let inp = either (error . show) id $ runPure $ writer def{ writerWrapText = WrapAuto} doc- in func (unpack $ name <> " reader") reader inp- _ -> return () -- no writer for reader
cabal.project view
@@ -3,8 +3,8 @@ tests: True package pandoc- flags: +embed_data_files -trypandoc- ghc-options: -j +RTS -A64m -RTS+ flags: +embed_data_files+ ghc-options: -j +RTS -A256m -RTS -- source-repository-package -- type: git
changelog.md view
@@ -1,5 +1,494 @@ # Revision history for pandoc +## pandoc 2.12 (2021-03-08)++ * `--resource-path` now accumulates if specified multiple+ times (#6152). Resource paths specified later on the command line are+ prepended to those specified earlier. Thus,+ `--resource-path foo --resource-path bar:baz` is equivalent to+ `--resource-path bar:bas:foo`. (The previous behavior was+ for the last `--resource-path` to replace all the rest.)+ `resource-path` in defaults files behaves the same way: it+ will be prepended to the resource path set by earlier+ command line options or defaults files. This change+ facilitates the use of multiple defaults files: each can+ specify a directory containing resources it refers to+ without clobbering the resource paths set by the others.++ * Allow defaults files to refer to the home directory, the+ user data directory, and the directory containing the defaults file+ itself (#5871, #5982, #5977). In fields that expect file paths+ (and only in these fields),++ + `${VARIABLE}` will expand to the value of the environment variable+ `VARIABLE` (and in particular `${HOME}` will expand to the path+ of the home directory). A warning will be raised for undefined+ variables.+ + `${USERDATA}` will expand to the path of the user data+ directory in force when the defaults file is being processed.+ + `${.}` will expand to the directory containing the defaults file.+ (This allows default files to be placed in a directory containing+ resources they make use of.)++ * When downloading content from URL arguments, be sensitive to+ the character encoding (#5600). We can properly handle UTF-8 and latin1+ (ISO-8859-1); for others we raise an error. Fall back to latin1 if+ no charset is given in the mime type and UTF-8 decoding fails.++ * Allow abbreviations that don't end in a period to be+ specified using `--abbreviations` (#7124).++ * Add new unexported module Text.Pandoc.XML.Light, as well+ as Text.Pandoc.XML.Light.Types, Text.Pantoc.XML.Light.Proc,+ Text.Pandoc.XML.Light.Output. (Closes #6001, #6565, #7091).++ This module exports definitions of `Element` and `Content`+ that are isomorphic to xml-light's, but with Text+ instead of String. This allows us to keep most of the code in existing+ readers that use xml-light, but avoid lots of unnecessary allocation.++ We also add versions of the functions from xml-light's+ Text.XML.Light.Output and Text.XML.Light.Proc that operate on our+ modified XML types, and functions that convert xml-light types to our+ types (since some of our dependencies, like texmath, use xml-light).++ We export functions that use xml-conduit's parser to produce an+ `Element` or `[Content]`. This allows existing pandoc code to use+ a better parser without much modification.++ The new parser is used in all places where xml-light's parser was+ previously used. Benchmarks show a significant performance improvement+ in parsing XML-based formats (with docbook, opml, jats, and docx+ almost twice as fast, odt and fb2 more than twice as fast).++ In addition, the new parser gives us better error reporting than+ xml-light. We report XML errors, when possible, using the new+ `PandocXMLError` constructor in `PandocError`.++ These changes revealed the need for some changes in the tests. The+ docbook-reader.docbook test lacked definitions for the entities it used;+ these have been added. And the docx golden tests have been updated,+ because the new parser does not preserve the order of attributes.++ * DocBook reader:++ + Avoid expensive tree normalization step, as it is not necessary+ with the new XML parser.+ + Support `informalfigure` (#7079) (Nils Carlson).++ * Docx reader:++ + Use Map instead of list for Namespaces. This gives a speedup of+ about 5-10%. With this and the XML parsing changes, the docx reader+ is now about twice as fast as in the previous release.++ * HTML reader:++ + Small performance tweaks.+ + Also, remove exported class `NamedTag(..)` [API change]. This was just+ intended to smooth over the transition from String to Text and is no+ longer needed.+ + As a result, the functions `isInlineTag` and `isBlockTag`+ are no longer polymorphic; they apply to a `Tag Text` [API change].+ + Do a lookahead to find the right parser to use. This takes+ benchmarks from 34ms to 23ms, with less allocation.+ + Fix bad handling of empty `src` attribute in `iframe` (#7099).+ If `src` is empty, we simply skip the `iframe`.+ If `src` is invalid or cannot be fetched, we issue a warning+ nd skip instead of failing with an error.++ * JATS reader:++ + Avoid tree normalization, which is no longer necessary given the+ new XML parser.++ * LaTeX reader:++ + Don't export `tokenize`, `untokenize` [API change]. These are internal+ implementation details, which were only exported for testing.+ They don't belong in the public API.+ + Improved efficiency of the parser. With these changes the reader+ is almost twice as fast as in the last release in our benchmarks.+ + Code cleanup, removing some unnecessary things.+ + Rewrite `withRaw` so it doesn't rely on fragile assumptions+ about token positions (which break when macros are expanded)+ (#7092). This requires the addition of `sEnableWithRaw` and+ `sRawTokens` in `LaTeXState`, and a new combinator `disablingWithRaw`+ to disable collecting of raw tokens in certain contexts.+ Add `parseFromToks` to Text.Pandoc.Readers.LaTeX.Parsing.+ Fix parsing of single character tokens so it doesn't mess+ up the new raw token collecting. These changes slightly increase+ allocations and have a small performance impact.+ + Handle some bibtex/biblatex-specific commands that used to be+ dealt with in pandoc-citeproc (#7049).+ + Optimize `satisfyTok`, avoiding unnecessary macro expansion steps.+ Benchmarks after this change show 2/3 of the run time and 2/3 of the+ allocation of the Feb. 10 benchmarks.+ + Removed `sExpanded` in state. This isn't actually needed and checking+ it doesn't change anything.+ + Improve `braced'`. Remove the parameter, have it parse the+ opening brace, and make it more efficient.+ + Factor out pieces of the LaTeX reader to make the module smaller.+ This reduces memory demands when compiling. Created+ Text.Pandoc.Readers.{LaTeX,Math,Citation,Table,Macro,Inline}.+ Changed Text.Pandoc.Readers.LaTeX.SIunitx to export a command map+ instead of individual commands.+ + Handle table cells containing `&` in `\verb` (#7129).++ * Make Text.Pandoc.Readers.LaTeX.Types an unexported module [API change].++ * Markdown reader:++ + Improved handling of mmd link attributes in references (#7080).+ Previously they only worked for links that had titles.+ + Improved efficiency of the parser (benchmarks show a 15% speedup).++ * OPML reader:++ + Avoid tree normalization, which is no longer necessary with the+ new XML parser.++ * ODT reader:++ + Finer-grained errors on parse failure (#7091).+ + Give more information if the zip container can't be unpacked.++ * Org reader:++ + Support `task_lists` extension (Albert Krewinkel, #6336).+ + Fix bug in org-ref citation parsing (Albert Krewinkel, #7101).+ The org-ref syntax allows to list multiple citations separated by+ comma. Previously commas were accepted as part of the citation id,+ so all citation lists were parsed as one single citation.++ * RST reader:++ + Use `getTimestamp` instead of `getCurrentTime` to fetch timestamp.+ Setting `SOURCE_DATE_EPOCH` will allow reproducible builds.+ + RST reader: fix handling of header in CSV tables (#7064).+ The interpretation of this line is not affected by the delim option.++ * Jira reader:++ + Modified the Doc parser to skip leading blank lines. This fixes+ parsing of documents which start with multiple blank lines (Albert+ Krewinkel, #7095).+ + Prevent URLs within link aliases to be treated as autolinks (Albert+ Krewinkel, #6944).++ * Text.Pandoc.Shared++ + Remove formerly exported functions that are no longer used in the+ code base: `splitByIndices`, `splitStringByIndicies`, `substitute`,+ and `underlineSpan` (which had been deprecated in April 2020)+ [API change].+ + Export `handleTaskListItem` (Albert Krewinkel) [API change].+ + Change `defaultUserDataDirs` to `defaultUserDataDir` [API+ change]. We determine what is the default user data directory+ by seeing whether the XDG directory and/or legacy+ directory exist.++ * BibTeX writer:++ + BibTeX writer: use doclayout and doctemplate. This change allows+ bibtex/biblatex output to wrap as other formats do,+ depending on the settings of `--wrap` and `--columns` (#7068).++ * CSL JSON writer:++ + Output `[]` if no references in input, instead of raising a+ PandocAppError as before.++ * Docx writer:++ + Use `getTimestamp` instead of `getCurrentTime` for timestamp.+ Setting `SOURCE_DATE_EPOCH` will allow reproducible builds.++ * EPUB writer:++ + Use `getTimestamp` instead of `getCurrentTime` for timestamp.+ Setting `SOURCE_DATE_EPOCH` will allow reproducible builds (#7093).+ This does not suffice to fully enable reproducible in EPUB, since+ a unique id is still being generated for each build.+ + Support `belongs-to-collection` metadata (#7063) (Nick Berendsen).++ * JATS writer:++ + Escape special chars in reference elements (Albert Krewinkel).+ Prevents the generation of invalid markup if a citation element+ contains an ampersand or another character with a special meaning+ in XML.++ * Jira writer:++ + Use Span identifiers as anchors (Albert Krewinkel).+ + Use `{noformat}` instead of `{code}` for unknown languages (Albert+ Krewinkel). Code blocks which are not marked as a language supported+ by Jira are rendered as preformatted text via `{noformat}` blocks.++ * LaTeX writer:++ + Adjust hypertargets to beginnings of paragraphs (#7078).+ Use `\vadjust pre` so that the hypertarget takes you to the beginning+ of the paragraph rather than one line down.+ This makes a particular difference for links to citations using+ `--citeproc` and `link-citations: true`.+ + Change BCP47 lang tag from `jp` to `ja` (Mauro Bieg, #7047).+ + Use function instead of map for accent lookup (should be+ more efficient).+ + Split the module to make it easier to compile on low-memory+ systems: added Text.Pandoc.Writers.LaTeX.{Util,Citation,Lang}.++ * Markdown writer:++ + Handle math right before digit. We insert an HTML comment to+ avoid a `$` right before a digit, which pandoc will not recognize+ as a math delimiter.+ + Split the module to make it easier to compile on low-memory+ systems: added Text.Pandoc.Writers.Markdown.{Types,Inline}.++ * ODT writer:++ + Use `getTimestamp` instead of `getCurrentTime` for timestamp.+ Setting `SOURCE_DATE_EPOCH` will allow reproducible builds.+ + Update default ODT style (Lorenzo). Previously, the "First paragraph"+ style inherited from "Standard" but not from "Text body." Now+ it is adjusted to inherit from "Text body", to avoid some ugly+ spacing issues. It may be necessary to update a custom `reference.odt`+ in light of this change.++ * Org writer:++ + Support `task_lists` extension (Albert Krewinkel, #6336).++ * Pptx writer:++ + Use `getTimestamp` instead of `getCurrentTime` for timestamp.+ Setting `SOURCE_DATE_EPOCH` will allow reproducible builds.++ * JATS templates: tag `author.name` as `string-name` (Albert Krewinkel).+ The partitioning the components of a name into surname, given names,+ etc. is not always possible or not available. Using `author.name`+ allows to give the full name as a fallback to be used when+ `author.surname` is not available.++ * Add default templates for bibtex and biblatex, so that+ the variables `header-include`, `include-before`, `include-after`+ (or alternatively the command line options+ `--include-in-header`, `--include-before-body`, `--include-after-body`)+ may be used.++ * LaTeX template:++ + Update to iftex package (#7073) (Andrew Dunning)+ + Wrap url colours in braces (#7121) (Loïc Grobol).++ * revealjs template: Add 'center' option for vertical slide centering.+ (maurerle, #7104).++ * Text.Pandoc.XML: Improve efficiency of `fromEntities`.++ * Text.Pandoc.MIME++ + Add exported function `getCharset` [API change].++ * Text.Pandoc.UTF8: change IO functions to return Text, not String+ [API change]. This affects `readFile`, `getContents`, `writeFileWith`,+ `writeFile`, `putStrWith`, `putStr`, `putStrLnWith`, `putStrLn`.+ `hPutStrWith`, `hPutStr`, `hPutStrLnWith`, `hPutStrLn`, `hGetContents`.+ This avoids the need to uselessly create a linked list of characters+ when emiting output.++ * Text.Pandoc.App++ + Add `parseOptionsFromArgs` [API change, new exported function].+ + Add fields for CSL options to `Opt` [API change]:+ `optCSL`, `optbibliography`, `optCitationAbbreviations`.++ * Text.Pandoc.Citeproc.BibTeX++ + `Text.Pandoc.Citeproc.writeBibTeXString` now returns+ `Doc Text` instead of `Text` (#7068).+ + Correctly handle `pages` (= `page` in CSL) (#7067).+ + Correctly handle BibLaTeX `langid` (= `language` in CSL, #7067).+ + In BibTeX output, protect foreign titles since there's no language+ field (#7067).+ + Clean up BibTeX parsing (#7049). Previously there was a messy code+ path that gave strange results in some cases, not passing through raw+ tex but trying to extract a string content. This was an artefact of+ trying to handle some special bibtex-specific commands in the BibTeX+ reader. Now we just handle these in the LaTeX reader and simplify+ parsing in the BibTeX reader. This does mean that more raw tex will+ be passed through (and currently this is not sensitive to the+ `raw_tex` extension; this should be fixed).++ * Text.Pandoc.Citeproc.MetaValue++ + Correctly parse "raw" date value in markdown references metadata.+ (See jgm/citeproc#53.)++ * Text.Pandoc.Citeproc++ + Use https URLs for links (Salim B, #7122).++ * Text.Pandoc.Class++ + Add `getTimestamp` [API change]. This attempts to read the+ `SOURCE_DATE_EPOCH` environment variable and parse a UTC time+ from it (treating it as a unix date stamp, see+ https://reproducible-builds.org/specs/source-date-epoch/). If the+ variable is not set or can't be parsed as a unix date stamp, then the+ function returns the current date.++ * Text.Pandoc.Error++ + Add `PandocUnsupportedCharsetError` constructor for+ `PandocError` [API change].+ + Export `renderError` [API change].+ + Refactor `handleError` to use `renderError`. This allows us render+ error messages without exiting.++ * Text.Pandoc.Extensions++ + `Ext_task_lists` is now supported by org (and turned+ on by default) (Albert Krewinkel, #6336).+ + Remove `Ext_fenced_code_attributes` from allowed commonmark attributes+ (#7097). This attribute was listed as allowed, but it didn't actually+ do anything. Use `attributes` for code attributes and more.++ * Lua subsystem:++ + Always load built-in Lua scripts from default data-dir (Albert+ Krewinkel). The Lua modules `pandoc` and `pandoc.List` are now always+ loaded from the system's default data directory. Loading from a+ different directory by overriding the default path, e.g. via+ `--data-dir`, is no longer supported to avoid unexpected behavior+ and to address security concerns.+ + Add module "pandoc.path" (Albert Krewinkel, #6001, #6565).+ The module allows to work with file paths in a convenient and+ platform-independent manner.+ + Use strict evaluation when retrieving AST value from the stack+ (Albert Krewinkel, #6674).++ * Text.Pandoc.PDF++ + Disable `smart` extension when building PDF via LaTeX.+ This is to prevent accidental creation of ligatures like+ `` ?` `` and `` !` `` (especially in languages with quotations like+ German), and similar ligature issues. (See jgm/citeproc#54.)++ * Text.Pandoc.CSV:++ + Fix parsing of unquoted values (#7112). Previously we didn't allow+ unescaped quotes in unquoted values, but they are allowed+ in CSV.++ * Test suite:++ + Use a more robust method for testing the executable. Many+ of our tests require running the pandoc executable. This+ is problematic for a few different reasons. First,+ cabal-install will sometimes run the test suite after+ building the library but before building the executable,+ which means the executable isn't in place for the tests.+ One can work around that by first building, then building+ and running the tests, but that's fragile. Second, we+ have to find the executable. So far, we've done that using+ a function `findPandoc` that attempts to locate it+ relative to the test executable (which can be located+ using findExecutablePath). But the logic here is delicate+ and work with every combination of options. To solve both+ problems, we add an `--emulate` option to the+ `test-pandoc` executable. When `--emulate` occurs as the+ first argument passed to `test-pandoc`, the program simply+ emulates the regular pandoc executable, using the rest of+ the arguments (after `--emulate`). Thus, `test-pandoc+ --emulate -f markdown -t latex` is just like `pandoc -f+ markdown -t latex`. Since all the work is done by library+ functions, implementing this emulation just takes a couple+ lines of code and should be entirely reliable. With this+ change, we can test the pandoc executable by running the+ test program itself (locatable using `findExecutablePath`)+ with the `--emulate` option. This removes the need for the+ fragile `findPandoc` step, and it means we can run our+ integration tests even when we're just building the+ library, not the executable. [Note: part of this change+ involved simplifying some complex handling to set+ environment variables for dynamic library paths. I have+ tested a build with `--enable-dynamic-executable`, and it+ works, but further testing may be needed.]+ + Print accurate location if a test fails (Albert+ Krewinkel). Ensures that tasty-hunit reports the location+ of the failing test instead of the location of the helper+ `test` function.++ * Documentation: Update URLs and use `https` where possible (#7122,+ Salim B).++ * Add `doc/libraries.md`, a description of libraries that support pandoc.++ * MANUAL.txt++ + MANUAL: block-level formatting is not allowed in line blocks (#7107).+ + Clarify `tex_math_dollars` extension. Note that no blank lines+ are allowed between the delimiters in display math.+ + Add MANUAL section on reproducible builds.+ + Document no template fallback for absolute path (#7077, Nixon+ Enraght-Moony.)+ + Improve docs for cite-method.+ + Update README and man page.++ * Makefile: in `make bench`, create CSV files for comparison and compare+ against previous benchmark run. Add timestamp to CSV filenames.++ * cabal.project: don't explicitly set -trypandoc.+ If we do, this can't be overridden on the cabal command line.++ * doc/lua-filters.md: improve documentation for+ `pandoc.mediabag.insert`, `pandoc.mediabag.fetch`,+ `directory`, `normalize` (Albert Krewinkel).++ * Allow base64-bytestring-1.2.* (Dmitrii Kovanikov)++ * Require jira-wiki-markup 1.3.3 (Albert Krewinkel)++ * Require citeproc 0.3.0.8, which correctly titlecases when titles+ contain non-ASCII characters.++ * Use skylighting 0.10.4. This version of skylighting uses xml-conduit+ rather than hxt. This speeds up parsing of XML syntax definitions+ fourfold, and removes four packages from pandoc's dependency graph:+ hxt-charproperties, hxt-unicode, hxt-regex-xmlschema, hxt.++ * Add script `tools/parseTimings.pl` to help pin down which+ modules take the most time and memory to compile.++ * Avoid unnecessary use of NoImplicitPrelude pragma (#7089) (Albert+ Krewinkel)++ * Benchmarks++ + Use the lighter-weight tasty-bench instead of criterion.+ + Run writer benchmarks for binary formats too.+ + Alphabetize benchmarks.+ + Don't run benchmarks for bibliography formats+ (yet; we need a special input for them).+ + Show allocation data+ + Clean up benchmark code.+ + Allow specifying patterns using `-p blah'.++ * trypandoc: add 2 second timeout.++ * Use `-split-sections` in creating linux release binary.+ This reduces executable size significantly (by about 30%).++ * Remove `weigh-pandoc`. It's not really useful any more, now that our+ regular benchmarks include data on allocation.++ * Improve linux package build process and add script to+ automate building an arm64 binary package.++ ## pandoc 2.11.4 (2021-01-22) * Add `biblatex`, `bibtex` as output formats (closes #7040).@@ -591,8 +1080,11 @@ translated to `C:\/foo/bar`, which caused problems. With this fix, the backslashes are removed. - * Text.Pandoc.Logging: Add constructor `ATXHeadingInLHS` constructor- to `LogMessage` [API change].+ * Text.Pandoc.Logging:++ + Add constructor `ATXHeadingInLHS` to `LogMessage` [API change].+ + Add constructor `EnvironmentVariableUndefined` to+ `LogMessage` [API change]. * Fix error that is given when people specify `doc` output (#6834, gison93).
data/odt/styles.xml view
@@ -350,7 +350,7 @@ </style:style> <style:style style:name="First_20_paragraph" style:display-name="First paragraph" style:family="paragraph"- style:parent-style-name="Standard"+ style:parent-style-name="Text_20_body" style:next-style-name="Text_20_body" style:class="text" /> <style:style style:name="Numbering_20_Symbols" style:display-name="Numbering Symbols" style:family="text" />
data/templates/article.jats_publishing view
@@ -30,10 +30,10 @@ $endif$ </journal-title-group> $if(journal.pissn)$-<issn pub-type="ppub">$journal.pissn$</issn>+<issn publication-format="print">$journal.pissn$</issn> $endif$ $if(journal.eissn)$-<issn pub-type="epub">$journal.eissn$</issn>+<issn publication-format="electronic">$journal.eissn$</issn> $endif$ $-- At least one issn element is required; use empty issn as fallback $if(journal.pissn)$@@ -95,6 +95,8 @@ <surname>$author.surname$</surname> <given-names>$author.given-names$</given-names> </name>+$elseif(author.name)$+<string-name>$author.name$</string-name> $else$ <string-name>$author$</string-name> $endif$@@ -128,7 +130,7 @@ </author-notes> $endif$ $if(date)$-<pub-date pub-type="epub"$if(date.iso-8601)$ iso-8601-date="$date.iso-8601$"$endif$>+<pub-date date-type="$if(date.type)$$date.type$$else$pub$endif$" publication-format="electronic"$if(date.iso-8601)$ iso-8601-date="$date.iso-8601$"$endif$> $if(date.day)$ <day>$date.day$</day> $endif$
+ data/templates/default.biblatex view
@@ -0,0 +1,10 @@+$for(header-includes)$+$header-includes$+$endfor$+$for(include-before)$+$include-before$+$endfor$+$body$+$for(include-after)$+$include-after$+$endfor$
+ data/templates/default.bibtex view
@@ -0,0 +1,10 @@+$for(header-includes)$+$header-includes$+$endfor$+$for(include-before)$+$include-before$+$endfor$+$body$+$for(include-after)$+$include-after$+$endfor$
data/templates/default.jats_articleauthoring view
@@ -28,6 +28,8 @@ <surname>$author.surname$</surname> <given-names>$author.given-names$</given-names> </name>+$elseif(author.name)$+<string-name>$author.name$</string-name> $else$ <string-name>$author$</string-name> $endif$
data/templates/default.latex view
@@ -98,14 +98,14 @@ $if(linestretch)$ \usepackage{setspace} $endif$-\usepackage{ifxetex,ifluatex}-\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex+\usepackage{iftex}+\ifPDFTeX \usepackage[$if(fontenc)$$fontenc$$else$T1$endif$]{fontenc} \usepackage[utf8]{inputenc} \usepackage{textcomp} % provide euro and other symbols \else % if luatex or xetex $if(mathspec)$- \ifxetex+ \ifXeTeX \usepackage{mathspec} \else \usepackage{unicode-math}@@ -129,7 +129,7 @@ $endfor$ $if(mathfont)$ $if(mathspec)$- \ifxetex+ \ifXeTeX \setmathfont(Digits,Latin,Greek)[$for(mathfontoptions)$$mathfontoptions$$sep$,$endfor$]{$mathfont$} \else \setmathfont[$for(mathfontoptions)$$mathfontoptions$$sep$,$endfor$]{$mathfont$}@@ -139,18 +139,18 @@ $endif$ $endif$ $if(CJKmainfont)$- \ifxetex+ \ifXeTeX \usepackage{xeCJK} \setCJKmainfont[$for(CJKoptions)$$CJKoptions$$sep$,$endfor$]{$CJKmainfont$} \fi $endif$ $if(luatexjapresetoptions)$- \ifluatex+ \ifLuaTeX \usepackage[$for(luatexjapresetoptions)$$luatexjapresetoptions$$sep$,$endfor$]{luatexja-preset} \fi $endif$ $if(CJKmainfont)$- \ifluatex+ \ifLuaTeX \usepackage[$for(luatexjafontspecoptions)$$luatexjafontspecoptions$$sep$,$endfor$]{luatexja-fontspec} \setmainjfont[$for(CJKoptions)$$CJKoptions$$sep$,$endfor$]{$CJKmainfont$} \fi@@ -219,10 +219,10 @@ $endif$ $if(colorlinks)$ colorlinks=true,- linkcolor=$if(linkcolor)$$linkcolor$$else$Maroon$endif$,- filecolor=$if(filecolor)$$filecolor$$else$Maroon$endif$,- citecolor=$if(citecolor)$$citecolor$$else$Blue$endif$,- urlcolor=$if(urlcolor)$$urlcolor$$else$Blue$endif$,+ linkcolor={$if(linkcolor)$$linkcolor$$else$Maroon$endif$},+ filecolor={$if(filecolor)$$filecolor$$else$Maroon$endif$},+ citecolor={$if(citecolor)$$citecolor$$else$Blue$endif$},+ urlcolor={$if(urlcolor)$$urlcolor$$else$Blue$endif$}, $else$ hidelinks, $endif$@@ -329,7 +329,7 @@ $header-includes$ $endfor$ $if(lang)$-\ifxetex+\ifXeTeX % Load polyglossia as late as possible: uses bidi with RTL langages (e.g. Hebrew, Arabic) \usepackage{polyglossia} \setmainlanguage[$for(polyglossia-lang.options)$$polyglossia-lang.options$$sep$,$endfor$]{$polyglossia-lang.name$}@@ -346,15 +346,15 @@ $endif$ \fi $endif$-\ifluatex+\ifLuaTeX \usepackage{selnolig} % disable illegal ligatures \fi $if(dir)$-\ifxetex+\ifXeTeX % Load bidi as late as possible as it modifies e.g. graphicx \usepackage{bidi} \fi-\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex+\ifPDFTeX \TeXXeTstate=1 \newcommand{\RL}[1]{\beginR #1\endR} \newcommand{\LR}[1]{\beginL #1\endL}
data/templates/default.revealjs view
@@ -82,6 +82,10 @@ // Full list of configuration options available at: // https://revealjs.com/config/ Reveal.initialize({+$if(center)$+ // Determines whether slide content should be vertically centered+ center: $center$,+$endif$ $if(controls)$ // Display controls in the bottom right corner controls: $controls$,
man/pandoc.1 view
@@ -1,7 +1,7 @@ '\" t-.\" Automatically generated by Pandoc 2.11.4+.\" Automatically generated by Pandoc 2.12 .\"-.TH "Pandoc User\[cq]s Guide" "" "January 21, 2021" "pandoc 2.11.4" ""+.TH "Pandoc User\[cq]s Guide" "" "March 8, 2021" "pandoc 2.12" "" .hy .SH NAME pandoc - general markup converter@@ -172,13 +172,12 @@ When using LaTeX, the following packages need to be available (they are included with all recent versions of TeX Live): \f[C]amsfonts\f[R], \f[C]amsmath\f[R], \f[C]lm\f[R], \f[C]unicode-math\f[R],-\f[C]ifxetex\f[R], \f[C]ifluatex\f[R], \f[C]listings\f[R] (if the-\f[C]--listings\f[R] option is used), \f[C]fancyvrb\f[R],-\f[C]longtable\f[R], \f[C]booktabs\f[R], \f[C]graphicx\f[R] (if the-document contains images), \f[C]hyperref\f[R], \f[C]xcolor\f[R],-\f[C]ulem\f[R], \f[C]geometry\f[R] (with the \f[C]geometry\f[R] variable-set), \f[C]setspace\f[R] (with \f[C]linestretch\f[R]), and-\f[C]babel\f[R] (with \f[C]lang\f[R]).+\f[C]iftex\f[R], \f[C]listings\f[R] (if the \f[C]--listings\f[R] option+is used), \f[C]fancyvrb\f[R], \f[C]longtable\f[R], \f[C]booktabs\f[R],+\f[C]graphicx\f[R] (if the document contains images),+\f[C]hyperref\f[R], \f[C]xcolor\f[R], \f[C]ulem\f[R], \f[C]geometry\f[R]+(with the \f[C]geometry\f[R] variable set), \f[C]setspace\f[R] (with+\f[C]linestretch\f[R]), and \f[C]babel\f[R] (with \f[C]lang\f[R]). The use of \f[C]xelatex\f[R] or \f[C]lualatex\f[R] as the PDF engine requires \f[C]fontspec\f[R]. \f[C]lualatex\f[R] uses \f[C]selnolig\f[R].@@ -458,16 +457,15 @@ of the XDG data directory (by default, \f[C]$HOME/.local/share\f[R], overridable by setting the \f[C]XDG_DATA_HOME\f[R] environment variable).-If that directory does not exist, \f[C]$HOME/.pandoc\f[R] will be used-(for backwards compatibility).-In Windows the default user data directory is+If that directory does not exist and \f[C]$HOME/.pandoc\f[R] exists, it+will be used (for backwards compatibility).+On Windows the default user data directory is \f[C]C:\[rs]Users\[rs]USERNAME\[rs]AppData\[rs]Roaming\[rs]pandoc\f[R]. You can find the default user data directory on your system by looking at the output of \f[C]pandoc --version\f[R].-A \f[C]reference.odt\f[R], \f[C]reference.docx\f[R], \f[C]epub.css\f[R],-\f[C]templates\f[R], \f[C]slidy\f[R], \f[C]slideous\f[R], or-\f[C]s5\f[R] directory placed in this directory will override-pandoc\[cq]s normal defaults.+Data files placed in this directory (for example,+\f[C]reference.odt\f[R], \f[C]reference.docx\f[R], \f[C]epub.css\f[R],+\f[C]templates\f[R]) will override pandoc\[cq]s normal defaults. .TP \f[B]\f[CB]-d\f[B]\f[R] \f[I]FILE\f[R], \f[B]\f[CB]--defaults=\f[B]\f[R]\f[I]FILE\f[R] Specify a set of default option settings.@@ -732,9 +730,9 @@ To see the system default, use \f[C]pandoc --print-default-data-file=abbreviations\f[R]. The only use pandoc makes of this list is in the Markdown reader.-Strings ending in a period that are found in this list will be followed-by a nonbreaking space, so that the period will not produce-sentence-ending space in formats like LaTeX.+Strings found in this list will be followed by a nonbreaking space, and+the period will not produce sentence-ending space in formats like LaTeX.+The strings may not contain spaces. .SS General writer options .TP \f[B]\f[CB]-s\f[B]\f[R], \f[B]\f[CB]--standalone\f[B]\f[R]@@ -925,6 +923,11 @@ directory must be explicitly listed or it will not be searched. For example: \f[C]--resource-path=.:test\f[R] will search the working directory and the \f[C]test\f[R] subdirectory, in that order.+This option can be used repeatedly.+Search path components that come later on the command line will be+searched before those that come earlier, so+\f[C]--resource-path foo:bar --resource-path baz:bim\f[R] is equivalent+to \f[C]--resource-path baz:bim:foo:bar\f[R]. .TP \f[B]\f[CB]--request-header=\f[B]\f[R]\f[I]NAME\f[R]\f[B]\f[CB]:\f[B]\f[R]\f[I]VAL\f[R] Set the request header \f[I]NAME\f[R] to the value \f[I]VAL\f[R] when@@ -1614,6 +1617,11 @@ PandocPDFError T} T{+44+T}@T{+PandocXMLError+T}+T{ 47 T}@T{ PandocPDFProgramNotFoundError@@ -1674,6 +1682,11 @@ PandocIpynbDecodingError T} T{+94+T}@T{+PandocUnsupportedCharsetError+T}+T{ 97 T}@T{ PandocCouldNotFindDataFileError@@ -1773,8 +1786,11 @@ verbosity: INFO log-file: log.json -# citeproc, natbib, or biblatex+# citeproc, natbib, or biblatex. This only affects LaTeX+# output. If you want to use citeproc to format citations,+# you should also set \[aq]citeproc: true\[aq] (see above). cite-method: citeproc+ # part, chapter, section, or default: top-level-division: chapter abbreviations:@@ -1875,6 +1891,38 @@ \f[R] .fi .PP+In fields that expect a file path (or list of file paths), the following+syntax may be used to interpolate environment variables:+.IP+.nf+\f[C]+csl: ${HOME}/mycsldir/special.csl+\f[R]+.fi+.PP+\f[C]${USERDATA}\f[R] may also be used; this will always resolve to the+user data directory that is current when the defaults file is parsed,+regardless of the setting of the environment variable+\f[C]USERDATA\f[R].+.PP+\f[C]${.}\f[R] will resolve to the directory containing the default file+itself.+This allows you to refer to resources contained in that directory:+.IP+.nf+\f[C]+epub-cover-image: ${.}/cover.jpg+epub-metadata: ${.}/meta.xml+resource-path:+- . # the working directory from which pandoc is run+- ${.}/images # the images subdirectory of the directory+ # containing this defaults file+\f[R]+.fi+.PP+This environment variable interpolation syntax \f[I]only\f[R] works in+fields that expect file paths.+.PP Default files can be placed in the \f[C]defaults\f[R] subdirectory of the user data directory and used from any directory. For example, one could create a file specifying defaults for writing@@ -2134,9 +2182,9 @@ \f[R] .fi .PP-(If a partial is not found in the directory of the template, it will-also be sought in the \f[C]templates\f[R] subdirectory of the user data-directory.)+(If a partial is not found in the directory of the template and the+template path is given as a relative path, it will also be sought in the+\f[C]templates\f[R] subdirectory of the user data directory.) .PP Partials may optionally be applied to variables using a colon: .IP@@ -3928,6 +3976,9 @@ \f[R] .fi .PP+Inline formatting (such as emphasis) is allowed in the content, but not+block-level formatting (such as block quotes or lists).+.PP This syntax is borrowed from reStructuredText. .SS Lists .SS Bullet lists@@ -5048,7 +5099,9 @@ .PP For display math, use \f[C]$$\f[R] delimiters. (In this case, the delimiters may be separated from the formula by-whitespace.)+whitespace.+However, there can be no blank lines betwen the opening and closing+\f[C]$$\f[R] delimiters.) .PP TeX math will be printed in all output formats. How it is rendered depends on the output format:@@ -6938,6 +6991,16 @@ \f[B]\f[CB]rights\f[B]\f[R] A string value. .TP+\f[B]\f[CB]belongs-to-collection\f[B]\f[R]+A string value.+identifies the name of a collection to which the EPUB Publication+belongs.+.TP+\f[B]\f[CB]group-position\f[B]\f[R]+The \f[C]group-position\f[R] field indicates the numeric position in+which the EPUB Publication belongs relative to other works belonging to+the same \f[C]belongs-to-collection\f[R] field.+.TP \f[B]\f[CB]cover-image\f[B]\f[R] A string value (path to cover image). .TP@@ -7453,6 +7516,20 @@ new default template with the name \f[C]default.NAME_OF_CUSTOM_WRITER.lua\f[R] to the \f[C]templates\f[R] subdirectory of your user data directory (see Templates).+.SH REPRODUCIBLE BUILDS+.PP+Some of the document formats pandoc targets (such as EPUB, docx, and+ODT) include build timestamps in the generated document.+That means that the files generated on successive builds will differ,+even if the source does not.+To avoid this, set the \f[C]SOURCE_DATE_EPOCH\f[R] environment variable,+and the timestamp will be taken from it instead of the current time.+\f[C]SOURCE_DATE_EPOCH\f[R] should contain an integer unix timestamp+(specifying the number of second since midnight UTC January 1, 1970).+.PP+Some document formats also include a unique identifier.+For EPUB, this can be set explicitly by setting the \f[C]identifier\f[R]+metadata field (see EPUB Metadata, above). .SH A NOTE ON SECURITY .PP If you use pandoc to convert user-contributed content in a web@@ -7495,4 +7572,4 @@ of contributors, see the file AUTHORS.md in the pandoc source code. .PP The Pandoc source code and all documentation may be downloaded-from <http://pandoc.org>.+from <https://pandoc.org>.
man/pandoc.1.after view
@@ -1,3 +1,3 @@ .PP The Pandoc source code and all documentation may be downloaded-from <http://pandoc.org>.+from <https://pandoc.org>.
pandoc.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: pandoc-version: 2.11.4+version: 2.12 build-type: Simple license: GPL-2.0-or-later license-file: COPYING.md@@ -56,6 +56,8 @@ data/templates/default.icml data/templates/default.opml data/templates/default.latex+ data/templates/default.bibtex+ data/templates/default.biblatex data/templates/default.context data/templates/default.texinfo data/templates/default.jira@@ -394,9 +396,43 @@ Description: Build trypandoc cgi executable. Default: False +common common-options+ default-language: Haskell2010+ build-depends: base >= 4.9 && < 5,+ text >= 1.1.1.0 && < 1.3+ ghc-options: -Wall -fno-warn-unused-do-bind+ -Wincomplete-record-updates+ -Wnoncanonical-monad-instances++ if impl(ghc < 8.4)+ hs-source-dirs: prelude+ other-modules: Prelude+ build-depends: base-compat >= 0.9+ other-extensions: NoImplicitPrelude++ if os(windows)+ cpp-options: -D_WINDOWS++ -- Later:+ -- -Wpartial-fields (currently used in Powerpoint writer)+ -- -Wmissing-export-lists (currently some Odt modules violate this)+ -- -Wredundant-constraints (problematic if we want to support older base)+ if impl(ghc >= 8.2)+ ghc-options: -Wcpp-undef+ if impl(ghc >= 8.4)+ ghc-options: -Wincomplete-uni-patterns+ -Widentities+ -fhide-source-paths++common common-executable+ import: common-options+ build-depends: pandoc+ ghc-options: -rtsopts -with-rtsopts=-K16m -threaded++ library- build-depends: base >= 4.9 && < 5,- Glob >= 0.7 && < 0.11,+ import: common-options+ build-depends: Glob >= 0.7 && < 0.11, HTTP >= 4000.0.5 && < 4000.4, HsYAML >= 0.2 && < 0.3, JuicyPixels >= 3.1.6.1 && < 3.4,@@ -404,13 +440,13 @@ aeson >= 0.7 && < 1.6, aeson-pretty >= 0.8.5 && < 0.9, attoparsec >= 0.12 && < 0.14,- base64-bytestring >= 0.1 && < 1.2,+ base64-bytestring >= 0.1 && < 1.3, binary >= 0.7 && < 0.11, blaze-html >= 0.9 && < 0.10, blaze-markup >= 0.8 && < 0.9, bytestring >= 0.9 && < 0.12, case-insensitive >= 1.2 && < 1.3,- citeproc >= 0.3.0.5 && < 0.4,+ citeproc >= 0.3.0.7 && < 0.4, commonmark >= 0.1.1.3 && < 0.2, commonmark-extensions >= 0.2.0.4 && < 0.3, commonmark-pandoc >= 0.2 && < 0.3,@@ -427,13 +463,14 @@ filepath >= 1.1 && < 1.5, haddock-library >= 1.8 && < 1.10, hslua >= 1.1 && < 1.4,+ hslua-module-path >= 0.1.0 && < 0.2.0, hslua-module-system >= 0.2 && < 0.3, hslua-module-text >= 0.2.1 && < 0.4, http-client >= 0.4.30 && < 0.8, http-client-tls >= 0.2.4 && < 0.4, http-types >= 0.8 && < 0.13, ipynb >= 0.1 && < 0.2,- jira-wiki-markup >= 1.3.2 && < 1.4,+ jira-wiki-markup >= 1.3.3 && < 1.4, mtl >= 2.2 && < 2.3, network >= 2.6, network-uri >= 2.6 && < 2.7,@@ -443,8 +480,8 @@ random >= 1 && < 1.2, safe >= 0.3 && < 0.4, scientific >= 0.3 && < 0.4,- skylighting >= 0.10.2 && < 0.11,- skylighting-core >= 0.10.2 && < 0.11,+ skylighting >= 0.10.4 && < 0.11,+ skylighting-core >= 0.10.4 && < 0.11, split >= 0.2 && < 0.3, syb >= 0.1 && < 0.8, tagsoup >= 0.14.6 && < 0.15,@@ -456,41 +493,18 @@ unicode-transforms >= 0.3 && < 0.4, unordered-containers >= 0.2 && < 0.3, xml >= 1.3.12 && < 1.4,+ xml-conduit >= 1.7 && < 1.10, zip-archive >= 0.2.3.4 && < 0.5, zlib >= 0.5 && < 0.7 if os(windows) && arch(i386) build-depends: basement >= 0.0.10, foundation >= 0.0.23 -- basement 0.0.9 won't build on 32-bit windows.- if impl(ghc < 8.4)- hs-source-dirs: prelude- other-modules: Prelude- build-depends: base-compat >= 0.9- if os(windows)- cpp-options: -D_WINDOWS- else+ if !os(windows) build-depends: unix >= 2.4 && < 2.8 if flag(embed_data_files) cpp-options: -DEMBED_DATA_FILES other-modules: Text.Pandoc.Data- if os(windows)- cpp-options: -D_WINDOWS- ghc-options: -Wall -fno-warn-unused-do-bind- -Wincomplete-record-updates- -Wnoncanonical-monad-instances- -- Later:- -- -Wpartial-fields (currently used in Powerpoint writer)- -- -Wmissing-export-lists (currently some Odt modules violate this)- -- -Wredundant-constraints (problematic if we want to support older base)- if impl(ghc >= 8.2)- ghc-options: -Wcpp-undef- if impl(ghc >= 8.4)- ghc-options: -Wincomplete-uni-patterns- -Widentities- -fhide-source-paths-- default-language: Haskell2010- other-extensions: NoImplicitPrelude hs-source-dirs: src exposed-modules: Text.Pandoc,@@ -504,7 +518,6 @@ Text.Pandoc.Readers, Text.Pandoc.Readers.HTML, Text.Pandoc.Readers.LaTeX,- Text.Pandoc.Readers.LaTeX.Types, Text.Pandoc.Readers.Markdown, Text.Pandoc.Readers.CommonMark, Text.Pandoc.Readers.Creole,@@ -613,9 +626,15 @@ Text.Pandoc.Readers.HTML.Table, Text.Pandoc.Readers.HTML.TagCategories, Text.Pandoc.Readers.HTML.Types,- Text.Pandoc.Readers.LaTeX.Parsing,+ Text.Pandoc.Readers.LaTeX.Inline,+ Text.Pandoc.Readers.LaTeX.Citation, Text.Pandoc.Readers.LaTeX.Lang,+ Text.Pandoc.Readers.LaTeX.Macro,+ Text.Pandoc.Readers.LaTeX.Math,+ Text.Pandoc.Readers.LaTeX.Parsing, Text.Pandoc.Readers.LaTeX.SIunitx,+ Text.Pandoc.Readers.LaTeX.Table,+ Text.Pandoc.Readers.LaTeX.Types, Text.Pandoc.Readers.Odt.Base, Text.Pandoc.Readers.Odt.Namespaces, Text.Pandoc.Readers.Odt.StyleReader,@@ -645,7 +664,12 @@ Text.Pandoc.Writers.LaTeX.Caption, Text.Pandoc.Writers.LaTeX.Notes, Text.Pandoc.Writers.LaTeX.Table,+ Text.Pandoc.Writers.LaTeX.Lang, Text.Pandoc.Writers.LaTeX.Types,+ Text.Pandoc.Writers.LaTeX.Citation,+ Text.Pandoc.Writers.LaTeX.Util,+ Text.Pandoc.Writers.Markdown.Types,+ Text.Pandoc.Writers.Markdown.Inline, Text.Pandoc.Writers.Roff, Text.Pandoc.Writers.Powerpoint.Presentation, Text.Pandoc.Writers.Powerpoint.Output,@@ -673,6 +697,10 @@ Text.Pandoc.Lua.PandocLua, Text.Pandoc.Lua.Util, Text.Pandoc.Lua.Walk,+ Text.Pandoc.XML.Light,+ Text.Pandoc.XML.Light.Types,+ Text.Pandoc.XML.Light.Proc,+ Text.Pandoc.XML.Light.Output, Text.Pandoc.CSS, Text.Pandoc.CSV, Text.Pandoc.RoffChar,@@ -691,91 +719,32 @@ buildable: True executable pandoc- build-depends: pandoc, base >= 4.8 && < 5- if impl(ghc < 8.4)- hs-source-dirs: prelude- other-modules: Prelude- build-depends: base-compat >= 0.9- default-language: Haskell2010- other-extensions: NoImplicitPrelude+ import: common-executable hs-source-dirs: app main-is: pandoc.hs buildable: True other-modules: Paths_pandoc- ghc-options: -rtsopts -with-rtsopts=-K16m -threaded- -Wall -fno-warn-unused-do-bind- -Wincomplete-record-updates- -Wnoncanonical-monad-instances- if impl(ghc >= 8.2)- ghc-options: -Wcpp-undef- if impl(ghc >= 8.4)- ghc-options: -Wincomplete-uni-patterns- -Widentities- -fhide-source-paths executable trypandoc+ import: common-executable main-is: trypandoc.hs hs-source-dirs: trypandoc- default-language: Haskell2010- other-extensions: NoImplicitPrelude if flag(trypandoc)- build-depends: base, aeson, pandoc,- text, wai-extra, wai >= 0.3, http-types+ build-depends: aeson, http-types, wai >= 0.3, wai-extra >= 3.0.24 buildable: True else buildable: False- if impl(ghc < 8.4)- hs-source-dirs: prelude- other-modules: Prelude- build-depends: base-compat >= 0.9- ghc-options: -rtsopts -with-rtsopts=-K16m -threaded- -Wall -fno-warn-unused-do-bind- -Wincomplete-record-updates- -Wnoncanonical-monad-instances- if impl(ghc >= 8.2)- ghc-options: -Wcpp-undef- if impl(ghc >= 8.4)- ghc-options: -Wincomplete-uni-patterns- -Widentities- -fhide-source-paths -benchmark weigh-pandoc- type: exitcode-stdio-1.0- main-is: weigh-pandoc.hs- hs-source-dirs: benchmark- build-depends: pandoc,- base >= 4.8 && < 5,- mtl >= 2.2 && < 2.3,- text,- weigh >= 0.0 && < 0.1,- if impl(ghc < 8.4)- hs-source-dirs: prelude- other-modules: Prelude- build-depends: base-compat >= 0.9- default-language: Haskell2010- other-extensions: NoImplicitPrelude- ghc-options: -rtsopts -with-rtsopts=-K16m -threaded- -Wall -fno-warn-unused-do-bind- -Wincomplete-record-updates- -Wnoncanonical-monad-instances- if impl(ghc >= 8.2)- ghc-options: -Wcpp-undef- if impl(ghc >= 8.4)- ghc-options: -Wincomplete-uni-patterns- -Widentities- -fhide-source-paths-- test-suite test-pandoc+ import: common-executable type: exitcode-stdio-1.0 main-is: test-pandoc.hs hs-source-dirs: test build-depends: pandoc,- base >= 4.8 && < 5, Diff >= 0.2 && < 0.5, Glob >= 0.7 && < 0.11, QuickCheck >= 2.4 && < 2.15,- base64-bytestring >= 0.1 && < 1.2,+ base64-bytestring >= 0.1 && < 1.3, bytestring >= 0.9 && < 0.12, containers >= 0.4.2.1 && < 0.7, directory >= 1.2.3 && < 1.4,@@ -787,20 +756,15 @@ mtl >= 2.2 && < 2.3, pandoc-types >= 1.22 && < 1.23, process >= 1.2.3 && < 1.7,- tasty >= 0.11 && < 1.4,+ tasty >= 0.11 && < 1.5, tasty-golden >= 2.3 && < 2.4, 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- if impl(ghc < 8.4)- hs-source-dirs: prelude- other-modules: Prelude- build-depends: base-compat >= 0.9 other-modules: Tests.Old Tests.Command Tests.Helpers@@ -856,47 +820,15 @@ Tests.Writers.OOXML Tests.Writers.Ms Tests.Writers.AnnotatedTable- if os(windows)- cpp-options: -D_WINDOWS- default-language: Haskell2010- other-extensions: NoImplicitPrelude- ghc-options: -rtsopts -with-rtsopts=-K16m -threaded- -Wall -fno-warn-unused-do-bind- -Wincomplete-record-updates- -Wnoncanonical-monad-instances- if impl(ghc >= 8.2)- ghc-options: -Wcpp-undef- if impl(ghc >= 8.4)- ghc-options: -Wincomplete-uni-patterns- -Widentities- -fhide-source-paths - benchmark benchmark-pandoc+ import: common-executable type: exitcode-stdio-1.0 main-is: benchmark-pandoc.hs hs-source-dirs: benchmark- build-depends: pandoc,- base >= 4.8 && < 5,- bytestring,+ build-depends: bytestring, containers,- criterion >= 1.0 && < 1.6,+ tasty,+ tasty-bench >= 0.2 && <= 0.3, mtl >= 2.2 && < 2.3,- text >= 1.1.1.0 && < 1.3, time- if impl(ghc < 8.4)- hs-source-dirs: prelude- other-modules: Prelude- build-depends: base-compat >= 0.9- default-language: Haskell2010- other-extensions: NoImplicitPrelude- ghc-options: -rtsopts -with-rtsopts=-K16m -threaded- -Wall -fno-warn-unused-do-bind- -Wincomplete-record-updates- -Wnoncanonical-monad-instances- if impl(ghc >= 8.2)- ghc-options: -Wcpp-undef- if impl(ghc >= 8.4)- ghc-options: -Wincomplete-uni-patterns- -Widentities- -fhide-source-paths
src/Text/Pandoc/App.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -19,6 +20,7 @@ , Filter(..) , defaultOpts , parseOptions+ , parseOptionsFromArgs , options , applyFilters ) where@@ -27,6 +29,7 @@ import Control.Monad.Trans ( MonadIO(..) ) import Control.Monad.Except (throwError) import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import Data.Char (toLower) import Data.Maybe (fromMaybe, isJust, isNothing)@@ -44,10 +47,13 @@ import System.IO (nativeNewline, stdout) import qualified System.IO as IO (Newline (..)) import Text.Pandoc+import Text.Pandoc.Builder (setMeta)+import Text.Pandoc.MIME (getCharset) import Text.Pandoc.App.FormatHeuristics (formatFromFilePaths) import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), defaultOpts,- IpynbOutput (..) )-import Text.Pandoc.App.CommandLineOptions (parseOptions, options)+ IpynbOutput (..))+import Text.Pandoc.App.CommandLineOptions (parseOptions, parseOptionsFromArgs,+ options) import Text.Pandoc.App.OutputSettings (OutputSettings (..), optToOutputSettings) import Text.Pandoc.BCP47 (Lang (..), parseBCP47) import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters)@@ -55,7 +61,7 @@ import Text.Pandoc.SelfContained (makeSelfContained) import Text.Pandoc.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs, headerShift, isURI, tabFilter, uriPathToPath, filterIpynbOutput,- defaultUserDataDirs, tshow, findM)+ defaultUserDataDir, tshow) import Text.Pandoc.Writers.Shared (lookupMetaString) import Text.Pandoc.Readers.Markdown (yamlToMeta) import qualified Text.Pandoc.UTF8 as UTF8@@ -66,25 +72,29 @@ convertWithOpts :: Opt -> IO () convertWithOpts opts = do+ datadir <- case optDataDir opts of+ Nothing -> do+ d <- defaultUserDataDir+ exists <- doesDirectoryExist d+ return $ if exists+ then Just d+ else Nothing+ Just _ -> return $ optDataDir opts+ let outputFile = fromMaybe "-" (optOutputFile opts) let filters = optFilters opts let verbosity = optVerbosity opts when (optDumpArgs opts) $- do UTF8.hPutStrLn stdout outputFile- mapM_ (UTF8.hPutStrLn stdout) (fromMaybe ["-"] $ optInputFiles opts)+ do UTF8.hPutStrLn stdout (T.pack outputFile)+ mapM_ (UTF8.hPutStrLn stdout . T.pack)+ (fromMaybe ["-"] $ optInputFiles opts) exitSuccess let sources = case optInputFiles opts of Just xs | not (optIgnoreArgs opts) -> xs _ -> ["-"] - datadir <- case optDataDir opts of- Nothing -> do- ds <- defaultUserDataDirs- findM doesDirectoryExist ds- Just _ -> return $ optDataDir opts- let runIO' :: PandocIO a -> IO a runIO' f = do (res, reports) <- runIOorExplode $ do@@ -269,12 +279,21 @@ report $ Deprecated "pandoc-citeproc filter" "Use --citeproc instead." + let cslMetadata =+ maybe id (setMeta "csl") (optCSL opts) .+ (case optBibliography opts of+ [] -> id+ xs -> setMeta "bibliography" xs) .+ maybe id (setMeta "citation-abbreviations")+ (optCitationAbbreviations opts) $ mempty+ doc <- sourceToDoc sources >>= ( (if isJust (optExtractMedia opts) then fillMediaBag else return) >=> return . adjustMetadata (metadataFromFile <>) >=> return . adjustMetadata (<> optMetadata opts)+ >=> return . adjustMetadata (<> cslMetadata) >=> applyTransforms transforms >=> applyFilters readerOpts filters [T.unpack format] >=> maybe return extractMedia (optExtractMedia opts)@@ -341,7 +360,18 @@ _ -> PandocAppError (tshow e)) readURI :: FilePath -> PandocIO Text-readURI src = UTF8.toText . fst <$> openURL (T.pack src)+readURI src = do+ (bs, mt) <- openURL (T.pack src)+ case mt >>= getCharset of+ Just "UTF-8" -> return $ UTF8.toText bs+ Just "ISO-8859-1" -> return $ T.pack $ B8.unpack bs+ Just charset -> throwError $ PandocUnsupportedCharsetError charset+ Nothing -> liftIO $ -- try first as UTF-8, then as latin1+ E.catch (return $! UTF8.toText bs)+ (\case+ TSE.DecodeError{} ->+ return $ T.pack $ B8.unpack bs+ e -> E.throwIO e) readFile' :: MonadIO m => FilePath -> m BL.ByteString readFile' "-" = liftIO BL.getContents@@ -352,6 +382,5 @@ writeFnBinary f = liftIO . BL.writeFile (UTF8.encodePath f) writerFn :: MonadIO m => IO.Newline -> FilePath -> Text -> m ()--- TODO this implementation isn't maximally efficient:-writerFn eol "-" = liftIO . UTF8.putStrWith eol . T.unpack-writerFn eol f = liftIO . UTF8.writeFileWith eol f . T.unpack+writerFn eol "-" = liftIO . UTF8.putStrWith eol+writerFn eol f = liftIO . UTF8.writeFileWith eol f
src/Text/Pandoc/App/CommandLineOptions.hs view
@@ -17,6 +17,7 @@ -} module Text.Pandoc.App.CommandLineOptions ( parseOptions+ , parseOptionsFromArgs , options , engines , lookupHighlightStyle@@ -47,12 +48,13 @@ import System.IO (stdout) import Text.DocTemplates (Context (..), ToContext (toVal), Val (..)) import Text.Pandoc+import Text.Pandoc.Builder (setMeta) import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), IpynbOutput (..),- DefaultsState (..), addMeta, applyDefaults,+ DefaultsState (..), applyDefaults, fullDefaultsPath) import Text.Pandoc.Filter (Filter (..)) import Text.Pandoc.Highlighting (highlightingStyles)-import Text.Pandoc.Shared (ordNub, elemText, safeStrRead, defaultUserDataDirs)+import Text.Pandoc.Shared (ordNub, elemText, safeStrRead, defaultUserDataDir) import Text.Printf #ifdef EMBED_DATA_FILES@@ -73,9 +75,13 @@ parseOptions options' defaults = do rawArgs <- map UTF8.decodeArg <$> getArgs prg <- getProgName+ parseOptionsFromArgs options' defaults prg rawArgs +parseOptionsFromArgs+ :: [OptDescr (Opt -> IO Opt)] -> Opt -> String -> [String] -> IO Opt+parseOptionsFromArgs options' defaults prg rawArgs = do let (actions, args, unrecognizedOpts, errors) =- getOpt' Permute options' rawArgs+ getOpt' Permute options' (map UTF8.decodeArg rawArgs) let unknownOptionErrors = foldr (handleUnrecognizedOption . takeWhile (/= '=')) []@@ -282,7 +288,8 @@ , Option "" ["resource-path"] (ReqArg (\arg opt -> return opt { optResourcePath =- splitSearchPath arg })+ splitSearchPath arg +++ optResourcePath opt }) "SEARCHPATH") "" -- "Paths to search for images and other resources" @@ -807,10 +814,10 @@ map (\c -> ['-',c]) shorts ++ map ("--" ++) longs let allopts = unwords (concatMap optnames options)- UTF8.hPutStrLn stdout $ printf tpl allopts- (unwords readersNames)- (unwords writersNames)- (unwords $ map (T.unpack . fst) highlightingStyles)+ UTF8.hPutStrLn stdout $ T.pack $ printf tpl allopts+ (T.unpack $ T.unwords readersNames)+ (T.unpack $ T.unwords writersNames)+ (T.unpack $ T.unwords $ map fst highlightingStyles) (unwords datafiles) exitSuccess )) "" -- "Print bash completion script"@@ -849,7 +856,7 @@ else if extensionEnabled x allExts then '-' else ' ') : drop 4 (show x)- mapM_ (UTF8.hPutStrLn stdout . showExt)+ mapM_ (UTF8.hPutStrLn stdout . T.pack . showExt) [ex | ex <- extList, extensionEnabled ex allExts] exitSuccess ) "FORMAT")@@ -863,14 +870,14 @@ , sShortname s `notElem` [T.pack "Alert", T.pack "Alert_indent"] ]- mapM_ (UTF8.hPutStrLn stdout) (sort langs)+ mapM_ (UTF8.hPutStrLn stdout . T.pack) (sort langs) exitSuccess )) "" , Option "" ["list-highlight-styles"] (NoArg (\_ -> do- mapM_ (UTF8.hPutStrLn stdout . T.unpack . fst) highlightingStyles+ mapM_ (UTF8.hPutStrLn stdout . fst) highlightingStyles exitSuccess )) "" @@ -888,7 +895,7 @@ | T.null t -> -- e.g. for docx, odt, json: E.throwIO $ PandocCouldNotFindDataFileError $ T.pack ("templates/default." ++ arg)- | otherwise -> write . T.unpack $ t+ | otherwise -> write t Left e -> E.throwIO e exitSuccess) "FORMAT")@@ -934,12 +941,13 @@ (NoArg (\_ -> do prg <- getProgName- defaultDatadirs <- defaultUserDataDirs- UTF8.hPutStrLn stdout (prg ++ " " ++ T.unpack pandocVersion ++- compileInfo ++- "\nUser data directory: " ++- intercalate " or " defaultDatadirs ++- ('\n':copyrightMessage))+ defaultDatadir <- defaultUserDataDir+ UTF8.hPutStrLn stdout+ $ T.pack+ $ prg ++ " " ++ T.unpack pandocVersion +++ compileInfo +++ "\nUser data directory: " ++ defaultDatadir +++ ('\n':copyrightMessage) exitSuccess )) "" -- "Print version" @@ -947,7 +955,7 @@ (NoArg (\_ -> do prg <- getProgName- UTF8.hPutStr stdout (usageMessage prg options)+ UTF8.hPutStr stdout (T.pack $ usageMessage prg options) exitSuccess )) "" -- "Show help" ]@@ -1008,12 +1016,12 @@ handleUnrecognizedOption x = (("Unknown option " ++ x ++ ".") :) -readersNames :: [String]-readersNames = sort (map (T.unpack . fst) (readers :: [(Text, Reader PandocIO)]))+readersNames :: [Text]+readersNames = sort (map fst (readers :: [(Text, Reader PandocIO)])) -writersNames :: [String]+writersNames :: [Text] writersNames = sort- ("pdf" : map (T.unpack . fst) (writers :: [(Text, Writer PandocIO)]))+ ("pdf" : map fst (writers :: [(Text, Writer PandocIO)])) splitField :: String -> (String, String) splitField = second (tailDef "true") . break (`elemText` ":=")@@ -1045,6 +1053,27 @@ where go Nothing = Just $ toVal val go (Just (ListVal xs)) = Just $ ListVal $ xs ++ [toVal val] go (Just x) = Just $ ListVal [x, toVal val]++addMeta :: String -> String -> Meta -> Meta+addMeta k v meta =+ case lookupMeta k' meta of+ Nothing -> setMeta k' v' meta+ Just (MetaList xs) ->+ setMeta k' (MetaList (xs ++ [v'])) meta+ Just x -> setMeta k' (MetaList [x, v']) meta+ where+ v' = readMetaValue v+ k' = T.pack k++readMetaValue :: String -> MetaValue+readMetaValue s+ | s == "true" = MetaBool True+ | s == "True" = MetaBool True+ | s == "TRUE" = MetaBool True+ | s == "false" = MetaBool False+ | s == "False" = MetaBool False+ | s == "FALSE" = MetaBool False+ | otherwise = MetaString $ T.pack s -- On Windows with ghc 8.6+, we need to rewrite paths -- beginning with \\ to \\?\UNC\. -- See #5127.
src/Text/Pandoc/App/Opt.hs view
@@ -22,28 +22,29 @@ , IpynbOutput (..) , DefaultsState (..) , defaultOpts- , addMeta , applyDefaults , fullDefaultsPath ) where import Control.Monad.Except (MonadIO, liftIO, throwError, (>=>), foldM) import Control.Monad.State.Strict (StateT, modify, gets)-import System.FilePath ( addExtension, (</>), takeExtension )+import System.FilePath ( addExtension, (</>), takeExtension, takeDirectory )+import System.Directory ( canonicalizePath ) import Data.Char (isLower, toLower) import Data.Maybe (fromMaybe) import GHC.Generics hiding (Meta)-import Text.Pandoc.Builder (setMeta) import Text.Pandoc.Filter (Filter (..))-import Text.Pandoc.Logging (Verbosity (WARNING))+import Text.Pandoc.Logging (Verbosity (WARNING), LogMessage(..)) import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault), TrackChanges (AcceptChanges), WrapOption (WrapAuto), HTMLMathMethod (PlainMath), ReferenceLocation (EndOfDocument), ObfuscationMethod (NoObfuscation), CiteMethod (Citeproc))-import Text.Pandoc.Class (readFileLazy, fileExists, setVerbosity, PandocMonad)+import Text.Pandoc.Class (readFileLazy, fileExists, setVerbosity, report,+ PandocMonad(lookupEnv), getUserDataDir) import Text.Pandoc.Error (PandocError (PandocParseError, PandocSomeError))-import Text.Pandoc.Shared (camelCaseStrToHyphenated, defaultUserDataDirs, findM, ordNub)+import Text.Pandoc.Shared (camelCaseStrToHyphenated, defaultUserDataDir,+ findM, ordNub) import qualified Text.Pandoc.Parsing as P import Text.Pandoc.Readers.Metadata (yamlMap) import Text.Pandoc.Class.PandocPure@@ -52,7 +53,7 @@ import Data.Default (def) import qualified Data.Text as T import qualified Data.Map as M-import Text.Pandoc.Definition (Meta(..), MetaValue(..), lookupMeta)+import Text.Pandoc.Definition (Meta(..), MetaValue(..)) import Data.Aeson (defaultOptions, Options(..)) import Data.Aeson.TH (deriveJSON) import Control.Applicative ((<|>))@@ -156,6 +157,9 @@ , optNoCheckCertificate :: Bool -- ^ Disable certificate validation , optEol :: LineEnding -- ^ Style of line-endings to use , optStripComments :: Bool -- ^ Skip HTML comments+ , optCSL :: Maybe FilePath -- ^ CSL stylesheet+ , optBibliography :: [FilePath] -- ^ Bibliography files+ , optCitationAbbreviations :: Maybe FilePath -- ^ Citation abbreviations } deriving (Generic, Show) instance FromYAML (Opt -> Opt) where@@ -175,17 +179,128 @@ dataDir <- case M.lookup "data-dir" opts of Nothing -> return Nothing Just v -> Just . unpack <$> parseYAML v- f <- parseOptions $ M.toList m+ f <- parseOptions (M.toList m) case M.lookup "defaults" opts of Just v -> do g <- parseDefaults v dataDir- return $ g >=> f- Nothing -> return f+ return $ g >=> f >=> resolveVarsInOpt+ Nothing -> return $ f >=> resolveVarsInOpt where toText (Scalar _ (SStr s)) = s toText _ = "" parseYAML n = failAtNode n "Expected a mapping" +resolveVarsInOpt :: forall m. (PandocMonad m, MonadIO m)+ => Opt -> StateT DefaultsState m Opt+resolveVarsInOpt+ opt@Opt+ { optTemplate = oTemplate+ , optMetadataFiles = oMetadataFiles+ , optOutputFile = oOutputFile+ , optInputFiles = oInputFiles+ , optSyntaxDefinitions = oSyntaxDefinitions+ , optAbbreviations = oAbbreviations+ , optReferenceDoc = oReferenceDoc+ , optEpubMetadata = oEpubMetadata+ , optEpubFonts = oEpubFonts+ , optEpubCoverImage = oEpubCoverImage+ , optLogFile = oLogFile+ , optFilters = oFilters+ , optDataDir = oDataDir+ , optExtractMedia = oExtractMedia+ , optCss = oCss+ , optIncludeBeforeBody = oIncludeBeforeBody+ , optIncludeAfterBody = oIncludeAfterBody+ , optIncludeInHeader = oIncludeInHeader+ , optResourcePath = oResourcePath+ , optCSL = oCSL+ , optBibliography = oBibliography+ , optCitationAbbreviations = oCitationAbbreviations+ }+ = do+ oTemplate' <- mapM resolveVars oTemplate+ oMetadataFiles' <- mapM resolveVars oMetadataFiles+ oOutputFile' <- mapM resolveVars oOutputFile+ oInputFiles' <- mapM (mapM resolveVars) oInputFiles+ oSyntaxDefinitions' <- mapM resolveVars oSyntaxDefinitions+ oAbbreviations' <- mapM resolveVars oAbbreviations+ oReferenceDoc' <- mapM resolveVars oReferenceDoc+ oEpubMetadata' <- mapM resolveVars oEpubMetadata+ oEpubFonts' <- mapM resolveVars oEpubFonts+ oEpubCoverImage' <- mapM resolveVars oEpubCoverImage+ oLogFile' <- mapM resolveVars oLogFile+ oFilters' <- mapM resolveVarsInFilter oFilters+ oDataDir' <- mapM resolveVars oDataDir+ oExtractMedia' <- mapM resolveVars oExtractMedia+ oCss' <- mapM resolveVars oCss+ oIncludeBeforeBody' <- mapM resolveVars oIncludeBeforeBody+ oIncludeAfterBody' <- mapM resolveVars oIncludeAfterBody+ oIncludeInHeader' <- mapM resolveVars oIncludeInHeader+ oResourcePath' <- mapM resolveVars oResourcePath+ oCSL' <- mapM resolveVars oCSL+ oBibliography' <- mapM resolveVars oBibliography+ oCitationAbbreviations' <- mapM resolveVars oCitationAbbreviations+ return opt{ optTemplate = oTemplate'+ , optMetadataFiles = oMetadataFiles'+ , optOutputFile = oOutputFile'+ , optInputFiles = oInputFiles'+ , optSyntaxDefinitions = oSyntaxDefinitions'+ , optAbbreviations = oAbbreviations'+ , optReferenceDoc = oReferenceDoc'+ , optEpubMetadata = oEpubMetadata'+ , optEpubFonts = oEpubFonts'+ , optEpubCoverImage = oEpubCoverImage'+ , optLogFile = oLogFile'+ , optFilters = oFilters'+ , optDataDir = oDataDir'+ , optExtractMedia = oExtractMedia'+ , optCss = oCss'+ , optIncludeBeforeBody = oIncludeBeforeBody'+ , optIncludeAfterBody = oIncludeAfterBody'+ , optIncludeInHeader = oIncludeInHeader'+ , optResourcePath = oResourcePath'+ , optCSL = oCSL'+ , optBibliography = oBibliography'+ , optCitationAbbreviations = oCitationAbbreviations'+ }++ where+ resolveVars :: FilePath -> StateT DefaultsState m FilePath+ resolveVars [] = return []+ resolveVars ('$':'{':xs) =+ let (ys, zs) = break (=='}') xs+ in if null zs+ then return $ '$':'{':xs+ else do+ val <- lookupEnv' ys+ (val ++) <$> resolveVars (drop 1 zs)+ resolveVars (c:cs) = (c:) <$> resolveVars cs+ lookupEnv' :: String -> StateT DefaultsState m String+ lookupEnv' "." = do+ mbCurDefaults <- gets curDefaults+ maybe (return "")+ (fmap takeDirectory . liftIO . canonicalizePath)+ mbCurDefaults+ lookupEnv' "USERDATA" = do+ mbodatadir <- mapM resolveVars oDataDir+ mbdatadir <- getUserDataDir+ defdatadir <- liftIO defaultUserDataDir+ return $ fromMaybe defdatadir (mbodatadir <|> mbdatadir)+ lookupEnv' v = do+ mbval <- fmap T.unpack <$> lookupEnv (T.pack v)+ case mbval of+ Nothing -> do+ report $ EnvironmentVariableUndefined (T.pack v)+ return mempty+ Just x -> return x+ resolveVarsInFilter (JSONFilter fp) =+ JSONFilter <$> resolveVars fp+ resolveVarsInFilter (LuaFilter fp) =+ LuaFilter <$> resolveVars fp+ resolveVarsInFilter CiteprocFilter = return CiteprocFilter+++ parseDefaults :: (PandocMonad m, MonadIO m) => Node Pos -> Maybe FilePath@@ -428,26 +543,18 @@ (parseYAML v >>= \x -> return (\o -> o{ optCss = optCss o <> [unpack x] })) "bibliography" ->- do let addItem x o = o{ optMetadata =- addMeta "bibliography" (T.unpack x)- (optMetadata o) }- (parseYAML v >>= \(xs :: [Text]) -> return $ \o ->- foldr addItem o xs)- <|>- (parseYAML v >>= \(x :: Text) -> return $ \o -> addItem x o)+ (parseYAML v >>= \x -> return (\o ->+ o{ optBibliography = optBibliography o <>+ map unpack x }))+ <|>+ (parseYAML v >>= \x -> return (\o ->+ o{ optBibliography = optBibliography o <>+ [unpack x] })) "csl" ->- do let addItem x o = o{ optMetadata =- addMeta "csl" (T.unpack x)- (optMetadata o) }- (parseYAML v >>= \(xs :: [Text]) -> return $ \o ->- foldr addItem o xs)- <|>- (parseYAML v >>= \(x :: Text) -> return $ \o -> addItem x o)+ parseYAML v >>= \x -> return (\o -> o{ optCSL = unpack <$> x }) "citation-abbreviations" ->- parseYAML v >>= \x ->- return (\o -> o{ optMetadata =- addMeta "citation-abbreviations" (T.unpack x)- (optMetadata o) })+ parseYAML v >>= \x -> return (\o -> o{ optCitationAbbreviations =+ unpack <$> x }) "ipynb-output" -> parseYAML v >>= \x -> return (\o -> o{ optIpynbOutput = x }) "include-before-body" ->@@ -476,7 +583,8 @@ optIncludeInHeader o <> [unpack x] })) "resource-path" -> parseYAML v >>= \x ->- return (\o -> o{ optResourcePath = map unpack x })+ return (\o -> o{ optResourcePath = map unpack x <>+ optResourcePath o }) "request-headers" -> parseYAML v >>= \x -> return (\o -> o{ optRequestHeaders = x })@@ -562,6 +670,9 @@ , optNoCheckCertificate = False , optEol = Native , optStripComments = False+ , optCSL = Nothing+ , optBibliography = []+ , optCitationAbbreviations = Nothing } parseStringKey :: Node Pos -> Parser Text@@ -579,27 +690,6 @@ >>= fmap (Meta . flip P.runF def) yamlToMeta _ = return mempty -addMeta :: String -> String -> Meta -> Meta-addMeta k v meta =- case lookupMeta k' meta of- Nothing -> setMeta k' v' meta- Just (MetaList xs) ->- setMeta k' (MetaList (xs ++ [v'])) meta- Just x -> setMeta k' (MetaList [x, v']) meta- where- v' = readMetaValue v- k' = T.pack k--readMetaValue :: String -> MetaValue-readMetaValue s- | s == "true" = MetaBool True- | s == "True" = MetaBool True- | s == "TRUE" = MetaBool True- | s == "false" = MetaBool False- | s == "False" = MetaBool False- | s == "FALSE" = MetaBool False- | otherwise = MetaString $ T.pack s- -- | Apply defaults from --defaults file. applyDefaults :: (PandocMonad m, MonadIO m) => Opt@@ -625,12 +715,9 @@ let fp = if null (takeExtension file) then addExtension file "yaml" else file- dataDirs <- liftIO defaultUserDataDirs- let fps = fp : case dataDir of- Nothing -> map (</> ("defaults" </> fp))- dataDirs- Just dd -> [dd </> "defaults" </> fp]- fromMaybe fp <$> findM fileExists fps+ defaultDataDir <- liftIO defaultUserDataDir+ let defaultFp = fromMaybe defaultDataDir dataDir </> "defaults" </> fp+ fromMaybe fp <$> findM fileExists [fp, defaultFp] -- | In a list of lists, append another list in front of every list which -- starts with specific element.
src/Text/Pandoc/App/OutputSettings.hs view
@@ -59,8 +59,8 @@ let outputFile = fromMaybe "-" (optOutputFile opts) when (optDumpArgs opts) . liftIO $ do- UTF8.hPutStrLn stdout outputFile- mapM_ (UTF8.hPutStrLn stdout) (fromMaybe [] $ optInputFiles opts)+ UTF8.hPutStrLn stdout (T.pack outputFile)+ mapM_ (UTF8.hPutStrLn stdout . T.pack) (fromMaybe [] $ optInputFiles opts) exitSuccess epubMetadata <- traverse readUtf8File $ optEpubMetadata opts
src/Text/Pandoc/CSV.hs view
@@ -68,8 +68,7 @@ pCSVUnquotedCell :: CSVOptions -> Parser Text pCSVUnquotedCell opts = T.pack <$>- many (satisfy (\c -> c /= csvDelim opts && c /= '\r' && c /= '\n'- && c /= csvQuote opts))+ many (satisfy (\c -> c /= csvDelim opts && c /= '\r' && c /= '\n')) pCSVDelim :: CSVOptions -> Parser () pCSVDelim opts = do
src/Text/Pandoc/Citeproc.hs view
@@ -544,7 +544,7 @@ fixShortDOI x = let x' = extractText x in if "10/" `T.isPrefixOf` x' then TextVal $ T.drop 3 x'- -- see http://shortdoi.org+ -- see https://shortdoi.org else TextVal x' tolink pref x = let x' = extractText x x'' = if "://" `T.isInfixOf` x'
src/Text/Pandoc/Citeproc/BibTeX.hs view
@@ -52,6 +52,8 @@ import Data.List (foldl', intercalate, intersperse) import Safe (readMay) import Text.Printf (printf)+import Text.DocLayout (literal, hsep, nest, hang, Doc(..),+ braces, ($$), cr) data Variant = Bibtex | Biblatex deriving (Show, Eq, Ord)@@ -77,10 +79,11 @@ -> Variant -- ^ bibtex or biblatex -> Maybe Lang -- ^ Language -> Reference Inlines -- ^ Reference to write- -> Text+ -> Doc Text writeBibtexString opts variant mblang ref =- "@" <> bibtexType <> "{" <> unItemId (referenceId ref) <> ",\n " <>- renderFields fs <> "\n}\n"+ "@" <> bibtexType <> "{" <> literal (unItemId (referenceId ref)) <> ","+ $$ nest 2 (renderFields fs)+ $$ "}" <> cr where bibtexType =@@ -115,7 +118,7 @@ "motion_picture" | variant == Biblatex -> "movie" "review" | variant == Biblatex -> "review" _ -> "misc"- + mbSubtype = case referenceType ref of "article-magazine" -> Just "magazine"@@ -149,7 +152,7 @@ , "type" , "entrysubtype" , "note"- , "language"+ , "langid" , "abstract" , "keywords" ]@@ -202,12 +205,19 @@ [ (", " <>) <$> nameGiven name, nameDroppingParticle name ] - titlecase = case mblang of+ mblang' = (parseLang <$> getVariableAsText "language") <|> mblang++ titlecase = case mblang' of Just (Lang "en" _) -> titlecase' Nothing -> titlecase'- _ -> id+ _ ->+ case variant of+ Bibtex -> B.spanWith nullAttr+ -- BibTex lacks a language field, so we wrap non-English+ -- titles in {} to protect case.+ Biblatex -> id - titlecase' = addTextCase mblang TitleCase .+ titlecase' = addTextCase mblang' TitleCase . (\ils -> B.fromList (case B.toList ils of Str t : xs -> Str t : Walk.walk spanAroundCapitalizedWords xs@@ -224,10 +234,12 @@ toLaTeX x = case runPure (writeLaTeX opts $ doc (B.plain x)) of Left _ -> Nothing- Right t -> Just t+ Right t -> Just $ hsep . map literal $ T.words t - renderField name = (\contents -> name <> " = {" <> contents <> "}")- <$> getContentsFor name+ renderField :: Text -> Maybe (Doc Text)+ renderField name =+ (((literal name) <>) . hang 2 " = " . braces)+ <$> getContentsFor name getVariable v = lookupVariable (toVariable v) ref @@ -241,10 +253,10 @@ Nothing -> case dateParts date of [DateParts (y1:_), DateParts (y2:_)] ->- Just (T.pack (printf "%04d" y1) <> "--" <>+ Just $ literal (T.pack (printf "%04d" y1) <> "--" <> T.pack (printf "%04d" y2)) [DateParts (y1:_)] ->- Just (T.pack (printf "%04d" y1))+ Just $ literal (T.pack (printf "%04d" y1)) _ -> Nothing _ -> Nothing @@ -267,19 +279,19 @@ DateVal date -> case dateParts date of [DateParts (_:m1:_), DateParts (_:m2:_)] ->- Just (toMonth m1 <> "--" <> toMonth m2)- [DateParts (_:m1:_)] -> Just (toMonth m1)+ Just $ literal (toMonth m1 <> "--" <> toMonth m2)+ [DateParts (_:m1:_)] -> Just $ literal (toMonth m1) _ -> Nothing _ -> Nothing - getContentsFor :: Text -> Maybe Text+ getContentsFor :: Text -> Maybe (Doc Text) getContentsFor "type" = getVariableAsText "genre" >>= \case "mathesis" -> Just "mastersthesis" "phdthesis" -> Just "phdthesis" _ -> Nothing- getContentsFor "entrysubtype" = mbSubtype+ getContentsFor "entrysubtype" = literal <$> mbSubtype getContentsFor "journal" | bibtexType `elem` ["article", "periodical", "suppperiodical", "review"] = getVariable "container-title" >>= toLaTeX . valToInlines@@ -299,13 +311,15 @@ getContentsFor "urldate" = getVariable "accessed" >>= toLaTeX . valToInlines getContentsFor "year" = getVariable "issued" >>= getYear getContentsFor "month" = getVariable "issued" >>= getMonth+ getContentsFor "pages" = getVariable "page" >>= toLaTeX . valToInlines+ getContentsFor "langid" = getVariable "language" >>= toLaTeX . valToInlines getContentsFor "number" = (getVariable "number" <|> getVariable "collection-number" <|> getVariable "issue") >>= toLaTeX . valToInlines getContentsFor x = getVariable x >>= if isURL x- then Just . stringify . valToInlines+ then Just . literal . stringify . valToInlines else toLaTeX . (if x == "title" then titlecase@@ -314,7 +328,7 @@ isURL x = x `elem` ["url","doi","issn","isbn"] - renderFields = T.intercalate ",\n " . mapMaybe renderField+ renderFields = mconcat . intersperse ("," <> cr) . mapMaybe renderField defaultLang :: Lang defaultLang = Lang "en" (Just "US")@@ -563,10 +577,10 @@ eprint <- getRawField "eprint" let baseUrl = case T.toLower etype of- "arxiv" -> "http://arxiv.org/abs/"- "jstor" -> "http://www.jstor.org/stable/"- "pubmed" -> "http://www.ncbi.nlm.nih.gov/pubmed/"- "googlebooks" -> "http://books.google.com?id="+ "arxiv" -> "https://arxiv.org/abs/"+ "jstor" -> "https://www.jstor.org/stable/"+ "pubmed" -> "https://www.ncbi.nlm.nih.gov/pubmed/"+ "googlebooks" -> "https://books.google.com?id=" _ -> "" if T.null baseUrl then mzero@@ -750,41 +764,10 @@ _ -> B.fromList $ Walk.query (:[]) bs adjustSpans :: Lang -> Inline -> Inline-adjustSpans lang (RawInline (Format "latex") s)- | s == "\\hyphen" || s == "\\hyphen " = Str "-"- | otherwise = parseRawLaTeX lang s+adjustSpans lang (Span ("",[],[("bibstring",s)]) _) = Str $ resolveKey' lang s adjustSpans _ SoftBreak = Space adjustSpans _ x = x -parseRawLaTeX :: Lang -> Text -> Inline-parseRawLaTeX lang t@(T.stripPrefix "\\" -> Just xs) =- case parseLaTeX lang contents of- Right [Para ys] -> f command ys- Right [Plain ys] -> f command ys- Right [] -> f command []- _ -> RawInline (Format "latex") t- where (command', contents') = T.break (\c -> c =='{' || c =='\\') xs- command = T.strip command'- contents = T.drop 1 $ T.dropEnd 1 contents'- f "mkbibquote" ils = Span nullAttr [Quoted DoubleQuote ils]- f "mkbibemph" ils = Span nullAttr [Emph ils]- f "mkbibitalic" ils = Span nullAttr [Emph ils]- f "mkbibbold" ils = Span nullAttr [Strong ils]- f "mkbibparens" ils = Span nullAttr $- [Str "("] ++ ils ++ [Str ")"]- f "mkbibbrackets" ils = Span nullAttr $- [Str "["] ++ ils ++ [Str "]"]- -- ... both should be nestable & should work in year fields- f "autocap" ils = Span nullAttr ils- -- TODO: should work in year fields- f "textnormal" ils = Span ("",["nodecor"],[]) ils- f "bibstring" [Str s] = Str $ resolveKey' lang s- f "adddot" [] = Str "."- f "adddotspace" [] = Span nullAttr [Str ".", Space]- f "addabbrvspace" [] = Space- f _ ils = Span nullAttr ils-parseRawLaTeX _ t = RawInline (Format "latex") t- latex' :: Text -> Bib [Block] latex' t = do lang <- gets localeLang@@ -1060,14 +1043,14 @@ let dateparts = filter (\x -> x /= DateParts []) $ map toDateParts [(year',month',day'), (endyear',endmonth',endday')]- literal <- if null dateparts- then Just <$> getRawField (prefix <> "year")- else return Nothing+ literal' <- if null dateparts+ then Just <$> getRawField (prefix <> "year")+ else return Nothing return $ Date { dateParts = dateparts , dateCirca = False , dateSeason = Nothing- , dateLiteral = literal }+ , dateLiteral = literal' } getRawField :: Text -> Bib Text getRawField f = do
src/Text/Pandoc/Citeproc/MetaValue.hs view
@@ -135,12 +135,13 @@ MetaMap _ -> TextVal mempty metaValueToDate :: MetaValue -> Date-metaValueToDate (MetaMap m) =- Date+metaValueToDate (MetaMap m) = fromMaybe+ (Date { dateParts = dateparts , dateCirca = circa , dateSeason = season- , dateLiteral = literal }+ , dateLiteral = literal })+ rawdate where dateparts = case M.lookup "date-parts" m of Just (MetaList xs) ->@@ -152,6 +153,7 @@ M.lookup "circa" m >>= metaValueToBool season = M.lookup "season" m >>= metaValueToInt literal = M.lookup "literal" m >>= metaValueToText+ rawdate = M.lookup "raw" m >>= metaValueToText >>= rawDateEDTF metaValueToDate (MetaList xs) = Date{ dateParts = mapMaybe metaValueToDateParts xs , dateCirca = False
src/Text/Pandoc/Class/IO.hs view
@@ -183,7 +183,7 @@ logOutput :: (PandocMonad m, MonadIO m) => LogMessage -> m () logOutput msg = liftIO $ do UTF8.hPutStr stderr $- "[" ++ show (messageVerbosity msg) ++ "] "+ "[" <> T.pack (show (messageVerbosity msg)) <> "] " alertIndent $ T.lines $ showLogMessage msg -- | Prints the list of lines to @stderr@, indenting every but the first@@ -191,10 +191,10 @@ alertIndent :: [Text] -> IO () alertIndent [] = return () alertIndent (l:ls) = do- UTF8.hPutStrLn stderr $ unpack l+ UTF8.hPutStrLn stderr l mapM_ go ls where go l' = do UTF8.hPutStr stderr " "- UTF8.hPutStrLn stderr $ unpack l'+ UTF8.hPutStrLn stderr l' -- | Extract media from the mediabag into a directory. extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc
src/Text/Pandoc/Class/PandocMonad.hs view
@@ -51,6 +51,7 @@ , setTranslations , translateTerm , makeCanonical+ , getTimestamp ) where import Codec.Archive.Zip@@ -59,7 +60,8 @@ import Data.Digest.Pure.SHA (sha1, showDigest) import Data.Maybe (fromMaybe) import Data.Time (UTCTime)-import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)+import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds,+ posixSecondsToUTCTime) import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime) import Network.URI ( escapeURIString, nonStrictRelativeTo, unEscapeString, parseURIReference, isAllowedInURI,@@ -74,7 +76,7 @@ import Text.Pandoc.Logging import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType) import Text.Pandoc.MediaBag (MediaBag, lookupMedia)-import Text.Pandoc.Shared (uriPathToPath)+import Text.Pandoc.Shared (uriPathToPath, safeRead) import Text.Pandoc.Translations (Term(..), Translations, lookupTerm, readTranslations) import Text.Pandoc.Walk (walkM)@@ -174,6 +176,21 @@ let level = messageVerbosity msg when (level <= verbosity) $ logOutput msg modifyCommonState $ \st -> st{ stLog = msg : stLog st }++-- | Get the time from the @SOURCE_DATE_EPOCH@+-- environment variable. The variable should contain a+-- unix time stamp, the number of seconds since midnight Jan 01+-- 1970 UTC. If the variable is not set or cannot be+-- parsed as a unix time stamp, the current time is returned.+-- This function is designed to make possible reproducible+-- builds in formats that include a creation timestamp.+getTimestamp :: PandocMonad m => m UTCTime+getTimestamp = do+ mbSourceDateEpoch <- lookupEnv "SOURCE_DATE_EPOCH"+ case mbSourceDateEpoch >>= safeRead of+ Just (epoch :: Integer) ->+ return $ posixSecondsToUTCTime $ fromIntegral epoch+ Nothing -> getCurrentTime -- | Determine whether tracing is enabled. This affects -- the behavior of 'trace'. If tracing is not enabled,
src/Text/Pandoc/Error.hs view
@@ -16,9 +16,10 @@ -} module Text.Pandoc.Error ( PandocError(..),+ renderError, handleError) where -import Control.Exception (Exception)+import Control.Exception (Exception, displayException) import Data.Typeable (Typeable) import Data.Word (Word8) import Data.Text (Text)@@ -48,6 +49,7 @@ | PandocFailOnWarningError | PandocPDFProgramNotFoundError Text | PandocPDFError Text+ | PandocXMLError Text Text | PandocFilterError Text Text | PandocLuaError Text | PandocCouldNotFindDataFileError Text@@ -58,6 +60,7 @@ | PandocMacroLoop Text | PandocUTF8DecodingError Text Int Word8 | PandocIpynbDecodingError Text+ | PandocUnsupportedCharsetError Text | PandocUnknownReaderError Text | PandocUnknownWriterError Text | PandocUnsupportedExtensionError Text Text@@ -67,19 +70,17 @@ instance Exception PandocError --- | Handle PandocError by exiting with an error message.-handleError :: Either PandocError a -> IO a-handleError (Right r) = return r-handleError (Left e) =+renderError :: PandocError -> Text+renderError e = case e of- PandocIOError _ err' -> ioError err'- PandocHttpError u err' -> err 61 $+ PandocIOError _ err' -> T.pack $ displayException err'+ PandocHttpError u err' -> "Could not fetch " <> u <> "\n" <> tshow err'- PandocShouldNeverHappenError s -> err 62 $+ PandocShouldNeverHappenError s -> "Something we thought was impossible happened!\n" <> "Please report this to pandoc's developers: " <> s- PandocSomeError s -> err 63 s- PandocParseError s -> err 64 s+ PandocSomeError s -> s+ PandocParseError s -> s PandocParsecError input err' -> let errPos = errorPos err' errLine = sourceLine errPos@@ -90,39 +91,43 @@ ,"\n", T.replicate (errColumn - 1) " " ,"^"] else ""- in err 65 $ "\nError at " <> tshow err' <>+ in "\nError at " <> tshow err' <> -- if error comes from a chunk or included file, -- then we won't get the right text this way: if sourceName errPos == "source" then errorInFile else ""- PandocMakePDFError s -> err 66 s- PandocOptionError s -> err 6 s- PandocSyntaxMapError s -> err 67 s- PandocFailOnWarningError -> err 3 "Failing because there were warnings."- PandocPDFProgramNotFoundError pdfprog -> err 47 $+ PandocMakePDFError s -> s+ PandocOptionError s -> s+ PandocSyntaxMapError s -> s+ PandocFailOnWarningError -> "Failing because there were warnings."+ PandocPDFProgramNotFoundError pdfprog -> pdfprog <> " not found. Please select a different --pdf-engine or install " <> pdfprog- PandocPDFError logmsg -> err 43 $ "Error producing PDF.\n" <> logmsg- PandocFilterError filtername msg -> err 83 $ "Error running filter " <>+ PandocPDFError logmsg -> "Error producing PDF.\n" <> logmsg+ PandocXMLError fp logmsg -> "Invalid XML" <>+ (if T.null fp then "" else " in " <> fp) <> ":\n" <> logmsg+ PandocFilterError filtername msg -> "Error running filter " <> filtername <> ":\n" <> msg- PandocLuaError msg -> err 84 $ "Error running Lua:\n" <> msg- PandocCouldNotFindDataFileError fn -> err 97 $+ PandocLuaError msg -> "Error running Lua:\n" <> msg+ PandocCouldNotFindDataFileError fn -> "Could not find data file " <> fn- PandocResourceNotFound fn -> err 99 $+ PandocResourceNotFound fn -> "File " <> fn <> " not found in resource path"- PandocTemplateError s -> err 5 $ "Error compiling template " <> s- PandocAppError s -> err 4 s- PandocEpubSubdirectoryError s -> err 31 $+ PandocTemplateError s -> "Error compiling template " <> s+ PandocAppError s -> s+ PandocEpubSubdirectoryError s -> "EPUB subdirectory name '" <> s <> "' contains illegal characters"- PandocMacroLoop s -> err 91 $+ PandocMacroLoop s -> "Loop encountered in expanding macro " <> s- PandocUTF8DecodingError f offset w -> err 92 $+ PandocUTF8DecodingError f offset w -> "UTF-8 decoding error in " <> f <> " at byte offset " <> tshow offset <> " (" <> T.pack (printf "%2x" w) <> ").\n" <> "The input must be a UTF-8 encoded text."- PandocIpynbDecodingError w -> err 93 $+ PandocIpynbDecodingError w -> "ipynb decoding error: " <> w- PandocUnknownReaderError r -> err 21 $+ PandocUnsupportedCharsetError charset ->+ "Unsupported charset " <> charset+ PandocUnknownReaderError r -> "Unknown input format " <> r <> case r of "doc" -> "\nPandoc can convert from DOCX, but not from DOC." <>@@ -130,7 +135,7 @@ " and convert that with pandoc." "pdf" -> "\nPandoc can convert to PDF, but not from PDF." _ -> ""- PandocUnknownWriterError w -> err 22 $+ PandocUnknownWriterError w -> "Unknown output format " <> w <> case w of "pdf" -> "To create a pdf using pandoc, use" <>@@ -139,16 +144,57 @@ ".pdf extension (-o filename.pdf)." "doc" -> "\nPandoc can convert to DOCX, but not to DOC." _ -> ""- PandocUnsupportedExtensionError ext f -> err 23 $+ PandocUnsupportedExtensionError ext f -> "The extension " <> ext <> " is not supported " <> "for " <> f- PandocCiteprocError e' -> err 24 $+ PandocCiteprocError e' -> prettyCiteprocError e'- PandocBibliographyError fp msg -> err 25 $+ PandocBibliographyError fp msg -> "Error reading bibliography file " <> fp <> ":\n" <> msg ++-- | Handle PandocError by exiting with an error message.+handleError :: Either PandocError a -> IO a+handleError (Right r) = return r+handleError (Left e) =+ case e of+ PandocIOError _ err' -> ioError err'+ _ -> err exitCode (renderError e)+ where+ exitCode =+ case e of+ PandocIOError{} -> 1+ PandocHttpError{} -> 61+ PandocShouldNeverHappenError{} -> 62+ PandocSomeError{} -> 63+ PandocParseError{} -> 64+ PandocParsecError{} -> 65+ PandocMakePDFError{} -> 66+ PandocOptionError{} -> 6+ PandocSyntaxMapError{} -> 67+ PandocFailOnWarningError{} -> 3+ PandocPDFProgramNotFoundError{} -> 47+ PandocPDFError{} -> 43+ PandocXMLError{} -> 44+ PandocFilterError{} -> 83+ PandocLuaError{} -> 84+ PandocCouldNotFindDataFileError{} -> 97+ PandocResourceNotFound{} -> 99+ PandocTemplateError{} -> 5+ PandocAppError{} -> 4+ PandocEpubSubdirectoryError{} -> 31+ PandocMacroLoop{} -> 91+ PandocUTF8DecodingError{} -> 92+ PandocIpynbDecodingError{} -> 93+ PandocUnsupportedCharsetError{} -> 94+ PandocUnknownReaderError{} -> 21+ PandocUnknownWriterError{} -> 22+ PandocUnsupportedExtensionError{} -> 23+ PandocCiteprocError{} -> 24+ PandocBibliographyError{} -> 25+ err :: Int -> Text -> IO a err exitCode msg = do- UTF8.hPutStrLn stderr (T.unpack msg)+ UTF8.hPutStrLn stderr msg exitWith $ ExitFailure exitCode return undefined
src/Text/Pandoc/Extensions.hs view
@@ -378,10 +378,10 @@ , Ext_raw_attribute , Ext_implicit_header_references , Ext_attributes- , Ext_fenced_code_attributes ] getDefaultExtensions "org" = extensionsFromList [Ext_citations,+ Ext_task_lists, Ext_auto_identifiers] getDefaultExtensions "html" = extensionsFromList [Ext_auto_identifiers,@@ -509,7 +509,6 @@ , Ext_raw_attribute , Ext_implicit_header_references , Ext_attributes- , Ext_fenced_code_attributes , Ext_sourcepos ] getAll "commonmark_x" = getAll "commonmark"@@ -517,6 +516,7 @@ extensionsFromList [ Ext_citations , Ext_smart+ , Ext_task_lists ] getAll "html" = autoIdExtensions <> extensionsFromList
src/Text/Pandoc/ImageSize.hs view
@@ -44,8 +44,9 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import qualified Text.Pandoc.UTF8 as UTF8-import qualified Text.XML.Light as Xml+import Text.Pandoc.XML.Light hiding (Attr) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE import Control.Applicative import qualified Data.Attoparsec.ByteString.Char8 as A@@ -327,14 +328,15 @@ svgSize :: WriterOptions -> ByteString -> Maybe ImageSize svgSize opts img = do- doc <- Xml.parseXMLDoc $ UTF8.toString img+ doc <- either (const mzero) return $ parseXMLElement+ $ TL.fromStrict $ UTF8.toText img let viewboxSize = do- vb <- Xml.findAttrBy (== Xml.QName "viewBox" Nothing Nothing) doc- [_,_,w,h] <- mapM safeRead (T.words (T.pack vb))+ vb <- findAttrBy (== QName "viewBox" Nothing Nothing) doc+ [_,_,w,h] <- mapM safeRead (T.words vb) return (w,h) let dpi = fromIntegral $ writerDpi opts let dirToInt dir = do- dim <- Xml.findAttrBy (== Xml.QName dir Nothing Nothing) doc >>= lengthToDim . T.pack+ dim <- findAttrBy (== QName dir Nothing Nothing) doc >>= lengthToDim return $ inPixel opts dim w <- dirToInt "width" <|> (fst <$> viewboxSize) h <- dirToInt "height" <|> (snd <$> viewboxSize)
src/Text/Pandoc/Logging.hs view
@@ -100,6 +100,7 @@ | FilterCompleted FilePath Integer | CiteprocWarning Text | ATXHeadingInLHS Int Text+ | EnvironmentVariableUndefined Text deriving (Show, Eq, Data, Ord, Typeable, Generic) instance ToJSON LogMessage where@@ -229,6 +230,8 @@ ATXHeadingInLHS lvl contents -> ["level" .= lvl ,"contents" .= contents]+ EnvironmentVariableUndefined var ->+ ["variable" .= var ] showPos :: SourcePos -> Text showPos pos = Text.pack $ sn ++ "line " ++@@ -345,6 +348,8 @@ if lvl < 3 then " Consider using --markdown-headings=setext." else ""+ EnvironmentVariableUndefined var ->+ "Undefined environment variable " <> var <> " in defaults file." messageVerbosity :: LogMessage -> Verbosity messageVerbosity msg =@@ -391,3 +396,4 @@ FilterCompleted{} -> INFO CiteprocWarning{} -> WARNING ATXHeadingInLHS{} -> WARNING+ EnvironmentVariableUndefined{}-> WARNING
src/Text/Pandoc/Lua/Init.hs view
@@ -12,17 +12,18 @@ ( runLua ) where +import Control.Monad (when) import Control.Monad.Catch (try) import Control.Monad.Trans (MonadIO (..)) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Foreign.Lua (Lua) import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)+import Text.Pandoc.Class.PandocMonad (readDataFile) import Text.Pandoc.Class.PandocIO (PandocIO) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)-import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,- loadScriptFromDataDir, runPandocLua)-+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua)+import Text.Pandoc.Lua.Util (throwTopMessageAsError') import qualified Foreign.Lua as Lua import qualified Text.Pandoc.Definition as Pandoc import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc@@ -44,7 +45,7 @@ liftPandocLua Lua.openlibs installPandocPackageSearcher initPandocModule- loadScriptFromDataDir "init.lua"+ loadInitScript "init.lua" where initPandocModule :: PandocLua () initPandocModule = do@@ -60,6 +61,15 @@ putConstructorsInRegistry -- assign module to global variable liftPandocLua $ Lua.setglobal "pandoc"++ loadInitScript :: FilePath -> PandocLua ()+ loadInitScript scriptFile = do+ script <- readDataFile scriptFile+ status <- liftPandocLua $ Lua.dostring script+ when (status /= Lua.OK) . liftPandocLua $+ throwTopMessageAsError'+ (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)+ -- | AST elements are marshaled via normal constructor functions in the -- @pandoc@ module. However, accessing Lua globals from Haskell is
src/Text/Pandoc/Lua/Marshaling/AST.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {- | Module : Text.Pandoc.Lua.Marshaling.AST@@ -17,6 +18,7 @@ ) where import Control.Applicative ((<|>))+import Control.Monad ((<$!>)) import Foreign.Lua (Lua, Peekable, Pushable, StackIndex) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError)@@ -32,17 +34,16 @@ pushViaConstructor "Pandoc" blocks meta instance Peekable Pandoc where- peek idx = defineHowTo "get Pandoc value" $ do- blocks <- LuaUtil.rawField idx "blocks"- meta <- LuaUtil.rawField idx "meta"- return $ Pandoc meta blocks+ peek idx = defineHowTo "get Pandoc value" $! Pandoc+ <$!> LuaUtil.rawField idx "meta"+ <*> LuaUtil.rawField idx "blocks" instance Pushable Meta where push (Meta mmap) = pushViaConstructor "Meta" mmap instance Peekable Meta where- peek idx = defineHowTo "get Meta value" $- Meta <$> Lua.peek idx+ peek idx = defineHowTo "get Meta value" $!+ Meta <$!> Lua.peek idx instance Pushable MetaValue where push = pushMetaValue@@ -68,14 +69,13 @@ pushViaConstructor "Citation" cid mode prefix suffix noteNum hash instance Peekable Citation where- peek idx = do- id' <- LuaUtil.rawField idx "id"- prefix <- LuaUtil.rawField idx "prefix"- suffix <- LuaUtil.rawField idx "suffix"- mode <- LuaUtil.rawField idx "mode"- num <- LuaUtil.rawField idx "note_num"- hash <- LuaUtil.rawField idx "hash"- return $ Citation id' prefix suffix mode num hash+ peek idx = Citation+ <$!> LuaUtil.rawField idx "id"+ <*> LuaUtil.rawField idx "prefix"+ <*> LuaUtil.rawField idx "suffix"+ <*> LuaUtil.rawField idx "mode"+ <*> LuaUtil.rawField idx "note_num"+ <*> LuaUtil.rawField idx "hash" instance Pushable Alignment where push = Lua.push . show@@ -90,7 +90,7 @@ instance Pushable Format where push (Format f) = Lua.push f instance Peekable Format where- peek idx = Format <$> Lua.peek idx+ peek idx = Format <$!> Lua.peek idx instance Pushable ListNumberDelim where push = Lua.push . show@@ -130,26 +130,26 @@ elementContent = Lua.peek idx luatype <- Lua.ltype idx case luatype of- Lua.TypeBoolean -> MetaBool <$> Lua.peek idx- Lua.TypeString -> MetaString <$> Lua.peek idx+ Lua.TypeBoolean -> MetaBool <$!> Lua.peek idx+ Lua.TypeString -> MetaString <$!> Lua.peek idx Lua.TypeTable -> do tag <- try $ LuaUtil.getTag idx case tag of- Right "MetaBlocks" -> MetaBlocks <$> elementContent- Right "MetaBool" -> MetaBool <$> elementContent- Right "MetaMap" -> MetaMap <$> elementContent- Right "MetaInlines" -> MetaInlines <$> elementContent- Right "MetaList" -> MetaList <$> elementContent- Right "MetaString" -> MetaString <$> elementContent+ Right "MetaBlocks" -> MetaBlocks <$!> elementContent+ Right "MetaBool" -> MetaBool <$!> elementContent+ Right "MetaMap" -> MetaMap <$!> elementContent+ Right "MetaInlines" -> MetaInlines <$!> elementContent+ Right "MetaList" -> MetaList <$!> elementContent+ Right "MetaString" -> MetaString <$!> elementContent Right t -> Lua.throwMessage ("Unknown meta tag: " <> t) Left _ -> do -- no meta value tag given, try to guess. len <- Lua.rawlen idx if len <= 0- then MetaMap <$> Lua.peek idx- else (MetaInlines <$> Lua.peek idx)- <|> (MetaBlocks <$> Lua.peek idx)- <|> (MetaList <$> Lua.peek idx)+ then MetaMap <$!> Lua.peek idx+ else (MetaInlines <$!> Lua.peek idx)+ <|> (MetaBlocks <$!> Lua.peek idx)+ <|> (MetaList <$!> Lua.peek idx) _ -> Lua.throwMessage "could not get meta value" -- | Push a block element to the top of the Lua stack.@@ -174,25 +174,25 @@ -- | Return the value at the given index as block if possible. peekBlock :: StackIndex -> Lua Block-peekBlock idx = defineHowTo "get Block value" $ do+peekBlock idx = defineHowTo "get Block value" $! do tag <- LuaUtil.getTag idx case tag of- "BlockQuote" -> BlockQuote <$> elementContent- "BulletList" -> BulletList <$> elementContent- "CodeBlock" -> withAttr CodeBlock <$> elementContent- "DefinitionList" -> DefinitionList <$> elementContent- "Div" -> withAttr Div <$> elementContent+ "BlockQuote" -> BlockQuote <$!> elementContent+ "BulletList" -> BulletList <$!> elementContent+ "CodeBlock" -> withAttr CodeBlock <$!> elementContent+ "DefinitionList" -> DefinitionList <$!> elementContent+ "Div" -> withAttr Div <$!> elementContent "Header" -> (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)- <$> elementContent+ <$!> elementContent "HorizontalRule" -> return HorizontalRule- "LineBlock" -> LineBlock <$> elementContent+ "LineBlock" -> LineBlock <$!> elementContent "OrderedList" -> (\(LuaListAttributes lstAttr, lst) -> OrderedList lstAttr lst)- <$> elementContent+ <$!> elementContent "Null" -> return Null- "Para" -> Para <$> elementContent- "Plain" -> Plain <$> elementContent- "RawBlock" -> uncurry RawBlock <$> elementContent+ "Para" -> Para <$!> elementContent+ "Plain" -> Plain <$!> elementContent+ "RawBlock" -> uncurry RawBlock <$!> elementContent "Table" -> (\(attr, capt, colSpecs, thead, tbodies, tfoot) -> Table (fromLuaAttr attr) capt@@ -200,7 +200,7 @@ thead tbodies tfoot)- <$> elementContent+ <$!> elementContent _ -> Lua.throwMessage ("Unknown block type: " <> tag) where -- Get the contents of an AST element.@@ -222,15 +222,14 @@ -- | Peek Caption element peekCaption :: StackIndex -> Lua Caption-peekCaption idx = do- short <- Lua.fromOptional <$> LuaUtil.rawField idx "short"- long <- LuaUtil.rawField idx "long"- return $ Caption short long+peekCaption idx = Caption+ <$!> (Lua.fromOptional <$!> LuaUtil.rawField idx "short")+ <*> LuaUtil.rawField idx "long" instance Peekable ColWidth where peek idx = do- width <- Lua.fromOptional <$> Lua.peek idx- return $ maybe ColWidthDefault ColWidth width+ width <- Lua.fromOptional <$!> Lua.peek idx+ return $! maybe ColWidthDefault ColWidth width instance Pushable ColWidth where push = \case@@ -252,12 +251,11 @@ LuaUtil.addField "body" body instance Peekable TableBody where- peek idx = do- attr <- LuaUtil.rawField idx "attr"- rowHeadColumns <- LuaUtil.rawField idx "row_head_columns"- head' <- LuaUtil.rawField idx "head"- body <- LuaUtil.rawField idx "body"- return $ TableBody attr (RowHeadColumns rowHeadColumns) head' body+ peek idx = TableBody+ <$!> LuaUtil.rawField idx "attr"+ <*> (RowHeadColumns <$!> LuaUtil.rawField idx "row_head_columns")+ <*> LuaUtil.rawField idx "head"+ <*> LuaUtil.rawField idx "body" instance Pushable TableHead where push (TableHead attr rows) = Lua.push (attr, rows)@@ -287,13 +285,12 @@ LuaUtil.addField "contents" contents peekCell :: StackIndex -> Lua Cell-peekCell idx = do- attr <- fromLuaAttr <$> LuaUtil.rawField idx "attr"- align <- LuaUtil.rawField idx "alignment"- rowSpan <- LuaUtil.rawField idx "row_span"- colSpan <- LuaUtil.rawField idx "col_span"- contents <- LuaUtil.rawField idx "contents"- return $ Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents+peekCell idx = Cell+ <$!> (fromLuaAttr <$!> LuaUtil.rawField idx "attr")+ <*> LuaUtil.rawField idx "alignment"+ <*> (RowSpan <$!> LuaUtil.rawField idx "row_span")+ <*> (ColSpan <$!> LuaUtil.rawField idx "col_span")+ <*> LuaUtil.rawField idx "contents" -- | Push an inline element to the top of the lua stack. pushInline :: Inline -> Lua ()@@ -324,28 +321,29 @@ peekInline idx = defineHowTo "get Inline value" $ do tag <- LuaUtil.getTag idx case tag of- "Cite" -> uncurry Cite <$> elementContent- "Code" -> withAttr Code <$> elementContent- "Emph" -> Emph <$> elementContent- "Underline" -> Underline <$> elementContent- "Image" -> (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)- <$> elementContent- "Link" -> (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)- <$> elementContent+ "Cite" -> uncurry Cite <$!> elementContent+ "Code" -> withAttr Code <$!> elementContent+ "Emph" -> Emph <$!> elementContent+ "Underline" -> Underline <$!> elementContent+ "Image" -> (\(LuaAttr !attr, !lst, !tgt) -> Image attr lst tgt)+ <$!> elementContent+ "Link" -> (\(LuaAttr !attr, !lst, !tgt) -> Link attr lst tgt)+ <$!> elementContent "LineBreak" -> return LineBreak- "Note" -> Note <$> elementContent- "Math" -> uncurry Math <$> elementContent- "Quoted" -> uncurry Quoted <$> elementContent- "RawInline" -> uncurry RawInline <$> elementContent- "SmallCaps" -> SmallCaps <$> elementContent+ "Note" -> Note <$!> elementContent+ "Math" -> uncurry Math <$!> elementContent+ "Quoted" -> uncurry Quoted <$!> elementContent+ "RawInline" -> uncurry RawInline <$!> elementContent+ "SmallCaps" -> SmallCaps <$!> elementContent "SoftBreak" -> return SoftBreak "Space" -> return Space- "Span" -> withAttr Span <$> elementContent- "Str" -> Str <$> elementContent- "Strikeout" -> Strikeout <$> elementContent- "Strong" -> Strong <$> elementContent- "Subscript" -> Subscript <$> elementContent- "Superscript"-> Superscript <$> elementContent+ "Span" -> withAttr Span <$!> elementContent+ -- strict to Lua string is copied before gc+ "Str" -> Str <$!> elementContent+ "Strikeout" -> Strikeout <$!> elementContent+ "Strong" -> Strong <$!> elementContent+ "Subscript" -> Subscript <$!> elementContent+ "Superscript"-> Superscript <$!> elementContent _ -> Lua.throwMessage ("Unknown inline type: " <> tag) where -- Get the contents of an AST element.@@ -366,7 +364,7 @@ pushViaConstructor "Attr" id' classes kv instance Peekable LuaAttr where- peek idx = defineHowTo "get Attr value" (LuaAttr <$> Lua.peek idx)+ peek idx = defineHowTo "get Attr value" $! (LuaAttr <$!> Lua.peek idx) -- | Wrapper for ListAttributes newtype LuaListAttributes = LuaListAttributes ListAttributes
src/Text/Pandoc/Lua/Module/MediaBag.hs view
@@ -13,6 +13,7 @@ ( pushModule ) where +import Prelude hiding (lookup) import Control.Monad (zipWithM_) import Foreign.Lua (Lua, NumResults, Optional) import Text.Pandoc.Class.CommonState (CommonState (..))@@ -36,10 +37,10 @@ liftPandocLua Lua.newtable addFunction "delete" delete addFunction "empty" empty- addFunction "insert" insertMediaFn+ addFunction "insert" insert addFunction "items" items- addFunction "lookup" lookupMediaFn- addFunction "list" mediaDirectoryFn+ addFunction "lookup" lookup+ addFunction "list" list addFunction "fetch" fetch return 1 @@ -53,11 +54,11 @@ empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty }) -- | Insert a new item into the media bag.-insertMediaFn :: FilePath- -> Optional MimeType- -> BL.ByteString- -> PandocLua NumResults-insertMediaFn fp optionalMime contents = do+insert :: FilePath+ -> Optional MimeType+ -> BL.ByteString+ -> PandocLua NumResults+insert fp optionalMime contents = do mb <- getMediaBag setMediaBag $ MB.insertMedia fp (Lua.fromOptional optionalMime) contents mb return (Lua.NumResults 0)@@ -66,9 +67,9 @@ items :: PandocLua NumResults items = getMediaBag >>= liftPandocLua . pushIterator -lookupMediaFn :: FilePath- -> PandocLua NumResults-lookupMediaFn fp = do+lookup :: FilePath+ -> PandocLua NumResults+lookup fp = do res <- MB.lookupMedia fp <$> getMediaBag liftPandocLua $ case res of Nothing -> 1 <$ Lua.pushnil@@ -77,8 +78,8 @@ Lua.push contents return 2 -mediaDirectoryFn :: PandocLua NumResults-mediaDirectoryFn = do+list :: PandocLua NumResults+list = do dirContents <- MB.mediaDirectory <$> getMediaBag liftPandocLua $ do Lua.newtable
src/Text/Pandoc/Lua/Module/Pandoc.hs view
@@ -14,6 +14,7 @@ ( pushModule ) where +import Prelude hiding (read) import Control.Monad (when) import Control.Monad.Except (throwError) import Data.Default (Default (..))@@ -25,7 +26,7 @@ import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter, SingletonsList (..)) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,- loadScriptFromDataDir)+ loadDefaultModule) import Text.Pandoc.Walk (Walkable) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess)@@ -38,15 +39,15 @@ import qualified Text.Pandoc.Lua.Util as LuaUtil import Text.Pandoc.Error --- | Push the "pandoc" on the lua stack. Requires the `list` module to be--- loaded.+-- | Push the "pandoc" package to the Lua stack. Requires the `List`+-- module to be loadable. pushModule :: PandocLua NumResults pushModule = do- loadScriptFromDataDir "pandoc.lua"- addFunction "read" readDoc- addFunction "pipe" pipeFn- addFunction "walk_block" walkBlock- addFunction "walk_inline" walkInline+ loadDefaultModule "pandoc"+ addFunction "read" read+ addFunction "pipe" pipe+ addFunction "walk_block" walk_block+ addFunction "walk_inline" walk_inline return 1 walkElement :: (Walkable (SingletonsList Inline) a,@@ -54,14 +55,14 @@ => a -> LuaFilter -> PandocLua a walkElement x f = liftPandocLua $ walkInlines f x >>= walkBlocks f -walkInline :: Inline -> LuaFilter -> PandocLua Inline-walkInline = walkElement+walk_inline :: Inline -> LuaFilter -> PandocLua Inline+walk_inline = walkElement -walkBlock :: Block -> LuaFilter -> PandocLua Block-walkBlock = walkElement+walk_block :: Block -> LuaFilter -> PandocLua Block+walk_block = walkElement -readDoc :: T.Text -> Optional T.Text -> PandocLua NumResults-readDoc content formatSpecOrNil = liftPandocLua $ do+read :: T.Text -> Optional T.Text -> PandocLua NumResults+read content formatSpecOrNil = liftPandocLua $ do let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil) res <- Lua.liftIO . runIO $ getReader formatSpec >>= \(rdr,es) ->@@ -79,11 +80,11 @@ Left e -> Lua.raiseError $ show e -- | Pipes input through a command.-pipeFn :: String- -> [String]- -> BL.ByteString- -> PandocLua NumResults-pipeFn command args input = liftPandocLua $ do+pipe :: String -- ^ path to executable+ -> [String] -- ^ list of arguments+ -> BL.ByteString -- ^ input passed to process via stdin+ -> PandocLua NumResults+pipe command args input = liftPandocLua $ do (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input case ec of ExitSuccess -> 1 <$ Lua.push output
src/Text/Pandoc/Lua/Packages.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-} {- | Module : Text.Pandoc.Lua.Packages Copyright : Copyright © 2017-2021 Albert Krewinkel@@ -15,15 +12,12 @@ ( installPandocPackageSearcher ) where -import Control.Monad.Catch (try) import Control.Monad (forM_)-import Data.ByteString (ByteString)-import Foreign.Lua (Lua, NumResults)-import Text.Pandoc.Error (PandocError)-import Text.Pandoc.Class.PandocMonad (readDataFile)-import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)+import Foreign.Lua (NumResults)+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) import qualified Foreign.Lua as Lua+import qualified Foreign.Lua.Module.Path as Path import qualified Foreign.Lua.Module.Text as Text import qualified Text.Pandoc.Lua.Module.Pandoc as Pandoc import qualified Text.Pandoc.Lua.Module.MediaBag as MediaBag@@ -50,28 +44,17 @@ case pkgName of "pandoc" -> pushWrappedHsFun Pandoc.pushModule "pandoc.mediabag" -> pushWrappedHsFun MediaBag.pushModule+ "pandoc.path" -> pushWrappedHsFun Path.pushModule "pandoc.system" -> pushWrappedHsFun System.pushModule "pandoc.types" -> pushWrappedHsFun Types.pushModule "pandoc.utils" -> pushWrappedHsFun Utils.pushModule "text" -> pushWrappedHsFun Text.pushModule- _ -> searchPureLuaLoader+ "pandoc.List" -> pushWrappedHsFun (loadDefaultModule pkgName)+ _ -> reportPandocSearcherFailure where pushWrappedHsFun f = liftPandocLua $ do Lua.pushHaskellFunction f return 1- searchPureLuaLoader = do- let filename = pkgName ++ ".lua"- try (readDataFile filename) >>= \case- Right script -> pushWrappedHsFun (loadStringAsPackage pkgName script)- Left (_ :: PandocError) -> liftPandocLua $ do- Lua.push ("\n\tno file '" ++ filename ++ "' in pandoc's datadir")- return (1 :: NumResults)--loadStringAsPackage :: String -> ByteString -> Lua NumResults-loadStringAsPackage pkgName script = do- status <- Lua.dostring script- if status == Lua.OK- then return (1 :: NumResults)- else do- msg <- Lua.popValue- Lua.raiseError ("Error while loading `" <> pkgName <> "`.\n" <> msg)+ reportPandocSearcherFailure = liftPandocLua $ do+ Lua.push ("\n\t" <> pkgName <> "is not one of pandoc's default packages")+ return (1 :: NumResults)
src/Text/Pandoc/Lua/PandocLua.hs view
@@ -23,24 +23,23 @@ , runPandocLua , liftPandocLua , addFunction- , loadScriptFromDataDir+ , loadDefaultModule ) where -import Control.Monad (when) import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Except (MonadError (catchError, throwError)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Foreign.Lua (Lua (..), NumResults, Pushable, ToHaskellFunction) import Text.Pandoc.Class.PandocIO (PandocIO)-import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDataFile)-import Text.Pandoc.Error (PandocError)+import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDefaultDataFile)+import Text.Pandoc.Error (PandocError (PandocLuaError)) import Text.Pandoc.Lua.Global (Global (..), setGlobals) import Text.Pandoc.Lua.ErrorConversion (errorConversion) import qualified Control.Monad.Catch as Catch+import qualified Data.Text as T import qualified Foreign.Lua as Lua import qualified Text.Pandoc.Class.IO as IO-import qualified Text.Pandoc.Lua.Util as LuaUtil -- | Type providing access to both, pandoc and Lua operations. newtype PandocLua a = PandocLua { unPandocLua :: Lua a }@@ -86,14 +85,22 @@ Lua.pushHaskellFunction fn Lua.rawset (-3) --- | Load a file from pandoc's data directory.-loadScriptFromDataDir :: FilePath -> PandocLua ()-loadScriptFromDataDir scriptFile = do- script <- readDataFile scriptFile+-- | Load a pure Lua module included with pandoc. Leaves the result on+-- the stack and returns @NumResults 1@.+--+-- The script is loaded from the default data directory. We do not load+-- from data directories supplied via command line, as this could cause+-- scripts to be executed even though they had not been passed explicitly.+loadDefaultModule :: String -> PandocLua NumResults+loadDefaultModule name = do+ script <- readDefaultDataFile (name <> ".lua") status <- liftPandocLua $ Lua.dostring script- when (status /= Lua.OK) . liftPandocLua $- LuaUtil.throwTopMessageAsError'- (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)+ if status == Lua.OK+ then return (1 :: NumResults)+ else do+ msg <- liftPandocLua Lua.popValue+ let err = "Error while loading `" <> name <> "`.\n" <> msg+ throwError $ PandocLuaError (T.pack err) -- | Global variables which should always be set. defaultGlobals :: PandocIO [Global]
src/Text/Pandoc/MIME.hs view
@@ -10,8 +10,13 @@ Mime type lookup. -}-module Text.Pandoc.MIME ( MimeType, getMimeType, getMimeTypeDef,- extensionFromMimeType, mediaCategory ) where+module Text.Pandoc.MIME (+ MimeType,+ getMimeType,+ getMimeTypeDef,+ getCharset,+ extensionFromMimeType,+ mediaCategory ) where import Data.List (isPrefixOf, isSuffixOf) import qualified Data.Map as M import qualified Data.Text as T@@ -53,6 +58,14 @@ mimeTypes :: M.Map T.Text MimeType mimeTypes = M.fromList mimeTypesList++-- | Get the charset from a mime type, if one is present.+getCharset :: MimeType -> Maybe T.Text+getCharset mt =+ let (_,y) = T.breakOn "charset=" mt+ in if T.null y+ then Nothing+ else Just $ T.toUpper $ T.takeWhile (/= ';') $ T.drop 8 y -- | Collection of common mime types. -- Except for first entry, list borrowed from
src/Text/Pandoc/PDF.hs view
@@ -43,6 +43,7 @@ import Text.Pandoc.Error (PandocError (PandocPDFProgramNotFoundError)) import Text.Pandoc.MIME (getMimeType) import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..))+import Text.Pandoc.Extensions (disableExtension, Extension(Ext_smart)) import Text.Pandoc.Process (pipeProcess) import System.Process (readProcessWithExitCode) import Text.Pandoc.Shared (inDirectory, stringify, tshow)@@ -114,7 +115,10 @@ runIOorExplode $ do putCommonState commonState doc' <- handleImages opts tmpdir doc- source <- writer opts doc'+ source <- writer opts{ writerExtensions = -- disable use of quote+ -- ligatures to avoid bad ligatures like ?`+ disableExtension Ext_smart+ (writerExtensions opts) } doc' res <- case baseProg of "context" -> context2pdf verbosity program pdfargs tmpdir source "tectonic" -> tectonic2pdf verbosity program pdfargs tmpdir source@@ -266,7 +270,7 @@ | isAscii c = T.singleton c | otherwise = T.pack $ c : " (U+" ++ printf "%04X" (ord c) ++ ")" let addCodePoint = T.concatMap toCodePoint- let warnings = [ addCodePoint (T.pack $ utf8ToString (BC.drop 19 l))+ let warnings = [ addCodePoint (utf8ToText (BC.drop 19 l)) | l <- ls , isMissingCharacterWarning l ]@@ -310,7 +314,7 @@ env <- liftIO getEnvironment when (verbosity >= INFO) $ liftIO $ showVerboseInfo (Just tmpDir) program programArgs env- (utf8ToString sourceBL)+ (utf8ToText sourceBL) (exit, out) <- liftIO $ E.catch (pipeProcess (Just env) program programArgs sourceBL) (handlePDFProgramNotFound program)@@ -381,7 +385,7 @@ (pipeProcess (Just env'') program programArgs BL.empty) (handlePDFProgramNotFound program) when (verbosity >= INFO) $ liftIO $ do- UTF8.hPutStrLn stderr $ "[makePDF] Run #" ++ show runNumber+ UTF8.hPutStrLn stderr $ "[makePDF] Run #" <> tshow runNumber BL.hPutStr stderr out UTF8.hPutStr stderr "\n" if runNumber < numRuns@@ -401,7 +405,7 @@ generic2pdf verbosity program args source = do env' <- getEnvironment when (verbosity >= INFO) $- showVerboseInfo Nothing program args env' (T.unpack source)+ showVerboseInfo Nothing program args env' source (exit, out) <- E.catch (pipeProcess (Just env') program args (BL.fromStrict $ UTF8.fromText source))@@ -490,19 +494,20 @@ -> String -> [String] -> [(String, String)]- -> String+ -> Text -> IO () showVerboseInfo mbTmpDir program programArgs env source = do case mbTmpDir of Just tmpDir -> do UTF8.hPutStrLn stderr "[makePDF] temp dir:"- UTF8.hPutStrLn stderr tmpDir+ UTF8.hPutStrLn stderr (T.pack tmpDir) Nothing -> return () UTF8.hPutStrLn stderr "[makePDF] Command line:"- UTF8.hPutStrLn stderr $ program ++ " " ++ unwords (map show programArgs)+ UTF8.hPutStrLn stderr $+ T.pack program <> " " <> T.pack (unwords (map show programArgs)) UTF8.hPutStr stderr "\n" UTF8.hPutStrLn stderr "[makePDF] Environment:"- mapM_ (UTF8.hPutStrLn stderr . show) env+ mapM_ (UTF8.hPutStrLn stderr . tshow) env UTF8.hPutStr stderr "\n" UTF8.hPutStrLn stderr "[makePDF] Source:" UTF8.hPutStrLn stderr source@@ -513,8 +518,8 @@ E.throwIO $ PandocPDFProgramNotFoundError $ T.pack program | otherwise = E.throwIO e -utf8ToString :: ByteString -> String-utf8ToString lbs =+utf8ToText :: ByteString -> Text+utf8ToText lbs = case decodeUtf8' lbs of- Left _ -> BC.unpack lbs -- if decoding fails, treat as latin1- Right t -> TL.unpack t+ Left _ -> T.pack $ BC.unpack lbs -- if decoding fails, treat as latin1+ Right t -> TL.toStrict t
src/Text/Pandoc/Parsing.hs view
@@ -1148,7 +1148,7 @@ => ParserT Text ParserState Identity a -> Text -> IO ()-testStringWith parser str = UTF8.putStrLn $ show $+testStringWith parser str = UTF8.putStrLn $ tshow $ readWith parser defaultParserState str -- | Parsing options.
src/Text/Pandoc/Readers/DocBook.hs view
@@ -12,7 +12,7 @@ -} module Text.Pandoc.Readers.DocBook ( readDocBook ) where import Control.Monad.State.Strict-import Data.Char (isSpace, toUpper)+import Data.Char (isSpace, isLetter) import Data.Default import Data.Either (rights) import Data.Foldable (asum)@@ -21,14 +21,17 @@ import Data.Maybe (fromMaybe,mapMaybe) import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Control.Monad.Except (throwError) import Text.HTML.TagSoup.Entity (lookupEntity)+import Text.Pandoc.Error (PandocError(..)) import Text.Pandoc.Builder import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import Text.Pandoc.Options import Text.Pandoc.Logging (LogMessage(..)) import Text.Pandoc.Shared (crFilter, safeRead, extractSpaces) import Text.TeXMath (readMathML, writeTeX)-import Text.XML.Light+import Text.Pandoc.XML.Light {- @@ -206,7 +209,7 @@ [x] info - A wrapper for information about a component or other block. (DocBook v5) [x] informalequation - A displayed mathematical equation without a title [x] informalexample - A displayed example without a title-[ ] informalfigure - A untitled figure+[x] informalfigure - An untitled figure [ ] informaltable - A table without a title [ ] initializer - The initializer for a FieldSynopsis [x] inlineequation - A mathematical equation or expression occurring inline@@ -537,22 +540,26 @@ readDocBook :: PandocMonad m => ReaderOptions -> Text -> m Pandoc readDocBook _ inp = do- let tree = normalizeTree . parseXML . handleInstructions $ crFilter inp+ tree <- either (throwError . PandocXMLError "") return $+ parseXMLContents+ (TL.fromStrict . handleInstructions $ crFilter inp) (bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock tree return $ Pandoc (dbMeta st') (toList . mconcat $ bs) --- We treat <?asciidoc-br?> specially (issue #1236), converting it--- to <br/>, since xml-light doesn't parse the instruction correctly.--- Other xml instructions are simply removed from the input stream.+-- We treat certain processing instructions by converting them to tags+-- beginning "pi-". handleInstructions :: Text -> Text-handleInstructions = T.pack . handleInstructions' . T.unpack--handleInstructions' :: String -> String-handleInstructions' ('<':'?':'a':'s':'c':'i':'i':'d':'o':'c':'-':'b':'r':'?':'>':xs) = '<':'b':'r':'/':'>': handleInstructions' xs-handleInstructions' xs = case break (=='<') xs of- (ys, []) -> ys- ([], '<':zs) -> '<' : handleInstructions' zs- (ys, zs) -> ys ++ handleInstructions' zs+handleInstructions t =+ let (x,y) = T.breakOn "<?" t+ in if T.null y+ then x+ else+ let (w,z) = T.breakOn "?>" y+ in (if T.takeWhile (\c -> isLetter c || c == '-')+ (T.drop 2 w) `elem` ["asciidoc-br", "dbfo"]+ then x <> "<pi-" <> T.drop 2 w <> "/>"+ else x <> w <> T.take 2 z) <>+ handleInstructions (T.drop 2 z) getFigure :: PandocMonad m => Element -> DB m Blocks getFigure e = do@@ -565,32 +572,14 @@ modify $ \st -> st{ dbFigureTitle = mempty, dbFigureId = mempty } return res --- normalize input, consolidating adjacent Text and CRef elements-normalizeTree :: [Content] -> [Content]-normalizeTree = everywhere (mkT go)- where go :: [Content] -> [Content]- go (Text (CData CDataRaw _ _):xs) = xs- go (Text (CData CDataText s1 z):Text (CData CDataText s2 _):xs) =- Text (CData CDataText (s1 ++ s2) z):xs- go (Text (CData CDataText s1 z):CRef r:xs) =- Text (CData CDataText (s1 ++ convertEntity r) z):xs- go (CRef r:Text (CData CDataText s1 z):xs) =- Text (CData CDataText (convertEntity r ++ s1) z):xs- go (CRef r1:CRef r2:xs) =- Text (CData CDataText (convertEntity r1 ++ convertEntity r2) Nothing):xs- go xs = xs--convertEntity :: String -> String-convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e)- -- convenience function to get an attribute value, defaulting to ""-attrValue :: String -> Element -> Text+attrValue :: Text -> Element -> Text attrValue attr elt =- maybe "" T.pack (lookupAttrBy (\x -> qName x == attr) (elAttribs elt))+ fromMaybe "" (lookupAttrBy (\x -> qName x == attr) (elAttribs elt)) -- convenience function named :: Text -> Element -> Bool-named s e = qName (elName e) == T.unpack s+named s e = qName (elName e) == s -- @@ -627,7 +616,7 @@ isBlockElement (Elem e) = qName (elName e) `elem` blockTags isBlockElement _ = False -blockTags :: [String]+blockTags :: [Text] blockTags = [ "abstract" , "ackno"@@ -669,6 +658,7 @@ , "index" , "info" , "informalexample"+ , "informalfigure" , "informaltable" , "itemizedlist" , "linegroup"@@ -713,7 +703,7 @@ , "variablelist" ] ++ admonitionTags -admonitionTags :: [String]+admonitionTags :: [Text] admonitionTags = ["important","caution","note","tip","warning"] -- Trim leading and trailing newline characters@@ -771,10 +761,10 @@ parseBlock :: PandocMonad m => Content -> DB m Blocks parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE-parseBlock (Text (CData _ s _)) = if all isSpace s+parseBlock (Text (CData _ s _)) = if T.all isSpace s then return mempty- else return $ plain $ trimInlines $ text $ T.pack s-parseBlock (CRef x) = return $ plain $ str $ T.toUpper $ T.pack x+ else return $ plain $ trimInlines $ text s+parseBlock (CRef x) = return $ plain $ str $ T.toUpper x parseBlock (Elem e) = case qName (elName e) of "toc" -> skip -- skip TOC, since in pandoc it's autogenerated@@ -829,7 +819,7 @@ "refsect2" -> sect 2 "refsect3" -> sect 3 "refsection" -> gets dbSectionLevel >>= sect . (+1)- l | l `elem` admonitionTags -> parseAdmonition $ T.pack l+ l | l `elem` admonitionTags -> parseAdmonition l "area" -> skip "areaset" -> skip "areaspec" -> skip@@ -855,6 +845,7 @@ "variablelist" -> definitionList <$> deflistitems "procedure" -> bulletList <$> steps "figure" -> getFigure e+ "informalfigure" -> getFigure e "mediaobject" -> para <$> getMediaobject e "caption" -> skip "info" -> addMetadataFromElement e@@ -890,7 +881,11 @@ "subtitle" -> return mempty -- handled in parent element _ -> skip >> getBlocks e where skip = do- lift $ report $ IgnoredElement $ T.pack $ qName (elName e)+ let qn = qName $ elName e+ let name = if "pi-" `T.isPrefixOf` qn+ then "<?" <> qn <> "?>"+ else qn+ lift $ report $ IgnoredElement name return mempty codeBlockWithLang = do@@ -898,7 +893,7 @@ "" -> [] x -> [x] return $ codeBlockWith (attrValue "id" e, classes', [])- $ trimNl $ T.pack $ strContentRecursive e+ $ trimNl $ strContentRecursive e parseBlockquote = do attrib <- case filterChild (named "attribution") e of Nothing -> return mempty@@ -952,7 +947,7 @@ w <- findAttr (unqual "colwidth") c n <- safeRead $ "0" <> T.filter (\x -> (x >= '0' && x <= '9')- || x == '.') (T.pack w)+ || x == '.') w if n > 0 then Just n else Nothing let numrows = case bodyrows of [] -> 0@@ -962,7 +957,7 @@ cs -> map toAlignment cs let parseWidth s = safeRead (T.filter (\x -> (x >= '0' && x <= '9') || x == '.') s)- let textWidth = case filterChild (named "?dbfo") e of+ let textWidth = case filterChild (named "pi-dbfo") e of Just d -> case attrValue "table-width" d of "" -> 1.0 w -> fromMaybe 100.0 (parseWidth w) / 100.0@@ -1035,12 +1030,12 @@ x <- parseMixed container rs return $ p <> b <> x -parseRow :: PandocMonad m => [String] -> Element -> DB m [Cell]+parseRow :: PandocMonad m => [Text] -> Element -> DB m [Cell] parseRow cn = do let isEntry x = named "entry" x || named "td" x || named "th" x mapM (parseEntry cn) . filterChildren isEntry -parseEntry :: PandocMonad m => [String] -> Element -> DB m Cell+parseEntry :: PandocMonad m => [Text] -> Element -> DB m Cell parseEntry cn el = do let colDistance sa ea = do let iStrt = elemIndex sa cn@@ -1062,7 +1057,7 @@ getInlines e' = trimInlines . mconcat <$> mapM parseInline (elContent e') -strContentRecursive :: Element -> String+strContentRecursive :: Element -> Text strContentRecursive = strContent . (\e' -> e'{ elContent = map elementToStr $ elContent e' }) @@ -1071,9 +1066,9 @@ elementToStr x = x parseInline :: PandocMonad m => Content -> DB m Inlines-parseInline (Text (CData _ s _)) = return $ text $ T.pack s+parseInline (Text (CData _ s _)) = return $ text s parseInline (CRef ref) =- return $ text $ maybe (T.toUpper $ T.pack ref) T.pack $ lookupEntity ref+ return $ text $ maybe (T.toUpper ref) T.pack $ lookupEntity (T.unpack ref) parseInline (Elem e) = case qName (elName e) of "anchor" -> do@@ -1125,7 +1120,7 @@ "userinput" -> codeWithLang "systemitem" -> codeWithLang "varargs" -> return $ code "(...)"- "keycap" -> return (str $ T.pack $ strContent e)+ "keycap" -> return (str $ strContent e) "keycombo" -> keycombo <$> mapM parseInline (elContent e) "menuchoice" -> menuchoice <$>@@ -1137,17 +1132,17 @@ let title = case attrValue "endterm" e of "" -> maybe "???" xrefTitleByElem (findElementById linkend content)- endterm -> maybe "???" (T.pack . strContent)+ endterm -> maybe "???" strContent (findElementById endterm content) return $ link ("#" <> linkend) "" (text title)- "email" -> return $ link ("mailto:" <> T.pack (strContent e)) ""- $ str $ T.pack $ strContent e- "uri" -> return $ link (T.pack $ strContent e) "" $ str $ T.pack $ strContent e+ "email" -> return $ link ("mailto:" <> strContent e) ""+ $ str $ strContent e+ "uri" -> return $ link (strContent e) "" $ str $ strContent e "ulink" -> innerInlines (link (attrValue "url" e) "") "link" -> do ils <- innerInlines id let href = case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of- Just h -> T.pack h+ Just h -> h _ -> "#" <> attrValue "linkend" e let ils' = if ils == mempty then str href else ils let attr = (attrValue "id" e, T.words $ attrValue "role" e, [])@@ -1163,12 +1158,15 @@ "title" -> return mempty "affiliation" -> skip -- Note: this isn't a real docbook tag; it's what we convert- -- <?asciidor-br?> to in handleInstructions, above. A kludge to- -- work around xml-light's inability to parse an instruction.- "br" -> return linebreak+ -- <?asciidor-br?> to in handleInstructions, above.+ "pi-asciidoc-br" -> return linebreak _ -> skip >> innerInlines id where skip = do- lift $ report $ IgnoredElement $ T.pack $ qName (elName e)+ let qn = qName $ elName e+ let name = if "pi-" `T.isPrefixOf` qn+ then "<?" <> qn <> "?>"+ else qn+ lift $ report $ IgnoredElement name return mempty innerInlines f = extractSpaces f . mconcat <$>@@ -1177,7 +1175,7 @@ let classes' = case attrValue "language" e of "" -> [] l -> [l]- return $ codeWith (attrValue "id" e,classes',[]) $ T.pack $ strContentRecursive e+ return $ codeWith (attrValue "id" e,classes',[]) $ strContentRecursive e simpleList = mconcat . intersperse (str "," <> space) <$> mapM getInlines (filterChildren (named "member") e) segmentedList = do@@ -1218,10 +1216,10 @@ "sect5" -> descendantContent "title" el "cmdsynopsis" -> descendantContent "command" el "funcsynopsis" -> descendantContent "function" el- _ -> T.pack $ qName (elName el) ++ "_title"+ _ -> qName (elName el) <> "_title" where xrefLabel = attrValue "xreflabel" el- descendantContent name = maybe "???" (T.pack . strContent)+ descendantContent name = maybe "???" strContent . filterElementName (\n -> qName n == name) -- | Extract a math equation from an element@@ -1242,7 +1240,7 @@ mathMLEquations :: [Text] mathMLEquations = map writeTeX $ rights $ readMath (\x -> qName (elName x) == "math" && qPrefix (elName x) == Just "mml")- (readMathML . T.pack . showElement)+ (readMathML . showElement) latexEquations :: [Text] latexEquations = readMath (\x -> qName (elName x) == "mathphrase")@@ -1256,8 +1254,8 @@ -- | Get the actual text stored in a CData block. 'showContent' -- returns the text still surrounded by the [[CDATA]] tags. showVerbatimCData :: Content -> Text-showVerbatimCData (Text (CData _ d _)) = T.pack d-showVerbatimCData c = T.pack $ showContent c+showVerbatimCData (Text (CData _ d _)) = d+showVerbatimCData c = showContent c -- | Set the prefix of a name to 'Nothing'
src/Text/Pandoc/Readers/Docx/Parse.hs view
@@ -63,6 +63,7 @@ import Data.List import qualified Data.Map as M import qualified Data.Text as T+import Data.Text (Text) import Data.Maybe import System.FilePath import Text.Pandoc.Readers.Docx.Util@@ -72,8 +73,7 @@ import Text.TeXMath (Exp) import Text.TeXMath.Readers.OMML (readOMML) import Text.TeXMath.Unicode.Fonts (Font (..), getUnicode, textToFont)-import Text.XML.Light-import qualified Text.XML.Light.Cursor as XMLC+import Text.Pandoc.XML.Light data ReaderEnv = ReaderEnv { envNotes :: Notes , envComments :: Comments@@ -127,37 +127,23 @@ in concatMapM handler xs -unwrap :: NameSpaces -> Content -> [Content]-unwrap ns (Elem element)+unwrapElement :: NameSpaces -> Element -> [Element]+unwrapElement ns element | isElem ns "w" "sdt" element , Just sdtContent <- findChildByName ns "w" "sdtContent" element- = concatMap (unwrap ns . Elem) (elChildren sdtContent)+ = concatMap (unwrapElement ns) (elChildren sdtContent) | isElem ns "w" "smartTag" element- = concatMap (unwrap ns . Elem) (elChildren element)-unwrap _ content = [content]--unwrapChild :: NameSpaces -> Content -> Content-unwrapChild ns (Elem element) =- Elem $ element { elContent = concatMap (unwrap ns) (elContent element) }-unwrapChild _ content = content+ = concatMap (unwrapElement ns) (elChildren element)+ | otherwise+ = [element{ elContent = concatMap (unwrapContent ns) (elContent element) }] -walkDocument' :: NameSpaces -> XMLC.Cursor -> XMLC.Cursor-walkDocument' ns cur =- let modifiedCur = XMLC.modifyContent (unwrapChild ns) cur- in- case XMLC.nextDF modifiedCur of- Just cur' -> walkDocument' ns cur'- Nothing -> XMLC.root modifiedCur+unwrapContent :: NameSpaces -> Content -> [Content]+unwrapContent ns (Elem element) = map Elem $ unwrapElement ns element+unwrapContent _ content = [content] -walkDocument :: NameSpaces -> Element -> Maybe Element+walkDocument :: NameSpaces -> Element -> Element walkDocument ns element =- let cur = XMLC.fromContent (Elem element)- cur' = walkDocument' ns cur- in- case XMLC.toTree cur' of- Elem element' -> Just element'- _ -> Nothing-+ element{ elContent = concatMap (unwrapContent ns) (elContent element) } newtype Docx = Docx Document deriving Show@@ -343,10 +329,16 @@ Right doc -> Right (Docx doc, stateWarnings st) Left e -> Left e +parseXMLFromEntry :: Entry -> Maybe Element+parseXMLFromEntry entry =+ case parseXMLElement (UTF8.toTextLazy (fromEntry entry)) of+ Left _ -> Nothing+ Right el -> Just el+ getDocumentXmlPath :: Archive -> Maybe FilePath getDocumentXmlPath zf = do entry <- findEntryByPath "_rels/.rels" zf- relsElem <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry+ relsElem <- parseXMLFromEntry entry let rels = filterChildrenName (\n -> qName n == "Relationship") relsElem rel <- find (\e -> findAttr (QName "Type" Nothing Nothing) e == Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument")@@ -354,18 +346,18 @@ fp <- findAttr (QName "Target" Nothing Nothing) rel -- sometimes there will be a leading slash, which windows seems to -- have trouble with.- return $ case fp of+ return $ case T.unpack fp of '/' : fp' -> fp'- _ -> fp+ fp' -> fp' archiveToDocument :: Archive -> D Document archiveToDocument zf = do docPath <- asks envDocXmlPath entry <- maybeToD $ findEntryByPath docPath zf- docElem <- maybeToD $ (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry+ docElem <- maybeToD $ parseXMLFromEntry entry let namespaces = elemToNameSpaces docElem bodyElem <- maybeToD $ findChildByName namespaces "w" "body" docElem- let bodyElem' = fromMaybe bodyElem (walkDocument namespaces bodyElem)+ let bodyElem' = walkDocument namespaces bodyElem body <- elemToBody namespaces bodyElem' return $ Document namespaces body @@ -401,23 +393,24 @@ archiveToNotes :: Archive -> Notes archiveToNotes zf = let fnElem = findEntryByPath "word/footnotes.xml" zf- >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)+ >>= parseXMLFromEntry enElem = findEntryByPath "word/endnotes.xml" zf- >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)- fn_namespaces = maybe [] elemToNameSpaces fnElem- en_namespaces = maybe [] elemToNameSpaces enElem- ns = unionBy (\x y -> fst x == fst y) fn_namespaces en_namespaces- fn = fnElem >>= walkDocument ns >>= elemToNotes ns "footnote"- en = enElem >>= walkDocument ns >>= elemToNotes ns "endnote"+ >>= parseXMLFromEntry+ fn_namespaces = maybe mempty elemToNameSpaces fnElem+ en_namespaces = maybe mempty elemToNameSpaces enElem+ ns = M.union fn_namespaces en_namespaces+ fn = fnElem >>= elemToNotes ns "footnote" . walkDocument ns+ en = enElem >>= elemToNotes ns "endnote" . walkDocument ns in Notes ns fn en archiveToComments :: Archive -> Comments archiveToComments zf = let cmtsElem = findEntryByPath "word/comments.xml" zf- >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)- cmts_namespaces = maybe [] elemToNameSpaces cmtsElem- cmts = elemToComments cmts_namespaces <$> (cmtsElem >>= walkDocument cmts_namespaces)+ >>= parseXMLFromEntry+ cmts_namespaces = maybe mempty elemToNameSpaces cmtsElem+ cmts = elemToComments cmts_namespaces . walkDocument cmts_namespaces <$>+ cmtsElem in case cmts of Just c -> Comments cmts_namespaces c@@ -436,8 +429,8 @@ relElemToRelationship :: DocumentLocation -> Element -> Maybe Relationship relElemToRelationship relType element | qName (elName element) == "Relationship" = do- relId <- findAttrText (QName "Id" Nothing Nothing) element- target <- findAttrText (QName "Target" Nothing Nothing) element+ relId <- findAttr (QName "Id" Nothing Nothing) element+ target <- findAttr (QName "Target" Nothing Nothing) element return $ Relationship relType relId target relElemToRelationship _ _ = Nothing @@ -445,7 +438,7 @@ filePathToRelationships ar docXmlPath fp | Just relType <- filePathToRelType fp docXmlPath , Just entry <- findEntryByPath fp ar- , Just relElems <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry =+ , Just relElems <- parseXMLFromEntry entry = mapMaybe (relElemToRelationship relType) $ elChildren relElems filePathToRelationships _ _ _ = [] @@ -478,10 +471,10 @@ loElemToLevelOverride :: NameSpaces -> Element -> Maybe LevelOverride loElemToLevelOverride ns element | isElem ns "w" "lvlOverride" element = do- ilvl <- findAttrTextByName ns "w" "ilvl" element+ ilvl <- findAttrByName ns "w" "ilvl" element let startOverride = findChildByName ns "w" "startOverride" element >>= findAttrByName ns "w" "val"- >>= (\s -> listToMaybe (map fst (reads s :: [(Integer, String)])))+ >>= stringToInteger lvl = findChildByName ns "w" "lvl" element >>= levelElemToLevel ns return $ LevelOverride ilvl startOverride lvl@@ -490,9 +483,9 @@ numElemToNum :: NameSpaces -> Element -> Maybe Numb numElemToNum ns element | isElem ns "w" "num" element = do- numId <- findAttrTextByName ns "w" "numId" element+ numId <- findAttrByName ns "w" "numId" element absNumId <- findChildByName ns "w" "abstractNumId" element- >>= findAttrTextByName ns "w" "val"+ >>= findAttrByName ns "w" "val" let lvlOverrides = mapMaybe (loElemToLevelOverride ns) (findChildrenByName ns "w" "lvlOverride" element)@@ -502,7 +495,7 @@ absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb absNumElemToAbsNum ns element | isElem ns "w" "abstractNum" element = do- absNumId <- findAttrTextByName ns "w" "abstractNumId" element+ absNumId <- findAttrByName ns "w" "abstractNumId" element let levelElems = findChildrenByName ns "w" "lvl" element levels = mapMaybe (levelElemToLevel ns) levelElems return $ AbstractNumb absNumId levels@@ -511,23 +504,23 @@ levelElemToLevel :: NameSpaces -> Element -> Maybe Level levelElemToLevel ns element | isElem ns "w" "lvl" element = do- ilvl <- findAttrTextByName ns "w" "ilvl" element+ ilvl <- findAttrByName ns "w" "ilvl" element fmt <- findChildByName ns "w" "numFmt" element- >>= findAttrTextByName ns "w" "val"+ >>= findAttrByName ns "w" "val" txt <- findChildByName ns "w" "lvlText" element- >>= findAttrTextByName ns "w" "val"+ >>= findAttrByName ns "w" "val" let start = findChildByName ns "w" "start" element >>= findAttrByName ns "w" "val"- >>= (\s -> listToMaybe (map fst (reads s :: [(Integer, String)])))+ >>= stringToInteger return (Level ilvl fmt txt start) levelElemToLevel _ _ = Nothing archiveToNumbering' :: Archive -> Maybe Numbering archiveToNumbering' zf = case findEntryByPath "word/numbering.xml" zf of- Nothing -> Just $ Numbering [] [] []+ Nothing -> Just $ Numbering mempty [] [] Just entry -> do- numberingElem <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry+ numberingElem <- parseXMLFromEntry entry let namespaces = elemToNameSpaces numberingElem numElems = findChildrenByName namespaces "w" "num" numberingElem absNumElems = findChildrenByName namespaces "w" "abstractNum" numberingElem@@ -537,13 +530,13 @@ archiveToNumbering :: Archive -> Numbering archiveToNumbering archive =- fromMaybe (Numbering [] [] []) (archiveToNumbering' archive)+ fromMaybe (Numbering mempty [] []) (archiveToNumbering' archive) -elemToNotes :: NameSpaces -> String -> Element -> Maybe (M.Map T.Text Element)+elemToNotes :: NameSpaces -> Text -> Element -> Maybe (M.Map T.Text Element) elemToNotes ns notetype element | isElem ns "w" (notetype <> "s") element = let pairs = mapMaybe- (\e -> findAttrTextByName ns "w" "id" e >>=+ (\e -> findAttrByName ns "w" "id" e >>= (\a -> Just (a, e))) (findChildrenByName ns "w" notetype element) in@@ -555,7 +548,7 @@ elemToComments ns element | isElem ns "w" "comments" element = let pairs = mapMaybe- (\e -> findAttrTextByName ns "w" "id" e >>=+ (\e -> findAttrByName ns "w" "id" e >>= (\a -> Just (a, e))) (findChildrenByName ns "w" "comment" element) in@@ -615,12 +608,12 @@ stringToInteger , hangingParIndent = findAttrByName ns "w" "hanging" element >>=- stringToInteger}+ stringToInteger } elemToParIndentation _ _ = Nothing -testBitMask :: String -> Int -> Bool+testBitMask :: Text -> Int -> Bool testBitMask bitMaskS n =- case (reads ("0x" ++ bitMaskS) :: [(Int, String)]) of+ case (reads ("0x" ++ T.unpack bitMaskS) :: [(Int, String)]) of [] -> False ((n', _) : _) -> (n' .|. n) /= 0 @@ -635,7 +628,7 @@ | isElem ns "w" "p" element , (c:_) <- findChildrenByName ns "m" "oMathPara" element = do- expsLst <- eitherToD $ readOMML $ T.pack $ showElement c+ expsLst <- eitherToD $ readOMML $ showElement c return $ OMathPara expsLst elemToBodyPart ns element | isElem ns "w" "p" element@@ -659,7 +652,7 @@ | isElem ns "w" "tbl" element = do let caption' = findChildByName ns "w" "tblPr" element >>= findChildByName ns "w" "tblCaption"- >>= findAttrTextByName ns "w" "val"+ >>= findAttrByName ns "w" "val" caption = fromMaybe "" caption' grid' = case findChildByName ns "w" "tblGrid" element of Just g -> elemToTblGrid ns g@@ -698,8 +691,8 @@ getTitleAndAlt ns element = let mbDocPr = findChildByName ns "wp" "inline" element >>= findChildByName ns "wp" "docPr"- title = fromMaybe "" (mbDocPr >>= findAttrTextByName ns "" "title")- alt = fromMaybe "" (mbDocPr >>= findAttrTextByName ns "" "descr")+ title = fromMaybe "" (mbDocPr >>= findAttrByName ns "" "title")+ alt = fromMaybe "" (mbDocPr >>= findAttrByName ns "" "descr") in (title, alt) elemToParPart :: NameSpaces -> Element -> D ParPart@@ -711,7 +704,7 @@ = let (title, alt) = getTitleAndAlt ns drawingElem a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main" drawing = findElement (QName "blip" (Just a_ns) (Just "a")) picElem- >>= findAttrTextByName ns "r" "embed"+ >>= findAttrByName ns "r" "embed" in case drawing of Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp title alt bs $ elemToExtent drawingElem)@@ -721,7 +714,7 @@ | isElem ns "w" "r" element , Just _ <- findChildByName ns "w" "pict" element = let drawing = findElement (elemName ns "v" "imagedata") element- >>= findAttrTextByName ns "r" "id"+ >>= findAttrByName ns "r" "id" in case drawing of -- Todo: check out title and attr for deprecated format.@@ -790,7 +783,7 @@ fldCharState <- gets stateFldCharState case fldCharState of FldCharOpen -> do- info <- eitherToD $ parseFieldInfo $ T.pack $ strContent instrText+ info <- eitherToD $ parseFieldInfo $ strContent instrText modify $ \st -> st{stateFldCharState = FldCharFieldInfo info} return NullParPart _ -> return NullParPart@@ -811,48 +804,48 @@ return $ ChangedRuns change runs elemToParPart ns element | isElem ns "w" "bookmarkStart" element- , Just bmId <- findAttrTextByName ns "w" "id" element- , Just bmName <- findAttrTextByName ns "w" "name" element =+ , Just bmId <- findAttrByName ns "w" "id" element+ , Just bmName <- findAttrByName ns "w" "name" element = return $ BookMark bmId bmName elemToParPart ns element | isElem ns "w" "hyperlink" element- , Just relId <- findAttrTextByName ns "r" "id" element = do+ , Just relId <- findAttrByName ns "r" "id" element = do location <- asks envLocation runs <- mapD (elemToRun ns) (elChildren element) rels <- asks envRelationships case lookupRelationship location relId rels of Just target ->- case findAttrTextByName ns "w" "anchor" element of+ case findAttrByName ns "w" "anchor" element of Just anchor -> return $ ExternalHyperLink (target <> "#" <> anchor) runs Nothing -> return $ ExternalHyperLink target runs Nothing -> return $ ExternalHyperLink "" runs elemToParPart ns element | isElem ns "w" "hyperlink" element- , Just anchor <- findAttrTextByName ns "w" "anchor" element = do+ , Just anchor <- findAttrByName ns "w" "anchor" element = do runs <- mapD (elemToRun ns) (elChildren element) return $ InternalHyperLink anchor runs elemToParPart ns element | isElem ns "w" "commentRangeStart" element- , Just cmtId <- findAttrTextByName ns "w" "id" element = do+ , Just cmtId <- findAttrByName ns "w" "id" element = do (Comments _ commentMap) <- asks envComments case M.lookup cmtId commentMap of Just cmtElem -> elemToCommentStart ns cmtElem Nothing -> throwError WrongElem elemToParPart ns element | isElem ns "w" "commentRangeEnd" element- , Just cmtId <- findAttrTextByName ns "w" "id" element =+ , Just cmtId <- findAttrByName ns "w" "id" element = return $ CommentEnd cmtId elemToParPart ns element | isElem ns "m" "oMath" element =- fmap PlainOMath (eitherToD $ readOMML $ T.pack $ showElement element)+ fmap PlainOMath (eitherToD $ readOMML $ showElement element) elemToParPart _ _ = throwError WrongElem elemToCommentStart :: NameSpaces -> Element -> D ParPart elemToCommentStart ns element | isElem ns "w" "comment" element- , Just cmtId <- findAttrTextByName ns "w" "id" element- , Just cmtAuthor <- findAttrTextByName ns "w" "author" element- , cmtDate <- findAttrTextByName ns "w" "date" element = do+ , Just cmtId <- findAttrByName ns "w" "id" element+ , Just cmtAuthor <- findAttrByName ns "w" "author" element+ , cmtDate <- findAttrByName ns "w" "date" element = do bps <- mapD (elemToBodyPart ns) (elChildren element) return $ CommentStart cmtId cmtAuthor cmtDate bps elemToCommentStart _ _ = throwError WrongElem@@ -871,7 +864,7 @@ where wp_ns = "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing" getDim at = findElement (QName "extent" (Just wp_ns) (Just "wp")) drawingElem- >>= findAttr (QName at Nothing Nothing) >>= safeRead . T.pack+ >>= findAttr (QName at Nothing Nothing) >>= safeRead childElemToRun :: NameSpaces -> Element -> D Run@@ -882,7 +875,7 @@ = let (title, alt) = getTitleAndAlt ns element a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main" drawing = findElement (QName "blip" (Just a_ns) (Just "a")) picElem- >>= findAttrText (QName "embed" (lookup "r" ns) (Just "r"))+ >>= findAttr (QName "embed" (M.lookup "r" ns) (Just "r")) in case drawing of Just s -> expandDrawingId s >>=@@ -895,7 +888,7 @@ = return InlineChart childElemToRun ns element | isElem ns "w" "footnoteReference" element- , Just fnId <- findAttrTextByName ns "w" "id" element = do+ , Just fnId <- findAttrByName ns "w" "id" element = do notes <- asks envNotes case lookupFootnote fnId notes of Just e -> do bps <- local (\r -> r {envLocation=InFootnote}) $ mapD (elemToBodyPart ns) (elChildren e)@@ -903,7 +896,7 @@ Nothing -> return $ Footnote [] childElemToRun ns element | isElem ns "w" "endnoteReference" element- , Just enId <- findAttrTextByName ns "w" "id" element = do+ , Just enId <- findAttrByName ns "w" "id" element = do notes <- asks envNotes case lookupEndnote enId notes of Just e -> do bps <- local (\r -> r {envLocation=InEndnote}) $ mapD (elemToBodyPart ns) (elChildren e)@@ -956,15 +949,15 @@ getTrackedChange :: NameSpaces -> Element -> Maybe TrackedChange getTrackedChange ns element | isElem ns "w" "ins" element || isElem ns "w" "moveTo" element- , Just cId <- findAttrTextByName ns "w" "id" element- , Just cAuthor <- findAttrTextByName ns "w" "author" element- , mcDate <- findAttrTextByName ns "w" "date" element =+ , Just cId <- findAttrByName ns "w" "id" element+ , Just cAuthor <- findAttrByName ns "w" "author" element+ , mcDate <- findAttrByName ns "w" "date" element = Just $ TrackedChange Insertion (ChangeInfo cId cAuthor mcDate) getTrackedChange ns element | isElem ns "w" "del" element || isElem ns "w" "moveFrom" element- , Just cId <- findAttrTextByName ns "w" "id" element- , Just cAuthor <- findAttrTextByName ns "w" "author" element- , mcDate <- findAttrTextByName ns "w" "date" element =+ , Just cId <- findAttrByName ns "w" "id" element+ , Just cAuthor <- findAttrByName ns "w" "author" element+ , mcDate <- findAttrByName ns "w" "date" element = Just $ TrackedChange Deletion (ChangeInfo cId cAuthor mcDate) getTrackedChange _ _ = Nothing @@ -973,7 +966,7 @@ | Just pPr <- findChildByName ns "w" "pPr" element = let style = mapMaybe- (fmap ParaStyleId . findAttrTextByName ns "w" "val")+ (fmap ParaStyleId . findAttrByName ns "w" "val") (findChildrenByName ns "w" "pStyle" pPr) in ParagraphStyle {pStyle = mapMaybe (`M.lookup` sty) style@@ -1005,7 +998,7 @@ charStyles <- asks envCharStyles let parentSty = findChildByName ns "w" "rStyle" rPr >>=- findAttrTextByName ns "w" "val" >>=+ findAttrByName ns "w" "val" >>= flip M.lookup charStyles . CharStyleId return $ elemToRunStyle ns element parentSty elemToRunStyleD _ _ = return defaultRunStyle@@ -1015,7 +1008,7 @@ | isElem ns "w" "t" element || isElem ns "w" "delText" element || isElem ns "m" "t" element = do- let str = T.pack $ strContent element+ let str = strContent element font <- asks envFont case font of Nothing -> return $ TextRun str@@ -1037,14 +1030,14 @@ getSymChar ns element | Just s <- lowerFromPrivate <$> getCodepoint , Just font <- getFont =- case readLitChar ("\\x" ++ s) of+ case readLitChar ("\\x" ++ T.unpack s) of [(char, _)] -> TextRun . maybe "" T.singleton $ getUnicode font char _ -> TextRun "" where getCodepoint = findAttrByName ns "w" "char" element- getFont = textToFont . T.pack =<< findAttrByName ns "w" "font" element- lowerFromPrivate ('F':xs) = '0':xs- lowerFromPrivate xs = xs+ getFont = textToFont =<< findAttrByName ns "w" "font" element+ lowerFromPrivate t | "F" `T.isPrefixOf` t = "0" <> T.drop 1 t+ | otherwise = t getSymChar _ _ = TextRun "" elemToRunElems :: NameSpaces -> Element -> D [RunElem]@@ -1054,8 +1047,9 @@ let qualName = elemName ns "w" let font = do fontElem <- findElement (qualName "rFonts") element- textToFont . T.pack =<<- foldr ((<|>) . (flip findAttr fontElem . qualName)) Nothing ["ascii", "hAnsi"]+ textToFont =<<+ foldr ((<|>) . (flip findAttr fontElem . qualName))+ Nothing ["ascii", "hAnsi"] local (setFont font) (mapD (elemToRunElem ns) (elChildren element)) elemToRunElems _ _ = throwError WrongElem
src/Text/Pandoc/Readers/Docx/Parse/Styles.hs view
@@ -48,11 +48,13 @@ import Data.String (IsString(..)) import qualified Data.Map as M import qualified Data.Text as T+import qualified Data.Text.Read+import Data.Text (Text) import Data.Maybe import Data.Coerce import Text.Pandoc.Readers.Docx.Util import qualified Text.Pandoc.UTF8 as UTF8-import Text.XML.Light+import Text.Pandoc.XML.Light newtype CharStyleId = CharStyleId T.Text deriving (Show, Eq, Ord, IsString, FromStyleId)@@ -108,7 +110,7 @@ , isRTL :: Maybe Bool , isForceCTL :: Maybe Bool , rVertAlign :: Maybe VertAlign- , rUnderline :: Maybe String+ , rUnderline :: Maybe Text , rParentStyle :: Maybe CharStyle } deriving Show@@ -135,19 +137,22 @@ , rParentStyle = Nothing } -archiveToStyles' :: (Ord k1, Ord k2, ElemToStyle a1, ElemToStyle a2) =>- (a1 -> k1) -> (a2 -> k2) -> Archive -> (M.Map k1 a1, M.Map k2 a2)+archiveToStyles'+ :: (Ord k1, Ord k2, ElemToStyle a1, ElemToStyle a2)+ => (a1 -> k1) -> (a2 -> k2) -> Archive -> (M.Map k1 a1, M.Map k2 a2) archiveToStyles' conv1 conv2 zf =- let stylesElem = findEntryByPath "word/styles.xml" zf >>=- (parseXMLDoc . UTF8.toStringLazy . fromEntry)- in- case stylesElem of- Nothing -> (M.empty, M.empty)- Just styElem ->- let namespaces = elemToNameSpaces styElem- in- ( M.fromList $ map (\r -> (conv1 r, r)) $ buildBasedOnList namespaces styElem Nothing,- M.fromList $ map (\p -> (conv2 p, p)) $ buildBasedOnList namespaces styElem Nothing)+ case findEntryByPath "word/styles.xml" zf of+ Nothing -> (M.empty, M.empty)+ Just entry ->+ case parseXMLElement . UTF8.toTextLazy . fromEntry $ entry of+ Left _ -> (M.empty, M.empty)+ Right styElem ->+ let namespaces = elemToNameSpaces styElem+ in+ ( M.fromList $ map (\r -> (conv1 r, r)) $+ buildBasedOnList namespaces styElem Nothing,+ M.fromList $ map (\p -> (conv2 p, p)) $+ buildBasedOnList namespaces styElem Nothing) isBasedOnStyle :: (ElemToStyle a, FromStyleId (StyleId a)) => NameSpaces -> Element -> Maybe a -> Bool isBasedOnStyle ns element parentStyle@@ -155,7 +160,7 @@ , Just styleType <- findAttrByName ns "w" "type" element , styleType == cStyleType parentStyle , Just basedOnVal <- findChildByName ns "w" "basedOn" element >>=- findAttrTextByName ns "w" "val"+ findAttrByName ns "w" "val" , Just ps <- parentStyle = basedOnVal == fromStyleId (getStyleId ps) | isElem ns "w" "style" element , Just styleType <- findAttrByName ns "w" "type" element@@ -165,7 +170,7 @@ | otherwise = False class HasStyleId a => ElemToStyle a where- cStyleType :: Maybe a -> String+ cStyleType :: Maybe a -> Text elemToStyle :: NameSpaces -> Element -> Maybe a -> Maybe a class FromStyleId (StyleId a) => HasStyleId a where@@ -222,8 +227,10 @@ stys -> stys ++ concatMap (buildBasedOnList ns element . Just) stys -stringToInteger :: String -> Maybe Integer-stringToInteger s = listToMaybe $ map fst (reads s :: [(Integer, String)])+stringToInteger :: Text -> Maybe Integer+stringToInteger s = case Data.Text.Read.decimal s of+ Right (x,_) -> Just x+ Left _ -> Nothing checkOnOff :: NameSpaces -> Element -> QName -> Maybe Bool checkOnOff ns rPr tag@@ -243,7 +250,7 @@ elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle -> Maybe CharStyle elemToCharStyle ns element parentStyle- = CharStyle <$> (CharStyleId <$> findAttrTextByName ns "w" "styleId" element)+ = CharStyle <$> (CharStyleId <$> findAttrByName ns "w" "styleId" element) <*> getElementStyleName ns element <*> Just (elemToRunStyle ns element parentStyle) @@ -277,7 +284,7 @@ getHeaderLevel :: NameSpaces -> Element -> Maybe (ParaStyleName, Int) getHeaderLevel ns element | Just styleName <- getElementStyleName ns element- , Just n <- stringToInteger . T.unpack =<<+ , Just n <- stringToInteger =<< (T.stripPrefix "heading " . T.toLower $ fromStyleName styleName) , n > 0 = Just (styleName, fromInteger n)@@ -285,8 +292,8 @@ getElementStyleName :: Coercible T.Text a => NameSpaces -> Element -> Maybe a getElementStyleName ns el = coerce <$>- ((findChildByName ns "w" "name" el >>= findAttrTextByName ns "w" "val")- <|> findAttrTextByName ns "w" "styleId" el)+ ((findChildByName ns "w" "name" el >>= findAttrByName ns "w" "val")+ <|> findAttrByName ns "w" "styleId" el) getNumInfo :: NameSpaces -> Element -> Maybe (T.Text, T.Text) getNumInfo ns element = do@@ -294,15 +301,15 @@ findChildByName ns "w" "numPr" lvl = fromMaybe "0" (numPr >>= findChildByName ns "w" "ilvl" >>=- findAttrTextByName ns "w" "val")+ findAttrByName ns "w" "val") numId <- numPr >>= findChildByName ns "w" "numId" >>=- findAttrTextByName ns "w" "val"+ findAttrByName ns "w" "val" return (numId, lvl) elemToParStyleData :: NameSpaces -> Element -> Maybe ParStyle -> Maybe ParStyle elemToParStyleData ns element parentStyle- | Just styleId <- findAttrTextByName ns "w" "styleId" element+ | Just styleId <- findAttrByName ns "w" "styleId" element , Just styleName <- getElementStyleName ns element = Just $ ParStyle {
src/Text/Pandoc/Readers/Docx/Util.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Readers.Docx.StyleMaps Copyright : © 2014-2020 Jesse Rosenthal <jrosenthal@jhu.edu>,@@ -18,51 +19,45 @@ , elemToNameSpaces , findChildByName , findChildrenByName- , findAttrText , findAttrByName- , findAttrTextByName ) where -import Data.Maybe (mapMaybe) import qualified Data.Text as T-import Text.XML.Light+import Data.Text (Text)+import Text.Pandoc.XML.Light+import qualified Data.Map as M -type NameSpaces = [(String, String)]+type NameSpaces = M.Map Text Text elemToNameSpaces :: Element -> NameSpaces-elemToNameSpaces = mapMaybe attrToNSPair . elAttribs--attrToNSPair :: Attr -> Maybe (String, String)-attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val)-attrToNSPair _ = Nothing+elemToNameSpaces = foldr (\(Attr qn val) ->+ case qn of+ QName s _ (Just "xmlns") -> M.insert s val+ _ -> id) mempty . elAttribs -elemName :: NameSpaces -> String -> String -> QName+elemName :: NameSpaces -> Text -> Text -> QName elemName ns prefix name =- QName name (lookup prefix ns) (if null prefix then Nothing else Just prefix)+ QName name (M.lookup prefix ns)+ (if T.null prefix then Nothing else Just prefix) -isElem :: NameSpaces -> String -> String -> Element -> Bool+isElem :: NameSpaces -> Text -> Text -> Element -> Bool isElem ns prefix name element =- let ns' = ns ++ elemToNameSpaces element+ let ns' = ns <> elemToNameSpaces element in qName (elName element) == name &&- qURI (elName element) == lookup prefix ns'+ qURI (elName element) == M.lookup prefix ns' -findChildByName :: NameSpaces -> String -> String -> Element -> Maybe Element+findChildByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element findChildByName ns pref name el =- let ns' = ns ++ elemToNameSpaces el+ let ns' = ns <> elemToNameSpaces el in findChild (elemName ns' pref name) el -findChildrenByName :: NameSpaces -> String -> String -> Element -> [Element]+findChildrenByName :: NameSpaces -> Text -> Text -> Element -> [Element] findChildrenByName ns pref name el =- let ns' = ns ++ elemToNameSpaces el+ let ns' = ns <> elemToNameSpaces el in findChildren (elemName ns' pref name) el -findAttrText :: QName -> Element -> Maybe T.Text-findAttrText x = fmap T.pack . findAttr x--findAttrByName :: NameSpaces -> String -> String -> Element -> Maybe String+findAttrByName :: NameSpaces -> Text -> Text -> Element -> Maybe Text findAttrByName ns pref name el =- let ns' = ns ++ elemToNameSpaces el+ let ns' = ns <> elemToNameSpaces el in findAttr (elemName ns' pref name) el -findAttrTextByName :: NameSpaces -> String -> String -> Element -> Maybe T.Text-findAttrTextByName a b c = fmap T.pack . findAttrByName a b c
src/Text/Pandoc/Readers/EPUB.hs view
@@ -17,14 +17,14 @@ (readEPUB) where -import Codec.Archive.Zip (Archive (..), Entry, findEntryByPath, fromEntry,+import Codec.Archive.Zip (Archive (..), Entry(..), findEntryByPath, fromEntry, toArchiveOrFail) import Control.DeepSeq (NFData, deepseq) import Control.Monad (guard, liftM, liftM2, mplus) import Control.Monad.Except (throwError) import qualified Data.ByteString.Lazy as BL (ByteString)-import Data.List (isInfixOf) import qualified Data.Text as T+import Data.Text (Text) import qualified Data.Map as M (Map, elems, fromList, lookup) import Data.Maybe (mapMaybe) import qualified Data.Text.Lazy as TL@@ -40,12 +40,12 @@ import Text.Pandoc.MIME (MimeType) import Text.Pandoc.Options (ReaderOptions (..)) import Text.Pandoc.Readers.HTML (readHtml)-import Text.Pandoc.Shared (addMetaField, collapseFilePath, escapeURI)-import qualified Text.Pandoc.UTF8 as UTF8 (toStringLazy)+import Text.Pandoc.Shared (addMetaField, collapseFilePath, escapeURI, tshow)+import qualified Text.Pandoc.UTF8 as UTF8 (toTextLazy) import Text.Pandoc.Walk (query, walk)-import Text.XML.Light+import Text.Pandoc.XML.Light -type Items = M.Map String (FilePath, MimeType)+type Items = M.Map Text (FilePath, MimeType) readEPUB :: PandocMonad m => ReaderOptions -> BL.ByteString -> m Pandoc readEPUB opts bytes = case toArchiveOrFail bytes of@@ -125,26 +125,27 @@ imageMimes :: [MimeType] imageMimes = ["image/gif", "image/jpeg", "image/png"] -type CoverId = String+type CoverId = Text type CoverImage = FilePath -parseManifest :: (PandocMonad m) => Element -> Maybe CoverId -> m (Maybe CoverImage, Items)+parseManifest :: (PandocMonad m)+ => Element -> Maybe CoverId -> m (Maybe CoverImage, Items) parseManifest content coverId = do manifest <- findElementE (dfName "manifest") content let items = findChildren (dfName "item") manifest r <- mapM parseItem items let cover = findAttr (emptyName "href") =<< filterChild findCover manifest- return (cover `mplus` coverId, M.fromList r)+ return (T.unpack <$> (cover `mplus` coverId), M.fromList r) where- findCover e = maybe False (isInfixOf "cover-image")+ findCover e = maybe False (T.isInfixOf "cover-image") (findAttr (emptyName "properties") e) || Just True == liftM2 (==) coverId (findAttr (emptyName "id") e) parseItem e = do uid <- findAttrE (emptyName "id") e href <- findAttrE (emptyName "href") e mime <- findAttrE (emptyName "media-type") e- return (uid, (href, T.pack mime))+ return (uid, (T.unpack href, mime)) parseSpine :: PandocMonad m => Items -> Element -> m [(FilePath, MimeType)] parseSpine is e = do@@ -172,25 +173,25 @@ -- http://www.idpf.org/epub/30/spec/epub30-publications.html#sec-metadata-elem parseMetaItem :: Element -> Meta -> Meta parseMetaItem e@(stripNamespace . elName -> field) meta =- addMetaField (renameMeta field) (B.str $ T.pack $ strContent e) meta+ addMetaField (renameMeta field) (B.str $ strContent e) meta -renameMeta :: String -> T.Text+renameMeta :: Text -> Text renameMeta "creator" = "author"-renameMeta s = T.pack s+renameMeta s = s getManifest :: PandocMonad m => Archive -> m (String, Element) getManifest archive = do metaEntry <- findEntryByPathE ("META-INF" </> "container.xml") archive- docElem <- (parseXMLDocE . UTF8.toStringLazy . fromEntry) metaEntry+ docElem <- parseXMLDocE metaEntry let namespaces = mapMaybe attrToNSPair (elAttribs docElem) ns <- mkE "xmlns not in namespaces" (lookup "xmlns" namespaces) as <- fmap (map attrToPair . elAttribs) (findElementE (QName "rootfile" (Just ns) Nothing) docElem)- manifestFile <- mkE "Root not found" (lookup "full-path" as)+ manifestFile <- T.unpack <$> mkE "Root not found" (lookup "full-path" as) let rootdir = dropFileName manifestFile --mime <- lookup "media-type" as manifest <- findEntryByPathE manifestFile archive- (rootdir,) <$> (parseXMLDocE . UTF8.toStringLazy . fromEntry $ manifest)+ (rootdir,) <$> parseXMLDocE manifest -- Fixup @@ -200,7 +201,8 @@ . walk (fixBlockIRs filename) . walk (fixInlineIRs filename) where- (root, T.unpack . escapeURI . T.pack -> filename) = splitFileName pathToFile+ (root, T.unpack . escapeURI . T.pack -> filename) =+ splitFileName pathToFile fixInlineIRs :: String -> Inline -> Inline fixInlineIRs s (Span as v) =@@ -213,7 +215,7 @@ Link (fixAttrs s as) is t fixInlineIRs _ v = v -prependHash :: [T.Text] -> Inline -> Inline+prependHash :: [Text] -> Inline -> Inline prependHash ps l@(Link attr is (url, tit)) | or [s `T.isPrefixOf` url | s <- ps] = Link attr is ("#" <> url, tit)@@ -230,16 +232,17 @@ fixBlockIRs _ b = b fixAttrs :: FilePath -> B.Attr -> B.Attr-fixAttrs s (ident, cs, kvs) = (addHash s ident, filter (not . T.null) cs, removeEPUBAttrs kvs)+fixAttrs s (ident, cs, kvs) =+ (addHash s ident, filter (not . T.null) cs, removeEPUBAttrs kvs) -addHash :: String -> T.Text -> T.Text+addHash :: FilePath -> Text -> Text addHash _ "" = "" addHash s ident = T.pack (takeFileName s) <> "#" <> ident -removeEPUBAttrs :: [(T.Text, T.Text)] -> [(T.Text, T.Text)]+removeEPUBAttrs :: [(Text, Text)] -> [(Text, Text)] removeEPUBAttrs kvs = filter (not . isEPUBAttr) kvs -isEPUBAttr :: (T.Text, a) -> Bool+isEPUBAttr :: (Text, a) -> Bool isEPUBAttr (k, _) = "epub:" `T.isPrefixOf` k -- Library@@ -256,39 +259,44 @@ -- Utility -stripNamespace :: QName -> String+stripNamespace :: QName -> Text stripNamespace (QName v _ _) = v -attrToNSPair :: Attr -> Maybe (String, String)+attrToNSPair :: Attr -> Maybe (Text, Text) attrToNSPair (Attr (QName "xmlns" _ _) val) = Just ("xmlns", val) attrToNSPair _ = Nothing -attrToPair :: Attr -> (String, String)+attrToPair :: Attr -> (Text, Text) attrToPair (Attr (QName name _ _) val) = (name, val) -defaultNameSpace :: Maybe String+defaultNameSpace :: Maybe Text defaultNameSpace = Just "http://www.idpf.org/2007/opf" -dfName :: String -> QName+dfName :: Text -> QName dfName s = QName s defaultNameSpace Nothing -emptyName :: String -> QName+emptyName :: Text -> QName emptyName s = QName s Nothing Nothing -- Convert Maybe interface to Either -findAttrE :: PandocMonad m => QName -> Element -> m String+findAttrE :: PandocMonad m => QName -> Element -> m Text findAttrE q e = mkE "findAttr" $ findAttr q e findEntryByPathE :: PandocMonad m => FilePath -> Archive -> m Entry findEntryByPathE (normalise . unEscapeString -> path) a =- mkE ("No entry on path: " ++ path) $ findEntryByPath path a+ mkE ("No entry on path: " <> T.pack path) $ findEntryByPath path a -parseXMLDocE :: PandocMonad m => String -> m Element-parseXMLDocE doc = mkE "Unable to parse XML doc" $ parseXMLDoc doc+parseXMLDocE :: PandocMonad m => Entry -> m Element+parseXMLDocE entry =+ either (throwError . PandocXMLError fp) return $ parseXMLElement doc+ where+ doc = UTF8.toTextLazy . fromEntry $ entry+ fp = T.pack $ eRelativePath entry findElementE :: PandocMonad m => QName -> Element -> m Element-findElementE e x = mkE ("Unable to find element: " ++ show e) $ findElement e x+findElementE e x =+ mkE ("Unable to find element: " <> tshow e) $ findElement e x -mkE :: PandocMonad m => String -> Maybe a -> m a-mkE s = maybe (throwError . PandocParseError $ T.pack s) return+mkE :: PandocMonad m => Text -> Maybe a -> m a+mkE s = maybe (throwError . PandocParseError $ s) return
src/Text/Pandoc/Readers/FB2.hs view
@@ -25,13 +25,13 @@ module Text.Pandoc.Readers.FB2 ( readFB2 ) where import Control.Monad.Except (throwError) import Control.Monad.State.Strict-import Data.ByteString.Lazy.Char8 ( pack ) import Data.ByteString.Base64.Lazy import Data.Functor import Data.List (intersperse) import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import Data.Default import Data.Maybe import Text.HTML.TagSoup.Entity (lookupEntity)@@ -41,7 +41,8 @@ import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Shared (crFilter)-import Text.XML.Light+import Text.Pandoc.XML.Light+import qualified Text.Pandoc.UTF8 as UTF8 type FB2 m = StateT FB2State m @@ -64,10 +65,10 @@ readFB2 :: PandocMonad m => ReaderOptions -> Text -> m Pandoc readFB2 _ inp =- case parseXMLDoc $ crFilter inp of- Nothing -> throwError $ PandocParseError "Not an XML document"- Just e -> do- (bs, st) <- runStateT (parseRootElement e) def+ case parseXMLElement $ TL.fromStrict $ crFilter inp of+ Left msg -> throwError $ PandocXMLError "" msg+ Right el -> do+ (bs, st) <- runStateT (parseRootElement el) def let authors = if null $ fb2Authors st then id else setMeta "author" (map text $ reverse $ fb2Authors st)@@ -83,12 +84,12 @@ Just ('#', xs) -> xs _ -> t -convertEntity :: String -> Text-convertEntity e = maybe (T.toUpper $ T.pack e) T.pack $ lookupEntity e+convertEntity :: Text -> Text+convertEntity e = maybe (T.toUpper e) T.pack $ lookupEntity (T.unpack e) parseInline :: PandocMonad m => Content -> FB2 m Inlines parseInline (Elem e) =- case T.pack $ qName $ elName e of+ case qName $ elName e of "strong" -> strong <$> parseStyleType e "emphasis" -> emph <$> parseStyleType e "style" -> parseNamedStyle e@@ -96,12 +97,12 @@ "strikethrough" -> strikeout <$> parseStyleType e "sub" -> subscript <$> parseStyleType e "sup" -> superscript <$> parseStyleType e- "code" -> pure $ code $ T.pack $ strContent e+ "code" -> pure $ code $ strContent e "image" -> parseInlineImageElement e name -> do report $ IgnoredElement name pure mempty-parseInline (Text x) = pure $ text $ T.pack $ cdData x+parseInline (Text x) = pure $ text $ cdData x parseInline (CRef r) = pure $ str $ convertEntity r parseSubtitle :: PandocMonad m => Element -> FB2 m Blocks@@ -111,7 +112,7 @@ parseRootElement :: PandocMonad m => Element -> FB2 m Blocks parseRootElement e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "FictionBook" -> do -- Parse notes before parsing the rest of the content. case filterChild isNotesBody e of@@ -144,7 +145,7 @@ Just sectionId -> do content <- mconcat <$> mapM parseSectionChild (dropTitle $ elChildren e) oldNotes <- gets fb2Notes- modify $ \s -> s { fb2Notes = M.insert ("#" <> T.pack sectionId) content oldNotes }+ modify $ \s -> s { fb2Notes = M.insert ("#" <> sectionId) content oldNotes } pure () where isTitle x = qName (elName x) == "title"@@ -156,7 +157,7 @@ -- | Parse a child of @\<FictionBook>@ element. parseFictionBookChild :: PandocMonad m => Element -> FB2 m Blocks parseFictionBookChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "stylesheet" -> pure mempty -- stylesheet is ignored "description" -> mempty <$ mapM_ parseDescriptionChild (elChildren e) "body" -> if isNotesBody e@@ -168,7 +169,7 @@ -- | Parse a child of @\<description>@ element. parseDescriptionChild :: PandocMonad m => Element -> FB2 m () parseDescriptionChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "title-info" -> mapM_ parseTitleInfoChild (elChildren e) "src-title-info" -> pure () -- ignore "document-info" -> pure ()@@ -182,7 +183,7 @@ -- | Parse a child of @\<body>@ element. parseBodyChild :: PandocMonad m => Element -> FB2 m Blocks parseBodyChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "image" -> parseImageElement e "title" -> header <$> gets fb2SectionLevel <*> parseTitleType (elContent e) "epigraph" -> parseEpigraph e@@ -196,7 +197,10 @@ (Nothing, _) -> report $ IgnoredElement "binary without id attribute" (Just _, Nothing) -> report $ IgnoredElement "binary without content-type attribute"- (Just filename, contentType) -> insertMedia filename (T.pack <$> contentType) (decodeLenient (pack (strContent e)))+ (Just filename, contentType) ->+ insertMedia (T.unpack filename) contentType+ (decodeLenient+ (UTF8.fromTextLazy . TL.fromStrict . strContent $ e)) -- * Type parsers @@ -206,13 +210,13 @@ parseAuthorChild :: PandocMonad m => Element -> FB2 m (Maybe Text) parseAuthorChild e =- case T.pack $ qName $ elName e of- "first-name" -> pure $ Just $ T.pack $ strContent e- "middle-name" -> pure $ Just $ T.pack $ strContent e- "last-name" -> pure $ Just $ T.pack $ strContent e- "nickname" -> pure $ Just $ T.pack $ strContent e- "home-page" -> pure $ Just $ T.pack $ strContent e- "email" -> pure $ Just $ T.pack $ strContent e+ case qName $ elName e of+ "first-name" -> pure $ Just $ strContent e+ "middle-name" -> pure $ Just $ strContent e+ "last-name" -> pure $ Just $ strContent e+ "nickname" -> pure $ Just $ strContent e+ "home-page" -> pure $ Just $ strContent e+ "email" -> pure $ Just $ strContent e name -> do report $ IgnoredElement $ name <> " in author" pure Nothing@@ -236,13 +240,13 @@ parseImageElement :: PandocMonad m => Element -> FB2 m Blocks parseImageElement e = case href of- Just src -> pure $ para $ imageWith (imgId, [], []) (removeHash $ T.pack src) title alt+ Just src -> pure $ para $ imageWith (imgId, [], []) (removeHash src) title alt Nothing -> do report $ IgnoredElement " image without href" pure mempty- where alt = maybe mempty (str . T.pack) $ findAttr (unqual "alt") e- title = maybe "" T.pack $ findAttr (unqual "title") e- imgId = maybe "" T.pack $ findAttr (unqual "id") e+ where alt = maybe mempty str $ findAttr (unqual "alt") e+ title = fromMaybe "" $ findAttr (unqual "title") e+ imgId = fromMaybe "" $ findAttr (unqual "id") e href = findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e -- | Parse @pType@@@ -256,7 +260,7 @@ -- | Parse @citeType@ child parseCiteChild :: PandocMonad m => Element -> FB2 m Blocks parseCiteChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "p" -> para <$> parsePType e "poem" -> parsePoem e "empty-line" -> pure horizontalRule@@ -271,13 +275,13 @@ parsePoemChild :: PandocMonad m => Element -> FB2 m Blocks parsePoemChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "title" -> parseTitle e "subtitle" -> parseSubtitle e "epigraph" -> parseEpigraph e "stanza" -> parseStanza e "text-author" -> para <$> parsePType e- "date" -> pure $ para $ text $ T.pack $ strContent e+ "date" -> pure $ para $ text $ strContent e name -> report (UnexpectedXmlElement name "poem") $> mempty parseStanza :: PandocMonad m => Element -> FB2 m Blocks@@ -290,7 +294,7 @@ parseStanzaChild :: PandocMonad m => Element -> FB2 m Blocks parseStanzaChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "title" -> parseTitle e "subtitle" -> parseSubtitle e "v" -> lineBlock . (:[]) <$> parsePType e@@ -300,11 +304,11 @@ parseEpigraph :: PandocMonad m => Element -> FB2 m Blocks parseEpigraph e = divWith (divId, ["epigraph"], []) . mconcat <$> mapM parseEpigraphChild (elChildren e)- where divId = maybe "" T.pack $ findAttr (unqual "id") e+ where divId = fromMaybe "" $ findAttr (unqual "id") e parseEpigraphChild :: PandocMonad m => Element -> FB2 m Blocks parseEpigraphChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "p" -> para <$> parsePType e "poem" -> parsePoem e "cite" -> parseCite e@@ -318,7 +322,7 @@ parseAnnotationChild :: PandocMonad m => Element -> FB2 m Blocks parseAnnotationChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "p" -> para <$> parsePType e "poem" -> parsePoem e "cite" -> parseCite e@@ -332,14 +336,14 @@ parseSection e = do n <- gets fb2SectionLevel modify $ \st -> st{ fb2SectionLevel = n + 1 }- let sectionId = maybe "" T.pack $ findAttr (unqual "id") e+ let sectionId = fromMaybe "" $ findAttr (unqual "id") e bs <- divWith (sectionId, ["section"], []) . mconcat <$> mapM parseSectionChild (elChildren e) modify $ \st -> st{ fb2SectionLevel = n } pure bs parseSectionChild :: PandocMonad m => Element -> FB2 m Blocks parseSectionChild e =- case T.pack $ qName $ elName e of+ case qName $ elName e of "title" -> parseBodyChild e "epigraph" -> parseEpigraph e "image" -> parseImageElement e@@ -361,16 +365,16 @@ parseNamedStyle :: PandocMonad m => Element -> FB2 m Inlines parseNamedStyle e = do content <- mconcat <$> mapM parseNamedStyleChild (elContent e)- let lang = maybeToList $ ("lang",) . T.pack <$> findAttr (QName "lang" Nothing (Just "xml")) e+ let lang = maybeToList $ ("lang",) <$> findAttr (QName "lang" Nothing (Just "xml")) e case findAttr (unqual "name") e of- Just name -> pure $ spanWith ("", [T.pack name], lang) content+ Just name -> pure $ spanWith ("", [name], lang) content Nothing -> do report $ IgnoredElement "link without required name" pure mempty parseNamedStyleChild :: PandocMonad m => Content -> FB2 m Inlines parseNamedStyleChild (Elem e) =- case T.pack $ qName (elName e) of+ case qName (elName e) of "strong" -> strong <$> parseStyleType e "emphasis" -> emph <$> parseStyleType e "style" -> parseNamedStyle e@@ -378,7 +382,7 @@ "strikethrough" -> strikeout <$> parseStyleType e "sub" -> subscript <$> parseStyleType e "sup" -> superscript <$> parseStyleType e- "code" -> pure $ code $ T.pack $ strContent e+ "code" -> pure $ code $ strContent e "image" -> parseInlineImageElement e name -> do report $ IgnoredElement $ name <> " in style"@@ -390,7 +394,7 @@ parseLinkType e = do content <- mconcat <$> mapM parseStyleLinkType (elContent e) notes <- gets fb2Notes- case T.pack <$> findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of+ case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of Just href -> case findAttr (QName "type" Nothing Nothing) e of Just "note" -> case M.lookup href notes of Nothing -> pure $ link href "" content@@ -417,15 +421,14 @@ -- | Parse @title-infoType@ parseTitleInfoChild :: PandocMonad m => Element -> FB2 m () parseTitleInfoChild e =- case T.pack $ qName (elName e) of+ case qName (elName e) of "genre" -> pure () "author" -> parseAuthor e >>= \author -> modify (\st -> st {fb2Authors = author:fb2Authors st})- "book-title" -> modify (setMeta "title" (text $ T.pack $ strContent e))+ "book-title" -> modify (setMeta "title" (text $ strContent e)) "annotation" -> parseAnnotation e >>= modify . setMeta "abstract" "keywords" -> modify (setMeta "keywords" (map (MetaString . trim) $ T.splitOn ","- $ T.pack $ strContent e))- "date" -> modify (setMeta "date" (text $ T.pack $ strContent e))+ "date" -> modify (setMeta "date" (text $ strContent e)) "coverpage" -> parseCoverPage e "lang" -> pure () "src-lang" -> pure ()@@ -439,7 +442,7 @@ Just img -> case href of Just src -> modify (setMeta "cover-image" (MetaString $ removeHash src)) Nothing -> pure ()- where href = T.pack <$> findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) img+ where href = findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) img Nothing -> pure () -- | Parse @inlineImageType@ element@@ -452,5 +455,5 @@ Nothing -> do report $ IgnoredElement "inline image without href" pure mempty- where alt = maybe mempty (str . T.pack) $ findAttr (unqual "alt") e- href = T.pack <$> findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e+ where alt = maybe mempty str $ findAttr (unqual "alt") e+ href = findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e
src/Text/Pandoc/Readers/HTML.hs view
@@ -19,14 +19,13 @@ , htmlInBalanced , isInlineTag , isBlockTag- , NamedTag(..) , isTextTag , isCommentTag ) where import Control.Applicative ((<|>)) import Control.Monad (guard, msum, mzero, unless, void)-import Control.Monad.Except (throwError)+import Control.Monad.Except (throwError, catchError) import Control.Monad.Reader (ask, asks, lift, local, runReaderT) import Data.ByteString.Base64 (encode) import Data.Char (isAlphaNum, isLetter)@@ -158,32 +157,64 @@ return mempty block :: PandocMonad m => TagParser m Blocks-block = do- res <- choice- [ eSection- , eSwitch B.para block- , mempty <$ eFootnote- , mempty <$ eTOC- , mempty <$ eTitlePage- , pPara- , pHeader- , pBlockQuote- , pCodeBlock- , pList- , pHrule- , pTable block- , pHtml- , pHead- , pBody- , pLineBlock- , pDiv- , pPlain- , pFigure- , pIframe- , pRawHtmlBlock- ]- trace (T.take 60 $ tshow $ B.toList res)- return res+block = ((do+ tag <- lookAhead (pSatisfy isBlockTag)+ exts <- getOption readerExtensions+ case tag of+ TagOpen name attr ->+ let type' = fromMaybe "" $+ lookup "type" attr <|> lookup "epub:type" attr+ epubExts = extensionEnabled Ext_epub_html_exts exts+ in+ case name of+ _ | name `elem` sectioningContent+ , epubExts+ , "chapter" `T.isInfixOf` type'+ -> eSection+ _ | epubExts+ , type' `elem` ["footnote", "rearnote"]+ -> mempty <$ eFootnote+ _ | epubExts+ , type' == "toc"+ -> mempty <$ eTOC+ _ | "titlepage" `T.isInfixOf` type'+ , name `elem` ("section" : groupingContent)+ -> mempty <$ eTitlePage+ "p" -> pPara+ "h1" -> pHeader+ "h2" -> pHeader+ "h3" -> pHeader+ "h4" -> pHeader+ "h5" -> pHeader+ "h6" -> pHeader+ "blockquote" -> pBlockQuote+ "pre" -> pCodeBlock+ "ul" -> pBulletList+ "ol" -> pOrderedList+ "dl" -> pDefinitionList+ "table" -> pTable block+ "hr" -> pHrule+ "html" -> pHtml+ "head" -> pHead+ "body" -> pBody+ "div"+ | extensionEnabled Ext_line_blocks exts+ , Just "line-block" <- lookup "class" attr+ -> pLineBlock+ | otherwise+ -> pDiv+ "section" -> pDiv+ "main" -> pDiv+ "figure" -> pFigure+ "iframe" -> pIframe+ "style" -> pRawHtmlBlock+ "textarea" -> pRawHtmlBlock+ "switch"+ | epubExts+ -> eSwitch B.para block+ _ -> mzero+ _ -> mzero) <|> pPlain <|> pRawHtmlBlock) >>= \res ->+ res <$ trace (T.take 60 $ tshow $ B.toList res) namespaces :: PandocMonad m => [(Text, TagParser m Inlines)] namespaces = [(mathMLNamespace, pMath True)]@@ -256,9 +287,6 @@ guard $ (lookup "type" attr <|> lookup "epub:type" attr) == Just "toc" void (pInTags tag block) -pList :: PandocMonad m => TagParser m Blocks-pList = pBulletList <|> pOrderedList <|> pDefinitionList- pBulletList :: PandocMonad m => TagParser m Blocks pBulletList = try $ do pSatisfy (matchTagOpen "ul" [])@@ -369,13 +397,15 @@ B.toList ils return $ B.lineBlock lns +isDivLike :: Text -> Bool+isDivLike "div" = True+isDivLike "section" = True+isDivLike "main" = True+isDivLike _ = False+ pDiv :: PandocMonad m => TagParser m Blocks pDiv = try $ do guardEnabled Ext_native_divs- let isDivLike "div" = True- isDivLike "section" = True- isDivLike "main" = True- isDivLike _ = False TagOpen tag attr' <- lookAhead $ pSatisfy $ tagOpen isDivLike (const True) let (ident, classes, kvs) = toAttr attr' contents <- pInTags tag block@@ -393,11 +423,17 @@ tag <- pSatisfy (tagOpen (=="iframe") (isJust . lookup "src")) pCloses "iframe" <|> eof url <- canonicalizeUrl $ fromAttrib "src" tag- (bs, _) <- openURL url- let inp = UTF8.toText bs- opts <- readerOpts <$> getState- Pandoc _ contents <- readHtml opts inp- return $ B.divWith ("",["iframe"],[]) $ B.fromList contents+ if T.null url+ then ignore $ renderTags' [tag, TagClose "iframe"]+ else catchError+ (do (bs, _) <- openURL url+ let inp = UTF8.toText bs+ opts <- readerOpts <$> getState+ Pandoc _ contents <- readHtml opts inp+ return $ B.divWith ("",["iframe"],[]) $ B.fromList contents)+ (\e -> do+ logMessage $ CouldNotFetchResource url (renderError e)+ ignore $ renderTags' [tag, TagClose "iframe"]) pRawHtmlBlock :: PandocMonad m => TagParser m Blocks pRawHtmlBlock = do@@ -538,31 +574,47 @@ tagToText _ = "" inline :: PandocMonad m => TagParser m Inlines-inline = choice- [ eNoteref- , eSwitch id inline- , pTagText- , pQ- , pEmph- , pStrong- , pSuperscript- , pSubscript- , pSpanLike- , pSmall- , pStrikeout- , pUnderline- , pLineBreak- , pLink- , pImage- , pSvg- , pBdo- , pCode- , pCodeWithClass [("samp","sample"),("var","variable")]- , pSpan- , pMath False- , pScriptMath- , pRawHtmlInline- ]+inline = pTagText <|> do+ tag <- lookAhead (pSatisfy isInlineTag)+ exts <- getOption readerExtensions+ case tag of+ TagOpen name attr ->+ case name of+ "a" | extensionEnabled Ext_epub_html_exts exts+ , Just "noteref" <- lookup "type" attr <|> lookup "epub:type" attr+ , Just ('#',_) <- lookup "href" attr >>= T.uncons+ -> eNoteref+ | otherwise -> pLink+ "switch" -> eSwitch id inline+ "q" -> pQ+ "em" -> pEmph+ "i" -> pEmph+ "strong" -> pStrong+ "b" -> pStrong+ "sup" -> pSuperscript+ "sub" -> pSubscript+ "small" -> pSmall+ "s" -> pStrikeout+ "strike" -> pStrikeout+ "del" -> pStrikeout+ "u" -> pUnderline+ "ins" -> pUnderline+ "br" -> pLineBreak+ "img" -> pImage+ "svg" -> pSvg+ "bdo" -> pBdo+ "code" -> pCode+ "samp" -> pCodeWithClass "samp" "sample"+ "var" -> pCodeWithClass "var" "variable"+ "span" -> pSpan+ "math" -> pMath False+ "script"+ | Just x <- lookup "type" attr+ , "math/tex" `T.isPrefixOf` x -> pScriptMath+ _ | name `elem` htmlSpanLikeElements -> pSpanLike+ _ -> pRawHtmlInline+ TagText _ -> pTagText+ _ -> pRawHtmlInline pSelfClosing :: PandocMonad m => (Text -> Bool) -> ([Attribute Text] -> Bool)@@ -573,27 +625,25 @@ return open pQ :: PandocMonad m => TagParser m Inlines-pQ = choice $ map try [citedQuote, normalQuote]- where citedQuote = do- tag <- pSatisfy $ tagOpenLit "q" (any ((=="cite") . fst))-- url <- canonicalizeUrl $ fromAttrib "cite" tag- let uid = fromMaybe (fromAttrib "name" tag) $- maybeFromAttrib "id" tag- let cls = T.words $ fromAttrib "class" tag-- makeQuote $ B.spanWith (uid, cls, [("cite", escapeURI url)])- normalQuote = do- pSatisfy $ tagOpenLit "q" (const True)- makeQuote id- makeQuote wrapper = do- ctx <- asks quoteContext- let (constructor, innerContext) = case ctx of- InDoubleQuote -> (B.singleQuoted, InSingleQuote)- _ -> (B.doubleQuoted, InDoubleQuote)-- content <- withQuoteContext innerContext (mconcat <$> manyTill inline (pCloses "q"))- return $ extractSpaces (constructor . wrapper) content+pQ = do+ TagOpen _ attrs <- pSatisfy $ tagOpenLit "q" (const True)+ case lookup "cite" attrs of+ Just url -> do+ let uid = fromMaybe mempty $+ lookup "name" attrs <> lookup "id" attrs+ let cls = maybe [] T.words $ lookup "class" attrs+ url' <- canonicalizeUrl url+ makeQuote $ B.spanWith (uid, cls, [("cite", escapeURI url')])+ Nothing -> makeQuote id+ where+ makeQuote wrapper = do+ ctx <- asks quoteContext+ let (constructor, innerContext) = case ctx of+ InDoubleQuote -> (B.singleQuoted, InSingleQuote)+ _ -> (B.doubleQuoted, InDoubleQuote)+ content <- withQuoteContext innerContext+ (mconcat <$> manyTill inline (pCloses "q"))+ return $ extractSpaces (constructor . wrapper) content pEmph :: PandocMonad m => TagParser m Inlines pEmph = pInlinesInTags "em" B.emph <|> pInlinesInTags "i" B.emph@@ -684,13 +734,12 @@ UTF8.toText (encode $ UTF8.fromText rawText) return $ B.imageWith (ident,cls,[]) svgData mempty mempty -pCodeWithClass :: PandocMonad m => [(T.Text,Text)] -> TagParser m Inlines-pCodeWithClass elemToClass = try $ do- let tagTest = flip elem . fmap fst $ elemToClass- TagOpen open attr' <- pSatisfy $ tagOpen tagTest (const True)+pCodeWithClass :: PandocMonad m => Text -> Text -> TagParser m Inlines+pCodeWithClass name class' = try $ do+ TagOpen open attr' <- pSatisfy $ tagOpen (== name) (const True) result <- manyTill pAny (pCloses open) let (ids,cs,kvs) = toAttr attr'- cs' = maybe cs (:cs) . lookup open $ elemToClass+ cs' = class' : cs return . B.codeWith (ids,cs',kvs) . T.unwords . T.lines . innerText $ result @@ -881,27 +930,21 @@ then return B.softbreak else return B.space -class NamedTag a where- getTagName :: a -> Maybe Text--instance NamedTag (Tag Text) where- getTagName (TagOpen t _) = Just t- getTagName (TagClose t) = Just t- getTagName _ = Nothing--instance NamedTag (Tag String) where- getTagName (TagOpen t _) = Just (T.pack t)- getTagName (TagClose t) = Just (T.pack t)- getTagName _ = Nothing+getTagName :: Tag Text -> Maybe Text+getTagName (TagOpen t _) = Just t+getTagName (TagClose t) = Just t+getTagName _ = Nothing -isInlineTag :: NamedTag (Tag a) => Tag a -> Bool+isInlineTag :: Tag Text -> Bool isInlineTag t =- isCommentTag t || case getTagName t of- Nothing -> False- Just x -> x `Set.notMember` blockTags ||- T.take 1 x == "?" -- processing instr.+ isCommentTag t ||+ case getTagName t of+ Nothing -> False+ Just "script" -> "math/tex" `T.isPrefixOf` fromAttrib "type" t+ Just x -> x `Set.notMember` blockTags ||+ T.take 1 x == "?" -- processing instr. -isBlockTag :: NamedTag (Tag a) => Tag a -> Bool+isBlockTag :: Tag Text -> Bool isBlockTag t = isBlockTagName || isTagComment t where isBlockTagName = case getTagName t of@@ -912,10 +955,10 @@ || x `Set.member` eitherBlockOrInline Nothing -> False -isTextTag :: Tag a -> Bool+isTextTag :: Tag Text -> Bool isTextTag = tagText (const True) -isCommentTag :: Tag a -> Bool+isCommentTag :: Tag Text -> Bool isCommentTag = tagComment (const True) --- parsers for use in markdown, textile readers@@ -964,7 +1007,7 @@ go n (t:ts') = (t :) <$> go n ts' go _ [] = mzero -hasTagWarning :: [Tag a] -> Bool+hasTagWarning :: [Tag Text] -> Bool hasTagWarning (TagWarning _:_) = True hasTagWarning _ = False
src/Text/Pandoc/Readers/JATS.hs view
@@ -14,7 +14,9 @@ module Text.Pandoc.Readers.JATS ( readJATS ) where import Control.Monad.State.Strict-import Data.Char (isDigit, isSpace, toUpper)+import Control.Monad.Except (throwError)+import Text.Pandoc.Error (PandocError(..))+import Data.Char (isDigit, isSpace) import Data.Default import Data.Generics import Data.List (foldl', intersperse)@@ -22,13 +24,14 @@ import Data.Maybe (maybeToList, fromMaybe) import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import Text.HTML.TagSoup.Entity (lookupEntity) import Text.Pandoc.Builder import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Options import Text.Pandoc.Shared (crFilter, safeRead, extractSpaces) import Text.TeXMath (readMathML, writeTeX)-import Text.XML.Light+import Text.Pandoc.XML.Light import qualified Data.Set as S (fromList, member) import Data.Set ((\\)) @@ -51,40 +54,22 @@ readJATS :: PandocMonad m => ReaderOptions -> Text -> m Pandoc readJATS _ inp = do- let tree = normalizeTree . parseXML- $ T.unpack $ crFilter inp+ tree <- either (throwError . PandocXMLError "") return $+ parseXMLContents (TL.fromStrict $ crFilter inp) (bs, st') <- flip runStateT (def{ jatsContent = tree }) $ mapM parseBlock tree return $ Pandoc (jatsMeta st') (toList . mconcat $ bs) --- normalize input, consolidating adjacent Text and CRef elements-normalizeTree :: [Content] -> [Content]-normalizeTree = everywhere (mkT go)- where go :: [Content] -> [Content]- go (Text (CData CDataRaw _ _):xs) = xs- go (Text (CData CDataText s1 z):Text (CData CDataText s2 _):xs) =- Text (CData CDataText (s1 ++ s2) z):xs- go (Text (CData CDataText s1 z):CRef r:xs) =- Text (CData CDataText (s1 ++ convertEntity r) z):xs- go (CRef r:Text (CData CDataText s1 z):xs) =- Text (CData CDataText (convertEntity r ++ s1) z):xs- go (CRef r1:CRef r2:xs) =- Text (CData CDataText (convertEntity r1 ++ convertEntity r2) Nothing):xs- go xs = xs--convertEntity :: String -> String-convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e)- -- convenience function to get an attribute value, defaulting to ""-attrValue :: String -> Element -> Text+attrValue :: Text -> Element -> Text attrValue attr = fromMaybe "" . maybeAttrValue attr -maybeAttrValue :: String -> Element -> Maybe Text+maybeAttrValue :: Text -> Element -> Maybe Text maybeAttrValue attr elt =- T.pack <$> lookupAttrBy (\x -> qName x == attr) (elAttribs elt)+ lookupAttrBy (\x -> qName x == attr) (elAttribs elt) -- convenience function-named :: String -> Element -> Bool+named :: Text -> Element -> Bool named s e = qName (elName e) == s --@@ -150,10 +135,10 @@ parseBlock :: PandocMonad m => Content -> JATS m Blocks parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE-parseBlock (Text (CData _ s _)) = if all isSpace s+parseBlock (Text (CData _ s _)) = if T.all isSpace s then return mempty- else return $ plain $ trimInlines $ text $ T.pack s-parseBlock (CRef x) = return $ plain $ str $ T.toUpper $ T.pack x+ else return $ plain $ trimInlines $ text s+parseBlock (CRef x) = return $ plain $ str $ T.toUpper x parseBlock (Elem e) = case qName (elName e) of "p" -> parseMixed para (elContent e)@@ -202,7 +187,7 @@ "" -> [] x -> [x] return $ codeBlockWith (attrValue "id" e, classes', [])- $ trimNl $ textContentRecursive e+ $ trimNl $ strContentRecursive e parseBlockquote = do attrib <- case filterChild (named "attribution") e of Nothing -> return mempty@@ -266,7 +251,7 @@ Just "center" -> AlignCenter _ -> AlignDefault let toWidth c = do- w <- findAttrText (unqual "colwidth") c+ w <- findAttr (unqual "colwidth") c n <- safeRead $ "0" <> T.filter (\x -> isDigit x || x == '.') w if n > 0 then Just n else Nothing let numrows = foldl' max 0 $ map length bodyrows@@ -437,16 +422,10 @@ Nothing -> return $ Map.insert "id" (toMetaValue refId) mempty -- TODO handle mixed-citation -findAttrText :: QName -> Element -> Maybe Text-findAttrText x = fmap T.pack . findAttr x- textContent :: Element -> Text-textContent = T.pack . strContent--textContentRecursive :: Element -> Text-textContentRecursive = T.pack . strContentRecursive+textContent = strContent -strContentRecursive :: Element -> String+strContentRecursive :: Element -> Text strContentRecursive = strContent . (\e' -> e'{ elContent = map elementToStr $ elContent e' }) @@ -455,9 +434,9 @@ elementToStr x = x parseInline :: PandocMonad m => Content -> JATS m Inlines-parseInline (Text (CData _ s _)) = return $ text $ T.pack s-parseInline (CRef ref) =- return . text . maybe (T.toUpper $ T.pack ref) T.pack $ lookupEntity ref+parseInline (Text (CData _ s _)) = return $ text s+parseInline (CRef ref) = return $ maybe (text $ T.toUpper ref) (text . T.pack)+ $ lookupEntity (T.unpack ref) parseInline (Elem e) = case qName (elName e) of "italic" -> innerInlines emph@@ -502,9 +481,9 @@ else linkWith attr ("#" <> rid) "" ils "ext-link" -> do ils <- innerInlines id- let title = fromMaybe "" $ findAttrText (QName "title" (Just "http://www.w3.org/1999/xlink") Nothing) e+ let title = fromMaybe "" $ findAttr (QName "title" (Just "http://www.w3.org/1999/xlink") Nothing) e let href = case findAttr (QName "href" (Just "http://www.w3.org/1999/xlink") Nothing) e of- Just h -> T.pack h+ Just h -> h _ -> "#" <> attrValue "rid" e let ils' = if ils == mempty then str href else ils let attr = (attrValue "id" e, [], [])@@ -524,7 +503,7 @@ where innerInlines f = extractSpaces f . mconcat <$> mapM parseInline (elContent e) mathML x =- case readMathML . T.pack . showElement $ everywhere (mkT removePrefix) x of+ case readMathML . showElement $ everywhere (mkT removePrefix) x of Left _ -> mempty Right m -> writeTeX m formula constructor = do@@ -542,4 +521,4 @@ let classes' = case attrValue "language" e of "" -> [] l -> [l]- return $ codeWith (attrValue "id" e,classes',[]) $ textContentRecursive e+ return $ codeWith (attrValue "id" e,classes',[]) $ strContentRecursive e
src/Text/Pandoc/Readers/LaTeX.hs view
@@ -1,2434 +1,1263 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}-{- |- Module : Text.Pandoc.Readers.LaTeX- Copyright : Copyright (C) 2006-2021 John MacFarlane- License : GNU GPL, version 2 or above-- Maintainer : John MacFarlane <jgm@berkeley.edu>- Stability : alpha- Portability : portable--Conversion of LaTeX to 'Pandoc' document.---}-module Text.Pandoc.Readers.LaTeX ( readLaTeX,- applyMacros,- rawLaTeXInline,- rawLaTeXBlock,- inlineCommand,- tokenize,- untokenize- ) where--import Control.Applicative (many, optional, (<|>))-import Control.Monad-import Control.Monad.Except (throwError)-import Data.Char (isDigit, isLetter, toUpper, chr)-import Data.Default-import Data.Functor (($>))-import Data.List (intercalate)-import qualified Data.Map as M-import Data.Maybe (fromMaybe, maybeToList)-import qualified Data.Set as Set-import qualified Data.Sequence as Seq-import Data.Text (Text)-import qualified Data.Text as T-import System.FilePath (addExtension, replaceExtension, takeExtension)-import Text.Pandoc.BCP47 (Lang (..), renderLang)-import Text.Pandoc.Builder-import Text.Pandoc.Class.PandocPure (PandocPure)-import Text.Pandoc.Class.PandocMonad (PandocMonad (..), getResourcePath,- readFileFromDirs, report, setResourcePath,- setTranslations, translateTerm)-import Text.Pandoc.Error (PandocError (PandocParseError, PandocParsecError))-import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)-import Text.Pandoc.ImageSize (numUnit, showFl)-import Text.Pandoc.Logging-import Text.Pandoc.Options-import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,- optional, space, spaces, withRaw, (<|>))-import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),- ArgSpec (..), Tok (..), TokType (..))-import Text.Pandoc.Readers.LaTeX.Parsing-import Text.Pandoc.Readers.LaTeX.Lang (polyglossiaLangToBCP47,- babelLangToBCP47)-import Text.Pandoc.Readers.LaTeX.SIunitx-import Text.Pandoc.Shared-import qualified Text.Pandoc.Translations as Translations-import Text.Pandoc.Walk-import qualified Text.Pandoc.Builder as B-import qualified Data.Text.Normalize as Normalize-import Safe---- for debugging:--- import Text.Pandoc.Extensions (getDefaultExtensions)--- import Text.Pandoc.Class.PandocIO (runIOorExplode, PandocIO)--- import Debug.Trace (traceShowId)---- | Parse LaTeX from string and return 'Pandoc' document.-readLaTeX :: PandocMonad m- => ReaderOptions -- ^ Reader options- -> Text -- ^ String to parse (assumes @'\n'@ line endings)- -> m Pandoc-readLaTeX opts ltx = do- parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"- (tokenize "source" (crFilter ltx))- case parsed of- Right result -> return result- Left e -> throwError $ PandocParsecError ltx e--parseLaTeX :: PandocMonad m => LP m Pandoc-parseLaTeX = do- bs <- blocks- eof- st <- getState- let meta = sMeta st- 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 adjustHeaders m (Header n attr ils) = Header (n+m) attr ils- adjustHeaders _ x = x- let (Pandoc _ bs') =- -- handle the case where you have \part or \chapter- (if bottomLevel < 1- then walk (adjustHeaders (1 - bottomLevel))- else id) $- walk (resolveRefs (sLabels st)) doc'- return $ Pandoc meta bs'--resolveRefs :: M.Map Text [Inline] -> Inline -> Inline-resolveRefs labels x@(Link (ident,classes,kvs) _ _) =- case (lookup "reference-type" kvs,- lookup "reference" kvs) of- (Just "ref", Just lab) ->- case M.lookup lab labels of- Just txt -> Link (ident,classes,kvs) txt ("#" <> lab, "")- Nothing -> x- _ -> x-resolveRefs _ x = x----- testParser :: LP PandocIO a -> Text -> IO a--- testParser p t = do--- res <- runIOorExplode (runParserT p defaultLaTeXState{--- sOptions = def{ readerExtensions =--- enableExtension Ext_raw_tex $--- getDefaultExtensions "latex" }} "source" (tokenize "source" t))--- case res of--- Left e -> error (show e)--- Right r -> return r---rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)- => ParserT Text s m Text-rawLaTeXBlock = do- lookAhead (try (char '\\' >> letter))- inp <- getInput- let toks = tokenize "source" inp- snd <$> (rawLaTeXParser toks False (macroDef (const mempty)) blocks- <|> rawLaTeXParser toks True- (do choice (map controlSeq- ["include", "input", "subfile", "usepackage"])- skipMany opt- braced- return mempty) blocks- <|> rawLaTeXParser toks True- (environment <|> blockCommand)- (mconcat <$> many (block <|> beginOrEndCommand)))---- See #4667 for motivation; sometimes people write macros--- that just evaluate to a begin or end command, which blockCommand--- won't accept.-beginOrEndCommand :: PandocMonad m => LP m Blocks-beginOrEndCommand = try $ do- Tok _ (CtrlSeq name) txt <- anyControlSeq- guard $ name == "begin" || name == "end"- (envname, rawargs) <- withRaw braced- if M.member (untokenize envname)- (inlineEnvironments :: M.Map Text (LP PandocPure Inlines))- then mzero- else return $ rawBlock "latex"- (txt <> untokenize rawargs)--rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)- => ParserT Text s m Text-rawLaTeXInline = do- lookAhead (try (char '\\' >> letter))- inp <- getInput- let toks = tokenize "source" inp- raw <- snd <$>- ( rawLaTeXParser toks True- (mempty <$ (controlSeq "input" >> skipMany opt >> braced))- inlines- <|> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')- inlines- )- finalbraces <- mconcat <$> many (try (string "{}")) -- see #5439- return $ raw <> T.pack finalbraces--inlineCommand :: PandocMonad m => ParserT Text ParserState m Inlines-inlineCommand = do- lookAhead (try (char '\\' >> letter))- inp <- getInput- let toks = tokenize "source" inp- fst <$> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')- inlines---- inline elements:--word :: PandocMonad m => LP m Inlines-word = str . untoken <$> satisfyTok isWordTok--regularSymbol :: PandocMonad m => LP m Inlines-regularSymbol = str . untoken <$> satisfyTok isRegularSymbol- where isRegularSymbol (Tok _ Symbol t) = not $ T.any isSpecial t- isRegularSymbol _ = False- isSpecial c = c `Set.member` specialChars--inlineGroup :: PandocMonad m => LP m Inlines-inlineGroup = do- ils <- grouped inline- if null ils- then return mempty- else return $ spanWith nullAttr ils- -- we need the span so we can detitlecase bibtex entries;- -- we need to know when something is {C}apitalized--doLHSverb :: PandocMonad m => LP m Inlines-doLHSverb =- codeWith ("",["haskell"],[]) . untokenize- <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')--mkImage :: PandocMonad m => [(Text, Text)] -> Text -> LP m Inlines-mkImage options (T.unpack -> src) = do- let replaceTextwidth (k,v) =- case numUnit v of- Just (num, "\\textwidth") -> (k, showFl (num * 100) <> "%")- _ -> (k, v)- let kvs = map replaceTextwidth- $ filter (\(k,_) -> k `elem` ["width", "height"]) options- let attr = ("",[], kvs)- let alt = str "image"- defaultExt <- getOption readerDefaultImageExtension- let exts' = [".pdf", ".png", ".jpg", ".mps", ".jpeg", ".jbig2", ".jb2"]- let exts = exts' ++ map (map toUpper) exts'- let findFile s [] = return s- findFile s (e:es) = do- let s' = addExtension s e- exists <- fileExists s'- if exists- then return s'- else findFile s es- src' <- case takeExtension src of- "" | not (T.null defaultExt) -> return $ addExtension src $ T.unpack defaultExt- | otherwise -> findFile src exts- _ -> return src- return $ imageWith attr (T.pack src') "" alt--doxspace :: PandocMonad m => LP m Inlines-doxspace =- (space <$ lookAhead (satisfyTok startsWithLetter)) <|> return mempty- where startsWithLetter (Tok _ Word t) =- case T.uncons t of- Just (c, _) | isLetter c -> True- _ -> False- startsWithLetter _ = False---lit :: Text -> LP m Inlines-lit = pure . str--removeDoubleQuotes :: Text -> Text-removeDoubleQuotes t =- Data.Maybe.fromMaybe t $ T.stripPrefix "\"" t >>= T.stripSuffix "\""--doubleQuote :: PandocMonad m => LP m Inlines-doubleQuote =- quoted' doubleQuoted (try $ count 2 $ symbol '`')- (void $ try $ count 2 $ symbol '\'')- <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')- -- the following is used by babel for localized quotes:- <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])- (void $ try $ sequence [symbol '"', symbol '\''])--singleQuote :: PandocMonad m => LP m Inlines-singleQuote =- quoted' singleQuoted ((:[]) <$> symbol '`')- (try $ symbol '\'' >>- notFollowedBy (satisfyTok startsWithLetter))- <|> quoted' singleQuoted ((:[]) <$> symbol '‘')- (try $ symbol '’' >>- notFollowedBy (satisfyTok startsWithLetter))- where startsWithLetter (Tok _ Word t) =- case T.uncons t of- Just (c, _) | isLetter c -> True- _ -> False- startsWithLetter _ = False--quoted' :: PandocMonad m- => (Inlines -> Inlines)- -> LP m [Tok]- -> LP m ()- -> LP m Inlines-quoted' f starter ender = do- startchs <- untokenize <$> starter- smart <- extensionEnabled Ext_smart <$> getOption readerExtensions- if smart- then do- ils <- many (notFollowedBy ender >> inline)- (ender >> return (f (mconcat ils))) <|>- (<> mconcat ils) <$>- lit (case startchs of- "``" -> "“"- "`" -> "‘"- cs -> cs)- else lit startchs--enquote :: PandocMonad m => Bool -> Maybe Text -> LP m Inlines-enquote starred mblang = do- skipopts- let lang = mblang >>= babelLangToBCP47- let langspan = case lang of- Nothing -> id- Just l -> spanWith ("",[],[("lang", renderLang l)])- quoteContext <- sQuoteContext <$> getState- if starred || quoteContext == InDoubleQuote- then singleQuoted . langspan <$> withQuoteContext InSingleQuote tok- else doubleQuoted . langspan <$> withQuoteContext InDoubleQuote tok--blockquote :: PandocMonad m => Bool -> Maybe Text -> LP m Blocks-blockquote cvariant mblang = do- citepar <- if cvariant- then (\xs -> para (cite xs mempty))- <$> cites NormalCitation False- else option mempty $ para <$> bracketed inline- let lang = mblang >>= babelLangToBCP47- let langdiv = case lang of- Nothing -> id- Just l -> divWith ("",[],[("lang", renderLang l)])- _closingPunct <- option mempty $ bracketed inline -- currently ignored- bs <- grouped block- optional $ symbolIn (".:;?!" :: [Char]) -- currently ignored- return $ blockQuote . langdiv $ (bs <> citepar)--doAcronym :: PandocMonad m => Text -> LP m Inlines-doAcronym form = do- acro <- braced- return . mconcat $ [spanWith ("",[],[("acronym-label", untokenize acro),- ("acronym-form", "singular+" <> form)])- $ str $ untokenize acro]--doAcronymPlural :: PandocMonad m => Text -> LP m Inlines-doAcronymPlural form = do- acro <- braced- plural <- lit "s"- return . mconcat $ [spanWith ("",[],[("acronym-label", untokenize acro),- ("acronym-form", "plural+" <> form)]) $- mconcat [str $ untokenize acro, plural]]--doverb :: PandocMonad m => LP m Inlines-doverb = do- Tok _ Symbol t <- anySymbol- marker <- case T.uncons t of- Just (c, ts) | T.null ts -> return c- _ -> mzero- withVerbatimMode $- code . untokenize <$>- manyTill (notFollowedBy newlineTok >> verbTok marker) (symbol marker)--verbTok :: PandocMonad m => Char -> LP m Tok-verbTok stopchar = do- t@(Tok pos toktype txt) <- anyTok- case T.findIndex (== stopchar) txt of- Nothing -> return t- Just i -> do- let (t1, t2) = T.splitAt i txt- inp <- getInput- setInput $ Tok (incSourceColumn pos i) Symbol (T.singleton stopchar)- : totoks (incSourceColumn pos (i + 1)) (T.drop 1 t2) ++ inp- return $ Tok pos toktype t1--listingsLanguage :: [(Text, Text)] -> Maybe Text-listingsLanguage opts =- case lookup "language" opts of- Nothing -> Nothing- Just l -> fromListingsLanguage l `mplus` Just l--dolstinline :: PandocMonad m => LP m Inlines-dolstinline = do- options <- option [] keyvals- let classes = maybeToList $ listingsLanguage options- doinlinecode classes--domintinline :: PandocMonad m => LP m Inlines-domintinline = do- skipopts- cls <- untokenize <$> braced- doinlinecode [cls]--doinlinecode :: PandocMonad m => [Text] -> LP m Inlines-doinlinecode classes = do- Tok _ Symbol t <- anySymbol- marker <- case T.uncons t of- Just (c, ts) | T.null ts -> return c- _ -> mzero- let stopchar = if marker == '{' then '}' else marker- withVerbatimMode $- codeWith ("",classes,[]) . T.map nlToSpace . untokenize <$>- manyTill (verbTok stopchar) (symbol stopchar)--nlToSpace :: Char -> Char-nlToSpace '\n' = ' '-nlToSpace x = x--mathDisplay :: Text -> Inlines-mathDisplay = displayMath . trimMath--mathInline :: Text -> Inlines-mathInline = math . trimMath--dollarsMath :: PandocMonad m => LP m Inlines-dollarsMath = do- symbol '$'- display <- option False (True <$ symbol '$')- (do contents <- try $ untokenize <$> pDollarsMath 0- if display- then mathDisplay contents <$ symbol '$'- else return $ mathInline contents)- <|> (guard display >> return (mathInline ""))---- Int is number of embedded groupings-pDollarsMath :: PandocMonad m => Int -> LP m [Tok]-pDollarsMath n = do- tk@(Tok _ toktype t) <- anyTok- case toktype of- Symbol | t == "$"- , n == 0 -> return []- | t == "\\" -> do- tk' <- anyTok- (tk :) . (tk' :) <$> pDollarsMath n- | t == "{" -> (tk :) <$> pDollarsMath (n+1)- | t == "}" ->- if n > 0- then (tk :) <$> pDollarsMath (n-1)- else mzero- _ -> (tk :) <$> pDollarsMath n---- citations--addPrefix :: [Inline] -> [Citation] -> [Citation]-addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks-addPrefix _ _ = []--addSuffix :: [Inline] -> [Citation] -> [Citation]-addSuffix s ks@(_:_) =- let k = last ks- in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]-addSuffix _ _ = []--simpleCiteArgs :: PandocMonad m => LP m [Citation]-simpleCiteArgs = try $ do- first <- optionMaybe $ toList <$> opt- second <- optionMaybe $ toList <$> opt- keys <- try $ bgroup *> manyTill citationLabel egroup- let (pre, suf) = case (first , second ) of- (Just s , Nothing) -> (mempty, s )- (Just s , Just t ) -> (s , t )- _ -> (mempty, mempty)- conv k = Citation { citationId = k- , citationPrefix = []- , citationSuffix = []- , citationMode = NormalCitation- , citationHash = 0- , citationNoteNum = 0- }- return $ addPrefix pre $ addSuffix suf $ map conv keys--citationLabel :: PandocMonad m => LP m Text-citationLabel = do- sp- untokenize <$>- (many1 (satisfyTok isWordTok <|> symbolIn bibtexKeyChar)- <* sp- <* optional (symbol ',')- <* sp)- where bibtexKeyChar = ".:;?!`'()/*@_+=-&[]" :: [Char]--cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]-cites mode multi = try $ do- cits <- if multi- then do- multiprenote <- optionMaybe $ toList <$> paropt- multipostnote <- optionMaybe $ toList <$> paropt- let (pre, suf) = case (multiprenote, multipostnote) of- (Just s , Nothing) -> (mempty, s)- (Nothing , Just t) -> (mempty, t)- (Just s , Just t ) -> (s, t)- _ -> (mempty, mempty)- tempCits <- many1 simpleCiteArgs- case tempCits of- (k:ks) -> case ks of- (_:_) -> return $ (addMprenote pre k : init ks) ++- [addMpostnote suf (last ks)]- _ -> return [addMprenote pre (addMpostnote suf k)]- _ -> return [[]]- else count 1 simpleCiteArgs- let cs = concat cits- return $ case mode of- AuthorInText -> case cs of- (c:rest) -> c {citationMode = mode} : rest- [] -> []- _ -> map (\a -> a {citationMode = mode}) cs- where mprenote (k:ks) = (k:ks) ++ [Space]- mprenote _ = mempty- mpostnote (k:ks) = [Str ",", Space] ++ (k:ks)- mpostnote _ = mempty- addMprenote mpn (k:ks) =- let mpnfinal = case citationPrefix k of- (_:_) -> mprenote mpn- _ -> mpn- in addPrefix mpnfinal (k:ks)- addMprenote _ _ = []- addMpostnote = addSuffix . mpostnote--citation :: PandocMonad m => Text -> CitationMode -> Bool -> LP m Inlines-citation name mode multi = do- (c,raw) <- withRaw $ cites mode multi- return $ cite c (rawInline "latex" $ "\\" <> name <> untokenize raw)--handleCitationPart :: Inlines -> [Citation]-handleCitationPart ils =- let isCite Cite{} = True- isCite _ = False- (pref, rest) = break isCite (toList ils)- in case rest of- (Cite cs _:suff) -> addPrefix pref $ addSuffix suff cs- _ -> []--complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines-complexNatbibCitation mode = try $ do- (cs, raw) <-- withRaw $ concat <$> do- bgroup- items <- mconcat <$>- many1 (notFollowedBy (symbol ';') >> inline)- `sepBy1` symbol ';'- egroup- return $ map handleCitationPart items- case cs of- [] -> mzero- (c:cits) -> return $ cite (c{ citationMode = mode }:cits)- (rawInline "latex" $ "\\citetext" <> untokenize raw)--inNote :: Inlines -> Inlines-inNote ils =- note $ para $ ils <> str "."--inlineCommand' :: PandocMonad m => LP m Inlines-inlineCommand' = try $ do- Tok _ (CtrlSeq name) cmd <- anyControlSeq- guard $ name /= "begin" && name /= "end" && name /= "and"- star <- option "" ("*" <$ symbol '*' <* sp)- overlay <- option "" overlaySpecification- let name' = name <> star <> overlay- let names = ordNub [name', name] -- check non-starred as fallback- let raw = do- guard $ isInlineCommand name || not (isBlockCommand name)- rawcommand <- getRawCommand name (cmd <> star)- (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))- <|> ignore rawcommand- lookupListDefault raw names inlineCommands---tok :: PandocMonad m => LP m Inlines-tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar'- where singleChar' = do- Tok _ _ t <- singleChar- return $ str t--opt :: PandocMonad m => LP m Inlines-opt = do- toks <- try (sp *> bracketedToks <* sp)- -- now parse the toks as inlines- st <- getState- parsed <- runParserT (mconcat <$> many inline) st "bracketed option" toks- case parsed of- Right result -> return result- Left e -> throwError $ PandocParsecError (untokenize toks) e--paropt :: PandocMonad m => LP m Inlines-paropt = parenWrapped inline--inBrackets :: Inlines -> Inlines-inBrackets x = str "[" <> x <> str "]"--unescapeURL :: Text -> Text-unescapeURL = T.concat . go . T.splitOn "\\"- where- isEscapable c = c `elemText` "#$%&~_^\\{}"- go (x:xs) = x : map unescapeInterior xs- go [] = []- unescapeInterior t- | Just (c, _) <- T.uncons t- , isEscapable c = t- | otherwise = "\\" <> t--mathEnvWith :: PandocMonad m- => (Inlines -> a) -> Maybe Text -> Text -> LP m a-mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name- where inner x = case innerEnv of- Nothing -> x- Just y -> "\\begin{" <> y <> "}\n" <> x <>- "\\end{" <> y <> "}"--mathEnv :: PandocMonad m => Text -> LP m Text-mathEnv name = do- skipopts- optional blankline- res <- manyTill anyTok (end_ name)- return $ stripTrailingNewlines $ untokenize res--inlineEnvironment :: PandocMonad m => LP m Inlines-inlineEnvironment = try $ do- controlSeq "begin"- name <- untokenize <$> braced- M.findWithDefault mzero name inlineEnvironments--inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)-inlineEnvironments = M.fromList [- ("displaymath", mathEnvWith id Nothing "displaymath")- , ("math", math <$> mathEnv "math")- , ("equation", mathEnvWith id Nothing "equation")- , ("equation*", mathEnvWith id Nothing "equation*")- , ("gather", mathEnvWith id (Just "gathered") "gather")- , ("gather*", mathEnvWith id (Just "gathered") "gather*")- , ("multline", mathEnvWith id (Just "gathered") "multline")- , ("multline*", mathEnvWith id (Just "gathered") "multline*")- , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")- , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")- , ("align", mathEnvWith id (Just "aligned") "align")- , ("align*", mathEnvWith id (Just "aligned") "align*")- , ("alignat", mathEnvWith id (Just "aligned") "alignat")- , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")- , ("dmath", mathEnvWith id Nothing "dmath")- , ("dmath*", mathEnvWith id Nothing "dmath*")- , ("dgroup", mathEnvWith id (Just "aligned") "dgroup")- , ("dgroup*", mathEnvWith id (Just "aligned") "dgroup*")- , ("darray", mathEnvWith id (Just "aligned") "darray")- , ("darray*", mathEnvWith id (Just "aligned") "darray*")- ]--inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)-inlineCommands = M.union inlineLanguageCommands $ M.fromList- [ ("emph", extractSpaces emph <$> tok)- , ("textit", extractSpaces emph <$> tok)- , ("textsl", extractSpaces emph <$> tok)- , ("textsc", extractSpaces smallcaps <$> tok)- , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)- , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)- , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)- , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)- , ("texttt", ttfamily)- , ("sout", extractSpaces strikeout <$> tok)- , ("alert", skipopts >> spanWith ("",["alert"],[]) <$> tok) -- beamer- , ("lq", return (str "‘"))- , ("rq", return (str "’"))- , ("textquoteleft", return (str "‘"))- , ("textquoteright", return (str "’"))- , ("textquotedblleft", return (str "“"))- , ("textquotedblright", return (str "”"))- , ("textsuperscript", extractSpaces superscript <$> tok)- , ("textsubscript", extractSpaces subscript <$> tok)- , ("textbackslash", lit "\\")- , ("backslash", lit "\\")- , ("slash", lit "/")- , ("textbf", extractSpaces strong <$> tok)- , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)- , ("underline", underline <$> tok)- , ("ldots", lit "…")- , ("vdots", lit "\8942")- , ("dots", lit "…")- , ("mdots", lit "…")- , ("sim", lit "~")- , ("sep", lit ",")- , ("label", rawInlineOr "label" dolabel)- , ("ref", rawInlineOr "ref" $ doref "ref")- , ("cref", rawInlineOr "cref" $ doref "ref") -- from cleveref.sty- , ("vref", rawInlineOr "vref" $ doref "ref+page") -- from varioref.sty- , ("eqref", rawInlineOr "eqref" $ doref "eqref") -- from amsmath.sty- , ("mbox", rawInlineOr "mbox" $ processHBox <$> tok)- , ("hbox", rawInlineOr "hbox" $ processHBox <$> tok)- , ("lettrine", rawInlineOr "lettrine" lettrine)- , ("(", mathInline . untokenize <$> manyTill anyTok (controlSeq ")"))- , ("[", mathDisplay . untokenize <$> manyTill anyTok (controlSeq "]"))- , ("ensuremath", mathInline . untokenize <$> braced)- , ("texorpdfstring", const <$> tok <*> tok)- , ("P", lit "¶")- , ("S", lit "§")- , ("$", lit "$")- , ("%", lit "%")- , ("&", lit "&")- , ("#", lit "#")- , ("_", lit "_")- , ("{", lit "{")- , ("}", lit "}")- , ("qed", lit "\a0\x25FB")- -- old TeX commands- , ("em", extractSpaces emph <$> inlines)- , ("it", extractSpaces emph <$> inlines)- , ("sl", extractSpaces emph <$> inlines)- , ("bf", extractSpaces strong <$> inlines)- , ("tt", code . stringify . toList <$> inlines)- , ("rm", inlines)- , ("itshape", extractSpaces emph <$> inlines)- , ("slshape", extractSpaces emph <$> inlines)- , ("scshape", extractSpaces smallcaps <$> inlines)- , ("bfseries", extractSpaces strong <$> inlines)- , ("MakeUppercase", makeUppercase <$> tok)- , ("MakeTextUppercase", makeUppercase <$> tok) -- textcase- , ("uppercase", makeUppercase <$> tok)- , ("MakeLowercase", makeLowercase <$> tok)- , ("MakeTextLowercase", makeLowercase <$> tok)- , ("lowercase", makeLowercase <$> tok)- , ("/", pure mempty) -- italic correction- , ("aa", lit "å")- , ("AA", lit "Å")- , ("ss", lit "ß")- , ("o", lit "ø")- , ("O", lit "Ø")- , ("L", lit "Ł")- , ("l", lit "ł")- , ("ae", lit "æ")- , ("AE", lit "Æ")- , ("oe", lit "œ")- , ("OE", lit "Œ")- , ("pounds", lit "£")- , ("euro", lit "€")- , ("copyright", lit "©")- , ("textasciicircum", lit "^")- , ("textasciitilde", lit "~")- , ("H", accent '\779' Nothing) -- hungarumlaut- , ("`", accent '\768' (Just '`')) -- grave- , ("'", accent '\769' (Just '\'')) -- acute- , ("^", accent '\770' (Just '^')) -- circ- , ("~", accent '\771' (Just '~')) -- tilde- , ("\"", accent '\776' Nothing) -- umlaut- , (".", accent '\775' Nothing) -- dot- , ("=", accent '\772' Nothing) -- macron- , ("|", accent '\781' Nothing) -- vertical line above- , ("b", accent '\817' Nothing) -- macron below- , ("c", accent '\807' Nothing) -- cedilla- , ("G", accent '\783' Nothing) -- doublegrave- , ("h", accent '\777' Nothing) -- hookabove- , ("d", accent '\803' Nothing) -- dotbelow- , ("f", accent '\785' Nothing) -- inverted breve- , ("r", accent '\778' Nothing) -- ringabove- , ("t", accent '\865' Nothing) -- double inverted breve- , ("U", accent '\782' Nothing) -- double vertical line above- , ("v", accent '\780' Nothing) -- hacek- , ("u", accent '\774' Nothing) -- breve- , ("k", accent '\808' Nothing) -- ogonek- , ("textogonekcentered", accent '\808' Nothing) -- ogonek- , ("i", lit "ı") -- dotless i- , ("j", lit "ȷ") -- dotless j- , ("newtie", accent '\785' Nothing) -- inverted breve- , ("textcircled", accent '\8413' Nothing) -- combining circle- , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState- guard $ not inTableCell- optional opt- spaces))- , (",", lit "\8198")- , ("@", pure mempty)- , (" ", lit "\160")- , ("ps", pure $ str "PS." <> space)- , ("TeX", lit "TeX")- , ("LaTeX", lit "LaTeX")- , ("bar", lit "|")- , ("textless", lit "<")- , ("textgreater", lit ">")- , ("thanks", skipopts >> note <$> grouped block)- , ("footnote", skipopts >> note <$> grouped block)- , ("passthrough", tok) -- \passthrough macro used by latex writer- -- for listings- , ("verb", doverb)- , ("lstinline", dolstinline)- , ("mintinline", domintinline)- , ("Verb", doverb)- , ("url", (\url -> link url "" (str url)) . unescapeURL . untokenize <$>- bracedUrl)- , ("nolinkurl", code . unescapeURL . untokenize <$> bracedUrl)- , ("href", do url <- bracedUrl- sp- link (unescapeURL $ untokenize url) "" <$> tok)- , ("includegraphics", do options <- option [] keyvals- src <- braced- mkImage options . unescapeURL . removeDoubleQuotes $- untokenize src)- , ("enquote*", enquote True Nothing)- , ("enquote", enquote False Nothing)- -- foreignquote is supposed to use native quote marks- , ("foreignquote*", braced >>= enquote True . Just . untokenize)- , ("foreignquote", braced >>= enquote False . Just . untokenize)- -- hypehnquote uses regular quotes- , ("hyphenquote*", braced >>= enquote True . Just . untokenize)- , ("hyphenquote", braced >>= enquote False . Just . untokenize)- , ("figurename", doTerm Translations.Figure)- , ("prefacename", doTerm Translations.Preface)- , ("refname", doTerm Translations.References)- , ("bibname", doTerm Translations.Bibliography)- , ("chaptername", doTerm Translations.Chapter)- , ("partname", doTerm Translations.Part)- , ("contentsname", doTerm Translations.Contents)- , ("listfigurename", doTerm Translations.ListOfFigures)- , ("listtablename", doTerm Translations.ListOfTables)- , ("indexname", doTerm Translations.Index)- , ("abstractname", doTerm Translations.Abstract)- , ("tablename", doTerm Translations.Table)- , ("enclname", doTerm Translations.Encl)- , ("ccname", doTerm Translations.Cc)- , ("headtoname", doTerm Translations.To)- , ("pagename", doTerm Translations.Page)- , ("seename", doTerm Translations.See)- , ("seealsoname", doTerm Translations.SeeAlso)- , ("proofname", doTerm Translations.Proof)- , ("glossaryname", doTerm Translations.Glossary)- , ("lstlistingname", doTerm Translations.Listing)- , ("cite", citation "cite" NormalCitation False)- , ("Cite", citation "Cite" NormalCitation False)- , ("citep", citation "citep" NormalCitation False)- , ("citep*", citation "citep*" NormalCitation False)- , ("citeal", citation "citeal" NormalCitation False)- , ("citealp", citation "citealp" NormalCitation False)- , ("citealp*", citation "citealp*" NormalCitation False)- , ("autocite", citation "autocite" NormalCitation False)- , ("smartcite", citation "smartcite" NormalCitation False)- , ("footcite", inNote <$> citation "footcite" NormalCitation False)- , ("parencite", citation "parencite" NormalCitation False)- , ("supercite", citation "supercite" NormalCitation False)- , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)- , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)- , ("citeyear", citation "citeyear" SuppressAuthor False)- , ("autocite*", citation "autocite*" SuppressAuthor False)- , ("cite*", citation "cite*" SuppressAuthor False)- , ("parencite*", citation "parencite*" SuppressAuthor False)- , ("textcite", citation "textcite" AuthorInText False)- , ("citet", citation "citet" AuthorInText False)- , ("citet*", citation "citet*" AuthorInText False)- , ("citealt", citation "citealt" AuthorInText False)- , ("citealt*", citation "citealt*" AuthorInText False)- , ("textcites", citation "textcites" AuthorInText True)- , ("cites", citation "cites" NormalCitation True)- , ("autocites", citation "autocites" NormalCitation True)- , ("footcites", inNote <$> citation "footcites" NormalCitation True)- , ("parencites", citation "parencites" NormalCitation True)- , ("supercites", citation "supercites" NormalCitation True)- , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)- , ("Autocite", citation "Autocite" NormalCitation False)- , ("Smartcite", citation "Smartcite" NormalCitation False)- , ("Footcite", inNote <$> citation "Footcite" NormalCitation False)- , ("Parencite", citation "Parencite" NormalCitation False)- , ("Supercite", citation "Supercite" NormalCitation False)- , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)- , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)- , ("Citeyear", citation "Citeyear" SuppressAuthor False)- , ("Autocite*", citation "Autocite*" SuppressAuthor False)- , ("Cite*", citation "Cite*" SuppressAuthor False)- , ("Parencite*", citation "Parencite*" SuppressAuthor False)- , ("Textcite", citation "Textcite" AuthorInText False)- , ("Textcites", citation "Textcites" AuthorInText True)- , ("Cites", citation "Cites" NormalCitation True)- , ("Autocites", citation "Autocites" NormalCitation True)- , ("Footcites", inNote <$> citation "Footcites" NormalCitation True)- , ("Parencites", citation "Parencites" NormalCitation True)- , ("Supercites", citation "Supercites" NormalCitation True)- , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)- , ("citetext", complexNatbibCitation NormalCitation)- , ("citeauthor", (try (tok *> sp *> controlSeq "citetext") *>- complexNatbibCitation AuthorInText)- <|> citation "citeauthor" AuthorInText False)- , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=- addMeta "nocite"))- , ("hyperlink", hyperlink)- , ("hypertarget", hypertargetInline)- -- glossaries package- , ("gls", doAcronym "short")- , ("Gls", doAcronym "short")- , ("glsdesc", doAcronym "long")- , ("Glsdesc", doAcronym "long")- , ("GLSdesc", doAcronym "long")- , ("acrlong", doAcronym "long")- , ("Acrlong", doAcronym "long")- , ("acrfull", doAcronym "full")- , ("Acrfull", doAcronym "full")- , ("acrshort", doAcronym "abbrv")- , ("Acrshort", doAcronym "abbrv")- , ("glspl", doAcronymPlural "short")- , ("Glspl", doAcronymPlural "short")- , ("glsdescplural", doAcronymPlural "long")- , ("Glsdescplural", doAcronymPlural "long")- , ("GLSdescplural", doAcronymPlural "long")- -- acronyms package- , ("ac", doAcronym "short")- , ("acf", doAcronym "full")- , ("acs", doAcronym "abbrv")- , ("acl", doAcronym "long")- , ("acp", doAcronymPlural "short")- , ("acfp", doAcronymPlural "full")- , ("acsp", doAcronymPlural "abbrv")- , ("aclp", doAcronymPlural "long")- , ("Ac", doAcronym "short")- , ("Acf", doAcronym "full")- , ("Acs", doAcronym "abbrv")- , ("Acl", doAcronym "long")- , ("Acp", doAcronymPlural "short")- , ("Acfp", doAcronymPlural "full")- , ("Acsp", doAcronymPlural "abbrv")- , ("Aclp", doAcronymPlural "long")- -- siuntix- , ("si", skipopts *> dosi tok)- , ("SI", doSI tok)- , ("SIrange", doSIrange True tok)- , ("numrange", doSIrange False tok)- , ("numlist", doSInumlist)- , ("num", doSInum)- , ("ang", doSIang)- -- hyphenat- , ("bshyp", lit "\\\173")- , ("fshyp", lit "/\173")- , ("dothyp", lit ".\173")- , ("colonhyp", lit ":\173")- , ("hyp", lit "-")- , ("nohyphens", tok)- , ("textnhtt", ttfamily)- , ("nhttfamily", ttfamily)- -- LaTeX colors- , ("textcolor", coloredInline "color")- , ("colorbox", coloredInline "background-color")- -- fontawesome- , ("faCheck", lit "\10003")- , ("faClose", lit "\10007")- -- xspace- , ("xspace", doxspace)- -- etoolbox- , ("ifstrequal", ifstrequal)- , ("newtoggle", braced >>= newToggle)- , ("toggletrue", braced >>= setToggle True)- , ("togglefalse", braced >>= setToggle False)- , ("iftoggle", try $ ifToggle >> inline)- -- biblatex misc- , ("RN", romanNumeralUpper)- , ("Rn", romanNumeralLower)- -- babel- , ("foreignlanguage", foreignlanguage)- -- include- , ("input", rawInlineOr "input" $ include "input")- -- soul package- , ("ul", underline <$> tok)- -- ulem package- , ("uline", underline <$> tok)- -- plain tex stuff that should just be passed through as raw tex- , ("ifdim", ifdim)- ]--accent :: PandocMonad m => Char -> Maybe Char -> LP m Inlines-accent combiningAccent fallBack = try $ do- ils <- tok- case toList ils of- (Str (T.uncons -> Just (x, xs)) : ys) -> return $ fromList $- -- try to normalize to the combined character:- Str (Normalize.normalize Normalize.NFC- (T.pack [x, combiningAccent]) <> xs) : ys- [Space] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack- [] -> return $ str $ T.singleton $ fromMaybe combiningAccent fallBack- _ -> return ils---lettrine :: PandocMonad m => LP m Inlines-lettrine = do- optional opt- x <- tok- y <- tok- return $ extractSpaces (spanWith ("",["lettrine"],[])) x <> smallcaps y--ifdim :: PandocMonad m => LP m Inlines-ifdim = do- contents <- manyTill anyTok (controlSeq "fi")- return $ rawInline "latex" $ "\\ifdim" <> untokenize contents <> "\\fi"--makeUppercase :: Inlines -> Inlines-makeUppercase = fromList . walk (alterStr T.toUpper) . toList--makeLowercase :: Inlines -> Inlines-makeLowercase = fromList . walk (alterStr T.toLower) . toList--alterStr :: (Text -> Text) -> Inline -> Inline-alterStr f (Str xs) = Str (f xs)-alterStr _ x = x--foreignlanguage :: PandocMonad m => LP m Inlines-foreignlanguage = do- babelLang <- untokenize <$> braced- case babelLangToBCP47 babelLang of- Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok- _ -> tok--inlineLanguageCommands :: PandocMonad m => M.Map Text (LP m Inlines)-inlineLanguageCommands = M.fromList $ mk <$> M.toList polyglossiaLangToBCP47- where- mk (polyglossia, bcp47Func) =- ("text" <> polyglossia, inlineLanguage bcp47Func)--inlineLanguage :: PandocMonad m => (Text -> Lang) -> LP m Inlines-inlineLanguage bcp47Func = do- o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')- <$> rawopt- let lang = renderLang $ bcp47Func o- extractSpaces (spanWith ("", [], [("lang", lang)])) <$> tok--hyperlink :: PandocMonad m => LP m Inlines-hyperlink = try $ do- src <- untokenize <$> braced- lab <- tok- return $ link ("#" <> src) "" lab--hypertargetBlock :: PandocMonad m => LP m Blocks-hypertargetBlock = try $ do- ref <- untokenize <$> braced- bs <- grouped block- case toList bs of- [Header 1 (ident,_,_) _] | ident == ref -> return bs- _ -> return $ divWith (ref, [], []) bs--hypertargetInline :: PandocMonad m => LP m Inlines-hypertargetInline = try $ do- ref <- untokenize <$> braced- ils <- grouped inline- return $ spanWith (ref, [], []) ils--romanNumeralUpper :: (PandocMonad m) => LP m Inlines-romanNumeralUpper =- str . toRomanNumeral <$> romanNumeralArg--romanNumeralLower :: (PandocMonad m) => LP m Inlines-romanNumeralLower =- str . T.toLower . toRomanNumeral <$> romanNumeralArg--romanNumeralArg :: (PandocMonad m) => LP m Int-romanNumeralArg = spaces *> (parser <|> inBraces)- where- inBraces = do- symbol '{'- spaces- res <- parser- spaces- symbol '}'- return res- parser = do- Tok _ Word s <- satisfyTok isWordTok- let (digits, rest) = T.span isDigit s- unless (T.null rest) $- Prelude.fail "Non-digits in argument to \\Rn or \\RN"- safeRead digits--newToggle :: (Monoid a, PandocMonad m) => [Tok] -> LP m a-newToggle name = do- updateState $ \st ->- st{ sToggles = M.insert (untokenize name) False (sToggles st) }- return mempty--setToggle :: (Monoid a, PandocMonad m) => Bool -> [Tok] -> LP m a-setToggle on name = do- updateState $ \st ->- st{ sToggles = M.adjust (const on) (untokenize name) (sToggles st) }- return mempty--ifToggle :: PandocMonad m => LP m ()-ifToggle = do- name <- braced- spaces- yes <- braced- spaces- no <- braced- toggles <- sToggles <$> getState- inp <- getInput- let name' = untokenize name- case M.lookup name' toggles of- Just True -> setInput (yes ++ inp)- Just False -> setInput (no ++ inp)- Nothing -> do- pos <- getPosition- report $ UndefinedToggle name' pos- return ()--doTerm :: PandocMonad m => Translations.Term -> LP m Inlines-doTerm term = str <$> translateTerm term--ifstrequal :: (PandocMonad m, Monoid a) => LP m a-ifstrequal = do- str1 <- tok- str2 <- tok- ifequal <- braced- ifnotequal <- braced- if str1 == str2- then getInput >>= setInput . (ifequal ++)- else getInput >>= setInput . (ifnotequal ++)- return mempty--coloredInline :: PandocMonad m => Text -> LP m Inlines-coloredInline stylename = do- skipopts- color <- braced- spanWith ("",[],[("style",stylename <> ": " <> untokenize color)]) <$> tok--ttfamily :: PandocMonad m => LP m Inlines-ttfamily = code . stringify . toList <$> tok--rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines-rawInlineOr name' fallback = do- parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions- if parseRaw- then rawInline "latex" <$> getRawCommand name' ("\\" <> name')- else fallback--processHBox :: Inlines -> Inlines-processHBox = walk convert- where- convert Space = Str $ T.singleton $ chr 160 -- non-breakable space- convert SoftBreak = Str $ T.singleton $ chr 160 -- non-breakable space- convert LineBreak = Str ""- convert x = x--isBlockCommand :: Text -> Bool-isBlockCommand s =- s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))- || s `Set.member` treatAsBlock--treatAsBlock :: Set.Set Text-treatAsBlock = Set.fromList- [ "special", "pdfannot", "pdfstringdef"- , "bibliographystyle"- , "maketitle", "makeindex", "makeglossary"- , "addcontentsline", "addtocontents", "addtocounter"- -- \ignore{} is used conventionally in literate haskell for definitions- -- that are to be processed by the compiler but not printed.- , "ignore"- , "hyperdef"- , "markboth", "markright", "markleft"- , "hspace", "vspace"- , "newpage"- , "clearpage"- , "pagebreak"- , "titleformat"- , "listoffigures"- , "listoftables"- , "write"- ]--isInlineCommand :: Text -> Bool-isInlineCommand s =- s `M.member` (inlineCommands :: M.Map Text (LP PandocPure Inlines))- || s `Set.member` treatAsInline--treatAsInline :: Set.Set Text-treatAsInline = Set.fromList- [ "index"- , "hspace"- , "vspace"- , "noindent"- , "newpage"- , "clearpage"- , "pagebreak"- ]--label :: PandocMonad m => LP m ()-label = do- controlSeq "label"- t <- braced- updateState $ \st -> st{ sLastLabel = Just $ untokenize t }--dolabel :: PandocMonad m => LP m Inlines-dolabel = do- v <- braced- let refstr = untokenize v- updateState $ \st ->- st{ sLastLabel = Just refstr }- return $ spanWith (refstr,[],[("label", refstr)])- $ inBrackets $ str $ untokenize v--doref :: PandocMonad m => Text -> LP m Inlines-doref cls = do- v <- braced- let refstr = untokenize v- return $ linkWith ("",[],[ ("reference-type", cls)- , ("reference", refstr)])- ("#" <> refstr)- ""- (inBrackets $ str refstr)--lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v-lookupListDefault d = (fromMaybe d .) . lookupList- where lookupList l m = msum $ map (`M.lookup` m) l--inline :: PandocMonad m => LP m Inlines-inline = (mempty <$ comment)- <|> (space <$ whitespace)- <|> (softbreak <$ endline)- <|> word- <|> macroDef (rawInline "latex")- <|> inlineCommand'- <|> inlineEnvironment- <|> inlineGroup- <|> (symbol '-' *>- option (str "-") (symbol '-' *>- option (str "–") (str "—" <$ symbol '-')))- <|> doubleQuote- <|> singleQuote- <|> (str "”" <$ try (symbol '\'' >> symbol '\''))- <|> (str "”" <$ symbol '”')- <|> (str "’" <$ symbol '\'')- <|> (str "’" <$ symbol '’')- <|> (str "\160" <$ symbol '~')- <|> dollarsMath- <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)- <|> (str . T.singleton <$> primEscape)- <|> regularSymbol- <|> (do res <- symbolIn "#^'`\"[]&"- pos <- getPosition- let s = untoken res- report $ ParsingUnescaped s pos- return $ str s)--inlines :: PandocMonad m => LP m Inlines-inlines = mconcat <$> many inline---- block elements:--preamble :: PandocMonad m => LP m Blocks-preamble = mconcat <$> many preambleBlock- where preambleBlock = (mempty <$ spaces1)- <|> macroDef (rawBlock "latex")- <|> filecontents- <|> (mempty <$ blockCommand)- <|> (mempty <$ braced)- <|> (do notFollowedBy (begin_ "document")- anyTok- return mempty)--rule :: PandocMonad m => LP m Blocks-rule = do- skipopts- width <- T.takeWhile (\c -> isDigit c || c == '.') . stringify <$> tok- _thickness <- tok- -- 0-width rules are used to fix spacing issues:- case safeRead width of- Just (0 :: Double) -> return mempty- _ -> return horizontalRule--paragraph :: PandocMonad m => LP m Blocks-paragraph = do- x <- trimInlines . mconcat <$> many1 inline- if x == mempty- then return mempty- else return $ para x--rawBlockOr :: PandocMonad m => Text -> LP m Blocks -> LP m Blocks-rawBlockOr name fallback = do- -- if raw_tex allowed, don't process- parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions- if parseRaw- then rawBlock "latex" <$> getRawCommand name ("\\" <> name)- else fallback--doSubfile :: PandocMonad m => LP m Blocks-doSubfile = do- skipMany opt- f <- T.unpack . removeDoubleQuotes . T.strip . untokenize <$> braced- oldToks <- getInput- setInput []- insertIncluded ".tex" f- bs <- blocks- eof- setInput oldToks- return bs--include :: (PandocMonad m, Monoid a) => Text -> LP m a-include name = do- skipMany opt- fs <- map (T.unpack . removeDoubleQuotes . T.strip) . T.splitOn "," .- untokenize <$> braced- let defaultExt | name == "usepackage" = ".sty"- | otherwise = ".tex"- mapM_ (insertIncluded defaultExt) fs- return mempty--readFileFromTexinputs :: PandocMonad m => FilePath -> LP m (Maybe Text)-readFileFromTexinputs fp = do- fileContentsMap <- sFileContents <$> getState- case M.lookup (T.pack fp) fileContentsMap of- Just t -> return (Just t)- Nothing -> do- dirs <- map T.unpack . splitTextBy (==':') . fromMaybe "."- <$> lookupEnv "TEXINPUTS"- readFileFromDirs dirs fp--insertIncluded :: PandocMonad m- => FilePath- -> FilePath- -> LP m ()-insertIncluded defaultExtension f' = do- let f = case takeExtension f' of- ".tex" -> f'- ".sty" -> f'- _ -> addExtension f' defaultExtension- pos <- getPosition- containers <- getIncludeFiles <$> getState- when (T.pack f `elem` containers) $- throwError $ PandocParseError $ T.pack $ "Include file loop at " ++ show pos- updateState $ addIncludeFile $ T.pack f- mbcontents <- readFileFromTexinputs f- contents <- case mbcontents of- Just s -> return s- Nothing -> do- report $ CouldNotLoadIncludeFile (T.pack f) pos- return ""- getInput >>= setInput . (tokenize f contents ++)- updateState dropLatestIncludeFile--addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> LP m ()-addMeta field val = updateState $ \st ->- st{ sMeta = addMetaField field val $ sMeta st }--authors :: PandocMonad m => LP m ()-authors = try $ do- bgroup- let oneAuthor = blocksToInlines' . B.toList . mconcat <$> many1 block- auths <- sepBy oneAuthor (controlSeq "and")- egroup- addMeta "author" (map trimInlines auths)--macroDef :: (PandocMonad m, Monoid a) => (Text -> a) -> LP m a-macroDef constructor = do- (_, s) <- withRaw (commandDef <|> environmentDef)- (constructor (untokenize s) <$- guardDisabled Ext_latex_macros)- <|> return mempty- where commandDef = do- (name, macro') <- newcommand <|> letmacro <|> defmacro- guardDisabled Ext_latex_macros <|>- updateState (\s -> s{ sMacros = M.insert name macro' (sMacros s) })- environmentDef = do- mbenv <- newenvironment- case mbenv of- Nothing -> return ()- Just (name, macro1, macro2) ->- guardDisabled Ext_latex_macros <|>- do updateState $ \s -> s{ sMacros =- M.insert name macro1 (sMacros s) }- updateState $ \s -> s{ sMacros =- M.insert ("end" <> name) macro2 (sMacros s) }- -- @\newenvironment{envname}[n-args][default]{begin}{end}@- -- is equivalent to- -- @\newcommand{\envname}[n-args][default]{begin}@- -- @\newcommand{\endenvname}@--letmacro :: PandocMonad m => LP m (Text, Macro)-letmacro = do- controlSeq "let"- (name, contents) <- withVerbatimMode $ do- Tok _ (CtrlSeq name) _ <- anyControlSeq- optional $ symbol '='- spaces- -- we first parse in verbatim mode, and then expand macros,- -- because we don't want \let\foo\bar to turn into- -- \let\foo hello if we have previously \def\bar{hello}- contents <- bracedOrToken- return (name, contents)- contents' <- doMacros' 0 contents- return (name, Macro ExpandWhenDefined [] Nothing contents')--defmacro :: PandocMonad m => LP m (Text, Macro)-defmacro = try $- -- we use withVerbatimMode, because macros are to be expanded- -- at point of use, not point of definition- withVerbatimMode $ do- controlSeq "def"- Tok _ (CtrlSeq name) _ <- anyControlSeq- argspecs <- many (argspecArg <|> argspecPattern)- contents <- bracedOrToken- return (name, Macro ExpandWhenUsed argspecs Nothing contents)--argspecArg :: PandocMonad m => LP m ArgSpec-argspecArg = do- Tok _ (Arg i) _ <- satisfyTok isArgTok- return $ ArgNum i--argspecPattern :: PandocMonad m => LP m ArgSpec-argspecPattern =- Pattern <$> many1 (satisfyTok (\(Tok _ toktype' txt) ->- (toktype' == Symbol || toktype' == Word) &&- (txt /= "{" && txt /= "\\" && txt /= "}")))--newcommand :: PandocMonad m => LP m (Text, Macro)-newcommand = do- pos <- getPosition- Tok _ (CtrlSeq mtype) _ <- controlSeq "newcommand" <|>- controlSeq "renewcommand" <|>- controlSeq "providecommand" <|>- controlSeq "DeclareMathOperator" <|>- controlSeq "DeclareRobustCommand"- withVerbatimMode $ do- Tok _ (CtrlSeq name) txt <- do- optional (symbol '*')- anyControlSeq <|>- (symbol '{' *> spaces *> anyControlSeq <* spaces <* symbol '}')- spaces- numargs <- option 0 $ try bracketedNum- let argspecs = map ArgNum [1..numargs]- spaces- optarg <- option Nothing $ Just <$> try bracketedToks- spaces- contents' <- bracedOrToken- let contents =- case mtype of- "DeclareMathOperator" ->- Tok pos (CtrlSeq "mathop") "\\mathop"- : Tok pos Symbol "{"- : Tok pos (CtrlSeq "mathrm") "\\mathrm"- : Tok pos Symbol "{"- : (contents' ++- [ Tok pos Symbol "}", Tok pos Symbol "}" ])- _ -> contents'- macros <- sMacros <$> getState- case M.lookup name macros of- Just macro- | mtype == "newcommand" -> do- report $ MacroAlreadyDefined txt pos- return (name, macro)- | mtype == "providecommand" -> return (name, macro)- _ -> return (name, Macro ExpandWhenUsed argspecs optarg contents)--newenvironment :: PandocMonad m => LP m (Maybe (Text, Macro, Macro))-newenvironment = do- pos <- getPosition- Tok _ (CtrlSeq mtype) _ <- controlSeq "newenvironment" <|>- controlSeq "renewenvironment" <|>- controlSeq "provideenvironment"- withVerbatimMode $ do- optional $ symbol '*'- spaces- name <- untokenize <$> braced- spaces- numargs <- option 0 $ try bracketedNum- spaces- optarg <- option Nothing $ Just <$> try bracketedToks- let argspecs = map (\i -> ArgNum i) [1..numargs]- startcontents <- spaces >> bracedOrToken- endcontents <- spaces >> bracedOrToken- macros <- sMacros <$> getState- case M.lookup name macros of- Just _- | mtype == "newenvironment" -> do- report $ MacroAlreadyDefined name pos- return Nothing- | mtype == "provideenvironment" ->- return Nothing- _ -> return $ Just (name,- Macro ExpandWhenUsed argspecs optarg startcontents,- Macro ExpandWhenUsed [] Nothing endcontents)--bracketedNum :: PandocMonad m => LP m Int-bracketedNum = do- ds <- untokenize <$> bracketedToks- case safeRead ds of- Just i -> return i- _ -> return 0--setCaption :: PandocMonad m => LP m ()-setCaption = try $ do- skipopts- ils <- tok- optional $ try $ spaces *> label- updateState $ \st -> st{ sCaption = Just ils }--looseItem :: PandocMonad m => LP m Blocks-looseItem = do- inListItem <- sInListItem <$> getState- guard $ not inListItem- skipopts- return mempty--epigraph :: PandocMonad m => LP m Blocks-epigraph = do- p1 <- grouped block- p2 <- grouped block- return $ divWith ("", ["epigraph"], []) (p1 <> p2)--resetCaption :: PandocMonad m => LP m ()-resetCaption = updateState $ \st -> st{ sCaption = Nothing- , sLastLabel = Nothing }--section :: PandocMonad m => Attr -> Int -> LP m Blocks-section (ident, classes, kvs) lvl = do- skipopts- contents <- grouped inline- lab <- option ident $- try (spaces >> controlSeq "label"- >> spaces >> untokenize <$> braced)- when (lvl == 0) $- updateState $ \st -> st{ sHasChapters = True }- unless ("unnumbered" `elem` classes) $ do- hn <- sLastHeaderNum <$> getState- hasChapters <- sHasChapters <$> getState- let lvl' = lvl + if hasChapters then 1 else 0- let num = incrementDottedNum lvl' hn- updateState $ \st -> st{ sLastHeaderNum = num- , sLabels = M.insert lab- [Str (renderDottedNum num)]- (sLabels st) }- attr' <- registerHeader (lab, classes, kvs) contents- return $ headerWith attr' lvl contents--blockCommand :: PandocMonad m => LP m Blocks-blockCommand = try $ do- Tok _ (CtrlSeq name) txt <- anyControlSeq- guard $ name /= "begin" && name /= "end" && name /= "and"- star <- option "" ("*" <$ symbol '*' <* sp)- let name' = name <> star- let names = ordNub [name', name]- let rawDefiniteBlock = do- guard $ isBlockCommand name- rawcontents <- getRawCommand name (txt <> star)- (guardEnabled Ext_raw_tex >> return (rawBlock "latex" rawcontents))- <|> ignore rawcontents- -- heuristic: if it could be either block or inline, we- -- treat it if block if we have a sequence of block- -- commands followed by a newline. But we stop if we- -- hit a \startXXX, since this might start a raw ConTeXt- -- environment (this is important because this parser is- -- used by the Markdown reader).- let startCommand = try $ do- Tok _ (CtrlSeq n) _ <- anyControlSeq- guard $ "start" `T.isPrefixOf` n- let rawMaybeBlock = try $ do- guard $ not $ isInlineCommand name- rawcontents <- getRawCommand name (txt <> star)- curr <- (guardEnabled Ext_raw_tex >>- return (rawBlock "latex" rawcontents))- <|> ignore rawcontents- rest <- many $ notFollowedBy startCommand *> blockCommand- lookAhead $ blankline <|> startCommand- return $ curr <> mconcat rest- let raw = rawDefiniteBlock <|> rawMaybeBlock- lookupListDefault raw names blockCommands--closing :: PandocMonad m => LP m Blocks-closing = do- contents <- tok- st <- getState- let extractInlines (MetaBlocks [Plain ys]) = ys- extractInlines (MetaBlocks [Para ys ]) = ys- extractInlines _ = []- let sigs = case lookupMeta "author" (sMeta st) of- Just (MetaList xs) ->- para $ trimInlines $ fromList $- intercalate [LineBreak] $ map extractInlines xs- _ -> mempty- return $ para (trimInlines contents) <> sigs--parbox :: PandocMonad m => LP m Blocks-parbox = try $ do- skipopts- braced -- size- oldInTableCell <- sInTableCell <$> getState- -- see #5711- updateState $ \st -> st{ sInTableCell = False }- res <- grouped block- updateState $ \st -> st{ sInTableCell = oldInTableCell }- return res--blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)-blockCommands = M.fromList- [ ("par", mempty <$ skipopts)- , ("parbox", parbox)- , ("title", mempty <$ (skipopts *>- (grouped inline >>= addMeta "title")- <|> (grouped block >>= addMeta "title")))- , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))- , ("author", mempty <$ (skipopts *> authors))- -- -- in letter class, temp. store address & sig as title, author- , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))- , ("signature", mempty <$ (skipopts *> authors))- , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))- , ("newtheorem", newtheorem)- , ("theoremstyle", theoremstyle)- -- KOMA-Script metadata commands- , ("extratitle", mempty <$ (skipopts *> tok >>= addMeta "extratitle"))- , ("frontispiece", mempty <$ (skipopts *> tok >>= addMeta "frontispiece"))- , ("titlehead", mempty <$ (skipopts *> tok >>= addMeta "titlehead"))- , ("subject", mempty <$ (skipopts *> tok >>= addMeta "subject"))- , ("publishers", mempty <$ (skipopts *> tok >>= addMeta "publishers"))- , ("uppertitleback", mempty <$ (skipopts *> tok >>= addMeta "uppertitleback"))- , ("lowertitleback", mempty <$ (skipopts *> tok >>= addMeta "lowertitleback"))- , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))- -- sectioning- , ("part", section nullAttr (-1))- , ("part*", section nullAttr (-1))- , ("chapter", section nullAttr 0)- , ("chapter*", section ("",["unnumbered"],[]) 0)- , ("section", section nullAttr 1)- , ("section*", section ("",["unnumbered"],[]) 1)- , ("subsection", section nullAttr 2)- , ("subsection*", section ("",["unnumbered"],[]) 2)- , ("subsubsection", section nullAttr 3)- , ("subsubsection*", section ("",["unnumbered"],[]) 3)- , ("paragraph", section nullAttr 4)- , ("paragraph*", section ("",["unnumbered"],[]) 4)- , ("subparagraph", section nullAttr 5)- , ("subparagraph*", section ("",["unnumbered"],[]) 5)- -- beamer slides- , ("frametitle", section nullAttr 3)- , ("framesubtitle", section nullAttr 4)- -- letters- , ("opening", para . trimInlines <$> (skipopts *> tok))- , ("closing", skipopts *> closing)- -- memoir- , ("plainbreak", braced >> pure horizontalRule)- , ("plainbreak*", braced >> pure horizontalRule)- , ("fancybreak", braced >> pure horizontalRule)- , ("fancybreak*", braced >> pure horizontalRule)- , ("plainfancybreak", braced >> braced >> braced >> pure horizontalRule)- , ("plainfancybreak*", braced >> braced >> braced >> pure horizontalRule)- , ("pfbreak", pure horizontalRule)- , ("pfbreak*", pure horizontalRule)- --- , ("hrule", pure horizontalRule)- , ("strut", pure mempty)- , ("rule", rule)- , ("item", looseItem)- , ("documentclass", skipopts *> braced *> preamble)- , ("centerline", para . trimInlines <$> (skipopts *> tok))- , ("caption", mempty <$ setCaption)- , ("bibliography", mempty <$ (skipopts *> braced >>=- addMeta "bibliography" . splitBibs . untokenize))- , ("addbibresource", mempty <$ (skipopts *> braced >>=- addMeta "bibliography" . splitBibs . untokenize))- , ("endinput", mempty <$ skipMany anyTok)- -- includes- , ("lstinputlisting", inputListing)- , ("inputminted", inputMinted)- , ("graphicspath", graphicsPath)- -- polyglossia- , ("setdefaultlanguage", setDefaultLanguage)- , ("setmainlanguage", setDefaultLanguage)- -- hyperlink- , ("hypertarget", hypertargetBlock)- -- LaTeX colors- , ("textcolor", coloredBlock "color")- , ("colorbox", coloredBlock "background-color")- -- csquotes- , ("blockquote", blockquote False Nothing)- , ("blockcquote", blockquote True Nothing)- , ("foreignblockquote", braced >>= blockquote False . Just . untokenize)- , ("foreignblockcquote", braced >>= blockquote True . Just . untokenize)- , ("hyphenblockquote", braced >>= blockquote False . Just . untokenize)- , ("hyphenblockcquote", braced >>= blockquote True . Just . untokenize)- -- include- , ("include", rawBlockOr "include" $ include "include")- , ("input", rawBlockOr "input" $ include "input")- , ("subfile", rawBlockOr "subfile" doSubfile)- , ("usepackage", rawBlockOr "usepackage" $ include "usepackage")- -- preamble- , ("PackageError", mempty <$ (braced >> braced >> braced))- -- epigraph package- , ("epigraph", epigraph)- ]---environments :: PandocMonad m => M.Map Text (LP m Blocks)-environments = M.fromList- [ ("document", env "document" blocks <* skipMany anyTok)- , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))- , ("sloppypar", env "sloppypar" blocks)- , ("letter", env "letter" letterContents)- , ("minipage", env "minipage" $- skipopts *> spaces *> optional braced *> spaces *> blocks)- , ("figure", env "figure" $ skipopts *> figure)- , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)- , ("center", divWith ("", ["center"], []) <$> env "center" blocks)- , ("longtable", env "longtable" $- resetCaption *> simpTable "longtable" False >>= addTableCaption)- , ("table", env "table" $- skipopts *> resetCaption *> blocks >>= addTableCaption)- , ("tabular*", env "tabular*" $ simpTable "tabular*" True)- , ("tabularx", env "tabularx" $ simpTable "tabularx" True)- , ("tabular", env "tabular" $ simpTable "tabular" False)- , ("quote", blockQuote <$> env "quote" blocks)- , ("quotation", blockQuote <$> env "quotation" blocks)- , ("verse", blockQuote <$> env "verse" blocks)- , ("itemize", bulletList <$> listenv "itemize" (many item))- , ("description", definitionList <$> listenv "description" (many descItem))- , ("enumerate", orderedList')- , ("alltt", alltt <$> env "alltt" blocks)- , ("code", guardEnabled Ext_literate_haskell *>- (codeBlockWith ("",["haskell","literate"],[]) <$> verbEnv "code"))- , ("comment", mempty <$ verbEnv "comment")- , ("verbatim", codeBlock <$> verbEnv "verbatim")- , ("Verbatim", fancyverbEnv "Verbatim")- , ("BVerbatim", fancyverbEnv "BVerbatim")- , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals- codeBlockWith attr <$> verbEnv "lstlisting")- , ("minted", minted)- , ("obeylines", obeylines)- , ("tikzpicture", rawVerbEnv "tikzpicture")- , ("tikzcd", rawVerbEnv "tikzcd")- , ("lilypond", rawVerbEnv "lilypond")- , ("ly", rawVerbEnv "ly")- -- amsthm- , ("proof", proof)- -- etoolbox- , ("ifstrequal", ifstrequal)- , ("newtoggle", braced >>= newToggle)- , ("toggletrue", braced >>= setToggle True)- , ("togglefalse", braced >>= setToggle False)- , ("iftoggle", try $ ifToggle >> block)- ]--filecontents :: PandocMonad m => LP m Blocks-filecontents = try $ do- controlSeq "begin"- name <- untokenize <$> braced- guard $ name == "filecontents" || name == "filecontents*"- skipopts- fp <- untokenize <$> braced- txt <- verbEnv name- updateState $ \st ->- st{ sFileContents = M.insert fp txt (sFileContents st) }- return mempty--theoremstyle :: PandocMonad m => LP m Blocks-theoremstyle = do- stylename <- untokenize <$> braced- let mbstyle = case stylename of- "plain" -> Just PlainStyle- "definition" -> Just DefinitionStyle- "remark" -> Just RemarkStyle- _ -> Nothing- case mbstyle of- Nothing -> return ()- Just sty -> updateState $ \s -> s{ sLastTheoremStyle = sty }- return mempty--newtheorem :: PandocMonad m => LP m Blocks-newtheorem = do- number <- option True (False <$ symbol '*' <* sp)- name <- untokenize <$> braced- sp- series <- option Nothing $ Just . untokenize <$> bracketedToks- sp- showName <- tok- sp- syncTo <- option Nothing $ Just . untokenize <$> bracketedToks- sty <- sLastTheoremStyle <$> getState- let spec = TheoremSpec { theoremName = showName- , theoremStyle = sty- , theoremSeries = series- , theoremSyncTo = syncTo- , theoremNumber = number- , theoremLastNum = DottedNum [0] }- tmap <- sTheoremMap <$> getState- updateState $ \s -> s{ sTheoremMap =- M.insert name spec tmap }- return mempty--proof :: PandocMonad m => LP m Blocks-proof = do- title <- option (B.text "Proof") opt- bs <- env "proof" blocks- return $- B.divWith ("", ["proof"], []) $- addQed $ addTitle (B.emph (title <> ".")) bs--addTitle :: Inlines -> Blocks -> Blocks-addTitle ils bs =- case B.toList bs of- (Para xs : rest)- -> B.fromList (Para (B.toList ils ++ (Space : xs)) : rest)- _ -> B.para ils <> bs--addQed :: Blocks -> Blocks-addQed bs =- case Seq.viewr (B.unMany bs) of- s Seq.:> Para ils- -> B.Many (s Seq.|> Para (ils ++ B.toList qedSign))- _ -> bs <> B.para qedSign- where- qedSign = B.str "\xa0\x25FB"--environment :: PandocMonad m => LP m Blocks-environment = try $ do- controlSeq "begin"- name <- untokenize <$> braced- M.findWithDefault mzero name environments <|>- theoremEnvironment name <|>- if M.member name (inlineEnvironments- :: M.Map Text (LP PandocPure Inlines))- then mzero- else try (rawEnv name) <|> rawVerbEnv name--theoremEnvironment :: PandocMonad m => Text -> LP m Blocks-theoremEnvironment name = do- tmap <- sTheoremMap <$> getState- case M.lookup name tmap of- Nothing -> mzero- Just tspec -> do- optTitle <- option mempty $ (\x -> space <> "(" <> x <> ")") <$> opt- mblabel <- option Nothing $ Just . untokenize <$>- try (spaces >> controlSeq "label" >> spaces >> braced)- bs <- env name blocks- number <-- if theoremNumber tspec- then do- let name' = fromMaybe name $ theoremSeries tspec- num <- getNextNumber- (maybe (DottedNum [0]) theoremLastNum .- M.lookup name' . sTheoremMap)- updateState $ \s ->- s{ sTheoremMap =- M.adjust- (\spec -> spec{ theoremLastNum = num })- name'- (sTheoremMap s)- }-- case mblabel of- Just ident ->- updateState $ \s ->- s{ sLabels = M.insert ident- (B.toList $- theoremName tspec <> "\160" <>- str (renderDottedNum num)) (sLabels s) }- Nothing -> return ()- return $ space <> B.text (renderDottedNum num)- else return mempty- let titleEmph = case theoremStyle tspec of- PlainStyle -> B.strong- DefinitionStyle -> B.strong- RemarkStyle -> B.emph- let title = titleEmph (theoremName tspec <> number)- <> optTitle <> "." <> space- return $ divWith (fromMaybe "" mblabel, [name], []) $ addTitle title- $ case theoremStyle tspec of- PlainStyle -> walk italicize bs- _ -> bs--italicize :: Block -> Block-italicize x@(Para [Image{}]) = x -- see #6925-italicize (Para ils) = Para [Emph ils]-italicize (Plain ils) = Plain [Emph ils]-italicize x = x--env :: PandocMonad m => Text -> LP m a -> LP m a-env name p = p <* end_ name--rawEnv :: PandocMonad m => Text -> LP m Blocks-rawEnv name = do- exts <- getOption readerExtensions- let parseRaw = extensionEnabled Ext_raw_tex exts- rawOptions <- mconcat <$> many rawopt- let beginCommand = "\\begin{" <> name <> "}" <> rawOptions- pos1 <- getPosition- (bs, raw) <- withRaw $ env name blocks- if parseRaw- then return $ rawBlock "latex"- $ beginCommand <> untokenize raw- else do- report $ SkippedContent beginCommand pos1- pos2 <- getPosition- report $ SkippedContent ("\\end{" <> name <> "}") pos2- return $ divWith ("",[name],[]) bs--rawVerbEnv :: PandocMonad m => Text -> LP m Blocks-rawVerbEnv name = do- pos <- getPosition- (_, raw) <- withRaw $ verbEnv name- let raw' = "\\begin{" <> name <> "}" <> untokenize raw- exts <- getOption readerExtensions- let parseRaw = extensionEnabled Ext_raw_tex exts- if parseRaw- then return $ rawBlock "latex" raw'- else do- report $ SkippedContent raw' pos- return mempty--fancyverbEnv :: PandocMonad m => Text -> LP m Blocks-fancyverbEnv name = do- options <- option [] keyvals- let kvs = [ (if k == "firstnumber"- then "startFrom"- else k, v) | (k,v) <- options ]- let classes = [ "numberLines" |- lookup "numbers" options == Just "left" ]- let attr = ("",classes,kvs)- codeBlockWith attr <$> verbEnv name--obeylines :: PandocMonad m => LP m Blocks-obeylines =- para . fromList . removeLeadingTrailingBreaks .- walk softBreakToHard . toList <$> env "obeylines" inlines- where softBreakToHard SoftBreak = LineBreak- softBreakToHard x = x- removeLeadingTrailingBreaks = reverse . dropWhile isLineBreak .- reverse . dropWhile isLineBreak- isLineBreak LineBreak = True- isLineBreak _ = False--minted :: PandocMonad m => LP m Blocks-minted = do- attr <- mintedAttr- codeBlockWith attr <$> verbEnv "minted"--mintedAttr :: PandocMonad m => LP m Attr-mintedAttr = do- options <- option [] keyvals- lang <- untokenize <$> braced- let kvs = [ (if k == "firstnumber"- then "startFrom"- else k, v) | (k,v) <- options ]- let classes = [ lang | not (T.null lang) ] ++- [ "numberLines" |- lookup "linenos" options == Just "true" ]- return ("",classes,kvs)--inputMinted :: PandocMonad m => LP m Blocks-inputMinted = do- pos <- getPosition- attr <- mintedAttr- f <- T.filter (/='"') . untokenize <$> braced- mbCode <- readFileFromTexinputs (T.unpack f)- rawcode <- case mbCode of- Just s -> return s- Nothing -> do- report $ CouldNotLoadIncludeFile f pos- return ""- return $ B.codeBlockWith attr rawcode--letterContents :: PandocMonad m => LP m Blocks-letterContents = do- bs <- blocks- st <- getState- -- add signature (author) and address (title)- let addr = case lookupMeta "address" (sMeta st) of- Just (MetaBlocks [Plain xs]) ->- para $ trimInlines $ fromList xs- _ -> mempty- return $ addr <> bs -- sig added by \closing--figure :: PandocMonad m => LP m Blocks-figure = try $ do- resetCaption- blocks >>= addImageCaption--addImageCaption :: PandocMonad m => Blocks -> LP m Blocks-addImageCaption = walkM go- where go (Image attr@(_, cls, kvs) alt (src,tit))- | not ("fig:" `T.isPrefixOf` tit) = do- st <- getState- let (alt', tit') = case sCaption st of- Just ils -> (toList ils, "fig:" <> tit)- Nothing -> (alt, tit)- attr' = case sLastLabel st of- Just lab -> (lab, cls, kvs)- Nothing -> attr- case attr' of- ("", _, _) -> return ()- (ident, _, _) -> do- num <- getNextNumber sLastFigureNum- setState- st{ sLastFigureNum = num- , sLabels = M.insert ident- [Str (renderDottedNum num)] (sLabels st) }- return $ Image attr' alt' (src, tit')- go x = return x--coloredBlock :: PandocMonad m => Text -> LP m Blocks-coloredBlock stylename = try $ do- skipopts- color <- braced- notFollowedBy (grouped inline)- let constructor = divWith ("",[],[("style",stylename <> ": " <> untokenize color)])- constructor <$> grouped block--graphicsPath :: PandocMonad m => LP m Blocks-graphicsPath = do- ps <- map (T.unpack . untokenize) <$>- (bgroup *> spaces *> manyTill (braced <* spaces) egroup)- getResourcePath >>= setResourcePath . (<> ps)- return mempty--splitBibs :: Text -> [Inlines]-splitBibs = map (str . T.pack . flip replaceExtension "bib" . T.unpack . trim) . splitTextBy (==',')--alltt :: Blocks -> Blocks-alltt = walk strToCode- where strToCode (Str s) = Code nullAttr s- strToCode Space = RawInline (Format "latex") "\\ "- strToCode SoftBreak = LineBreak- strToCode x = x--parseListingsOptions :: [(Text, Text)] -> Attr-parseListingsOptions options =- let kvs = [ (if k == "firstnumber"- then "startFrom"- else k, v) | (k,v) <- options ]- classes = [ "numberLines" |- lookup "numbers" options == Just "left" ]- ++ maybeToList (listingsLanguage options)- in (fromMaybe "" (lookup "label" options), classes, kvs)--inputListing :: PandocMonad m => LP m Blocks-inputListing = do- pos <- getPosition- options <- option [] keyvals- f <- T.filter (/='"') . untokenize <$> braced- mbCode <- readFileFromTexinputs (T.unpack f)- codeLines <- case mbCode of- Just s -> return $ T.lines s- Nothing -> do- report $ CouldNotLoadIncludeFile f pos- return []- let (ident,classes,kvs) = parseListingsOptions options- let classes' =- (case listingsLanguage options of- Nothing -> (take 1 (languagesByExtension (T.pack $ takeExtension $ T.unpack f)) <>)- Just _ -> id) classes- let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead- let lastline = fromMaybe (length codeLines) $- lookup "lastline" options >>= safeRead- let codeContents = T.intercalate "\n" $ take (1 + lastline - firstline) $- drop (firstline - 1) codeLines- return $ codeBlockWith (ident,classes',kvs) codeContents---- lists--item :: PandocMonad m => LP m Blocks-item = void blocks *> controlSeq "item" *> skipopts *> blocks--descItem :: PandocMonad m => LP m (Inlines, [Blocks])-descItem = do- blocks -- skip blocks before item- controlSeq "item"- sp- ils <- opt- bs <- blocks- return (ils, [bs])--listenv :: PandocMonad m => Text -> LP m a -> LP m a-listenv name p = try $ do- oldInListItem <- sInListItem `fmap` getState- updateState $ \st -> st{ sInListItem = True }- res <- env name p- updateState $ \st -> st{ sInListItem = oldInListItem }- return res--orderedList' :: PandocMonad m => LP m Blocks-orderedList' = try $ do- spaces- let markerSpec = do- symbol '['- ts <- untokenize <$> manyTill anyTok (symbol ']')- case runParser anyOrderedListMarker def "option" ts of- Right r -> return r- Left _ -> do- pos <- getPosition- report $ SkippedContent ("[" <> ts <> "]") pos- return (1, DefaultStyle, DefaultDelim)- (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) markerSpec- spaces- optional $ try $ controlSeq "setlength"- *> grouped (count 1 $ controlSeq "itemindent")- *> braced- spaces- start <- option 1 $ try $ do pos <- getPosition- controlSeq "setcounter"- ctr <- untokenize <$> braced- guard $ "enum" `T.isPrefixOf` ctr- guard $ T.all (`elem` ['i','v']) (T.drop 4 ctr)- sp- num <- untokenize <$> braced- case safeRead num of- Just i -> return (i + 1 :: Int)- Nothing -> do- report $ SkippedContent- ("\\setcounter{" <> ctr <>- "}{" <> num <> "}") pos- return 1- bs <- listenv "enumerate" (many item)- return $ orderedListWith (start, style, delim) bs---- tables--hline :: PandocMonad m => LP m ()-hline = try $ do- spaces- controlSeq "hline" <|>- -- booktabs rules:- controlSeq "toprule" <|>- controlSeq "bottomrule" <|>- controlSeq "midrule" <|>- controlSeq "endhead" <|>- controlSeq "endfirsthead"- spaces- optional opt- return ()--lbreak :: PandocMonad m => LP m Tok-lbreak = (controlSeq "\\" <|> controlSeq "tabularnewline")- <* skipopts <* spaces--amp :: PandocMonad m => LP m Tok-amp = symbol '&'---- Split a Word into individual Symbols (for parseAligns)-splitWordTok :: PandocMonad m => LP m ()-splitWordTok = do- inp <- getInput- case inp of- (Tok spos Word t : rest) ->- setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) <> rest- _ -> return ()--parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]-parseAligns = try $ do- let maybeBar = skipMany- (try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced)))- let cAlign = AlignCenter <$ symbol 'c'- let lAlign = AlignLeft <$ symbol 'l'- let rAlign = AlignRight <$ symbol 'r'- let parAlign = AlignLeft <$ symbol 'p'- -- aligns from tabularx- let xAlign = AlignLeft <$ symbol 'X'- let mAlign = AlignLeft <$ symbol 'm'- let bAlign = AlignLeft <$ symbol 'b'- let alignChar = splitWordTok *> ( cAlign <|> lAlign <|> rAlign <|> parAlign- <|> xAlign <|> mAlign <|> bAlign )- let alignPrefix = symbol '>' >> braced- let alignSuffix = symbol '<' >> braced- let colWidth = try $ do- symbol '{'- ds <- trim . untokenize <$> manyTill anyTok (controlSeq "linewidth")- spaces- symbol '}'- return $ safeRead ds- let alignSpec = do- pref <- option [] alignPrefix- spaces- al <- alignChar- width <- colWidth <|> option Nothing (do s <- untokenize <$> braced- pos <- getPosition- report $ SkippedContent s pos- return Nothing)- spaces- suff <- option [] alignSuffix- return (al, width, (pref, suff))- let starAlign = do -- '*{2}{r}' == 'rr', we just expand like a macro- symbol '*'- spaces- ds <- trim . untokenize <$> braced- spaces- spec <- braced- case safeRead ds of- Just n ->- getInput >>= setInput . (mconcat (replicate n spec) ++)- Nothing -> Prelude.fail $ "Could not parse " <> T.unpack ds <> " as number"- bgroup- spaces- maybeBar- aligns' <- many $ try $ spaces >> optional starAlign >>- (alignSpec <* maybeBar)- spaces- egroup- spaces- return $ map toSpec aligns'- where- toColWidth (Just w) | w > 0 = ColWidth w- toColWidth _ = ColWidthDefault- toSpec (x, y, z) = (x, toColWidth y, z)---- N.B. this parser returns a Row that may have erroneous empty cells--- in it. See the note above fixTableHead for details.-parseTableRow :: PandocMonad m- => Text -- ^ table environment name- -> [([Tok], [Tok])] -- ^ pref/suffixes- -> LP m Row-parseTableRow envname prefsufs = do- notFollowedBy (spaces *> end_ envname)- -- add prefixes and suffixes in token stream:- let celltoks (pref, suff) = do- prefpos <- getPosition- contents <- mconcat <$>- many ( snd <$> withRaw (controlSeq "parbox" >> parbox) -- #5711- <|>- snd <$> withRaw (inlineEnvironment <|> dollarsMath)- <|>- (do notFollowedBy- (() <$ amp <|> () <$ lbreak <|> end_ envname)- count 1 anyTok) )-- suffpos <- getPosition- option [] (count 1 amp)- return $ map (setpos prefpos) pref ++ contents ++ map (setpos suffpos) suff- rawcells <- mapM celltoks prefsufs- oldInput <- getInput- cells <- mapM (\ts -> setInput ts >> parseTableCell) rawcells- setInput oldInput- spaces- return $ Row nullAttr cells--parseTableCell :: PandocMonad m => LP m Cell-parseTableCell = do- spaces- updateState $ \st -> st{ sInTableCell = True }- cell' <- multicolumnCell- <|> multirowCell- <|> parseSimpleCell- <|> parseEmptyCell- updateState $ \st -> st{ sInTableCell = False }- spaces- return cell'- where- -- The parsing of empty cells is important in LaTeX, especially when dealing- -- with multirow/multicolumn. See #6603.- parseEmptyCell = spaces $> emptyCell--cellAlignment :: PandocMonad m => LP m Alignment-cellAlignment = skipMany (symbol '|') *> alignment <* skipMany (symbol '|')- where- alignment = do- c <- untoken <$> singleChar- return $ case c of- "l" -> AlignLeft- "r" -> AlignRight- "c" -> AlignCenter- "*" -> AlignDefault- _ -> AlignDefault--plainify :: Blocks -> Blocks-plainify bs = case toList bs of- [Para ils] -> plain (fromList ils)- _ -> bs--multirowCell :: PandocMonad m => LP m Cell-multirowCell = controlSeq "multirow" >> do- -- Full prototype for \multirow macro is:- -- \multirow[vpos]{nrows}[bigstruts]{width}[vmove]{text}- -- However, everything except `nrows` and `text` make- -- sense in the context of the Pandoc AST- _ <- optional $ symbol '[' *> cellAlignment <* symbol ']' -- vertical position- nrows <- fmap (fromMaybe 1 . safeRead . untokenize) braced- _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- bigstrut-related- _ <- symbol '{' *> manyTill anyTok (symbol '}') -- Cell width- _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- Length used for fine-tuning- content <- symbol '{' *> (plainify <$> blocks) <* symbol '}'- return $ cell AlignDefault (RowSpan nrows) (ColSpan 1) content--multicolumnCell :: PandocMonad m => LP m Cell-multicolumnCell = controlSeq "multicolumn" >> do- span' <- fmap (fromMaybe 1 . safeRead . untokenize) braced- alignment <- symbol '{' *> cellAlignment <* symbol '}'-- let singleCell = do- content <- plainify <$> blocks- return $ cell alignment (RowSpan 1) (ColSpan span') content-- -- Two possible contents: either a \multirow cell, or content.- -- E.g. \multicol{1}{c}{\multirow{2}{1em}{content}}- -- Note that a \multirow cell can be nested in a \multicolumn,- -- but not the other way around. See #6603- let nestedCell = do- (Cell _ _ (RowSpan rs) _ bs) <- multirowCell- return $ cell- alignment- (RowSpan rs)- (ColSpan span')- (fromList bs)-- symbol '{' *> (nestedCell <|> singleCell) <* symbol '}'---- Parse a simple cell, i.e. not multirow/multicol-parseSimpleCell :: PandocMonad m => LP m Cell-parseSimpleCell = simpleCell <$> (plainify <$> blocks)---- LaTeX tables are stored with empty cells underneath multirow cells--- denoting the grid spaces taken up by them. More specifically, if a--- cell spans m rows, then it will overwrite all the cells in the--- columns it spans for (m-1) rows underneath it, requiring padding--- cells in these places. These padding cells need to be removed for--- proper table reading. See #6603.------ These fixTable functions do not otherwise fix up malformed--- input tables: that is left to the table builder.-fixTableHead :: TableHead -> TableHead-fixTableHead (TableHead attr rows) = TableHead attr rows'- where- rows' = fixTableRows rows--fixTableBody :: TableBody -> TableBody-fixTableBody (TableBody attr rhc th tb)- = TableBody attr rhc th' tb'- where- th' = fixTableRows th- tb' = fixTableRows tb--fixTableRows :: [Row] -> [Row]-fixTableRows = fixTableRows' $ repeat Nothing- where- fixTableRows' oldHang (Row attr cells : rs)- = let (newHang, cells') = fixTableRow oldHang cells- rs' = fixTableRows' newHang rs- in Row attr cells' : rs'- fixTableRows' _ [] = []---- The overhang is represented as Just (relative cell dimensions) or--- Nothing for an empty grid space.-fixTableRow :: [Maybe (ColSpan, RowSpan)] -> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])-fixTableRow oldHang cells- -- If there's overhang, drop cells until their total width meets the- -- width of the occupied grid spaces (or we run out)- | (n, prefHang, restHang) <- splitHang oldHang- , n > 0- = let cells' = dropToWidth getCellW n cells- (restHang', cells'') = fixTableRow restHang cells'- in (prefHang restHang', cells'')- -- Otherwise record the overhang of a pending cell and fix the rest- -- of the row- | c@(Cell _ _ h w _):cells' <- cells- = let h' = max 1 h- w' = max 1 w- oldHang' = dropToWidth getHangW w' oldHang- (newHang, cells'') = fixTableRow oldHang' cells'- in (toHang w' h' <> newHang, c : cells'')- | otherwise- = (oldHang, [])- where- getCellW (Cell _ _ _ w _) = w- getHangW = maybe 1 fst- getCS (ColSpan n) = n-- toHang c r- | r > 1 = [Just (c, r)]- | otherwise = replicate (getCS c) Nothing-- -- Take the prefix of the overhang list representing filled grid- -- spaces. Also return the remainder and the length of this prefix.- splitHang = splitHang' 0 id-- splitHang' !n l (Just (c, r):xs)- = splitHang' (n + c) (l . (toHang c (r-1) ++)) xs- splitHang' n l xs = (n, l, xs)-- -- Drop list items until the total width of the dropped items- -- exceeds the passed width.- dropToWidth _ n l | n < 1 = l- dropToWidth wproj n (c:cs) = dropToWidth wproj (n - wproj c) cs- dropToWidth _ _ [] = []--simpTable :: PandocMonad m => Text -> Bool -> LP m Blocks-simpTable envname hasWidthParameter = try $ do- when hasWidthParameter $ () <$ (spaces >> tok)- skipopts- colspecs <- parseAligns- let (aligns, widths, prefsufs) = unzip3 colspecs- optional $ controlSeq "caption" *> setCaption- spaces- optional label- spaces- optional lbreak- spaces- skipMany hline- spaces- header' <- option [] . try . fmap (:[]) $- parseTableRow envname prefsufs <* lbreak <* many1 hline- spaces- rows <- sepEndBy (parseTableRow envname prefsufs)- (lbreak <* optional (skipMany hline))- spaces- optional $ controlSeq "caption" *> setCaption- spaces- optional label- spaces- optional lbreak- spaces- lookAhead $ controlSeq "end" -- make sure we're at end- let th = fixTableHead $ TableHead nullAttr header'- let tbs = [fixTableBody $ TableBody nullAttr 0 [] rows]- let tf = TableFoot nullAttr []- return $ table emptyCaption (zip aligns widths) th tbs tf--addTableCaption :: PandocMonad m => Blocks -> LP m Blocks-addTableCaption = walkM go- where go (Table attr c spec th tb tf) = do- st <- getState- let mblabel = sLastLabel st- capt <- case (sCaption st, mblabel) of- (Just ils, Nothing) -> return $ caption Nothing (plain ils)- (Just ils, Just lab) -> do- num <- getNextNumber sLastTableNum- setState- st{ sLastTableNum = num- , sLabels = M.insert lab- [Str (renderDottedNum num)]- (sLabels st) }- return $ caption Nothing (plain ils) -- add number??- (Nothing, _) -> return c- let attr' = case (attr, mblabel) of- ((_,classes,kvs), Just ident) ->- (ident,classes,kvs)- _ -> attr- return $ addAttrDiv attr' $ Table nullAttr capt spec th tb tf- go x = return x---- TODO: For now we add a Div to contain table attributes, since--- most writers don't do anything yet with attributes on Table.--- This can be removed when that changes.-addAttrDiv :: Attr -> Block -> Block-addAttrDiv ("",[],[]) b = b-addAttrDiv attr b = Div attr [b]--block :: PandocMonad m => LP m Blocks-block = do- res <- (mempty <$ spaces1)- <|> environment- <|> macroDef (rawBlock "latex")- <|> blockCommand- <|> paragraph- <|> grouped block- trace (T.take 60 $ tshow $ B.toList res)- return res--blocks :: PandocMonad m => LP m Blocks-blocks = mconcat <$> many block--setDefaultLanguage :: PandocMonad m => LP m Blocks-setDefaultLanguage = do- o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')- <$> rawopt- polylang <- untokenize <$> braced- case M.lookup polylang polyglossiaLangToBCP47 of- Nothing -> return mempty -- TODO mzero? warning?- Just langFunc -> do- let l = langFunc o- setTranslations l- updateState $ setMeta "lang" $ str (renderLang l)- return mempty+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+{- |+ Module : Text.Pandoc.Readers.LaTeX+ Copyright : Copyright (C) 2006-2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable++Conversion of LaTeX to 'Pandoc' document.++-}+module Text.Pandoc.Readers.LaTeX ( readLaTeX,+ applyMacros,+ rawLaTeXInline,+ rawLaTeXBlock,+ inlineCommand+ ) where++import Control.Applicative (many, optional, (<|>))+import Control.Monad+import Control.Monad.Except (throwError)+import Data.Char (isDigit, isLetter, toUpper, chr)+import Data.Default+import Data.List (intercalate)+import qualified Data.Map as M+import Data.Maybe (fromMaybe, maybeToList)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as T+import System.FilePath (addExtension, replaceExtension, takeExtension)+import Text.Pandoc.BCP47 (renderLang)+import Text.Pandoc.Builder as B+import Text.Pandoc.Class.PandocPure (PandocPure)+import Text.Pandoc.Class.PandocMonad (PandocMonad (..), getResourcePath,+ readFileFromDirs, report,+ setResourcePath)+import Text.Pandoc.Error (PandocError (PandocParseError, PandocParsecError))+import Text.Pandoc.Highlighting (languagesByExtension)+import Text.Pandoc.ImageSize (numUnit, showFl)+import Text.Pandoc.Logging+import Text.Pandoc.Options+import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,+ optional, space, spaces, withRaw, (<|>))+import Text.Pandoc.Readers.LaTeX.Types (Tok (..), TokType (..))+import Text.Pandoc.Readers.LaTeX.Parsing+import Text.Pandoc.Readers.LaTeX.Citation (citationCommands, cites)+import Text.Pandoc.Readers.LaTeX.Math (dollarsMath, inlineEnvironments,+ inlineEnvironment,+ mathDisplay, mathInline,+ newtheorem, theoremstyle, proof,+ theoremEnvironment)+import Text.Pandoc.Readers.LaTeX.Table (tableEnvironments)+import Text.Pandoc.Readers.LaTeX.Macro (macroDef)+import Text.Pandoc.Readers.LaTeX.Lang (inlineLanguageCommands,+ enquoteCommands,+ babelLangToBCP47, setDefaultLanguage)+import Text.Pandoc.Readers.LaTeX.SIunitx (siunitxCommands)+import Text.Pandoc.Readers.LaTeX.Inline (acronymCommands, refCommands,+ nameCommands, charCommands,+ accentCommands,+ biblatexInlineCommands,+ verbCommands, rawInlineOr,+ listingsLanguage)+import Text.Pandoc.Shared+import Text.Pandoc.Walk+import Safe++-- for debugging:+-- import Text.Pandoc.Extensions (getDefaultExtensions)+-- import Text.Pandoc.Class.PandocIO (runIOorExplode, PandocIO)+-- import Debug.Trace (traceShowId)++-- | Parse LaTeX from string and return 'Pandoc' document.+readLaTeX :: PandocMonad m+ => ReaderOptions -- ^ Reader options+ -> Text -- ^ String to parse (assumes @'\n'@ line endings)+ -> m Pandoc+readLaTeX opts ltx = do+ parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"+ (tokenize "source" (crFilter ltx))+ case parsed of+ Right result -> return result+ Left e -> throwError $ PandocParsecError ltx e++parseLaTeX :: PandocMonad m => LP m Pandoc+parseLaTeX = do+ bs <- blocks+ eof+ st <- getState+ let meta = sMeta st+ 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 adjustHeaders m (Header n attr ils) = Header (n+m) attr ils+ adjustHeaders _ x = x+ let (Pandoc _ bs') =+ -- handle the case where you have \part or \chapter+ (if bottomLevel < 1+ then walk (adjustHeaders (1 - bottomLevel))+ else id) $+ walk (resolveRefs (sLabels st)) doc'+ return $ Pandoc meta bs'++resolveRefs :: M.Map Text [Inline] -> Inline -> Inline+resolveRefs labels x@(Link (ident,classes,kvs) _ _) =+ case (lookup "reference-type" kvs,+ lookup "reference" kvs) of+ (Just "ref", Just lab) ->+ case M.lookup lab labels of+ Just txt -> Link (ident,classes,kvs) txt ("#" <> lab, "")+ Nothing -> x+ _ -> x+resolveRefs _ x = x+++-- testParser :: LP PandocIO a -> Text -> IO a+-- testParser p t = do+-- res <- runIOorExplode (runParserT p defaultLaTeXState{+-- sOptions = def{ readerExtensions =+-- enableExtension Ext_raw_tex $+-- getDefaultExtensions "latex" }} "source" (tokenize "source" t))+-- case res of+-- Left e -> error (show e)+-- Right r -> return r+++rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)+ => ParserT Text s m Text+rawLaTeXBlock = do+ lookAhead (try (char '\\' >> letter))+ inp <- getInput+ let toks = tokenize "source" inp+ snd <$> (rawLaTeXParser toks False (macroDef (const mempty)) blocks+ <|> rawLaTeXParser toks True+ (do choice (map controlSeq+ ["include", "input", "subfile", "usepackage"])+ skipMany opt+ braced+ return mempty) blocks+ <|> rawLaTeXParser toks True+ (environment <|> blockCommand)+ (mconcat <$> many (block <|> beginOrEndCommand)))++-- See #4667 for motivation; sometimes people write macros+-- that just evaluate to a begin or end command, which blockCommand+-- won't accept.+beginOrEndCommand :: PandocMonad m => LP m Blocks+beginOrEndCommand = try $ do+ Tok _ (CtrlSeq name) txt <- anyControlSeq+ guard $ name == "begin" || name == "end"+ (envname, rawargs) <- withRaw braced+ if M.member (untokenize envname)+ (inlineEnvironments :: M.Map Text (LP PandocPure Inlines))+ then mzero+ else return $ rawBlock "latex"+ (txt <> untokenize rawargs)++rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)+ => ParserT Text s m Text+rawLaTeXInline = do+ lookAhead (try (char '\\' >> letter))+ inp <- getInput+ let toks = tokenize "source" inp+ raw <- snd <$>+ ( rawLaTeXParser toks True+ (mempty <$ (controlSeq "input" >> skipMany rawopt >> braced))+ inlines+ <|> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')+ inlines+ )+ finalbraces <- mconcat <$> many (try (string "{}")) -- see #5439+ return $ raw <> T.pack finalbraces++inlineCommand :: PandocMonad m => ParserT Text ParserState m Inlines+inlineCommand = do+ lookAhead (try (char '\\' >> letter))+ inp <- getInput+ let toks = tokenize "source" inp+ fst <$> rawLaTeXParser toks True (inlineEnvironment <|> inlineCommand')+ inlines++-- inline elements:++word :: PandocMonad m => LP m Inlines+word = str . untoken <$> satisfyTok isWordTok++inlineGroup :: PandocMonad m => LP m Inlines+inlineGroup = do+ ils <- grouped inline+ if null ils+ then return mempty+ else return $ spanWith nullAttr ils+ -- we need the span so we can detitlecase bibtex entries;+ -- we need to know when something is {C}apitalized++doLHSverb :: PandocMonad m => LP m Inlines+doLHSverb =+ codeWith ("",["haskell"],[]) . untokenize+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')++mkImage :: PandocMonad m => [(Text, Text)] -> Text -> LP m Inlines+mkImage options (T.unpack -> src) = do+ let replaceTextwidth (k,v) =+ case numUnit v of+ Just (num, "\\textwidth") -> (k, showFl (num * 100) <> "%")+ _ -> (k, v)+ let kvs = map replaceTextwidth+ $ filter (\(k,_) -> k `elem` ["width", "height"]) options+ let attr = ("",[], kvs)+ let alt = str "image"+ defaultExt <- getOption readerDefaultImageExtension+ let exts' = [".pdf", ".png", ".jpg", ".mps", ".jpeg", ".jbig2", ".jb2"]+ let exts = exts' ++ map (map toUpper) exts'+ let findFile s [] = return s+ findFile s (e:es) = do+ let s' = addExtension s e+ exists <- fileExists s'+ if exists+ then return s'+ else findFile s es+ src' <- case takeExtension src of+ "" | not (T.null defaultExt) -> return $ addExtension src $ T.unpack defaultExt+ | otherwise -> findFile src exts+ _ -> return src+ return $ imageWith attr (T.pack src') "" alt++doxspace :: PandocMonad m => LP m Inlines+doxspace =+ (space <$ lookAhead (satisfyTok startsWithLetter)) <|> return mempty+ where startsWithLetter (Tok _ Word t) =+ case T.uncons t of+ Just (c, _) | isLetter c -> True+ _ -> False+ startsWithLetter _ = False+++removeDoubleQuotes :: Text -> Text+removeDoubleQuotes t =+ Data.Maybe.fromMaybe t $ T.stripPrefix "\"" t >>= T.stripSuffix "\""++doubleQuote :: PandocMonad m => LP m Inlines+doubleQuote =+ quoted' doubleQuoted (try $ count 2 $ symbol '`')+ (void $ try $ count 2 $ symbol '\'')+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')+ -- the following is used by babel for localized quotes:+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])+ (void $ try $ sequence [symbol '"', symbol '\''])++singleQuote :: PandocMonad m => LP m Inlines+singleQuote =+ quoted' singleQuoted ((:[]) <$> symbol '`')+ (try $ symbol '\'' >>+ notFollowedBy (satisfyTok startsWithLetter))+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')+ (try $ symbol '’' >>+ notFollowedBy (satisfyTok startsWithLetter))+ where startsWithLetter (Tok _ Word t) =+ case T.uncons t of+ Just (c, _) | isLetter c -> True+ _ -> False+ startsWithLetter _ = False++quoted' :: PandocMonad m+ => (Inlines -> Inlines)+ -> LP m [Tok]+ -> LP m ()+ -> LP m Inlines+quoted' f starter ender = do+ startchs <- untokenize <$> starter+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions+ if smart+ then do+ ils <- many (notFollowedBy ender >> inline)+ (ender >> return (f (mconcat ils))) <|>+ (<> mconcat ils) <$>+ lit (case startchs of+ "``" -> "“"+ "`" -> "‘"+ cs -> cs)+ else lit startchs++lit :: Text -> LP m Inlines+lit = pure . str++blockquote :: PandocMonad m => Bool -> Maybe Text -> LP m Blocks+blockquote cvariant mblang = do+ citepar <- if cvariant+ then (\xs -> para (cite xs mempty))+ <$> cites inline NormalCitation False+ else option mempty $ para <$> bracketed inline+ let lang = mblang >>= babelLangToBCP47+ let langdiv = case lang of+ Nothing -> id+ Just l -> divWith ("",[],[("lang", renderLang l)])+ _closingPunct <- option mempty $ bracketed inline -- currently ignored+ bs <- grouped block+ optional $ symbolIn (".:;?!" :: [Char]) -- currently ignored+ return $ blockQuote . langdiv $ (bs <> citepar)++inlineCommand' :: PandocMonad m => LP m Inlines+inlineCommand' = try $ do+ Tok _ (CtrlSeq name) cmd <- anyControlSeq+ guard $ name /= "begin" && name /= "end" && name /= "and"+ star <- option "" ("*" <$ symbol '*' <* sp)+ overlay <- option "" overlaySpecification+ let name' = name <> star <> overlay+ let names = ordNub [name', name] -- check non-starred as fallback+ let raw = do+ guard $ isInlineCommand name || not (isBlockCommand name)+ rawcommand <- getRawCommand name (cmd <> star)+ (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))+ <|> ignore rawcommand+ lookupListDefault raw names inlineCommands++tok :: PandocMonad m => LP m Inlines+tok = tokWith inline++unescapeURL :: Text -> Text+unescapeURL = T.concat . go . T.splitOn "\\"+ where+ isEscapable c = c `elemText` "#$%&~_^\\{}"+ go (x:xs) = x : map unescapeInterior xs+ go [] = []+ unescapeInterior t+ | Just (c, _) <- T.uncons t+ , isEscapable c = t+ | otherwise = "\\" <> t++inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)+inlineCommands = M.unions+ [ accentCommands tok+ , citationCommands inline+ , siunitxCommands tok+ , acronymCommands+ , refCommands+ , nameCommands+ , verbCommands+ , charCommands+ , enquoteCommands tok+ , inlineLanguageCommands tok+ , biblatexInlineCommands tok+ , rest ]+ where+ rest = M.fromList+ [ ("emph", extractSpaces emph <$> tok)+ , ("textit", extractSpaces emph <$> tok)+ , ("textsl", extractSpaces emph <$> tok)+ , ("textsc", extractSpaces smallcaps <$> tok)+ , ("textsf", extractSpaces (spanWith ("",["sans-serif"],[])) <$> tok)+ , ("textmd", extractSpaces (spanWith ("",["medium"],[])) <$> tok)+ , ("textrm", extractSpaces (spanWith ("",["roman"],[])) <$> tok)+ , ("textup", extractSpaces (spanWith ("",["upright"],[])) <$> tok)+ , ("texttt", ttfamily)+ , ("sout", extractSpaces strikeout <$> tok)+ , ("alert", skipopts >> spanWith ("",["alert"],[]) <$> tok) -- beamer+ , ("textsuperscript", extractSpaces superscript <$> tok)+ , ("textsubscript", extractSpaces subscript <$> tok)+ , ("textbf", extractSpaces strong <$> tok)+ , ("textnormal", extractSpaces (spanWith ("",["nodecor"],[])) <$> tok)+ , ("underline", underline <$> tok)+ , ("mbox", rawInlineOr "mbox" $ processHBox <$> tok)+ , ("hbox", rawInlineOr "hbox" $ processHBox <$> tok)+ , ("lettrine", rawInlineOr "lettrine" lettrine)+ , ("(", mathInline . untokenize <$> manyTill anyTok (controlSeq ")"))+ , ("[", mathDisplay . untokenize <$> manyTill anyTok (controlSeq "]"))+ , ("ensuremath", mathInline . untokenize <$> braced)+ , ("texorpdfstring", const <$> tok <*> tok)+ -- old TeX commands+ , ("em", extractSpaces emph <$> inlines)+ , ("it", extractSpaces emph <$> inlines)+ , ("sl", extractSpaces emph <$> inlines)+ , ("bf", extractSpaces strong <$> inlines)+ , ("tt", code . stringify . toList <$> inlines)+ , ("rm", inlines)+ , ("itshape", extractSpaces emph <$> inlines)+ , ("slshape", extractSpaces emph <$> inlines)+ , ("scshape", extractSpaces smallcaps <$> inlines)+ , ("bfseries", extractSpaces strong <$> inlines)+ , ("MakeUppercase", makeUppercase <$> tok)+ , ("MakeTextUppercase", makeUppercase <$> tok) -- textcase+ , ("uppercase", makeUppercase <$> tok)+ , ("MakeLowercase", makeLowercase <$> tok)+ , ("MakeTextLowercase", makeLowercase <$> tok)+ , ("lowercase", makeLowercase <$> tok)+ , ("thanks", skipopts >> note <$> grouped block)+ , ("footnote", skipopts >> note <$> grouped block)+ , ("passthrough", tok) -- \passthrough macro used by latex writer+ -- for listings+ , ("includegraphics", do options <- option [] keyvals+ src <- braced+ mkImage options .+ unescapeURL .+ removeDoubleQuotes $ untokenize src)+ -- hyperref+ , ("url", (\url -> link url "" (str url)) . unescapeURL . untokenize <$>+ bracedUrl)+ , ("nolinkurl", code . unescapeURL . untokenize <$> bracedUrl)+ , ("href", do url <- bracedUrl+ sp+ link (unescapeURL $ untokenize url) "" <$> tok)+ , ("hyperlink", hyperlink)+ , ("hyperref", hyperref)+ , ("hypertarget", hypertargetInline)+ -- hyphenat+ , ("nohyphens", tok)+ , ("textnhtt", ttfamily)+ , ("nhttfamily", ttfamily)+ -- LaTeX colors+ , ("textcolor", coloredInline "color")+ , ("colorbox", coloredInline "background-color")+ -- xspace+ , ("xspace", doxspace)+ -- etoolbox+ , ("ifstrequal", ifstrequal)+ , ("newtoggle", braced >>= newToggle)+ , ("toggletrue", braced >>= setToggle True)+ , ("togglefalse", braced >>= setToggle False)+ , ("iftoggle", try $ ifToggle >> inline)+ -- include+ , ("input", rawInlineOr "input" $ include "input")+ -- soul package+ , ("ul", underline <$> tok)+ -- ulem package+ , ("uline", underline <$> tok)+ -- plain tex stuff that should just be passed through as raw tex+ , ("ifdim", ifdim)+ ]++lettrine :: PandocMonad m => LP m Inlines+lettrine = do+ optional rawopt+ x <- tok+ y <- tok+ return $ extractSpaces (spanWith ("",["lettrine"],[])) x <> smallcaps y++ifdim :: PandocMonad m => LP m Inlines+ifdim = do+ contents <- manyTill anyTok (controlSeq "fi")+ return $ rawInline "latex" $ "\\ifdim" <> untokenize contents <> "\\fi"++makeUppercase :: Inlines -> Inlines+makeUppercase = fromList . walk (alterStr T.toUpper) . toList++makeLowercase :: Inlines -> Inlines+makeLowercase = fromList . walk (alterStr T.toLower) . toList++alterStr :: (Text -> Text) -> Inline -> Inline+alterStr f (Str xs) = Str (f xs)+alterStr _ x = x++hyperlink :: PandocMonad m => LP m Inlines+hyperlink = try $ do+ src <- untokenize <$> braced+ lab <- tok+ return $ link ("#" <> src) "" lab++hyperref :: PandocMonad m => LP m Inlines+hyperref = try $ do+ url <- (("#" <>) . untokenize <$> try (sp *> bracketedToks <* sp))+ <|> untokenize <$> (bracedUrl <* bracedUrl <* bracedUrl)+ link url "" <$> tok++hypertargetBlock :: PandocMonad m => LP m Blocks+hypertargetBlock = try $ do+ ref <- untokenize <$> braced+ bs <- grouped block+ case toList bs of+ [Header 1 (ident,_,_) _] | ident == ref -> return bs+ _ -> return $ divWith (ref, [], []) bs++hypertargetInline :: PandocMonad m => LP m Inlines+hypertargetInline = try $ do+ ref <- untokenize <$> braced+ ils <- grouped inline+ return $ spanWith (ref, [], []) ils++newToggle :: (Monoid a, PandocMonad m) => [Tok] -> LP m a+newToggle name = do+ updateState $ \st ->+ st{ sToggles = M.insert (untokenize name) False (sToggles st) }+ return mempty++setToggle :: (Monoid a, PandocMonad m) => Bool -> [Tok] -> LP m a+setToggle on name = do+ updateState $ \st ->+ st{ sToggles = M.adjust (const on) (untokenize name) (sToggles st) }+ return mempty++ifToggle :: PandocMonad m => LP m ()+ifToggle = do+ name <- braced+ spaces+ yes <- braced+ spaces+ no <- braced+ toggles <- sToggles <$> getState+ inp <- getInput+ let name' = untokenize name+ case M.lookup name' toggles of+ Just True -> setInput (yes ++ inp)+ Just False -> setInput (no ++ inp)+ Nothing -> do+ pos <- getPosition+ report $ UndefinedToggle name' pos+ return ()++ifstrequal :: (PandocMonad m, Monoid a) => LP m a+ifstrequal = do+ str1 <- tok+ str2 <- tok+ ifequal <- braced+ ifnotequal <- braced+ if str1 == str2+ then getInput >>= setInput . (ifequal ++)+ else getInput >>= setInput . (ifnotequal ++)+ return mempty++coloredInline :: PandocMonad m => Text -> LP m Inlines+coloredInline stylename = do+ skipopts+ color <- braced+ spanWith ("",[],[("style",stylename <> ": " <> untokenize color)]) <$> tok++ttfamily :: PandocMonad m => LP m Inlines+ttfamily = code . stringify . toList <$> tok++processHBox :: Inlines -> Inlines+processHBox = walk convert+ where+ convert Space = Str $ T.singleton $ chr 160 -- non-breakable space+ convert SoftBreak = Str $ T.singleton $ chr 160 -- non-breakable space+ convert LineBreak = Str ""+ convert x = x++isBlockCommand :: Text -> Bool+isBlockCommand s =+ s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))+ || s `Set.member` treatAsBlock++treatAsBlock :: Set.Set Text+treatAsBlock = Set.fromList+ [ "special", "pdfannot", "pdfstringdef"+ , "bibliographystyle"+ , "maketitle", "makeindex", "makeglossary"+ , "addcontentsline", "addtocontents", "addtocounter"+ -- \ignore{} is used conventionally in literate haskell for definitions+ -- that are to be processed by the compiler but not printed.+ , "ignore"+ , "hyperdef"+ , "markboth", "markright", "markleft"+ , "hspace", "vspace"+ , "newpage"+ , "clearpage"+ , "pagebreak"+ , "titleformat"+ , "listoffigures"+ , "listoftables"+ , "write"+ ]++isInlineCommand :: Text -> Bool+isInlineCommand s =+ s `M.member` (inlineCommands :: M.Map Text (LP PandocPure Inlines))+ || s `Set.member` treatAsInline++treatAsInline :: Set.Set Text+treatAsInline = Set.fromList+ [ "index"+ , "hspace"+ , "vspace"+ , "noindent"+ , "newpage"+ , "clearpage"+ , "pagebreak"+ ]++lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v+lookupListDefault d = (fromMaybe d .) . lookupList+ where lookupList l m = msum $ map (`M.lookup` m) l++inline :: PandocMonad m => LP m Inlines+inline = do+ Tok pos toktype t <- lookAhead anyTok+ let symbolAsString = str . untoken <$> anySymbol+ let unescapedSymbolAsString =+ do s <- untoken <$> anySymbol+ report $ ParsingUnescaped s pos+ return $ str s+ case toktype of+ Comment -> mempty <$ comment+ Spaces -> space <$ whitespace+ Newline -> softbreak <$ endline+ Word -> word+ Esc1 -> str . T.singleton <$> primEscape+ Esc2 -> str . T.singleton <$> primEscape+ Symbol ->+ case t of+ "-" -> symbol '-' *>+ option (str "-") (symbol '-' *>+ option (str "–") (str "—" <$ symbol '-'))+ "'" -> symbol '\'' *>+ option (str "’") (str "”" <$ symbol '\'')+ "~" -> str "\160" <$ symbol '~'+ "`" -> doubleQuote <|> singleQuote <|> symbolAsString+ "\"" -> doubleQuote <|> singleQuote <|> symbolAsString+ "“" -> doubleQuote <|> symbolAsString+ "‘" -> singleQuote <|> symbolAsString+ "$" -> dollarsMath <|> unescapedSymbolAsString+ "|" -> (guardEnabled Ext_literate_haskell *>+ symbol '|' *> doLHSverb) <|> symbolAsString+ "{" -> inlineGroup+ "#" -> unescapedSymbolAsString+ "&" -> unescapedSymbolAsString+ "_" -> unescapedSymbolAsString+ "^" -> unescapedSymbolAsString+ "\\" -> mzero+ "}" -> mzero+ _ -> symbolAsString+ CtrlSeq _ -> macroDef (rawInline "latex")+ <|> inlineCommand'+ <|> inlineEnvironment+ <|> inlineGroup+ _ -> mzero++inlines :: PandocMonad m => LP m Inlines+inlines = mconcat <$> many inline++opt :: PandocMonad m => LP m Inlines+opt = do+ toks <- try (sp *> bracketedToks <* sp)+ -- now parse the toks as inlines+ st <- getState+ parsed <- runParserT (mconcat <$> many inline) st "bracketed option" toks+ case parsed of+ Right result -> return result+ Left e -> throwError $ PandocParsecError (untokenize toks) e++-- block elements:++preamble :: PandocMonad m => LP m Blocks+preamble = mconcat <$> many preambleBlock+ where preambleBlock = (mempty <$ spaces1)+ <|> macroDef (rawBlock "latex")+ <|> filecontents+ <|> (mempty <$ blockCommand)+ <|> (mempty <$ braced)+ <|> (do notFollowedBy (begin_ "document")+ anyTok+ return mempty)++rule :: PandocMonad m => LP m Blocks+rule = do+ skipopts+ width <- T.takeWhile (\c -> isDigit c || c == '.') . stringify <$> tok+ _thickness <- tok+ -- 0-width rules are used to fix spacing issues:+ case safeRead width of+ Just (0 :: Double) -> return mempty+ _ -> return horizontalRule++paragraph :: PandocMonad m => LP m Blocks+paragraph = do+ x <- trimInlines . mconcat <$> many1 inline+ if x == mempty+ then return mempty+ else return $ para x++rawBlockOr :: PandocMonad m => Text -> LP m Blocks -> LP m Blocks+rawBlockOr name fallback = do+ -- if raw_tex allowed, don't process+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions+ if parseRaw+ then rawBlock "latex" <$> getRawCommand name ("\\" <> name)+ else fallback++doSubfile :: PandocMonad m => LP m Blocks+doSubfile = do+ skipMany opt+ f <- T.unpack . removeDoubleQuotes . T.strip . untokenize <$> braced+ oldToks <- getInput+ setInput []+ insertIncluded ".tex" f+ bs <- blocks+ eof+ setInput oldToks+ return bs++include :: (PandocMonad m, Monoid a) => Text -> LP m a+include name = do+ skipMany opt+ fs <- map (T.unpack . removeDoubleQuotes . T.strip) . T.splitOn "," .+ untokenize <$> braced+ let defaultExt | name == "usepackage" = ".sty"+ | otherwise = ".tex"+ mapM_ (insertIncluded defaultExt) fs+ return mempty++readFileFromTexinputs :: PandocMonad m => FilePath -> LP m (Maybe Text)+readFileFromTexinputs fp = do+ fileContentsMap <- sFileContents <$> getState+ case M.lookup (T.pack fp) fileContentsMap of+ Just t -> return (Just t)+ Nothing -> do+ dirs <- map T.unpack . splitTextBy (==':') . fromMaybe "."+ <$> lookupEnv "TEXINPUTS"+ readFileFromDirs dirs fp++insertIncluded :: PandocMonad m+ => FilePath+ -> FilePath+ -> LP m ()+insertIncluded defaultExtension f' = do+ let f = case takeExtension f' of+ ".tex" -> f'+ ".sty" -> f'+ _ -> addExtension f' defaultExtension+ pos <- getPosition+ containers <- getIncludeFiles <$> getState+ when (T.pack f `elem` containers) $+ throwError $ PandocParseError $ T.pack $ "Include file loop at " ++ show pos+ updateState $ addIncludeFile $ T.pack f+ mbcontents <- readFileFromTexinputs f+ contents <- case mbcontents of+ Just s -> return s+ Nothing -> do+ report $ CouldNotLoadIncludeFile (T.pack f) pos+ return ""+ getInput >>= setInput . (tokenize f contents ++)+ updateState dropLatestIncludeFile++authors :: PandocMonad m => LP m ()+authors = try $ do+ bgroup+ let oneAuthor = blocksToInlines' . B.toList . mconcat <$> many1 block+ auths <- sepBy oneAuthor (controlSeq "and")+ egroup+ addMeta "author" (map trimInlines auths)++looseItem :: PandocMonad m => LP m Blocks+looseItem = do+ inListItem <- sInListItem <$> getState+ guard $ not inListItem+ skipopts+ return mempty++epigraph :: PandocMonad m => LP m Blocks+epigraph = do+ p1 <- grouped block+ p2 <- grouped block+ return $ divWith ("", ["epigraph"], []) (p1 <> p2)++section :: PandocMonad m => Attr -> Int -> LP m Blocks+section (ident, classes, kvs) lvl = do+ skipopts+ contents <- grouped inline+ lab <- option ident $+ try (spaces >> controlSeq "label"+ >> spaces >> untokenize <$> braced)+ when (lvl == 0) $+ updateState $ \st -> st{ sHasChapters = True }+ unless ("unnumbered" `elem` classes) $ do+ hn <- sLastHeaderNum <$> getState+ hasChapters <- sHasChapters <$> getState+ let lvl' = lvl + if hasChapters then 1 else 0+ let num = incrementDottedNum lvl' hn+ updateState $ \st -> st{ sLastHeaderNum = num+ , sLabels = M.insert lab+ [Str (renderDottedNum num)]+ (sLabels st) }+ attr' <- registerHeader (lab, classes, kvs) contents+ return $ headerWith attr' lvl contents++blockCommand :: PandocMonad m => LP m Blocks+blockCommand = try $ do+ Tok _ (CtrlSeq name) txt <- anyControlSeq+ guard $ name /= "begin" && name /= "end" && name /= "and"+ star <- option "" ("*" <$ symbol '*' <* sp)+ let name' = name <> star+ let names = ordNub [name', name]+ let rawDefiniteBlock = do+ guard $ isBlockCommand name+ rawcontents <- getRawCommand name (txt <> star)+ (guardEnabled Ext_raw_tex >> return (rawBlock "latex" rawcontents))+ <|> ignore rawcontents+ -- heuristic: if it could be either block or inline, we+ -- treat it if block if we have a sequence of block+ -- commands followed by a newline. But we stop if we+ -- hit a \startXXX, since this might start a raw ConTeXt+ -- environment (this is important because this parser is+ -- used by the Markdown reader).+ let startCommand = try $ do+ Tok _ (CtrlSeq n) _ <- anyControlSeq+ guard $ "start" `T.isPrefixOf` n+ let rawMaybeBlock = try $ do+ guard $ not $ isInlineCommand name+ rawcontents <- getRawCommand name (txt <> star)+ curr <- (guardEnabled Ext_raw_tex >>+ return (rawBlock "latex" rawcontents))+ <|> ignore rawcontents+ rest <- many $ notFollowedBy startCommand *> blockCommand+ lookAhead $ blankline <|> startCommand+ return $ curr <> mconcat rest+ let raw = rawDefiniteBlock <|> rawMaybeBlock+ lookupListDefault raw names blockCommands++closing :: PandocMonad m => LP m Blocks+closing = do+ contents <- tok+ st <- getState+ let extractInlines (MetaBlocks [Plain ys]) = ys+ extractInlines (MetaBlocks [Para ys ]) = ys+ extractInlines _ = []+ let sigs = case lookupMeta "author" (sMeta st) of+ Just (MetaList xs) ->+ para $ trimInlines $ fromList $+ intercalate [LineBreak] $ map extractInlines xs+ _ -> mempty+ return $ para (trimInlines contents) <> sigs++parbox :: PandocMonad m => LP m Blocks+parbox = try $ do+ skipopts+ braced -- size+ oldInTableCell <- sInTableCell <$> getState+ -- see #5711+ updateState $ \st -> st{ sInTableCell = False }+ res <- grouped block+ updateState $ \st -> st{ sInTableCell = oldInTableCell }+ return res++blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)+blockCommands = M.fromList+ [ ("par", mempty <$ skipopts)+ , ("parbox", parbox)+ , ("title", mempty <$ (skipopts *>+ (grouped inline >>= addMeta "title")+ <|> (grouped block >>= addMeta "title")))+ , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))+ , ("author", mempty <$ (skipopts *> authors))+ -- -- in letter class, temp. store address & sig as title, author+ , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))+ , ("signature", mempty <$ (skipopts *> authors))+ , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))+ , ("newtheorem", newtheorem inline)+ , ("theoremstyle", theoremstyle)+ -- KOMA-Script metadata commands+ , ("extratitle", mempty <$ (skipopts *> tok >>= addMeta "extratitle"))+ , ("frontispiece", mempty <$ (skipopts *> tok >>= addMeta "frontispiece"))+ , ("titlehead", mempty <$ (skipopts *> tok >>= addMeta "titlehead"))+ , ("subject", mempty <$ (skipopts *> tok >>= addMeta "subject"))+ , ("publishers", mempty <$ (skipopts *> tok >>= addMeta "publishers"))+ , ("uppertitleback", mempty <$ (skipopts *> tok >>= addMeta "uppertitleback"))+ , ("lowertitleback", mempty <$ (skipopts *> tok >>= addMeta "lowertitleback"))+ , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))+ -- sectioning+ , ("part", section nullAttr (-1))+ , ("part*", section nullAttr (-1))+ , ("chapter", section nullAttr 0)+ , ("chapter*", section ("",["unnumbered"],[]) 0)+ , ("section", section nullAttr 1)+ , ("section*", section ("",["unnumbered"],[]) 1)+ , ("subsection", section nullAttr 2)+ , ("subsection*", section ("",["unnumbered"],[]) 2)+ , ("subsubsection", section nullAttr 3)+ , ("subsubsection*", section ("",["unnumbered"],[]) 3)+ , ("paragraph", section nullAttr 4)+ , ("paragraph*", section ("",["unnumbered"],[]) 4)+ , ("subparagraph", section nullAttr 5)+ , ("subparagraph*", section ("",["unnumbered"],[]) 5)+ -- beamer slides+ , ("frametitle", section nullAttr 3)+ , ("framesubtitle", section nullAttr 4)+ -- letters+ , ("opening", para . trimInlines <$> (skipopts *> tok))+ , ("closing", skipopts *> closing)+ -- memoir+ , ("plainbreak", braced >> pure horizontalRule)+ , ("plainbreak*", braced >> pure horizontalRule)+ , ("fancybreak", braced >> pure horizontalRule)+ , ("fancybreak*", braced >> pure horizontalRule)+ , ("plainfancybreak", braced >> braced >> braced >> pure horizontalRule)+ , ("plainfancybreak*", braced >> braced >> braced >> pure horizontalRule)+ , ("pfbreak", pure horizontalRule)+ , ("pfbreak*", pure horizontalRule)+ --+ , ("hrule", pure horizontalRule)+ , ("strut", pure mempty)+ , ("rule", rule)+ , ("item", looseItem)+ , ("documentclass", skipopts *> braced *> preamble)+ , ("centerline", para . trimInlines <$> (skipopts *> tok))+ , ("caption", mempty <$ setCaption inline)+ , ("bibliography", mempty <$ (skipopts *> braced >>=+ addMeta "bibliography" . splitBibs . untokenize))+ , ("addbibresource", mempty <$ (skipopts *> braced >>=+ addMeta "bibliography" . splitBibs . untokenize))+ , ("endinput", mempty <$ skipMany anyTok)+ -- includes+ , ("lstinputlisting", inputListing)+ , ("inputminted", inputMinted)+ , ("graphicspath", graphicsPath)+ -- polyglossia+ , ("setdefaultlanguage", setDefaultLanguage)+ , ("setmainlanguage", setDefaultLanguage)+ -- hyperlink+ , ("hypertarget", hypertargetBlock)+ -- LaTeX colors+ , ("textcolor", coloredBlock "color")+ , ("colorbox", coloredBlock "background-color")+ -- csquotes+ , ("blockquote", blockquote False Nothing)+ , ("blockcquote", blockquote True Nothing)+ , ("foreignblockquote", braced >>= blockquote False . Just . untokenize)+ , ("foreignblockcquote", braced >>= blockquote True . Just . untokenize)+ , ("hyphenblockquote", braced >>= blockquote False . Just . untokenize)+ , ("hyphenblockcquote", braced >>= blockquote True . Just . untokenize)+ -- include+ , ("include", rawBlockOr "include" $ include "include")+ , ("input", rawBlockOr "input" $ include "input")+ , ("subfile", rawBlockOr "subfile" doSubfile)+ , ("usepackage", rawBlockOr "usepackage" $ include "usepackage")+ -- preamble+ , ("PackageError", mempty <$ (braced >> braced >> braced))+ -- epigraph package+ , ("epigraph", epigraph)+ ]+++environments :: PandocMonad m => M.Map Text (LP m Blocks)+environments = M.union (tableEnvironments blocks inline) $+ M.fromList+ [ ("document", env "document" blocks <* skipMany anyTok)+ , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))+ , ("sloppypar", env "sloppypar" blocks)+ , ("letter", env "letter" letterContents)+ , ("minipage", env "minipage" $+ skipopts *> spaces *> optional braced *> spaces *> blocks)+ , ("figure", env "figure" $ skipopts *> figure)+ , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)+ , ("center", divWith ("", ["center"], []) <$> env "center" blocks)+ , ("quote", blockQuote <$> env "quote" blocks)+ , ("quotation", blockQuote <$> env "quotation" blocks)+ , ("verse", blockQuote <$> env "verse" blocks)+ , ("itemize", bulletList <$> listenv "itemize" (many item))+ , ("description", definitionList <$> listenv "description" (many descItem))+ , ("enumerate", orderedList')+ , ("alltt", alltt <$> env "alltt" blocks)+ , ("code", guardEnabled Ext_literate_haskell *>+ (codeBlockWith ("",["haskell","literate"],[]) <$> verbEnv "code"))+ , ("comment", mempty <$ verbEnv "comment")+ , ("verbatim", codeBlock <$> verbEnv "verbatim")+ , ("Verbatim", fancyverbEnv "Verbatim")+ , ("BVerbatim", fancyverbEnv "BVerbatim")+ , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals+ codeBlockWith attr <$> verbEnv "lstlisting")+ , ("minted", minted)+ , ("obeylines", obeylines)+ , ("tikzpicture", rawVerbEnv "tikzpicture")+ , ("tikzcd", rawVerbEnv "tikzcd")+ , ("lilypond", rawVerbEnv "lilypond")+ , ("ly", rawVerbEnv "ly")+ -- amsthm+ , ("proof", proof blocks opt)+ -- etoolbox+ , ("ifstrequal", ifstrequal)+ , ("newtoggle", braced >>= newToggle)+ , ("toggletrue", braced >>= setToggle True)+ , ("togglefalse", braced >>= setToggle False)+ , ("iftoggle", try $ ifToggle >> block)+ ]++filecontents :: PandocMonad m => LP m Blocks+filecontents = try $ do+ controlSeq "begin"+ name <- untokenize <$> braced+ guard $ name == "filecontents" || name == "filecontents*"+ skipopts+ fp <- untokenize <$> braced+ txt <- verbEnv name+ updateState $ \st ->+ st{ sFileContents = M.insert fp txt (sFileContents st) }+ return mempty++environment :: PandocMonad m => LP m Blocks+environment = try $ do+ controlSeq "begin"+ name <- untokenize <$> braced+ M.findWithDefault mzero name environments <|>+ theoremEnvironment blocks opt name <|>+ if M.member name (inlineEnvironments+ :: M.Map Text (LP PandocPure Inlines))+ then mzero+ else try (rawEnv name) <|> rawVerbEnv name++rawEnv :: PandocMonad m => Text -> LP m Blocks+rawEnv name = do+ exts <- getOption readerExtensions+ let parseRaw = extensionEnabled Ext_raw_tex exts+ rawOptions <- mconcat <$> many rawopt+ let beginCommand = "\\begin{" <> name <> "}" <> rawOptions+ pos1 <- getPosition+ if parseRaw+ then do+ (_, raw) <- withRaw $ env name blocks+ return $ rawBlock "latex"+ $ beginCommand <> untokenize raw+ else do+ bs <- env name blocks+ report $ SkippedContent beginCommand pos1+ pos2 <- getPosition+ report $ SkippedContent ("\\end{" <> name <> "}") pos2+ return $ divWith ("",[name],[]) bs++rawVerbEnv :: PandocMonad m => Text -> LP m Blocks+rawVerbEnv name = do+ pos <- getPosition+ (_, raw) <- withRaw $ verbEnv name+ let raw' = "\\begin{" <> name <> "}" <> untokenize raw+ exts <- getOption readerExtensions+ let parseRaw = extensionEnabled Ext_raw_tex exts+ if parseRaw+ then return $ rawBlock "latex" raw'+ else do+ report $ SkippedContent raw' pos+ return mempty++fancyverbEnv :: PandocMonad m => Text -> LP m Blocks+fancyverbEnv name = do+ options <- option [] keyvals+ let kvs = [ (if k == "firstnumber"+ then "startFrom"+ else k, v) | (k,v) <- options ]+ let classes = [ "numberLines" |+ lookup "numbers" options == Just "left" ]+ let attr = ("",classes,kvs)+ codeBlockWith attr <$> verbEnv name++obeylines :: PandocMonad m => LP m Blocks+obeylines =+ para . fromList . removeLeadingTrailingBreaks .+ walk softBreakToHard . toList <$> env "obeylines" inlines+ where softBreakToHard SoftBreak = LineBreak+ softBreakToHard x = x+ removeLeadingTrailingBreaks = reverse . dropWhile isLineBreak .+ reverse . dropWhile isLineBreak+ isLineBreak LineBreak = True+ isLineBreak _ = False++minted :: PandocMonad m => LP m Blocks+minted = do+ attr <- mintedAttr+ codeBlockWith attr <$> verbEnv "minted"++mintedAttr :: PandocMonad m => LP m Attr+mintedAttr = do+ options <- option [] keyvals+ lang <- untokenize <$> braced+ let kvs = [ (if k == "firstnumber"+ then "startFrom"+ else k, v) | (k,v) <- options ]+ let classes = [ lang | not (T.null lang) ] +++ [ "numberLines" |+ lookup "linenos" options == Just "true" ]+ return ("",classes,kvs)++inputMinted :: PandocMonad m => LP m Blocks+inputMinted = do+ pos <- getPosition+ attr <- mintedAttr+ f <- T.filter (/='"') . untokenize <$> braced+ mbCode <- readFileFromTexinputs (T.unpack f)+ rawcode <- case mbCode of+ Just s -> return s+ Nothing -> do+ report $ CouldNotLoadIncludeFile f pos+ return ""+ return $ B.codeBlockWith attr rawcode++letterContents :: PandocMonad m => LP m Blocks+letterContents = do+ bs <- blocks+ st <- getState+ -- add signature (author) and address (title)+ let addr = case lookupMeta "address" (sMeta st) of+ Just (MetaBlocks [Plain xs]) ->+ para $ trimInlines $ fromList xs+ _ -> mempty+ return $ addr <> bs -- sig added by \closing++figure :: PandocMonad m => LP m Blocks+figure = try $ do+ resetCaption+ blocks >>= addImageCaption++addImageCaption :: PandocMonad m => Blocks -> LP m Blocks+addImageCaption = walkM go+ where go (Image attr@(_, cls, kvs) alt (src,tit))+ | not ("fig:" `T.isPrefixOf` tit) = do+ st <- getState+ let (alt', tit') = case sCaption st of+ Just ils -> (toList ils, "fig:" <> tit)+ Nothing -> (alt, tit)+ attr' = case sLastLabel st of+ Just lab -> (lab, cls, kvs)+ Nothing -> attr+ case attr' of+ ("", _, _) -> return ()+ (ident, _, _) -> do+ num <- getNextNumber sLastFigureNum+ setState+ st{ sLastFigureNum = num+ , sLabels = M.insert ident+ [Str (renderDottedNum num)] (sLabels st) }+ return $ Image attr' alt' (src, tit')+ go x = return x++coloredBlock :: PandocMonad m => Text -> LP m Blocks+coloredBlock stylename = try $ do+ skipopts+ color <- braced+ notFollowedBy (grouped inline)+ let constructor = divWith ("",[],[("style",stylename <> ": " <> untokenize color)])+ constructor <$> grouped block++graphicsPath :: PandocMonad m => LP m Blocks+graphicsPath = do+ ps <- map (T.unpack . untokenize) <$>+ (bgroup *> spaces *> manyTill (braced <* spaces) egroup)+ getResourcePath >>= setResourcePath . (<> ps)+ return mempty++splitBibs :: Text -> [Inlines]+splitBibs = map (str . T.pack . flip replaceExtension "bib" . T.unpack . trim) . splitTextBy (==',')++alltt :: Blocks -> Blocks+alltt = walk strToCode+ where strToCode (Str s) = Code nullAttr s+ strToCode Space = RawInline (Format "latex") "\\ "+ strToCode SoftBreak = LineBreak+ strToCode x = x++parseListingsOptions :: [(Text, Text)] -> Attr+parseListingsOptions options =+ let kvs = [ (if k == "firstnumber"+ then "startFrom"+ else k, v) | (k,v) <- options ]+ classes = [ "numberLines" |+ lookup "numbers" options == Just "left" ]+ ++ maybeToList (listingsLanguage options)+ in (fromMaybe "" (lookup "label" options), classes, kvs)++inputListing :: PandocMonad m => LP m Blocks+inputListing = do+ pos <- getPosition+ options <- option [] keyvals+ f <- T.filter (/='"') . untokenize <$> braced+ mbCode <- readFileFromTexinputs (T.unpack f)+ codeLines <- case mbCode of+ Just s -> return $ T.lines s+ Nothing -> do+ report $ CouldNotLoadIncludeFile f pos+ return []+ let (ident,classes,kvs) = parseListingsOptions options+ let classes' =+ (case listingsLanguage options of+ Nothing -> (take 1 (languagesByExtension (T.pack $ takeExtension $ T.unpack f)) <>)+ Just _ -> id) classes+ let firstline = fromMaybe 1 $ lookup "firstline" options >>= safeRead+ let lastline = fromMaybe (length codeLines) $+ lookup "lastline" options >>= safeRead+ let codeContents = T.intercalate "\n" $ take (1 + lastline - firstline) $+ drop (firstline - 1) codeLines+ return $ codeBlockWith (ident,classes',kvs) codeContents++-- lists++item :: PandocMonad m => LP m Blocks+item = void blocks *> controlSeq "item" *> skipopts *> blocks++descItem :: PandocMonad m => LP m (Inlines, [Blocks])+descItem = do+ blocks -- skip blocks before item+ controlSeq "item"+ sp+ ils <- opt+ bs <- blocks+ return (ils, [bs])++listenv :: PandocMonad m => Text -> LP m a -> LP m a+listenv name p = try $ do+ oldInListItem <- sInListItem `fmap` getState+ updateState $ \st -> st{ sInListItem = True }+ res <- env name p+ updateState $ \st -> st{ sInListItem = oldInListItem }+ return res++orderedList' :: PandocMonad m => LP m Blocks+orderedList' = try $ do+ spaces+ let markerSpec = do+ symbol '['+ ts <- untokenize <$> manyTill anyTok (symbol ']')+ case runParser anyOrderedListMarker def "option" ts of+ Right r -> return r+ Left _ -> do+ pos <- getPosition+ report $ SkippedContent ("[" <> ts <> "]") pos+ return (1, DefaultStyle, DefaultDelim)+ (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) markerSpec+ spaces+ optional $ try $ controlSeq "setlength"+ *> grouped (count 1 $ controlSeq "itemindent")+ *> braced+ spaces+ start <- option 1 $ try $ do pos <- getPosition+ controlSeq "setcounter"+ ctr <- untokenize <$> braced+ guard $ "enum" `T.isPrefixOf` ctr+ guard $ T.all (`elem` ['i','v']) (T.drop 4 ctr)+ sp+ num <- untokenize <$> braced+ case safeRead num of+ Just i -> return (i + 1 :: Int)+ Nothing -> do+ report $ SkippedContent+ ("\\setcounter{" <> ctr <>+ "}{" <> num <> "}") pos+ return 1+ bs <- listenv "enumerate" (many item)+ return $ orderedListWith (start, style, delim) bs++block :: PandocMonad m => LP m Blocks+block = do+ Tok _ toktype _ <- lookAhead anyTok+ res <- (case toktype of+ Newline -> mempty <$ spaces1+ Spaces -> mempty <$ spaces1+ Comment -> mempty <$ spaces1+ Word -> paragraph+ CtrlSeq "begin" -> environment+ CtrlSeq _ -> macroDef (rawBlock "latex")+ <|> blockCommand+ _ -> mzero)+ <|> paragraph+ <|> grouped block+ trace (T.take 60 $ tshow $ B.toList res)+ return res++blocks :: PandocMonad m => LP m Blocks+blocks = mconcat <$> many block+
+ src/Text/Pandoc/Readers/LaTeX/Citation.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+module Text.Pandoc.Readers.LaTeX.Citation+ ( citationCommands+ , cites+ )+where++import Text.Pandoc.Class+import Text.Pandoc.Readers.LaTeX.Parsing+import Text.Pandoc.Builder as B+import qualified Data.Map as M+import Data.Text (Text)+import Control.Applicative ((<|>), optional, many)+import Control.Monad (mzero)+import Control.Monad.Trans (lift)+import Control.Monad.Except (throwError)+import Text.Pandoc.Error (PandocError(PandocParsecError))+import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,+ optional, space, spaces, withRaw, (<|>))++citationCommands :: PandocMonad m => LP m Inlines -> M.Map Text (LP m Inlines)+citationCommands inline =+ let citation = citationWith inline+ tok = spaces *> grouped inline+ in M.fromList+ [ ("cite", citation "cite" NormalCitation False)+ , ("Cite", citation "Cite" NormalCitation False)+ , ("citep", citation "citep" NormalCitation False)+ , ("citep*", citation "citep*" NormalCitation False)+ , ("citeal", citation "citeal" NormalCitation False)+ , ("citealp", citation "citealp" NormalCitation False)+ , ("citealp*", citation "citealp*" NormalCitation False)+ , ("autocite", citation "autocite" NormalCitation False)+ , ("smartcite", citation "smartcite" NormalCitation False)+ , ("footcite", inNote <$> citation "footcite" NormalCitation False)+ , ("parencite", citation "parencite" NormalCitation False)+ , ("supercite", citation "supercite" NormalCitation False)+ , ("footcitetext", inNote <$> citation "footcitetext" NormalCitation False)+ , ("citeyearpar", citation "citeyearpar" SuppressAuthor False)+ , ("citeyear", citation "citeyear" SuppressAuthor False)+ , ("autocite*", citation "autocite*" SuppressAuthor False)+ , ("cite*", citation "cite*" SuppressAuthor False)+ , ("parencite*", citation "parencite*" SuppressAuthor False)+ , ("textcite", citation "textcite" AuthorInText False)+ , ("citet", citation "citet" AuthorInText False)+ , ("citet*", citation "citet*" AuthorInText False)+ , ("citealt", citation "citealt" AuthorInText False)+ , ("citealt*", citation "citealt*" AuthorInText False)+ , ("textcites", citation "textcites" AuthorInText True)+ , ("cites", citation "cites" NormalCitation True)+ , ("autocites", citation "autocites" NormalCitation True)+ , ("footcites", inNote <$> citation "footcites" NormalCitation True)+ , ("parencites", citation "parencites" NormalCitation True)+ , ("supercites", citation "supercites" NormalCitation True)+ , ("footcitetexts", inNote <$> citation "footcitetexts" NormalCitation True)+ , ("Autocite", citation "Autocite" NormalCitation False)+ , ("Smartcite", citation "Smartcite" NormalCitation False)+ , ("Footcite", inNote <$> citation "Footcite" NormalCitation False)+ , ("Parencite", citation "Parencite" NormalCitation False)+ , ("Supercite", citation "Supercite" NormalCitation False)+ , ("Footcitetext", inNote <$> citation "Footcitetext" NormalCitation False)+ , ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False)+ , ("Citeyear", citation "Citeyear" SuppressAuthor False)+ , ("Autocite*", citation "Autocite*" SuppressAuthor False)+ , ("Cite*", citation "Cite*" SuppressAuthor False)+ , ("Parencite*", citation "Parencite*" SuppressAuthor False)+ , ("Textcite", citation "Textcite" AuthorInText False)+ , ("Textcites", citation "Textcites" AuthorInText True)+ , ("Cites", citation "Cites" NormalCitation True)+ , ("Autocites", citation "Autocites" NormalCitation True)+ , ("Footcites", inNote <$> citation "Footcites" NormalCitation True)+ , ("Parencites", citation "Parencites" NormalCitation True)+ , ("Supercites", citation "Supercites" NormalCitation True)+ , ("Footcitetexts", inNote <$> citation "Footcitetexts" NormalCitation True)+ , ("citetext", complexNatbibCitation inline NormalCitation)+ , ("citeauthor", (try (tok *> sp *> controlSeq "citetext") *>+ complexNatbibCitation inline AuthorInText)+ <|> citation "citeauthor" AuthorInText False)+ , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=+ addMeta "nocite"))+ ]++-- citations++addPrefix :: [Inline] -> [Citation] -> [Citation]+addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks+addPrefix _ _ = []++addSuffix :: [Inline] -> [Citation] -> [Citation]+addSuffix s ks@(_:_) =+ let k = last ks+ in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]+addSuffix _ _ = []++simpleCiteArgs :: forall m . PandocMonad m => LP m Inlines -> LP m [Citation]+simpleCiteArgs inline = try $ do+ first <- optionMaybe $ toList <$> opt+ second <- optionMaybe $ toList <$> opt+ keys <- try $ bgroup *> manyTill citationLabel egroup+ let (pre, suf) = case (first , second ) of+ (Just s , Nothing) -> (mempty, s )+ (Just s , Just t ) -> (s , t )+ _ -> (mempty, mempty)+ conv k = Citation { citationId = k+ , citationPrefix = []+ , citationSuffix = []+ , citationMode = NormalCitation+ , citationHash = 0+ , citationNoteNum = 0+ }+ return $ addPrefix pre $ addSuffix suf $ map conv keys+ where+ opt :: PandocMonad m => LP m Inlines+ opt = do+ toks <- try (sp *> bracketedToks <* sp)+ -- now parse the toks as inlines+ st <- getState+ parsed <- lift $+ runParserT (mconcat <$> many inline) st "bracketed option" toks+ case parsed of+ Right result -> return result+ Left e -> throwError $ PandocParsecError (untokenize toks) e++++citationLabel :: PandocMonad m => LP m Text+citationLabel = do+ sp+ untokenize <$>+ (many1 (satisfyTok isWordTok <|> symbolIn bibtexKeyChar)+ <* sp+ <* optional (symbol ',')+ <* sp)+ where bibtexKeyChar = ".:;?!`'()/*@_+=-&[]" :: [Char]++cites :: PandocMonad m+ => LP m Inlines -> CitationMode -> Bool -> LP m [Citation]+cites inline mode multi = try $ do+ let paropt = parenWrapped inline+ cits <- if multi+ then do+ multiprenote <- optionMaybe $ toList <$> paropt+ multipostnote <- optionMaybe $ toList <$> paropt+ let (pre, suf) = case (multiprenote, multipostnote) of+ (Just s , Nothing) -> (mempty, s)+ (Nothing , Just t) -> (mempty, t)+ (Just s , Just t ) -> (s, t)+ _ -> (mempty, mempty)+ tempCits <- many1 $ simpleCiteArgs inline+ case tempCits of+ (k:ks) -> case ks of+ (_:_) -> return $ (addMprenote pre k : init ks) +++ [addMpostnote suf (last ks)]+ _ -> return [addMprenote pre (addMpostnote suf k)]+ _ -> return [[]]+ else count 1 $ simpleCiteArgs inline+ let cs = concat cits+ return $ case mode of+ AuthorInText -> case cs of+ (c:rest) -> c {citationMode = mode} : rest+ [] -> []+ _ -> map (\a -> a {citationMode = mode}) cs+ where mprenote (k:ks) = (k:ks) ++ [Space]+ mprenote _ = mempty+ mpostnote (k:ks) = [Str ",", Space] ++ (k:ks)+ mpostnote _ = mempty+ addMprenote mpn (k:ks) =+ let mpnfinal = case citationPrefix k of+ (_:_) -> mprenote mpn+ _ -> mpn+ in addPrefix mpnfinal (k:ks)+ addMprenote _ _ = []+ addMpostnote = addSuffix . mpostnote++citationWith :: PandocMonad m+ => LP m Inlines -> Text -> CitationMode -> Bool -> LP m Inlines+citationWith inline name mode multi = do+ (c,raw) <- withRaw $ cites inline mode multi+ return $ cite c (rawInline "latex" $ "\\" <> name <> untokenize raw)++handleCitationPart :: Inlines -> [Citation]+handleCitationPart ils =+ let isCite Cite{} = True+ isCite _ = False+ (pref, rest) = break isCite (toList ils)+ in case rest of+ (Cite cs _:suff) -> addPrefix pref $ addSuffix suff cs+ _ -> []++complexNatbibCitation :: PandocMonad m+ => LP m Inlines -> CitationMode -> LP m Inlines+complexNatbibCitation inline mode = try $ do+ (cs, raw) <-+ withRaw $ concat <$> do+ bgroup+ items <- mconcat <$>+ many1 (notFollowedBy (symbol ';') >> inline)+ `sepBy1` symbol ';'+ egroup+ return $ map handleCitationPart items+ case cs of+ [] -> mzero+ (c:cits) -> return $ cite (c{ citationMode = mode }:cits)+ (rawInline "latex" $ "\\citetext" <> untokenize raw)++inNote :: Inlines -> Inlines+inNote ils =+ note $ para $ ils <> str "."+
+ src/Text/Pandoc/Readers/LaTeX/Inline.hs view
@@ -0,0 +1,397 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{- |+ Module : Text.Pandoc.Readers.LaTeX.Inline+ Copyright : Copyright (C) 2006-2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable+-}+module Text.Pandoc.Readers.LaTeX.Inline+ ( acronymCommands+ , verbCommands+ , charCommands+ , accentCommands+ , nameCommands+ , biblatexInlineCommands+ , refCommands+ , rawInlineOr+ , listingsLanguage+ )+where++import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import Text.Pandoc.Builder+import Text.Pandoc.Shared (toRomanNumeral, safeRead)+import Text.Pandoc.Readers.LaTeX.Types (Tok (..), TokType (..))+import Control.Applicative (optional, (<|>))+import Control.Monad (guard, mzero, mplus, unless)+import Text.Pandoc.Class.PandocMonad (PandocMonad (..), translateTerm)+import Text.Pandoc.Readers.LaTeX.Parsing+import Text.Pandoc.Extensions (extensionEnabled, Extension(..))+import Text.Pandoc.Parsing (getOption, updateState, getState, notFollowedBy,+ manyTill, getInput, setInput, incSourceColumn,+ option, many1, try)+import Data.Char (isDigit)+import Text.Pandoc.Highlighting (fromListingsLanguage,)+import Data.Maybe (maybeToList, fromMaybe)+import Text.Pandoc.Options (ReaderOptions(..))+import qualified Data.Text.Normalize as Normalize+import qualified Text.Pandoc.Translations as Translations++rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines+rawInlineOr name' fallback = do+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions+ if parseRaw+ then rawInline "latex" <$> getRawCommand name' ("\\" <> name')+ else fallback++dolabel :: PandocMonad m => LP m Inlines+dolabel = do+ v <- braced+ let refstr = untokenize v+ updateState $ \st ->+ st{ sLastLabel = Just refstr }+ return $ spanWith (refstr,[],[("label", refstr)])+ $ inBrackets $ str $ untokenize v++doref :: PandocMonad m => Text -> LP m Inlines+doref cls = do+ v <- braced+ let refstr = untokenize v+ return $ linkWith ("",[],[ ("reference-type", cls)+ , ("reference", refstr)])+ ("#" <> refstr)+ ""+ (inBrackets $ str refstr)++inBrackets :: Inlines -> Inlines+inBrackets x = str "[" <> x <> str "]"++doTerm :: PandocMonad m => Translations.Term -> LP m Inlines+doTerm term = str <$> translateTerm term++lit :: Text -> LP m Inlines+lit = pure . str++doverb :: PandocMonad m => LP m Inlines+doverb = do+ Tok _ Symbol t <- anySymbol+ marker <- case T.uncons t of+ Just (c, ts) | T.null ts -> return c+ _ -> mzero+ withVerbatimMode $+ code . untokenize <$>+ manyTill (notFollowedBy newlineTok >> verbTok marker) (symbol marker)++verbTok :: PandocMonad m => Char -> LP m Tok+verbTok stopchar = do+ t@(Tok pos toktype txt) <- anyTok+ case T.findIndex (== stopchar) txt of+ Nothing -> return t+ Just i -> do+ let (t1, t2) = T.splitAt i txt+ inp <- getInput+ setInput $ Tok (incSourceColumn pos i) Symbol (T.singleton stopchar)+ : totoks (incSourceColumn pos (i + 1)) (T.drop 1 t2) ++ inp+ return $ Tok pos toktype t1++listingsLanguage :: [(Text, Text)] -> Maybe Text+listingsLanguage opts =+ case lookup "language" opts of+ Nothing -> Nothing+ Just l -> fromListingsLanguage l `mplus` Just l++dolstinline :: PandocMonad m => LP m Inlines+dolstinline = do+ options <- option [] keyvals+ let classes = maybeToList $ listingsLanguage options+ doinlinecode classes++domintinline :: PandocMonad m => LP m Inlines+domintinline = do+ skipopts+ cls <- untokenize <$> braced+ doinlinecode [cls]++doinlinecode :: PandocMonad m => [Text] -> LP m Inlines+doinlinecode classes = do+ Tok _ Symbol t <- anySymbol+ marker <- case T.uncons t of+ Just (c, ts) | T.null ts -> return c+ _ -> mzero+ let stopchar = if marker == '{' then '}' else marker+ withVerbatimMode $+ codeWith ("",classes,[]) . T.map nlToSpace . untokenize <$>+ manyTill (verbTok stopchar) (symbol stopchar)++nlToSpace :: Char -> Char+nlToSpace '\n' = ' '+nlToSpace x = x++romanNumeralUpper :: (PandocMonad m) => LP m Inlines+romanNumeralUpper =+ str . toRomanNumeral <$> romanNumeralArg++romanNumeralLower :: (PandocMonad m) => LP m Inlines+romanNumeralLower =+ str . T.toLower . toRomanNumeral <$> romanNumeralArg++romanNumeralArg :: (PandocMonad m) => LP m Int+romanNumeralArg = spaces *> (parser <|> inBraces)+ where+ inBraces = do+ symbol '{'+ spaces+ res <- parser+ spaces+ symbol '}'+ return res+ parser = do+ s <- untokenize <$> many1 (satisfyTok isWordTok)+ let (digits, rest) = T.span isDigit s+ unless (T.null rest) $+ Prelude.fail "Non-digits in argument to \\Rn or \\RN"+ safeRead digits++accentWith :: PandocMonad m+ => LP m Inlines -> Char -> Maybe Char -> LP m Inlines+accentWith tok combiningAccent fallBack = try $ do+ ils <- tok+ case toList ils of+ (Str (T.uncons -> Just (x, xs)) : ys) -> return $ fromList $+ -- try to normalize to the combined character:+ Str (Normalize.normalize Normalize.NFC+ (T.pack [x, combiningAccent]) <> xs) : ys+ [Space] -> return $ str $ T.singleton+ $ fromMaybe combiningAccent fallBack+ [] -> return $ str $ T.singleton+ $ fromMaybe combiningAccent fallBack+ _ -> return ils+++verbCommands :: PandocMonad m => M.Map Text (LP m Inlines)+verbCommands = M.fromList+ [ ("verb", doverb)+ , ("lstinline", dolstinline)+ , ("mintinline", domintinline)+ , ("Verb", doverb)+ ]++accentCommands :: PandocMonad m => LP m Inlines -> M.Map Text (LP m Inlines)+accentCommands tok =+ let accent = accentWith tok+ in M.fromList+ [ ("aa", lit "å")+ , ("AA", lit "Å")+ , ("ss", lit "ß")+ , ("o", lit "ø")+ , ("O", lit "Ø")+ , ("L", lit "Ł")+ , ("l", lit "ł")+ , ("ae", lit "æ")+ , ("AE", lit "Æ")+ , ("oe", lit "œ")+ , ("OE", lit "Œ")+ , ("pounds", lit "£")+ , ("euro", lit "€")+ , ("copyright", lit "©")+ , ("textasciicircum", lit "^")+ , ("textasciitilde", lit "~")+ , ("H", accent '\779' Nothing) -- hungarumlaut+ , ("`", accent '\768' (Just '`')) -- grave+ , ("'", accent '\769' (Just '\'')) -- acute+ , ("^", accent '\770' (Just '^')) -- circ+ , ("~", accent '\771' (Just '~')) -- tilde+ , ("\"", accent '\776' Nothing) -- umlaut+ , (".", accent '\775' Nothing) -- dot+ , ("=", accent '\772' Nothing) -- macron+ , ("|", accent '\781' Nothing) -- vertical line above+ , ("b", accent '\817' Nothing) -- macron below+ , ("c", accent '\807' Nothing) -- cedilla+ , ("G", accent '\783' Nothing) -- doublegrave+ , ("h", accent '\777' Nothing) -- hookabove+ , ("d", accent '\803' Nothing) -- dotbelow+ , ("f", accent '\785' Nothing) -- inverted breve+ , ("r", accent '\778' Nothing) -- ringabove+ , ("t", accent '\865' Nothing) -- double inverted breve+ , ("U", accent '\782' Nothing) -- double vertical line above+ , ("v", accent '\780' Nothing) -- hacek+ , ("u", accent '\774' Nothing) -- breve+ , ("k", accent '\808' Nothing) -- ogonek+ , ("textogonekcentered", accent '\808' Nothing) -- ogonek+ , ("i", lit "ı") -- dotless i+ , ("j", lit "ȷ") -- dotless j+ , ("newtie", accent '\785' Nothing) -- inverted breve+ , ("textcircled", accent '\8413' Nothing) -- combining circle+ ]++charCommands :: PandocMonad m => M.Map Text (LP m Inlines)+charCommands = M.fromList+ [ ("ldots", lit "…")+ , ("vdots", lit "\8942")+ , ("dots", lit "…")+ , ("mdots", lit "…")+ , ("sim", lit "~")+ , ("sep", lit ",")+ , ("P", lit "¶")+ , ("S", lit "§")+ , ("$", lit "$")+ , ("%", lit "%")+ , ("&", lit "&")+ , ("#", lit "#")+ , ("_", lit "_")+ , ("{", lit "{")+ , ("}", lit "}")+ , ("qed", lit "\a0\x25FB")+ , ("lq", return (str "‘"))+ , ("rq", return (str "’"))+ , ("textquoteleft", return (str "‘"))+ , ("textquoteright", return (str "’"))+ , ("textquotedblleft", return (str "“"))+ , ("textquotedblright", return (str "”"))+ , ("/", pure mempty) -- italic correction+ , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState+ guard $ not inTableCell+ optional rawopt+ spaces))+ , (",", lit "\8198")+ , ("@", pure mempty)+ , (" ", lit "\160")+ , ("ps", pure $ str "PS." <> space)+ , ("TeX", lit "TeX")+ , ("LaTeX", lit "LaTeX")+ , ("bar", lit "|")+ , ("textless", lit "<")+ , ("textgreater", lit ">")+ , ("textbackslash", lit "\\")+ , ("backslash", lit "\\")+ , ("slash", lit "/")+ -- fontawesome+ , ("faCheck", lit "\10003")+ , ("faClose", lit "\10007")+ -- hyphenat+ , ("bshyp", lit "\\\173")+ , ("fshyp", lit "/\173")+ , ("dothyp", lit ".\173")+ , ("colonhyp", lit ":\173")+ , ("hyp", lit "-")+ ]++biblatexInlineCommands :: PandocMonad m+ => LP m Inlines -> M.Map Text (LP m Inlines)+biblatexInlineCommands tok = M.fromList+ -- biblatex misc+ [ ("RN", romanNumeralUpper)+ , ("Rn", romanNumeralLower)+ , ("mkbibquote", spanWith nullAttr . doubleQuoted <$> tok)+ , ("mkbibemph", spanWith nullAttr . emph <$> tok)+ , ("mkbibitalic", spanWith nullAttr . emph <$> tok)+ , ("mkbibbold", spanWith nullAttr . strong <$> tok)+ , ("mkbibparens",+ spanWith nullAttr . (\x -> str "(" <> x <> str ")") <$> tok)+ , ("mkbibbrackets",+ spanWith nullAttr . (\x -> str "[" <> x <> str "]") <$> tok)+ , ("autocap", spanWith nullAttr <$> tok)+ , ("textnormal", spanWith ("",["nodecor"],[]) <$> tok)+ , ("bibstring",+ (\x -> spanWith ("",[],[("bibstring",x)]) (str x)) . untokenize+ <$> braced)+ , ("adddot", pure (str "."))+ , ("adddotspace", pure (spanWith nullAttr (str "." <> space)))+ , ("addabbrvspace", pure space)+ , ("hyphen", pure (str "-"))+ ]++nameCommands :: PandocMonad m => M.Map Text (LP m Inlines)+nameCommands = M.fromList+ [ ("figurename", doTerm Translations.Figure)+ , ("prefacename", doTerm Translations.Preface)+ , ("refname", doTerm Translations.References)+ , ("bibname", doTerm Translations.Bibliography)+ , ("chaptername", doTerm Translations.Chapter)+ , ("partname", doTerm Translations.Part)+ , ("contentsname", doTerm Translations.Contents)+ , ("listfigurename", doTerm Translations.ListOfFigures)+ , ("listtablename", doTerm Translations.ListOfTables)+ , ("indexname", doTerm Translations.Index)+ , ("abstractname", doTerm Translations.Abstract)+ , ("tablename", doTerm Translations.Table)+ , ("enclname", doTerm Translations.Encl)+ , ("ccname", doTerm Translations.Cc)+ , ("headtoname", doTerm Translations.To)+ , ("pagename", doTerm Translations.Page)+ , ("seename", doTerm Translations.See)+ , ("seealsoname", doTerm Translations.SeeAlso)+ , ("proofname", doTerm Translations.Proof)+ , ("glossaryname", doTerm Translations.Glossary)+ , ("lstlistingname", doTerm Translations.Listing)+ ]++refCommands :: PandocMonad m => M.Map Text (LP m Inlines)+refCommands = M.fromList+ [ ("label", rawInlineOr "label" dolabel)+ , ("ref", rawInlineOr "ref" $ doref "ref")+ , ("cref", rawInlineOr "cref" $ doref "ref") -- from cleveref.sty+ , ("vref", rawInlineOr "vref" $ doref "ref+page") -- from varioref.sty+ , ("eqref", rawInlineOr "eqref" $ doref "eqref") -- from amsmath.sty+ ]++acronymCommands :: PandocMonad m => M.Map Text (LP m Inlines)+acronymCommands = M.fromList+ -- glossaries package+ [ ("gls", doAcronym "short")+ , ("Gls", doAcronym "short")+ , ("glsdesc", doAcronym "long")+ , ("Glsdesc", doAcronym "long")+ , ("GLSdesc", doAcronym "long")+ , ("acrlong", doAcronym "long")+ , ("Acrlong", doAcronym "long")+ , ("acrfull", doAcronym "full")+ , ("Acrfull", doAcronym "full")+ , ("acrshort", doAcronym "abbrv")+ , ("Acrshort", doAcronym "abbrv")+ , ("glspl", doAcronymPlural "short")+ , ("Glspl", doAcronymPlural "short")+ , ("glsdescplural", doAcronymPlural "long")+ , ("Glsdescplural", doAcronymPlural "long")+ , ("GLSdescplural", doAcronymPlural "long")+ -- acronyms package+ , ("ac", doAcronym "short")+ , ("acf", doAcronym "full")+ , ("acs", doAcronym "abbrv")+ , ("acl", doAcronym "long")+ , ("acp", doAcronymPlural "short")+ , ("acfp", doAcronymPlural "full")+ , ("acsp", doAcronymPlural "abbrv")+ , ("aclp", doAcronymPlural "long")+ , ("Ac", doAcronym "short")+ , ("Acf", doAcronym "full")+ , ("Acs", doAcronym "abbrv")+ , ("Acl", doAcronym "long")+ , ("Acp", doAcronymPlural "short")+ , ("Acfp", doAcronymPlural "full")+ , ("Acsp", doAcronymPlural "abbrv")+ , ("Aclp", doAcronymPlural "long")+ ]++doAcronym :: PandocMonad m => Text -> LP m Inlines+doAcronym form = do+ acro <- braced+ return . mconcat $ [spanWith ("",[],[("acronym-label", untokenize acro),+ ("acronym-form", "singular+" <> form)])+ $ str $ untokenize acro]++doAcronymPlural :: PandocMonad m => Text -> LP m Inlines+doAcronymPlural form = do+ acro <- braced+ let plural = str "s"+ return . mconcat $ [spanWith ("",[],[("acronym-label", untokenize acro),+ ("acronym-form", "plural+" <> form)]) $+ mconcat [str $ untokenize acro, plural]]++
src/Text/Pandoc/Readers/LaTeX/Lang.hs view
@@ -12,13 +12,89 @@ BCP47 'Lang'. -} module Text.Pandoc.Readers.LaTeX.Lang- ( polyglossiaLangToBCP47+ ( setDefaultLanguage+ , polyglossiaLangToBCP47 , babelLangToBCP47+ , enquoteCommands+ , inlineLanguageCommands ) where import qualified Data.Map as M+import Data.Text (Text) import qualified Data.Text as T-import Text.Pandoc.BCP47 (Lang(..))+import Text.Pandoc.Shared (extractSpaces)+import Text.Pandoc.BCP47 (Lang(..), renderLang)+import Text.Pandoc.Class (PandocMonad(..), setTranslations)+import Text.Pandoc.Readers.LaTeX.Parsing+import Text.Pandoc.Parsing (updateState, option, getState, QuoteContext(..),+ withQuoteContext)+import Text.Pandoc.Builder (Blocks, Inlines, setMeta, str, spanWith,+ singleQuoted, doubleQuoted)++enquote :: PandocMonad m+ => LP m Inlines+ -> Bool -> Maybe Text -> LP m Inlines+enquote tok starred mblang = do+ skipopts+ let lang = mblang >>= babelLangToBCP47+ let langspan = case lang of+ Nothing -> id+ Just l -> spanWith ("",[],[("lang", renderLang l)])+ quoteContext <- sQuoteContext <$> getState+ if starred || quoteContext == InDoubleQuote+ then singleQuoted . langspan <$> withQuoteContext InSingleQuote tok+ else doubleQuoted . langspan <$> withQuoteContext InDoubleQuote tok++enquoteCommands :: PandocMonad m+ => LP m Inlines -> M.Map Text (LP m Inlines)+enquoteCommands tok = M.fromList+ [ ("enquote*", enquote tok True Nothing)+ , ("enquote", enquote tok False Nothing)+ -- foreignquote is supposed to use native quote marks+ , ("foreignquote*", braced >>= enquote tok True . Just . untokenize)+ , ("foreignquote", braced >>= enquote tok False . Just . untokenize)+ -- hypehnquote uses regular quotes+ , ("hyphenquote*", braced >>= enquote tok True . Just . untokenize)+ , ("hyphenquote", braced >>= enquote tok False . Just . untokenize)+ ]++foreignlanguage :: PandocMonad m => LP m Inlines -> LP m Inlines+foreignlanguage tok = do+ babelLang <- untokenize <$> braced+ case babelLangToBCP47 babelLang of+ Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok+ _ -> tok++inlineLanguageCommands :: PandocMonad m+ => LP m Inlines -> M.Map Text (LP m Inlines)+inlineLanguageCommands tok =+ M.fromList $+ ("foreignlanguage", foreignlanguage tok) :+ (mk <$> M.toList polyglossiaLangToBCP47)+ where+ mk (polyglossia, bcp47Func) =+ ("text" <> polyglossia, inlineLanguage tok bcp47Func)++inlineLanguage :: PandocMonad m+ => LP m Inlines -> (Text -> Lang) -> LP m Inlines+inlineLanguage tok bcp47Func = do+ o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')+ <$> rawopt+ let lang = renderLang $ bcp47Func o+ extractSpaces (spanWith ("", [], [("lang", lang)])) <$> tok++setDefaultLanguage :: PandocMonad m => LP m Blocks+setDefaultLanguage = do+ o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')+ <$> rawopt+ polylang <- untokenize <$> braced+ case M.lookup polylang polyglossiaLangToBCP47 of+ Nothing -> return mempty -- TODO mzero? warning?+ Just langFunc -> do+ let l = langFunc o+ setTranslations l+ updateState $ setMeta "lang" $ str (renderLang l)+ return mempty polyglossiaLangToBCP47 :: M.Map T.Text (T.Text -> Lang) polyglossiaLangToBCP47 = M.fromList
+ src/Text/Pandoc/Readers/LaTeX/Macro.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Pandoc.Readers.LaTeX.Macro+ ( macroDef+ )+where+import Text.Pandoc.Extensions (Extension(..))+import Text.Pandoc.Logging (LogMessage(MacroAlreadyDefined))+import Text.Pandoc.Readers.LaTeX.Parsing+import Text.Pandoc.Readers.LaTeX.Types+import Text.Pandoc.Class+import Text.Pandoc.Shared (safeRead)+import Text.Pandoc.Parsing hiding (blankline, mathDisplay, mathInline,+ optional, space, spaces, withRaw, (<|>))+import Control.Applicative ((<|>), optional)+import qualified Data.Map as M+import Data.Text (Text)++macroDef :: (PandocMonad m, Monoid a) => (Text -> a) -> LP m a+macroDef constructor = do+ (_, s) <- withRaw (commandDef <|> environmentDef)+ (constructor (untokenize s) <$+ guardDisabled Ext_latex_macros)+ <|> return mempty+ where commandDef = do+ (name, macro') <- newcommand <|> letmacro <|> defmacro+ guardDisabled Ext_latex_macros <|>+ updateState (\s -> s{ sMacros = M.insert name macro' (sMacros s) })+ environmentDef = do+ mbenv <- newenvironment+ case mbenv of+ Nothing -> return ()+ Just (name, macro1, macro2) ->+ guardDisabled Ext_latex_macros <|>+ do updateState $ \s -> s{ sMacros =+ M.insert name macro1 (sMacros s) }+ updateState $ \s -> s{ sMacros =+ M.insert ("end" <> name) macro2 (sMacros s) }+ -- @\newenvironment{envname}[n-args][default]{begin}{end}@+ -- is equivalent to+ -- @\newcommand{\envname}[n-args][default]{begin}@+ -- @\newcommand{\endenvname}@++letmacro :: PandocMonad m => LP m (Text, Macro)+letmacro = do+ controlSeq "let"+ (name, contents) <- withVerbatimMode $ do+ Tok _ (CtrlSeq name) _ <- anyControlSeq+ optional $ symbol '='+ spaces+ -- we first parse in verbatim mode, and then expand macros,+ -- because we don't want \let\foo\bar to turn into+ -- \let\foo hello if we have previously \def\bar{hello}+ contents <- bracedOrToken+ return (name, contents)+ contents' <- doMacros' 0 contents+ return (name, Macro ExpandWhenDefined [] Nothing contents')++defmacro :: PandocMonad m => LP m (Text, Macro)+defmacro = try $+ -- we use withVerbatimMode, because macros are to be expanded+ -- at point of use, not point of definition+ withVerbatimMode $ do+ controlSeq "def"+ Tok _ (CtrlSeq name) _ <- anyControlSeq+ argspecs <- many (argspecArg <|> argspecPattern)+ contents <- bracedOrToken+ return (name, Macro ExpandWhenUsed argspecs Nothing contents)++argspecArg :: PandocMonad m => LP m ArgSpec+argspecArg = do+ Tok _ (Arg i) _ <- satisfyTok isArgTok+ return $ ArgNum i++argspecPattern :: PandocMonad m => LP m ArgSpec+argspecPattern =+ Pattern <$> many1 (satisfyTok (\(Tok _ toktype' txt) ->+ (toktype' == Symbol || toktype' == Word) &&+ (txt /= "{" && txt /= "\\" && txt /= "}")))++newcommand :: PandocMonad m => LP m (Text, Macro)+newcommand = do+ pos <- getPosition+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newcommand" <|>+ controlSeq "renewcommand" <|>+ controlSeq "providecommand" <|>+ controlSeq "DeclareMathOperator" <|>+ controlSeq "DeclareRobustCommand"+ withVerbatimMode $ do+ Tok _ (CtrlSeq name) txt <- do+ optional (symbol '*')+ anyControlSeq <|>+ (symbol '{' *> spaces *> anyControlSeq <* spaces <* symbol '}')+ spaces+ numargs <- option 0 $ try bracketedNum+ let argspecs = map ArgNum [1..numargs]+ spaces+ optarg <- option Nothing $ Just <$> try bracketedToks+ spaces+ contents' <- bracedOrToken+ let contents =+ case mtype of+ "DeclareMathOperator" ->+ Tok pos (CtrlSeq "mathop") "\\mathop"+ : Tok pos Symbol "{"+ : Tok pos (CtrlSeq "mathrm") "\\mathrm"+ : Tok pos Symbol "{"+ : (contents' +++ [ Tok pos Symbol "}", Tok pos Symbol "}" ])+ _ -> contents'+ macros <- sMacros <$> getState+ case M.lookup name macros of+ Just macro+ | mtype == "newcommand" -> do+ report $ MacroAlreadyDefined txt pos+ return (name, macro)+ | mtype == "providecommand" -> return (name, macro)+ _ -> return (name, Macro ExpandWhenUsed argspecs optarg contents)++newenvironment :: PandocMonad m => LP m (Maybe (Text, Macro, Macro))+newenvironment = do+ pos <- getPosition+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newenvironment" <|>+ controlSeq "renewenvironment" <|>+ controlSeq "provideenvironment"+ withVerbatimMode $ do+ optional $ symbol '*'+ spaces+ name <- untokenize <$> braced+ spaces+ numargs <- option 0 $ try bracketedNum+ spaces+ optarg <- option Nothing $ Just <$> try bracketedToks+ let argspecs = map (\i -> ArgNum i) [1..numargs]+ startcontents <- spaces >> bracedOrToken+ endcontents <- spaces >> bracedOrToken+ macros <- sMacros <$> getState+ case M.lookup name macros of+ Just _+ | mtype == "newenvironment" -> do+ report $ MacroAlreadyDefined name pos+ return Nothing+ | mtype == "provideenvironment" ->+ return Nothing+ _ -> return $ Just (name,+ Macro ExpandWhenUsed argspecs optarg startcontents,+ Macro ExpandWhenUsed [] Nothing endcontents)++bracketedNum :: PandocMonad m => LP m Int+bracketedNum = do+ ds <- untokenize <$> bracketedToks+ case safeRead ds of+ Just i -> return i+ _ -> return 0
+ src/Text/Pandoc/Readers/LaTeX/Math.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Pandoc.Readers.LaTeX.Math+ ( dollarsMath+ , inlineEnvironments+ , inlineEnvironment+ , mathInline+ , mathDisplay+ , theoremstyle+ , theoremEnvironment+ , newtheorem+ , proof+ )+where+import Data.Maybe (fromMaybe)+import Text.Pandoc.Walk (walk)+import Text.Pandoc.Builder as B+import qualified Data.Sequence as Seq+import Text.Pandoc.Readers.LaTeX.Parsing+import Text.Pandoc.Readers.LaTeX.Types+import Text.Pandoc.Class+import Text.Pandoc.Shared (trimMath, stripTrailingNewlines)+import Text.Pandoc.Parsing hiding (blankline, mathDisplay, mathInline,+ optional, space, spaces, withRaw, (<|>))+import Control.Applicative ((<|>), optional)+import Control.Monad (guard, mzero)+import qualified Data.Map as M+import Data.Text (Text)++dollarsMath :: PandocMonad m => LP m Inlines+dollarsMath = do+ symbol '$'+ display <- option False (True <$ symbol '$')+ (do contents <- try $ untokenize <$> pDollarsMath 0+ if display+ then mathDisplay contents <$ symbol '$'+ else return $ mathInline contents)+ <|> (guard display >> return (mathInline ""))++-- Int is number of embedded groupings+pDollarsMath :: PandocMonad m => Int -> LP m [Tok]+pDollarsMath n = do+ tk@(Tok _ toktype t) <- anyTok+ case toktype of+ Symbol | t == "$"+ , n == 0 -> return []+ | t == "\\" -> do+ tk' <- anyTok+ (tk :) . (tk' :) <$> pDollarsMath n+ | t == "{" -> (tk :) <$> pDollarsMath (n+1)+ | t == "}" ->+ if n > 0+ then (tk :) <$> pDollarsMath (n-1)+ else mzero+ _ -> (tk :) <$> pDollarsMath n++mathDisplay :: Text -> Inlines+mathDisplay = displayMath . trimMath++mathInline :: Text -> Inlines+mathInline = math . trimMath++mathEnvWith :: PandocMonad m+ => (Inlines -> a) -> Maybe Text -> Text -> LP m a+mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name+ where inner x = case innerEnv of+ Nothing -> x+ Just y -> "\\begin{" <> y <> "}\n" <> x <>+ "\\end{" <> y <> "}"++mathEnv :: PandocMonad m => Text -> LP m Text+mathEnv name = do+ skipopts+ optional blankline+ res <- manyTill anyTok (end_ name)+ return $ stripTrailingNewlines $ untokenize res++inlineEnvironment :: PandocMonad m => LP m Inlines+inlineEnvironment = try $ do+ controlSeq "begin"+ name <- untokenize <$> braced+ M.findWithDefault mzero name inlineEnvironments++inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)+inlineEnvironments = M.fromList [+ ("displaymath", mathEnvWith id Nothing "displaymath")+ , ("math", math <$> mathEnv "math")+ , ("equation", mathEnvWith id Nothing "equation")+ , ("equation*", mathEnvWith id Nothing "equation*")+ , ("gather", mathEnvWith id (Just "gathered") "gather")+ , ("gather*", mathEnvWith id (Just "gathered") "gather*")+ , ("multline", mathEnvWith id (Just "gathered") "multline")+ , ("multline*", mathEnvWith id (Just "gathered") "multline*")+ , ("eqnarray", mathEnvWith id (Just "aligned") "eqnarray")+ , ("eqnarray*", mathEnvWith id (Just "aligned") "eqnarray*")+ , ("align", mathEnvWith id (Just "aligned") "align")+ , ("align*", mathEnvWith id (Just "aligned") "align*")+ , ("alignat", mathEnvWith id (Just "aligned") "alignat")+ , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")+ , ("dmath", mathEnvWith id Nothing "dmath")+ , ("dmath*", mathEnvWith id Nothing "dmath*")+ , ("dgroup", mathEnvWith id (Just "aligned") "dgroup")+ , ("dgroup*", mathEnvWith id (Just "aligned") "dgroup*")+ , ("darray", mathEnvWith id (Just "aligned") "darray")+ , ("darray*", mathEnvWith id (Just "aligned") "darray*")+ ]++theoremstyle :: PandocMonad m => LP m Blocks+theoremstyle = do+ stylename <- untokenize <$> braced+ let mbstyle = case stylename of+ "plain" -> Just PlainStyle+ "definition" -> Just DefinitionStyle+ "remark" -> Just RemarkStyle+ _ -> Nothing+ case mbstyle of+ Nothing -> return ()+ Just sty -> updateState $ \s -> s{ sLastTheoremStyle = sty }+ return mempty++newtheorem :: PandocMonad m => LP m Inlines -> LP m Blocks+newtheorem inline = do+ number <- option True (False <$ symbol '*' <* sp)+ name <- untokenize <$> braced+ sp+ series <- option Nothing $ Just . untokenize <$> bracketedToks+ sp+ showName <- tokWith inline+ sp+ syncTo <- option Nothing $ Just . untokenize <$> bracketedToks+ sty <- sLastTheoremStyle <$> getState+ let spec = TheoremSpec { theoremName = showName+ , theoremStyle = sty+ , theoremSeries = series+ , theoremSyncTo = syncTo+ , theoremNumber = number+ , theoremLastNum = DottedNum [0] }+ tmap <- sTheoremMap <$> getState+ updateState $ \s -> s{ sTheoremMap =+ M.insert name spec tmap }+ return mempty++theoremEnvironment :: PandocMonad m+ => LP m Blocks -> LP m Inlines -> Text -> LP m Blocks+theoremEnvironment blocks opt name = do+ tmap <- sTheoremMap <$> getState+ case M.lookup name tmap of+ Nothing -> mzero+ Just tspec -> do+ optTitle <- option mempty $ (\x -> space <> "(" <> x <> ")") <$> opt+ mblabel <- option Nothing $ Just . untokenize <$>+ try (spaces >> controlSeq "label" >> spaces >> braced)+ bs <- env name blocks+ number <-+ if theoremNumber tspec+ then do+ let name' = fromMaybe name $ theoremSeries tspec+ num <- getNextNumber+ (maybe (DottedNum [0]) theoremLastNum .+ M.lookup name' . sTheoremMap)+ updateState $ \s ->+ s{ sTheoremMap =+ M.adjust+ (\spec -> spec{ theoremLastNum = num })+ name'+ (sTheoremMap s)+ }++ case mblabel of+ Just ident ->+ updateState $ \s ->+ s{ sLabels = M.insert ident+ (B.toList $+ theoremName tspec <> "\160" <>+ str (renderDottedNum num)) (sLabels s) }+ Nothing -> return ()+ return $ space <> B.text (renderDottedNum num)+ else return mempty+ let titleEmph = case theoremStyle tspec of+ PlainStyle -> B.strong+ DefinitionStyle -> B.strong+ RemarkStyle -> B.emph+ let title = titleEmph (theoremName tspec <> number)+ <> optTitle <> "." <> space+ return $ divWith (fromMaybe "" mblabel, [name], []) $ addTitle title+ $ case theoremStyle tspec of+ PlainStyle -> walk italicize bs+ _ -> bs++++proof :: PandocMonad m => LP m Blocks -> LP m Inlines -> LP m Blocks+proof blocks opt = do+ title <- option (B.text "Proof") opt+ bs <- env "proof" blocks+ return $+ B.divWith ("", ["proof"], []) $+ addQed $ addTitle (B.emph (title <> ".")) bs++addTitle :: Inlines -> Blocks -> Blocks+addTitle ils bs =+ case B.toList bs of+ (Para xs : rest)+ -> B.fromList (Para (B.toList ils ++ (Space : xs)) : rest)+ _ -> B.para ils <> bs++addQed :: Blocks -> Blocks+addQed bs =+ case Seq.viewr (B.unMany bs) of+ s Seq.:> Para ils+ -> B.Many (s Seq.|> Para (ils ++ B.toList qedSign))+ _ -> bs <> B.para qedSign+ where+ qedSign = B.str "\xa0\x25FB"++italicize :: Block -> Block+italicize x@(Para [Image{}]) = x -- see #6925+italicize (Para ils) = Para [Emph ils]+italicize (Plain ils) = Plain [Emph ils]+italicize x = x++
src/Text/Pandoc/Readers/LaTeX/Parsing.hs view
@@ -32,6 +32,8 @@ , totoks , toksToString , satisfyTok+ , parseFromToks+ , disablingWithRaw , doMacros , doMacros' , setpos@@ -52,6 +54,7 @@ , comment , anyTok , singleChar+ , tokWith , specialChars , endline , blankline@@ -78,6 +81,11 @@ , rawopt , overlaySpecification , getNextNumber+ , label+ , setCaption+ , resetCaption+ , env+ , addMeta ) where import Control.Applicative (many, (<|>))@@ -87,13 +95,15 @@ import Data.Char (chr, isAlphaNum, isDigit, isLetter, ord) import Data.Default import Data.List (intercalate)+import qualified Data.IntMap as IntMap import qualified Data.Map as M import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Builder import Text.Pandoc.Class.PandocMonad (PandocMonad, report)-import Text.Pandoc.Error (PandocError (PandocMacroLoop))+import Text.Pandoc.Error+ (PandocError (PandocMacroLoop,PandocShouldNeverHappenError)) import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,@@ -151,8 +161,9 @@ , sLabels :: M.Map Text [Inline] , sHasChapters :: Bool , sToggles :: M.Map Text Bool- , sExpanded :: Bool , sFileContents :: M.Map Text Text+ , sEnableWithRaw :: Bool+ , sRawTokens :: IntMap.IntMap [Tok] } deriving Show @@ -177,8 +188,9 @@ , sLabels = M.empty , sHasChapters = False , sToggles = M.empty- , sExpanded = False , sFileContents = M.empty+ , sEnableWithRaw = True+ , sRawTokens = IntMap.empty } instance PandocMonad m => HasQuoteContext LaTeXState m where@@ -248,7 +260,6 @@ Right toks' -> do res <- lift $ runParserT (do when retokenize $ do -- retokenize, applying macros- doMacros ts <- many (satisfyTok (const True)) setInput ts rawparser)@@ -281,6 +292,15 @@ Left e -> Prelude.fail (show e) Right s' -> return s' +{-+When tokenize or untokenize change, test with this+QuickCheck property:++> tokUntokRoundtrip :: String -> Bool+> tokUntokRoundtrip s =+> let t = T.pack s in untokenize (tokenize "random" t) == t+-}+ tokenize :: SourceName -> Text -> [Tok] tokenize sourcename = totoks (initialPos sourcename) @@ -404,12 +424,31 @@ toksToString :: [Tok] -> String toksToString = T.unpack . untokenize +parseFromToks :: PandocMonad m => LP m a -> [Tok] -> LP m a+parseFromToks parser toks = do+ oldInput <- getInput+ setInput toks+ result <- disablingWithRaw parser+ setInput oldInput+ return result++disablingWithRaw :: PandocMonad m => LP m a -> LP m a+disablingWithRaw parser = do+ oldEnableWithRaw <- sEnableWithRaw <$> getState+ updateState $ \st -> st{ sEnableWithRaw = False }+ result <- parser+ updateState $ \st -> st{ sEnableWithRaw = oldEnableWithRaw }+ return result+ satisfyTok :: PandocMonad m => (Tok -> Bool) -> LP m Tok satisfyTok f = do doMacros -- apply macros on remaining input stream res <- tokenPrim (T.unpack . untoken) updatePos matcher- updateState $ \st -> st{ sExpanded = False }- return res+ updateState $ \st ->+ if sEnableWithRaw st+ then st{ sRawTokens = IntMap.map (res:) $ sRawTokens st }+ else st+ return $! res where matcher t | f t = Just t | otherwise = Nothing updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos@@ -418,27 +457,24 @@ doMacros :: PandocMonad m => LP m () doMacros = do- expanded <- sExpanded <$> getState- verbatimMode <- sVerbatimMode <$> getState- unless (expanded || verbatimMode) $ do- getInput >>= doMacros' 1 >>= setInput- updateState $ \st -> st{ sExpanded = True }+ st <- getState+ unless (sVerbatimMode st || M.null (sMacros st)) $ do+ getInput >>= doMacros' 1 >>= setInput doMacros' :: PandocMonad m => Int -> [Tok] -> LP m [Tok] doMacros' n inp = case inp of Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" : Tok _ Word name : Tok _ Symbol "}" : ts- -> handleMacros n spos name ts+ -> handleMacros n spos name ts <|> return inp Tok spos (CtrlSeq "end") _ : Tok _ Symbol "{" : Tok _ Word name : Tok _ Symbol "}" : ts- -> handleMacros n spos ("end" <> name) ts+ -> handleMacros n spos ("end" <> name) ts <|> return inp Tok _ (CtrlSeq "expandafter") _ : t : ts -> combineTok t <$> doMacros' n ts Tok spos (CtrlSeq name) _ : ts- -> handleMacros n spos name ts+ -> handleMacros n spos name ts <|> return inp _ -> return inp- <|> return inp where combineTok (Tok spos (CtrlSeq name) x) (Tok _ Word w : ts)@@ -594,18 +630,22 @@ anyTok :: PandocMonad m => LP m Tok anyTok = satisfyTok (const True) +singleCharTok :: PandocMonad m => LP m Tok+singleCharTok =+ satisfyTok $ \case+ Tok _ Word t -> T.length t == 1+ Tok _ Symbol t -> not (T.any (`Set.member` specialChars) t)+ _ -> False+ singleChar :: PandocMonad m => LP m Tok-singleChar = try $ do- Tok pos toktype t <- satisfyTok (tokTypeIn [Word, Symbol])- guard $ not $ toktype == Symbol &&- T.any (`Set.member` specialChars) t- if T.length t > 1- then do- let (t1, t2) = (T.take 1 t, T.drop 1 t)- inp <- getInput- setInput $ Tok (incSourceColumn pos 1) toktype t2 : inp- return $ Tok pos toktype t1- else return $ Tok pos toktype t+singleChar = singleCharTok <|> singleCharFromWord+ where+ singleCharFromWord = do+ Tok pos toktype t <- disablingWithRaw $ satisfyTok isWordTok+ let (t1, t2) = (T.take 1 t, T.drop 1 t)+ inp <- getInput+ setInput $ Tok pos toktype t1 : Tok (incSourceColumn pos 1) toktype t2 : inp+ anyTok specialChars :: Set.Set Char specialChars = Set.fromList "#$%&~_^\\{}"@@ -648,28 +688,25 @@ -- {{a,b}} should be parsed the same as {a,b} try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup) -braced' :: PandocMonad m => LP m Tok -> Int -> LP m [Tok]-braced' getTok n =- handleEgroup <|> handleBgroup <|> handleOther- where handleEgroup = do- t <- symbol '}'- if n == 1- then return []- else (t:) <$> braced' getTok (n - 1)- handleBgroup = do- t <- symbol '{'- (t:) <$> braced' getTok (n + 1)- handleOther = do- t <- getTok- (t:) <$> braced' getTok n+braced' :: PandocMonad m => LP m Tok -> LP m [Tok]+braced' getTok = symbol '{' *> go (1 :: Int)+ where+ go n = do+ t <- getTok+ case t of+ Tok _ Symbol "}"+ | n > 1 -> (t:) <$> go (n - 1)+ | otherwise -> return []+ Tok _ Symbol "{" -> (t:) <$> go (n + 1)+ _ -> (t:) <$> go n braced :: PandocMonad m => LP m [Tok]-braced = symbol '{' *> braced' anyTok 1+braced = braced' anyTok -- URLs require special handling, because they can contain % -- characters. So we retonenize comments as we go... bracedUrl :: PandocMonad m => LP m [Tok]-bracedUrl = bgroup *> braced' (retokenizeComment >> anyTok) 1+bracedUrl = braced' (retokenizeComment >> anyTok) -- For handling URLs, which allow literal % characters... retokenizeComment :: PandocMonad m => LP m ()@@ -725,11 +762,23 @@ withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok]) withRaw parser = do- inp <- getInput+ rawTokensMap <- sRawTokens <$> getState+ let key = case IntMap.lookupMax rawTokensMap of+ Nothing -> 0+ Just (n,_) -> n + 1+ -- insert empty list at key+ updateState $ \st -> st{ sRawTokens =+ IntMap.insert key [] $ sRawTokens st } result <- parser- nxtpos <- option Nothing ((\(Tok pos' _ _) -> Just pos') <$> lookAhead anyTok)- let raw = takeWhile (\(Tok pos _ _) -> maybe True- (\p -> sourceName p /= sourceName pos || pos < p) nxtpos) inp+ mbRevToks <- IntMap.lookup key . sRawTokens <$> getState+ raw <- case mbRevToks of+ Just revtoks -> do+ updateState $ \st -> st{ sRawTokens =+ IntMap.delete key $ sRawTokens st}+ return $ reverse revtoks+ Nothing ->+ throwError $ PandocShouldNeverHappenError $+ "sRawTokens has nothing at key " <> T.pack (show key) return (result, raw) keyval :: PandocMonad m => LP m (Text, Text)@@ -794,7 +843,7 @@ (_, rawargs) <- withRaw $ case name of "write" -> do- void $ satisfyTok isWordTok -- digits+ void $ many $ satisfyTok isDigitTok -- digits void braced "titleformat" -> do void braced@@ -809,6 +858,10 @@ void $ many braced return $ txt <> untokenize rawargs +isDigitTok :: Tok -> Bool+isDigitTok (Tok _ Word t) = T.all isDigit t+isDigitTok _ = False+ skipopts :: PandocMonad m => LP m () skipopts = skipMany (void overlaySpecification <|> void rawopt) @@ -876,3 +929,35 @@ Just n -> [n, 1] Nothing -> [1] +label :: PandocMonad m => LP m ()+label = do+ controlSeq "label"+ t <- braced+ updateState $ \st -> st{ sLastLabel = Just $ untokenize t }++setCaption :: PandocMonad m => LP m Inlines -> LP m ()+setCaption inline = try $ do+ skipopts+ ils <- tokWith inline+ optional $ try $ spaces *> label+ updateState $ \st -> st{ sCaption = Just ils }++resetCaption :: PandocMonad m => LP m ()+resetCaption = updateState $ \st -> st{ sCaption = Nothing+ , sLastLabel = Nothing }++env :: PandocMonad m => Text -> LP m a -> LP m a+env name p = p <* end_ name++tokWith :: PandocMonad m => LP m Inlines -> LP m Inlines+tokWith inlineParser = try $ spaces >>+ grouped inlineParser+ <|> (lookAhead anyControlSeq >> inlineParser)+ <|> singleChar'+ where singleChar' = do+ Tok _ _ t <- singleChar+ return $ str t++addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> LP m ()+addMeta field val = updateState $ \st ->+ st{ sMeta = addMetaField field val $ sMeta st }
src/Text/Pandoc/Readers/LaTeX/SIunitx.hs view
@@ -1,12 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Text.Pandoc.Readers.LaTeX.SIunitx- ( dosi- , doSI- , doSIrange- , doSInum- , doSInumlist- , doSIang- )+ ( siunitxCommands ) where import Text.Pandoc.Builder import Text.Pandoc.Readers.LaTeX.Parsing@@ -20,6 +14,19 @@ import Data.Text (Text) import qualified Data.Text as T import Data.List (intersperse)+++siunitxCommands :: PandocMonad m+ => LP m Inlines -> M.Map Text (LP m Inlines)+siunitxCommands tok = M.fromList+ [ ("si", skipopts *> dosi tok)+ , ("SI", doSI tok)+ , ("SIrange", doSIrange True tok)+ , ("numrange", doSIrange False tok)+ , ("numlist", doSInumlist)+ , ("num", doSInum)+ , ("ang", doSIang)+ ] dosi :: PandocMonad m => LP m Inlines -> LP m Inlines dosi tok = grouped (siUnit tok) <|> siUnit tok
+ src/Text/Pandoc/Readers/LaTeX/Table.hs view
@@ -0,0 +1,378 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+module Text.Pandoc.Readers.LaTeX.Table+ ( tableEnvironments )+where++import Data.Functor (($>))+import Text.Pandoc.Class+import Text.Pandoc.Readers.LaTeX.Parsing+import Text.Pandoc.Readers.LaTeX.Types+import Text.Pandoc.Builder as B+import qualified Data.Map as M+import Data.Text (Text)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import Control.Applicative ((<|>), optional, many)+import Control.Monad (when, void)+import Text.Pandoc.Shared (safeRead, trim)+import Text.Pandoc.Logging (LogMessage(SkippedContent))+import Text.Pandoc.Walk (walkM)+import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,+ optional, space, spaces, withRaw, (<|>))++tableEnvironments :: PandocMonad m+ => LP m Blocks+ -> LP m Inlines+ -> M.Map Text (LP m Blocks)+tableEnvironments blocks inline =+ M.fromList+ [ ("longtable", env "longtable" $+ resetCaption *>+ simpTable blocks inline "longtable" False >>= addTableCaption)+ , ("table", env "table" $+ skipopts *> resetCaption *> blocks >>= addTableCaption)+ , ("tabular*", env "tabular*" $ simpTable blocks inline "tabular*" True)+ , ("tabularx", env "tabularx" $ simpTable blocks inline "tabularx" True)+ , ("tabular", env "tabular" $ simpTable blocks inline "tabular" False)+ ]++hline :: PandocMonad m => LP m ()+hline = try $ do+ spaces+ controlSeq "hline" <|>+ -- booktabs rules:+ controlSeq "toprule" <|>+ controlSeq "bottomrule" <|>+ controlSeq "midrule" <|>+ controlSeq "endhead" <|>+ controlSeq "endfirsthead"+ spaces+ optional rawopt+ return ()++lbreak :: PandocMonad m => LP m Tok+lbreak = (controlSeq "\\" <|> controlSeq "tabularnewline")+ <* skipopts <* spaces++amp :: PandocMonad m => LP m Tok+amp = symbol '&'++-- Split a Word into individual Symbols (for parseAligns)+splitWordTok :: PandocMonad m => LP m ()+splitWordTok = do+ inp <- getInput+ case inp of+ (Tok spos Word t : rest) ->+ setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) <> rest+ _ -> return ()++parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]+parseAligns = try $ do+ let maybeBar = skipMany+ (try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced)))+ let cAlign = AlignCenter <$ symbol 'c'+ let lAlign = AlignLeft <$ symbol 'l'+ let rAlign = AlignRight <$ symbol 'r'+ let parAlign = AlignLeft <$ symbol 'p'+ -- aligns from tabularx+ let xAlign = AlignLeft <$ symbol 'X'+ let mAlign = AlignLeft <$ symbol 'm'+ let bAlign = AlignLeft <$ symbol 'b'+ let alignChar = splitWordTok *> ( cAlign <|> lAlign <|> rAlign <|> parAlign+ <|> xAlign <|> mAlign <|> bAlign )+ let alignPrefix = symbol '>' >> braced+ let alignSuffix = symbol '<' >> braced+ let colWidth = try $ do+ symbol '{'+ ds <- trim . untokenize <$> manyTill anyTok (controlSeq "linewidth")+ spaces+ symbol '}'+ return $ safeRead ds+ let alignSpec = do+ pref <- option [] alignPrefix+ spaces+ al <- alignChar+ width <- colWidth <|> option Nothing (do s <- untokenize <$> braced+ pos <- getPosition+ report $ SkippedContent s pos+ return Nothing)+ spaces+ suff <- option [] alignSuffix+ return (al, width, (pref, suff))+ let starAlign = do -- '*{2}{r}' == 'rr', we just expand like a macro+ symbol '*'+ spaces+ ds <- trim . untokenize <$> braced+ spaces+ spec <- braced+ case safeRead ds of+ Just n ->+ getInput >>= setInput . (mconcat (replicate n spec) ++)+ Nothing -> Prelude.fail $ "Could not parse " <> T.unpack ds <> " as number"+ bgroup+ spaces+ maybeBar+ aligns' <- many $ try $ spaces >> optional starAlign >>+ (alignSpec <* maybeBar)+ spaces+ egroup+ spaces+ return $ map toSpec aligns'+ where+ toColWidth (Just w) | w > 0 = ColWidth w+ toColWidth _ = ColWidthDefault+ toSpec (x, y, z) = (x, toColWidth y, z)++-- N.B. this parser returns a Row that may have erroneous empty cells+-- in it. See the note above fixTableHead for details.+parseTableRow :: PandocMonad m+ => LP m Blocks -- ^ block parser+ -> LP m Inlines -- ^ inline parser+ -> Text -- ^ table environment name+ -> [([Tok], [Tok])] -- ^ pref/suffixes+ -> LP m Row+parseTableRow blocks inline envname prefsufs = do+ notFollowedBy (spaces *> end_ envname)+ -- contexts that can contain & that is not colsep:+ let canContainAmp (Tok _ (CtrlSeq "begin") _) = True+ canContainAmp (Tok _ (CtrlSeq "verb") _) = True+ canContainAmp (Tok _ (CtrlSeq "Verb") _) = True+ canContainAmp _ = False+ -- add prefixes and suffixes in token stream:+ let celltoks (pref, suff) = do+ prefpos <- getPosition+ contents <- mconcat <$>+ many ( snd <$> withRaw+ ((lookAhead (controlSeq "parbox") >>+ void blocks) -- #5711+ <|>+ (lookAhead (satisfyTok canContainAmp) >> void inline)+ <|>+ (lookAhead (symbol '$') >> void inline))+ <|>+ (do notFollowedBy+ (() <$ amp <|> () <$ lbreak <|> end_ envname)+ count 1 anyTok) )++ suffpos <- getPosition+ option [] (count 1 amp)+ return $ map (setpos prefpos) pref ++ contents ++ map (setpos suffpos) suff+ rawcells <- mapM celltoks prefsufs+ cells <- mapM (parseFromToks (parseTableCell blocks)) rawcells+ spaces+ return $ Row nullAttr cells++parseTableCell :: PandocMonad m => LP m Blocks -> LP m Cell+parseTableCell blocks = do+ spaces+ updateState $ \st -> st{ sInTableCell = True }+ cell' <- multicolumnCell blocks+ <|> multirowCell blocks+ <|> parseSimpleCell+ <|> parseEmptyCell+ updateState $ \st -> st{ sInTableCell = False }+ spaces+ return cell'+ where+ -- The parsing of empty cells is important in LaTeX, especially when dealing+ -- with multirow/multicolumn. See #6603.+ parseEmptyCell = spaces $> emptyCell+ parseSimpleCell = simpleCell <$> (plainify <$> blocks)+++cellAlignment :: PandocMonad m => LP m Alignment+cellAlignment = skipMany (symbol '|') *> alignment <* skipMany (symbol '|')+ where+ alignment = do+ c <- untoken <$> singleChar+ return $ case c of+ "l" -> AlignLeft+ "r" -> AlignRight+ "c" -> AlignCenter+ "*" -> AlignDefault+ _ -> AlignDefault++plainify :: Blocks -> Blocks+plainify bs = case toList bs of+ [Para ils] -> plain (fromList ils)+ _ -> bs++multirowCell :: PandocMonad m => LP m Blocks -> LP m Cell+multirowCell blocks = controlSeq "multirow" >> do+ -- Full prototype for \multirow macro is:+ -- \multirow[vpos]{nrows}[bigstruts]{width}[vmove]{text}+ -- However, everything except `nrows` and `text` make+ -- sense in the context of the Pandoc AST+ _ <- optional $ symbol '[' *> cellAlignment <* symbol ']' -- vertical position+ nrows <- fmap (fromMaybe 1 . safeRead . untokenize) braced+ _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- bigstrut-related+ _ <- symbol '{' *> manyTill anyTok (symbol '}') -- Cell width+ _ <- optional $ symbol '[' *> manyTill anyTok (symbol ']') -- Length used for fine-tuning+ content <- symbol '{' *> (plainify <$> blocks) <* symbol '}'+ return $ cell AlignDefault (RowSpan nrows) (ColSpan 1) content++multicolumnCell :: PandocMonad m => LP m Blocks -> LP m Cell+multicolumnCell blocks = controlSeq "multicolumn" >> do+ span' <- fmap (fromMaybe 1 . safeRead . untokenize) braced+ alignment <- symbol '{' *> cellAlignment <* symbol '}'++ let singleCell = do+ content <- plainify <$> blocks+ return $ cell alignment (RowSpan 1) (ColSpan span') content++ -- Two possible contents: either a \multirow cell, or content.+ -- E.g. \multicol{1}{c}{\multirow{2}{1em}{content}}+ -- Note that a \multirow cell can be nested in a \multicolumn,+ -- but not the other way around. See #6603+ let nestedCell = do+ (Cell _ _ (RowSpan rs) _ bs) <- multirowCell blocks+ return $ cell+ alignment+ (RowSpan rs)+ (ColSpan span')+ (fromList bs)++ symbol '{' *> (nestedCell <|> singleCell) <* symbol '}'++-- LaTeX tables are stored with empty cells underneath multirow cells+-- denoting the grid spaces taken up by them. More specifically, if a+-- cell spans m rows, then it will overwrite all the cells in the+-- columns it spans for (m-1) rows underneath it, requiring padding+-- cells in these places. These padding cells need to be removed for+-- proper table reading. See #6603.+--+-- These fixTable functions do not otherwise fix up malformed+-- input tables: that is left to the table builder.+fixTableHead :: TableHead -> TableHead+fixTableHead (TableHead attr rows) = TableHead attr rows'+ where+ rows' = fixTableRows rows++fixTableBody :: TableBody -> TableBody+fixTableBody (TableBody attr rhc th tb)+ = TableBody attr rhc th' tb'+ where+ th' = fixTableRows th+ tb' = fixTableRows tb++fixTableRows :: [Row] -> [Row]+fixTableRows = fixTableRows' $ repeat Nothing+ where+ fixTableRows' oldHang (Row attr cells : rs)+ = let (newHang, cells') = fixTableRow oldHang cells+ rs' = fixTableRows' newHang rs+ in Row attr cells' : rs'+ fixTableRows' _ [] = []++-- The overhang is represented as Just (relative cell dimensions) or+-- Nothing for an empty grid space.+fixTableRow :: [Maybe (ColSpan, RowSpan)] -> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])+fixTableRow oldHang cells+ -- If there's overhang, drop cells until their total width meets the+ -- width of the occupied grid spaces (or we run out)+ | (n, prefHang, restHang) <- splitHang oldHang+ , n > 0+ = let cells' = dropToWidth getCellW n cells+ (restHang', cells'') = fixTableRow restHang cells'+ in (prefHang restHang', cells'')+ -- Otherwise record the overhang of a pending cell and fix the rest+ -- of the row+ | c@(Cell _ _ h w _):cells' <- cells+ = let h' = max 1 h+ w' = max 1 w+ oldHang' = dropToWidth getHangW w' oldHang+ (newHang, cells'') = fixTableRow oldHang' cells'+ in (toHang w' h' <> newHang, c : cells'')+ | otherwise+ = (oldHang, [])+ where+ getCellW (Cell _ _ _ w _) = w+ getHangW = maybe 1 fst+ getCS (ColSpan n) = n++ toHang c r+ | r > 1 = [Just (c, r)]+ | otherwise = replicate (getCS c) Nothing++ -- Take the prefix of the overhang list representing filled grid+ -- spaces. Also return the remainder and the length of this prefix.+ splitHang = splitHang' 0 id++ splitHang' !n l (Just (c, r):xs)+ = splitHang' (n + c) (l . (toHang c (r-1) ++)) xs+ splitHang' n l xs = (n, l, xs)++ -- Drop list items until the total width of the dropped items+ -- exceeds the passed width.+ dropToWidth _ n l | n < 1 = l+ dropToWidth wproj n (c:cs) = dropToWidth wproj (n - wproj c) cs+ dropToWidth _ _ [] = []++simpTable :: PandocMonad m+ => LP m Blocks+ -> LP m Inlines+ -> Text+ -> Bool+ -> LP m Blocks+simpTable blocks inline envname hasWidthParameter = try $ do+ when hasWidthParameter $ () <$ tokWith inline+ skipopts+ colspecs <- parseAligns+ let (aligns, widths, prefsufs) = unzip3 colspecs+ optional $ controlSeq "caption" *> setCaption inline+ spaces+ optional label+ spaces+ optional lbreak+ spaces+ skipMany hline+ spaces+ header' <- option [] . try . fmap (:[]) $+ parseTableRow blocks inline envname prefsufs <*+ lbreak <* many1 hline+ spaces+ rows <- sepEndBy (parseTableRow blocks inline envname prefsufs)+ (lbreak <* optional (skipMany hline))+ spaces+ optional $ controlSeq "caption" *> setCaption inline+ spaces+ optional label+ spaces+ optional lbreak+ spaces+ lookAhead $ controlSeq "end" -- make sure we're at end+ let th = fixTableHead $ TableHead nullAttr header'+ let tbs = [fixTableBody $ TableBody nullAttr 0 [] rows]+ let tf = TableFoot nullAttr []+ return $ table emptyCaption (zip aligns widths) th tbs tf++addTableCaption :: PandocMonad m => Blocks -> LP m Blocks+addTableCaption = walkM go+ where go (Table attr c spec th tb tf) = do+ st <- getState+ let mblabel = sLastLabel st+ capt <- case (sCaption st, mblabel) of+ (Just ils, Nothing) -> return $ caption Nothing (plain ils)+ (Just ils, Just lab) -> do+ num <- getNextNumber sLastTableNum+ setState+ st{ sLastTableNum = num+ , sLabels = M.insert lab+ [Str (renderDottedNum num)]+ (sLabels st) }+ return $ caption Nothing (plain ils) -- add number??+ (Nothing, _) -> return c+ let attr' = case (attr, mblabel) of+ ((_,classes,kvs), Just ident) ->+ (ident,classes,kvs)+ _ -> attr+ return $ addAttrDiv attr' $ Table nullAttr capt spec th tb tf+ go x = return x++-- TODO: For now we add a Div to contain table attributes, since+-- most writers don't do anything yet with attributes on Table.+-- This can be removed when that changes.+addAttrDiv :: Attr -> Block -> Block+addAttrDiv ("",[],[]) b = b+addAttrDiv attr b = Div attr [b]
src/Text/Pandoc/Readers/Markdown.hs view
@@ -247,51 +247,60 @@ titleBlock = pandocTitleBlock <|> mmdTitleBlock pandocTitleBlock :: PandocMonad m => MarkdownParser m ()-pandocTitleBlock = try $ do+pandocTitleBlock = do guardEnabled Ext_pandoc_title_block lookAhead (char '%')- title <- option mempty titleLine- author <- option (return []) authorsLine- date <- option mempty dateLine- optional blanklines- let meta' = do title' <- title- author' <- author- date' <- date- return $- (if null title' then id else B.setMeta "title" title')- . (if null author' then id else B.setMeta "author" author')- . (if null date' then id else B.setMeta "date" date')- $ nullMeta- updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }+ try $ do+ title <- option mempty titleLine+ author <- option (return []) authorsLine+ date <- option mempty dateLine+ optional blanklines+ let meta' = do title' <- title+ author' <- author+ date' <- date+ return $+ (if null title'+ then id+ else B.setMeta "title" title')+ . (if null author'+ then id+ else B.setMeta "author" author')+ . (if null date'+ then id+ else B.setMeta "date" date')+ $ nullMeta+ updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' } yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)-yamlMetaBlock = try $ do+yamlMetaBlock = do guardEnabled Ext_yaml_metadata_block- 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+ 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 () mmdTitleBlock :: PandocMonad m => MarkdownParser m ()-mmdTitleBlock = try $ do+mmdTitleBlock = do guardEnabled Ext_mmd_title_block- firstPair <- kvPair False- restPairs <- many (kvPair True)- let kvPairs = firstPair : restPairs- blanklines- updateState $ \st -> st{ stateMeta' = stateMeta' st <>- return (Meta $ M.fromList kvPairs) }+ try $ do+ firstPair <- kvPair False+ restPairs <- many (kvPair True)+ let kvPairs = firstPair : restPairs+ blanklines+ updateState $ \st -> st{ stateMeta' = stateMeta' st <>+ return (Meta $ M.fromList kvPairs) } kvPair :: PandocMonad m => Bool -> MarkdownParser m (Text, MetaValue) kvPair allowEmpty = try $ do@@ -334,6 +343,8 @@ skipMany spaceChar notFollowedBy' referenceTitle notFollowedBy' $ guardEnabled Ext_link_attributes >> attributes+ notFollowedBy' $ guardEnabled Ext_mmd_link_attributes >>+ try (spnl <* keyValAttr) notFollowedBy' (() <$ reference) many1Char $ notFollowedBy space >> litChar let betweenAngles = try $ char '<' >> manyTillChar litChar (char '>')@@ -659,15 +670,15 @@ codeBlockFenced = try $ do indentchars <- nonindentSpaces let indentLevel = T.length indentchars- c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))+ c <- (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~')) <|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`')) size <- blockDelimiter (== c) Nothing skipMany spaceChar rawattr <-- (Left <$> try (guardEnabled Ext_raw_attribute >> rawAttribute))+ (Left <$> (guardEnabled Ext_raw_attribute >> try rawAttribute)) <|> (Right <$> option ("",[],[])- (try (guardEnabled Ext_fenced_code_attributes >> attributes)+ ((guardEnabled Ext_fenced_code_attributes >> try attributes) <|> ((\x -> ("",[toLanguageId x],[])) <$> many1Char nonspaceChar))) blankline contents <- T.intercalate "\n" <$>@@ -1155,11 +1166,12 @@ -- lineBlock :: PandocMonad m => MarkdownParser m (F Blocks)-lineBlock = try $ do+lineBlock = do guardEnabled Ext_line_blocks- lines' <- lineBlockLines >>=- mapM (parseFromString' (trimInlinesF <$> inlines))- return $ B.lineBlock <$> sequence lines'+ try $ do+ lines' <- lineBlockLines >>=+ mapM (parseFromString' (trimInlinesF <$> inlines))+ return $ B.lineBlock <$> sequence lines' -- -- Tables@@ -1261,11 +1273,12 @@ -- Parses a table caption: inlines beginning with 'Table:' -- and followed by blank lines. tableCaption :: PandocMonad m => MarkdownParser m (F Inlines)-tableCaption = try $ do+tableCaption = do guardEnabled Ext_table_captions- skipNonindentSpaces- (string ":" <* notFollowedBy (satisfy isPunctuation)) <|> string "Table:"- trimInlinesF <$> inlines1 <* blanklines+ try $ do+ skipNonindentSpaces+ (string ":" <* notFollowedBy (satisfy isPunctuation)) <|> string "Table:"+ trimInlinesF <$> inlines1 <* blanklines -- Parse a simple table with '---' header and one line per row. simpleTable :: PandocMonad m@@ -1434,15 +1447,14 @@ table = try $ do frontCaption <- option Nothing (Just <$> tableCaption) (aligns, widths, heads, lns) <-- try (guardEnabled Ext_pipe_tables >> scanForPipe >> pipeTable) <|>- try (guardEnabled Ext_multiline_tables >>- multilineTable False) <|>- try (guardEnabled Ext_simple_tables >>- (simpleTable True <|> simpleTable False)) <|>- try (guardEnabled Ext_multiline_tables >>- multilineTable True) <|>- try (guardEnabled Ext_grid_tables >>- (gridTable False <|> gridTable True)) <?> "table"+ (guardEnabled Ext_pipe_tables >> try (scanForPipe >> pipeTable)) <|>+ (guardEnabled Ext_multiline_tables >> try (multilineTable False)) <|>+ (guardEnabled Ext_simple_tables >>+ try (simpleTable True <|> simpleTable False)) <|>+ (guardEnabled Ext_multiline_tables >>+ try (multilineTable True)) <|>+ (guardEnabled Ext_grid_tables >>+ try (gridTable False <|> gridTable True)) <?> "table" optional blanklines caption <- case frontCaption of Nothing -> option (return mempty) tableCaption@@ -1476,35 +1488,37 @@ inlines1 = mconcat <$> many1 inline inline :: PandocMonad m => MarkdownParser m (F Inlines)-inline = choice [ whitespace- , bareURL- , str- , endline- , code- , strongOrEmph- , note- , cite- , bracketedSpan- , link- , image- , math- , strikeout- , subscript- , superscript- , inlineNote -- after superscript because of ^[link](/foo)^- , autoLink- , spanHtml- , rawHtmlInline- , escapedNewline- , escapedChar- , rawLaTeXInline'- , exampleRef- , smart- , return . B.singleton <$> charRef- , emoji- , symbol- , ltSign- ] <?> "inline"+inline = do+ c <- lookAhead anyChar+ ((case c of+ ' ' -> whitespace+ '\t' -> whitespace+ '\n' -> endline+ '`' -> code+ '_' -> strongOrEmph+ '*' -> strongOrEmph+ '^' -> superscript <|> inlineNote -- in this order bc ^[link](/foo)^+ '[' -> note <|> cite <|> bracketedSpan <|> link+ '!' -> image+ '$' -> math+ '~' -> strikeout <|> subscript+ '<' -> autoLink <|> spanHtml <|> rawHtmlInline <|> ltSign+ '\\' -> escapedNewline <|> escapedChar <|> rawLaTeXInline'+ '@' -> cite <|> exampleRef+ '"' -> smart+ '\'' -> smart+ '\8216' -> smart+ '\145' -> smart+ '\8220' -> smart+ '\147' -> smart+ '-' -> smart+ '.' -> smart+ '&' -> return . B.singleton <$> charRef+ ':' -> emoji+ _ -> mzero)+ <|> bareURL+ <|> str+ <|> symbol) <?> "inline" escapedChar' :: PandocMonad m => MarkdownParser m Char escapedChar' = try $ do@@ -1515,11 +1529,12 @@ <|> oneOf "\\`*_{}[]()>#+-.!~\"" escapedNewline :: PandocMonad m => MarkdownParser m (F Inlines)-escapedNewline = try $ do+escapedNewline = do guardEnabled Ext_escaped_line_breaks- char '\\'- lookAhead (char '\n') -- don't consume the newline (see #3730)- return $ return B.linebreak+ try $ do+ char '\\'+ lookAhead (char '\n') -- don't consume the newline (see #3730)+ return $ return B.linebreak escapedChar :: PandocMonad m => MarkdownParser m (F Inlines) escapedChar = do@@ -1541,19 +1556,20 @@ -- whole document has been parsed. But we need this parser -- here in case citations is disabled. exampleRef :: PandocMonad m => MarkdownParser m (F Inlines)-exampleRef = try $ do+exampleRef = do guardEnabled Ext_example_lists- char '@'- lab <- mconcat . map T.pack <$>- many (many1 alphaNum <|>- try (do c <- char '_' <|> char '-'- cs <- many1 alphaNum- return (c:cs)))- return $ do- st <- askF- return $ case M.lookup lab (stateExamples st) of- Just n -> B.str $ tshow n- Nothing -> B.str $ "@" <> lab+ try $ do+ char '@'+ lab <- mconcat . map T.pack <$>+ many (many1 alphaNum <|>+ try (do c <- char '_' <|> char '-'+ cs <- many1 alphaNum+ return (c:cs)))+ return $ do+ st <- askF+ return $ case M.lookup lab (stateExamples st) of+ Just n -> B.str $ tshow n+ Nothing -> B.str $ "@" <> lab symbol :: PandocMonad m => MarkdownParser m (F Inlines) symbol = do@@ -1580,10 +1596,10 @@ >> count (length starts) (char '`') >> notFollowedBy (char '`')) rawattr <-- (Left <$> try (guardEnabled Ext_raw_attribute >> rawAttribute))+ (Left <$> (guardEnabled Ext_raw_attribute >> try rawAttribute)) <|> (Right <$> option ("",[],[])- (try (guardEnabled Ext_inline_code_attributes >> attributes)))+ (guardEnabled Ext_inline_code_attributes >> try attributes)) return $ return $ case rawattr of Left syn -> B.rawInline syn result@@ -1676,20 +1692,22 @@ strikeEnd = try $ string "~~" superscript :: PandocMonad m => MarkdownParser m (F Inlines)-superscript = fmap B.superscript <$> try (do+superscript = do guardEnabled Ext_superscript- char '^'- mconcat <$> many1Till (do notFollowedBy spaceChar- notFollowedBy newline- inline) (char '^'))+ fmap B.superscript <$> try (do+ char '^'+ mconcat <$> many1Till (do notFollowedBy spaceChar+ notFollowedBy newline+ inline) (char '^')) subscript :: PandocMonad m => MarkdownParser m (F Inlines)-subscript = fmap B.subscript <$> try (do+subscript = do guardEnabled Ext_subscript- char '~'- mconcat <$> many1Till (do notFollowedBy spaceChar- notFollowedBy newline- inline) (char '~'))+ fmap B.subscript <$> try (do+ char '~'+ mconcat <$> many1Till (do notFollowedBy spaceChar+ notFollowedBy newline+ inline) (char '~')) whitespace :: PandocMonad m => MarkdownParser m (F Inlines) whitespace = spaceChar >> return <$> (lb <|> regsp) <?> "whitespace"@@ -1707,7 +1725,7 @@ updateLastStrPos (do guardEnabled Ext_smart abbrevs <- getOption readerAbbreviations- if not (T.null result) && T.last result == '.' && result `Set.member` abbrevs+ if result `Set.member` abbrevs then try (do ils <- whitespace notFollowedBy (() <$ cite <|> () <$ note) -- ?? lookAhead alphaNum@@ -1790,15 +1808,16 @@ regLink B.linkWith lab <|> referenceLink B.linkWith (lab,raw) bracketedSpan :: PandocMonad m => MarkdownParser m (F Inlines)-bracketedSpan = try $ do+bracketedSpan = do guardEnabled Ext_bracketed_spans- (lab,_) <- reference- attr <- attributes- return $ if isSmallCaps attr- then B.smallcaps <$> lab- else if isUnderline attr- then B.underline <$> lab- else B.spanWith attr <$> lab+ try $ do+ (lab,_) <- reference+ attr <- attributes+ return $ if isSmallCaps attr+ then B.smallcaps <$> lab+ else if isUnderline attr+ then B.underline <$> lab+ else B.spanWith attr <$> lab -- | We treat a span as SmallCaps if class is "smallcaps" (and -- no other attributes are set or if style is "font-variant:small-caps"@@ -1877,12 +1896,13 @@ dropLB xs = xs bareURL :: PandocMonad m => MarkdownParser m (F Inlines)-bareURL = try $ do+bareURL = do guardEnabled Ext_autolink_bare_uris getState >>= guard . stateAllowLinks- (cls, (orig, src)) <- (("uri",) <$> uri) <|> (("email",) <$> emailAddress)- notFollowedBy $ try $ spaces >> htmlTag (~== TagClose ("a" :: Text))- return $ return $ B.linkWith ("",[cls],[]) src "" (B.str orig)+ try $ do+ (cls, (orig, src)) <- (("uri",) <$> uri) <|> (("email",) <$> emailAddress)+ notFollowedBy $ try $ spaces >> htmlTag (~== TagClose ("a" :: Text))+ return $ return $ B.linkWith ("",[cls],[]) src "" (B.str orig) autoLink :: PandocMonad m => MarkdownParser m (F Inlines) autoLink = try $ do@@ -1935,21 +1955,23 @@ return $ B.note $ walk adjustCite contents' inlineNote :: PandocMonad m => MarkdownParser m (F Inlines)-inlineNote = try $ do+inlineNote = do guardEnabled Ext_inline_notes- char '^'- updateState $ \st -> st{ stateInNote = True- , stateNoteNumber = stateNoteNumber st + 1 }- contents <- inlinesInBalancedBrackets- updateState $ \st -> st{ stateInNote = False }- return $ B.note . B.para <$> contents+ try $ do+ char '^'+ updateState $ \st -> st{ stateInNote = True+ , stateNoteNumber = stateNoteNumber st + 1 }+ contents <- inlinesInBalancedBrackets+ updateState $ \st -> st{ stateInNote = False }+ return $ B.note . B.para <$> contents rawLaTeXInline' :: PandocMonad m => MarkdownParser m (F Inlines)-rawLaTeXInline' = try $ do+rawLaTeXInline' = do guardEnabled Ext_raw_tex notFollowedBy' rawConTeXtEnvironment- s <- rawLaTeXInline- return $ return $ B.rawInline "tex" s -- "tex" because it might be context+ try $ do+ s <- rawLaTeXInline+ return $ return $ B.rawInline "tex" s -- "tex" because it might be context rawConTeXtEnvironment :: PandocMonad m => ParserT Text st m Text rawConTeXtEnvironment = try $ do@@ -1968,55 +1990,60 @@ return $ "[" <> contents <> "]" spanHtml :: PandocMonad m => MarkdownParser m (F Inlines)-spanHtml = try $ do+spanHtml = do guardEnabled Ext_native_spans- (TagOpen _ attrs, _) <- htmlTag (~== TagOpen ("span" :: Text) [])- contents <- mconcat <$> manyTill inline (htmlTag (~== TagClose ("span" :: Text)))- let ident = fromMaybe "" $ lookup "id" attrs- let classes = maybe [] T.words $ lookup "class" attrs- let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]- return $ if isSmallCaps (ident, classes, keyvals)- then B.smallcaps <$> contents- else if isUnderline (ident, classes, keyvals)- then B.underline <$> contents- else B.spanWith (ident, classes, keyvals) <$> contents+ try $ do+ (TagOpen _ attrs, _) <- htmlTag (~== TagOpen ("span" :: Text) [])+ contents <- mconcat <$> manyTill inline (htmlTag (~== TagClose ("span" :: Text)))+ let ident = fromMaybe "" $ lookup "id" attrs+ let classes = maybe [] T.words $ lookup "class" attrs+ let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]+ return $ if isSmallCaps (ident, classes, keyvals)+ then B.smallcaps <$> contents+ else if isUnderline (ident, classes, keyvals)+ then B.underline <$> contents+ else B.spanWith (ident, classes, keyvals) <$> contents divHtml :: PandocMonad m => MarkdownParser m (F Blocks)-divHtml = try $ do+divHtml = do guardEnabled Ext_native_divs- (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen ("div" :: Text) [])- -- we set stateInHtmlBlock so that closing tags that can be either block or- -- inline will not be parsed as inline tags- oldInHtmlBlock <- stateInHtmlBlock <$> getState- updateState $ \st -> st{ stateInHtmlBlock = Just "div" }- bls <- option "" (blankline >> option "" blanklines)- contents <- mconcat <$>- many (notFollowedBy' (htmlTag (~== TagClose ("div" :: Text))) >> block)- closed <- option False (True <$ htmlTag (~== TagClose ("div" :: Text)))- if closed- then do- updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }- let ident = fromMaybe "" $ lookup "id" attrs- let classes = maybe [] T.words $ lookup "class" attrs- let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]- return $ B.divWith (ident, classes, keyvals) <$> contents- else -- avoid backtracing- return $ return (B.rawBlock "html" (rawtag <> bls)) <> contents+ try $ do+ (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen ("div" :: Text) [])+ -- we set stateInHtmlBlock so that closing tags that can be either block+ -- or inline will not be parsed as inline tags+ oldInHtmlBlock <- stateInHtmlBlock <$> getState+ updateState $ \st -> st{ stateInHtmlBlock = Just "div" }+ bls <- option "" (blankline >> option "" blanklines)+ contents <- mconcat <$>+ many (notFollowedBy' (htmlTag (~== TagClose ("div" :: Text))) >> block)+ closed <- option False (True <$ htmlTag (~== TagClose ("div" :: Text)))+ if closed+ then do+ updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }+ let ident = fromMaybe "" $ lookup "id" attrs+ let classes = maybe [] T.words $ lookup "class" attrs+ let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]+ return $ B.divWith (ident, classes, keyvals) <$> contents+ else -- avoid backtracing+ return $ return (B.rawBlock "html" (rawtag <> bls)) <> contents divFenced :: PandocMonad m => MarkdownParser m (F Blocks)-divFenced = try $ do+divFenced = do guardEnabled Ext_fenced_divs- string ":::"- skipMany (char ':')- skipMany spaceChar- attribs <- attributes <|> ((\x -> ("",[x],[])) <$> many1Char nonspaceChar)- skipMany spaceChar- skipMany (char ':')- blankline- updateState $ \st -> st{ stateFencedDivLevel = stateFencedDivLevel st + 1 }- bs <- mconcat <$> manyTill block divFenceEnd- updateState $ \st -> st{ stateFencedDivLevel = stateFencedDivLevel st - 1 }- return $ B.divWith attribs <$> bs+ try $ do+ string ":::"+ skipMany (char ':')+ skipMany spaceChar+ attribs <- attributes <|> ((\x -> ("",[x],[])) <$> many1Char nonspaceChar)+ skipMany spaceChar+ skipMany (char ':')+ blankline+ updateState $ \st ->+ st{ stateFencedDivLevel = stateFencedDivLevel st + 1 }+ bs <- mconcat <$> manyTill block divFenceEnd+ updateState $ \st ->+ st{ stateFencedDivLevel = stateFencedDivLevel st - 1 }+ return $ B.divWith attribs <$> bs divFenceEnd :: PandocMonad m => MarkdownParser m () divFenceEnd = try $ do@@ -2048,14 +2075,15 @@ emojiChars = ['a'..'z'] ++ ['0'..'9'] ++ ['_','+','-'] emoji :: PandocMonad m => MarkdownParser m (F Inlines)-emoji = try $ do+emoji = do guardEnabled Ext_emoji- char ':'- emojikey <- many1Char (oneOf emojiChars)- char ':'- case emojiToInline emojikey of- Just i -> return (return $ B.singleton i)- Nothing -> mzero+ try $ do+ char ':'+ emojikey <- many1Char (oneOf emojiChars)+ char ':'+ case emojiToInline emojikey of+ Just i -> return (return $ B.singleton i)+ Nothing -> mzero -- Citations
src/Text/Pandoc/Readers/OPML.hs view
@@ -13,20 +13,20 @@ module Text.Pandoc.Readers.OPML ( readOPML ) where import Control.Monad.State.Strict-import Data.Char (toUpper) import Data.Default-import Data.Generics import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T-import Text.HTML.TagSoup.Entity (lookupEntity)+import qualified Data.Text.Lazy as TL import Text.Pandoc.Builder import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Options+import Text.Pandoc.Error (PandocError(..)) import Text.Pandoc.Readers.HTML (readHtml) import Text.Pandoc.Readers.Markdown (readMarkdown) import Text.Pandoc.Shared (crFilter, blocksToInlines')-import Text.XML.Light+import Text.Pandoc.XML.Light+import Control.Monad.Except (throwError) type OPML m = StateT OPMLState m @@ -49,39 +49,20 @@ readOPML :: PandocMonad m => ReaderOptions -> Text -> m Pandoc readOPML opts inp = do (bs, st') <- runStateT- (mapM parseBlock $ normalizeTree $- parseXML (T.unpack (crFilter inp))) def{ opmlOptions = opts }+ (case parseXMLContents (TL.fromStrict (crFilter inp)) of+ Left msg -> throwError $ PandocXMLError "" msg+ Right ns -> mapM parseBlock ns)+ def{ opmlOptions = opts } return $ setTitle (opmlDocTitle st') $ setAuthors (opmlDocAuthors st') $ setDate (opmlDocDate st') $ doc $ mconcat bs --- normalize input, consolidating adjacent Text and CRef elements-normalizeTree :: [Content] -> [Content]-normalizeTree = everywhere (mkT go)- where go :: [Content] -> [Content]- go (Text (CData CDataRaw _ _):xs) = xs- go (Text (CData CDataText s1 z):Text (CData CDataText s2 _):xs) =- Text (CData CDataText (s1 ++ s2) z):xs- go (Text (CData CDataText s1 z):CRef r:xs) =- Text (CData CDataText (s1 ++ convertEntity r) z):xs- go (CRef r:Text (CData CDataText s1 z):xs) =- Text (CData CDataText (convertEntity r ++ s1) z):xs- go (CRef r1:CRef r2:xs) =- Text (CData CDataText (convertEntity r1 ++ convertEntity r2) Nothing):xs- go xs = xs--convertEntity :: String -> String-convertEntity e = Data.Maybe.fromMaybe (map toUpper e) (lookupEntity e)- -- convenience function to get an attribute value, defaulting to ""-attrValue :: String -> Element -> Text+attrValue :: Text -> Element -> Text attrValue attr elt =- maybe "" T.pack (lookupAttrBy (\x -> qName x == attr) (elAttribs elt))--textContent :: Element -> Text-textContent = T.pack . strContent+ fromMaybe "" (lookupAttrBy (\x -> qName x == attr) (elAttribs elt)) -- exceptT :: PandocMonad m => Either PandocError a -> OPML m a -- exceptT = either throwError return@@ -105,11 +86,11 @@ parseBlock (Elem e) = case qName (elName e) of "ownerName" -> mempty <$ modify (\st ->- st{opmlDocAuthors = [text $ textContent e]})+ st{opmlDocAuthors = [text $ strContent e]}) "dateModified" -> mempty <$ modify (\st ->- st{opmlDocDate = text $ textContent e})+ st{opmlDocDate = text $ strContent e}) "title" -> mempty <$ modify (\st ->- st{opmlDocTitle = text $ textContent e})+ st{opmlDocTitle = text $ strContent e}) "outline" -> gets opmlSectionLevel >>= sect . (+1) "?xml" -> return mempty _ -> getBlocks e
src/Text/Pandoc/Readers/Odt.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Reader.Odt@@ -15,7 +14,7 @@ module Text.Pandoc.Readers.Odt ( readOdt ) where import Codec.Archive.Zip-import qualified Text.XML.Light as XML+import Text.Pandoc.XML.Light import qualified Data.ByteString.Lazy as B @@ -23,6 +22,8 @@ import Control.Monad.Except (throwError) +import qualified Data.Text as T+ import Text.Pandoc.Class.PandocMonad (PandocMonad) import qualified Text.Pandoc.Class.PandocMonad as P import Text.Pandoc.Definition@@ -60,35 +61,37 @@ bytesToOdt :: B.ByteString -> Either PandocError (Pandoc, MediaBag) bytesToOdt bytes = case toArchiveOrFail bytes of Right archive -> archiveToOdt archive- Left _ -> Left $ PandocParseError "Couldn't parse odt file."+ Left err -> Left $ PandocParseError+ $ "Could not unzip ODT: " <> T.pack err -- archiveToOdt :: Archive -> Either PandocError (Pandoc, MediaBag)-archiveToOdt archive- | Just contentEntry <- findEntryByPath "content.xml" archive- , Just stylesEntry <- findEntryByPath "styles.xml" archive- , Just contentElem <- entryToXmlElem contentEntry- , Just stylesElem <- entryToXmlElem stylesEntry- , Right styles <- chooseMax (readStylesAt stylesElem )- (readStylesAt contentElem)- , media <- filteredFilesFromArchive archive filePathIsOdtMedia- , startState <- readerState styles media- , Right pandocWithMedia <- runConverter' read_body- startState- contentElem-- = Right pandocWithMedia-- | otherwise- -- Not very detailed, but I don't think more information would be helpful- = Left $ PandocParseError "Couldn't parse odt file."- where- filePathIsOdtMedia :: FilePath -> Bool+archiveToOdt archive = do+ let onFailure msg Nothing = Left $ PandocParseError msg+ onFailure _ (Just x) = Right x+ contentEntry <- onFailure "Could not find content.xml"+ (findEntryByPath "content.xml" archive)+ stylesEntry <- onFailure "Could not find styles.xml"+ (findEntryByPath "styles.xml" archive)+ contentElem <- entryToXmlElem contentEntry+ stylesElem <- entryToXmlElem stylesEntry+ styles <- either+ (\_ -> Left $ PandocParseError "Could not read styles")+ Right+ (chooseMax (readStylesAt stylesElem ) (readStylesAt contentElem))+ let filePathIsOdtMedia :: FilePath -> Bool filePathIsOdtMedia fp = let (dir, name) = splitFileName fp in (dir == "Pictures/") || (dir /= "./" && name == "content.xml")+ let media = filteredFilesFromArchive archive filePathIsOdtMedia+ let startState = readerState styles media+ either (\_ -> Left $ PandocParseError "Could not convert opendocument") Right+ (runConverter' read_body startState contentElem) ---entryToXmlElem :: Entry -> Maybe XML.Element-entryToXmlElem = XML.parseXMLDoc . UTF8.toStringLazy . fromEntry+entryToXmlElem :: Entry -> Either PandocError Element+entryToXmlElem entry =+ case parseXMLElement . UTF8.toTextLazy . fromEntry $ entry of+ Right x -> Right x+ Left msg -> Left $ PandocXMLError (T.pack $ eRelativePath entry) msg
src/Text/Pandoc/Readers/Odt/ContentReader.hs view
@@ -29,14 +29,14 @@ import qualified Data.ByteString.Lazy as B import Data.Foldable (fold)-import Data.List (find, stripPrefix)+import Data.List (find) import qualified Data.Map as M import qualified Data.Text as T import Data.Maybe import Data.Semigroup (First(..), Option(..)) import Text.TeXMath (readMathML, writeTeX)-import qualified Text.XML.Light as XML+import qualified Text.Pandoc.XML.Light as XML import Text.Pandoc.Builder hiding (underline) import Text.Pandoc.MediaBag (MediaBag, insertMedia)@@ -557,7 +557,7 @@ >>?% mappend -- extractText :: XML.Content -> Fallible T.Text- extractText (XML.Text cData) = succeedWith (T.pack $ XML.cdData cData)+ extractText (XML.Text cData) = succeedWith (XML.cdData cData) extractText _ = failEmpty read_text_seq :: InlineMatcher@@ -777,14 +777,14 @@ "" -> returnV mempty -< () src' -> do let exts = extensionsFromList [Ext_auto_identifiers]- resource <- lookupResource -< src'+ resource <- lookupResource -< T.unpack src' _ <- updateMediaWithResource -< resource w <- findAttrText' NsSVG "width" -< () h <- findAttrText' NsSVG "height" -< () titleNodes <- matchChildContent' [ read_frame_title ] -< () alt <- matchChildContent [] read_plain_text -< () arr (firstMatch . uncurry4 imageWith) -<- (image_attributes w h, T.pack src', inlineListToIdentifier exts (toList titleNodes), alt)+ (image_attributes w h, src', inlineListToIdentifier exts (toList titleNodes), alt) read_frame_title :: InlineMatcher read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text)@@ -804,7 +804,8 @@ case fold src of "" -> returnV mempty -< () src' -> do- let path = fromMaybe src' (stripPrefix "./" src') ++ "/content.xml"+ let path = T.unpack $+ fromMaybe src' (T.stripPrefix "./" src') <> "/content.xml" (_, mathml) <- lookupResource -< path case readMathML (UTF8.toText $ B.toStrict mathml) of Left _ -> returnV mempty -< ()
src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs view
@@ -14,9 +14,10 @@ module Text.Pandoc.Readers.Odt.Generic.Namespaces where import qualified Data.Map as M+import Data.Text (Text) ---type NameSpaceIRI = String+type NameSpaceIRI = Text -- type NameSpaceIRIs nsID = M.Map nsID NameSpaceIRI
src/Text/Pandoc/Readers/Odt/Generic/Utils.hs view
@@ -20,7 +20,6 @@ , reverseComposition , tryToRead , Lookupable(..)-, readLookupables , readLookupable , readPercent , findBy@@ -30,11 +29,11 @@ import Control.Category (Category, (<<<), (>>>)) import qualified Control.Category as Cat (id)-import Control.Monad (msum)-+import Data.Char (isSpace) import qualified Data.Foldable as F (Foldable, foldr) import Data.Maybe-+import Data.Text (Text)+import qualified Data.Text as T -- | Equivalent to -- > foldr (.) id@@ -76,8 +75,8 @@ -- (nobody wants that) while the latter returns "to much" for simple purposes. -- This function instead applies 'reads' and returns the first match (if any) -- in a 'Maybe'.-tryToRead :: (Read r) => String -> Maybe r-tryToRead = reads >>> listToMaybe >>> fmap fst+tryToRead :: (Read r) => Text -> Maybe r+tryToRead = (reads . T.unpack) >>> listToMaybe >>> fmap fst -- | A version of 'reads' that requires a '%' sign after the number readPercent :: ReadS Int@@ -88,26 +87,12 @@ -- | Data that can be looked up. -- This is mostly a utility to read data with kind *. class Lookupable a where- lookupTable :: [(String, a)]---- | The idea is to use this function as if there was a declaration like------ > instance (Lookupable a) => (Read a) where--- > readsPrec _ = readLookupables--- .--- But including this code in this form would need UndecideableInstances.--- That is a bad idea. Luckily 'readLookupable' (without the s at the end)--- can be used directly in almost any case.-readLookupables :: (Lookupable a) => String -> [(a,String)]-readLookupables s = [ (a,rest) | (word,rest) <- lex s,- a <- maybeToList (lookup word lookupTable)- ]+ lookupTable :: [(Text, a)] -- | Very similar to a simple 'lookup' in the 'lookupTable', but with a lexer.-readLookupable :: (Lookupable a) => String -> Maybe a-readLookupable s = msum- $ map ((`lookup` lookupTable).fst)- $ lex s+readLookupable :: (Lookupable a) => Text -> Maybe a+readLookupable s =+ lookup (T.takeWhile (not . isSpace) $ T.dropWhile isSpace s) lookupTable uncurry3 :: (a->b->c -> z) -> (a,b,c ) -> z uncurry4 :: (a->b->c->d -> z) -> (a,b,c,d ) -> z
src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}@@ -60,11 +61,11 @@ import Data.Bool ( bool ) import Data.Either ( rights ) import qualified Data.Map as M-import qualified Data.Text as T+import Data.Text (Text) import Data.Default import Data.Maybe -import qualified Text.XML.Light as XML+import qualified Text.Pandoc.XML.Light as XML import Text.Pandoc.Readers.Odt.Arrows.State import Text.Pandoc.Readers.Odt.Arrows.Utils@@ -78,13 +79,13 @@ -------------------------------------------------------------------------------- ---type ElementName = String-type AttributeName = String-type AttributeValue = String-type TextAttributeValue = T.Text+type ElementName = Text+type AttributeName = Text+type AttributeValue = Text+type TextAttributeValue = Text ---type NameSpacePrefix = String+type NameSpacePrefix = Text -- type NameSpacePrefixes nsID = M.Map nsID NameSpacePrefix@@ -461,7 +462,7 @@ lookupDefaultingAttr nsID attrName = lookupAttrWithDefault nsID attrName def --- | Return value as a (Maybe String)+-- | Return value as a (Maybe Text) findAttr' :: (NameSpaceID nsID) => nsID -> AttributeName -> XMLConverter nsID extraState x (Maybe AttributeValue)@@ -477,7 +478,6 @@ = qualifyName nsID attrName &&& getCurrentElement >>% XML.findAttr- >>^ fmap T.pack -- | Return value as string or fail findAttr :: (NameSpaceID nsID)@@ -492,7 +492,6 @@ -> FallibleXMLConverter nsID extraState x TextAttributeValue findAttrText nsID attrName = findAttr' nsID attrName- >>^ fmap T.pack >>> maybeToChoice -- | Return value as string or return provided default value@@ -511,7 +510,7 @@ -> XMLConverter nsID extraState x TextAttributeValue findAttrTextWithDefault nsID attrName deflt = findAttr' nsID attrName- >>^ maybe deflt T.pack+ >>^ fromMaybe deflt -- | Read and return value or fail readAttr :: (NameSpaceID nsID, Read attrValue)@@ -748,7 +747,7 @@ -- Internals -------------------------------------------------------------------------------- -stringToBool' :: String -> Maybe Bool+stringToBool' :: Text -> Maybe Bool stringToBool' val | val `elem` trueValues = Just True | val `elem` falseValues = Just False | otherwise = Nothing
src/Text/Pandoc/Readers/Odt/Namespaces.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Reader.Odt.Namespaces Copyright : Copyright (C) 2015 Martin Linnemann@@ -13,10 +14,10 @@ module Text.Pandoc.Readers.Odt.Namespaces ( Namespace (..) ) where -import Data.List (isPrefixOf) import qualified Data.Map as M (empty, insert) import Data.Maybe (fromMaybe, listToMaybe)-+import Data.Text (Text)+import qualified Data.Text as T import Text.Pandoc.Readers.Odt.Generic.Namespaces @@ -30,7 +31,7 @@ findID :: NameSpaceIRI -> Maybe Namespace-findID iri = listToMaybe [nsID | (iri',nsID) <- nsIDs, iri' `isPrefixOf` iri]+findID iri = listToMaybe [nsID | (iri',nsID) <- nsIDs, iri' `T.isPrefixOf` iri] nsIDmap :: NameSpaceIRIs Namespace nsIDmap = foldr (uncurry $ flip M.insert) M.empty nsIDs@@ -54,12 +55,12 @@ -- Core XML (basically only for the 'id'-attribute) | NsXML -- Fallback- | NsOther String+ | NsOther Text deriving ( Eq, Ord, Show ) -- | Not the actual iri's, but large prefixes of them - this way there are -- less versioning problems and the like.-nsIDs :: [(String,Namespace)]+nsIDs :: [(Text, Namespace)] nsIDs = [ ("urn:oasis:names:tc:opendocument:xmlns:animation" , NsAnim ), ("urn:oasis:names:tc:opendocument:xmlns:chart" , NsChart ),
src/Text/Pandoc/Readers/Odt/StyleReader.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Readers.Odt.StyleReader Copyright : Copyright (C) 2015 Martin Linnemann@@ -46,11 +47,13 @@ import Data.List (unfoldr) import qualified Data.Map as M import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T import qualified Data.Set as S -import qualified Text.XML.Light as XML+import qualified Text.Pandoc.XML.Light as XML -import Text.Pandoc.Shared (safeRead)+import Text.Pandoc.Shared (safeRead, tshow) import Text.Pandoc.Readers.Odt.Arrows.Utils @@ -90,7 +93,7 @@ -- -- Thus, we want -type FontFaceName = String+type FontFaceName = Text type FontPitches = M.Map FontFaceName FontPitch @@ -151,7 +154,7 @@ -- Definitions of main data -------------------------------------------------------------------------------- -type StyleName = String+type StyleName = Text -- | There are two types of styles: named styles with a style family and an -- optional style parent, and default styles for each style family,@@ -355,8 +358,8 @@ -- \^ simpler, but in general less efficient data ListLevelStyle = ListLevelStyle { listLevelType :: ListLevelType- , listItemPrefix :: Maybe String- , listItemSuffix :: Maybe String+ , listItemPrefix :: Maybe Text+ , listItemSuffix :: Maybe Text , listItemFormat :: ListItemNumberFormat , listItemStart :: Int }@@ -366,9 +369,9 @@ show ListLevelStyle{..} = "<LLS|" ++ show listLevelType ++ "|"- ++ maybeToString listItemPrefix+ ++ maybeToString (T.unpack <$> listItemPrefix) ++ show listItemFormat- ++ maybeToString listItemSuffix+ ++ maybeToString (T.unpack <$> listItemSuffix) ++ ">" where maybeToString = fromMaybe "" @@ -471,7 +474,7 @@ ) where isFontEmphasised = [("normal",False),("italic",True),("oblique",True)] isFontBold = ("normal",False):("bold",True)- :map ((,True).show) ([100,200..900]::[Int])+ :map ((,True) . tshow) ([100,200..900]::[Int]) readUnderlineMode :: StyleReaderSafe _x (Maybe UnderlineMode) readUnderlineMode = readLineMode "text-underline-mode"@@ -481,7 +484,7 @@ readStrikeThroughMode = readLineMode "text-line-through-mode" "text-line-through-style" -readLineMode :: String -> String -> StyleReaderSafe _x (Maybe UnderlineMode)+readLineMode :: Text -> Text -> StyleReaderSafe _x (Maybe UnderlineMode) readLineMode modeAttr styleAttr = proc x -> do isUL <- searchAttr NsStyle styleAttr False isLinePresent -< x mode <- lookupAttr' NsStyle modeAttr -< x
src/Text/Pandoc/Readers/Org/Blocks.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {- | Module : Text.Pandoc.Readers.Org.Blocks Copyright : Copyright (C) 2014-2021 Albert Krewinkel@@ -850,16 +851,52 @@ definitionMarker = spaceChar *> string "::" <* (spaceChar <|> lookAhead newline) +-- | Checkbox for tasks.+data Checkbox+ = UncheckedBox+ | CheckedBox+ | SemicheckedBox++-- | Parses a checkbox in a plain list.+checkbox :: PandocMonad m+ => OrgParser m Checkbox+checkbox = do+ guardEnabled Ext_task_lists+ try (char '[' *> status <* char ']') <?> "checkbox"+ where+ status = choice+ [ UncheckedBox <$ char ' '+ , CheckedBox <$ char 'X'+ , SemicheckedBox <$ char '-'+ ]++checkboxToInlines :: Checkbox -> Inline+checkboxToInlines = B.Str . \case+ UncheckedBox -> "☐"+ SemicheckedBox -> "☐"+ CheckedBox -> "☒"+ -- | parse raw text for one list item listItem :: PandocMonad m => OrgParser m Int -> OrgParser m (F Blocks) listItem parseIndentedMarker = try . withContext ListItemState $ do markerLength <- try parseIndentedMarker+ box <- optionMaybe checkbox firstLine <- anyLineNewline blank <- option "" ("\n" <$ blankline) rest <- T.concat <$> many (listContinuation markerLength)- parseFromString blocks $ firstLine <> blank <> rest+ contents <- parseFromString blocks $ firstLine <> blank <> rest+ return (maybe id (prependInlines . checkboxToInlines) box <$> contents)++-- | Prepend inlines to blocks, adding them to the first paragraph or+-- creating a new Plain element if necessary.+prependInlines :: Inline -> Blocks -> Blocks+prependInlines inlns = B.fromList . prepend . B.toList+ where+ prepend (Plain is : bs) = Plain (inlns : Space : is) : bs+ prepend (Para is : bs) = Para (inlns : Space : is) : bs+ prepend bs = Plain [inlns, Space] : bs -- continuation of a list item - indented and separated by blankline or endline. -- Note: nested lists are parsed as continuations.
src/Text/Pandoc/Readers/Org/Inlines.hs view
@@ -322,7 +322,7 @@ -- from the `org-ref-cite-re` variable in `org-ref.el`. orgRefCiteKey :: PandocMonad m => OrgParser m Text orgRefCiteKey =- let citeKeySpecialChars = "-_:\\./," :: String+ let citeKeySpecialChars = "-_:\\./" :: String isCiteKeySpecialChar c = c `elem` citeKeySpecialChars isCiteKeyChar c = isAlphaNum c || isCiteKeySpecialChar c endOfCitation = try $ do
src/Text/Pandoc/Readers/RST.hs view
@@ -28,7 +28,7 @@ import Text.Pandoc.Builder (Blocks, Inlines, fromList, setMeta, trimInlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem,- readFileFromDirs, getCurrentTime)+ readFileFromDirs, getTimestamp) import Text.Pandoc.CSV (CSVOptions (..), defaultCSVOptions, parseCSV) import Text.Pandoc.Definition import Text.Pandoc.Error@@ -685,7 +685,7 @@ "replace" -> B.para <$> -- consumed by substKey parseInlineFromText (trim top) "date" -> B.para <$> do -- consumed by substKey- t <- getCurrentTime+ t <- getTimestamp let format = case T.unpack (T.strip top) of [] -> "%Y-%m-%d" x -> x@@ -877,10 +877,11 @@ (bs, _) <- fetchItem u return $ UTF8.toText bs Nothing -> return rawcsv- let res = parseCSV opts (case explicitHeader of- Just h -> h <> "\n" <> rawcsv'- Nothing -> rawcsv')- case res of+ let header' = case explicitHeader of+ Just h -> parseCSV defaultCSVOptions h+ Nothing -> Right []+ let res = parseCSV opts rawcsv'+ case (<>) <$> header' <*> res of Left e -> throwError $ PandocParsecError "csv table" e Right rawrows -> do
src/Text/Pandoc/Readers/Textile.hs view
@@ -11,7 +11,7 @@ Portability : portable Conversion from Textile to 'Pandoc' document, based on the spec-available at http://redcloth.org/textile.+available at https://www.promptworks.com/textile/. Implemented and parsed: - Paragraphs
@@ -21,10 +21,7 @@ -- * List processing splitBy, splitTextBy,- splitByIndices,- splitStringByIndices, splitTextByIndices,- substitute, ordNub, findM, -- * Text processing@@ -70,10 +67,10 @@ isTightList, taskListItemFromAscii, taskListItemToAscii,+ handleTaskListItem, addMetaField, makeMeta, eastAsianLineBreakFilter,- underlineSpan, htmlSpanLikeElements, splitSentences, filterIpynbOutput,@@ -98,7 +95,7 @@ safeRead, safeStrRead, -- * User data directory- defaultUserDataDirs,+ defaultUserDataDir, -- * Version pandocVersion ) where@@ -112,7 +109,7 @@ import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum, generalCategory, GeneralCategory(NonSpacingMark, SpacingCombiningMark, EnclosingMark, ConnectorPunctuation))-import Data.List (find, intercalate, intersperse, stripPrefix, sortOn)+import Data.List (find, intercalate, intersperse, sortOn) import qualified Data.Map as M import Data.Maybe (mapMaybe, fromMaybe) import Data.Monoid (Any (..))@@ -150,45 +147,22 @@ splitBy _ [] = [] splitBy isSep lst = let (first, rest) = break isSep lst- rest' = dropWhile isSep rest- in first:splitBy isSep rest'+ in first:splitBy isSep (dropWhile isSep rest) +-- | Split text by groups of one or more separator. splitTextBy :: (Char -> Bool) -> T.Text -> [T.Text] splitTextBy isSep t | T.null t = [] | otherwise = let (first, rest) = T.break isSep t- rest' = T.dropWhile isSep rest- in first : splitTextBy isSep rest'--splitByIndices :: [Int] -> [a] -> [[a]]-splitByIndices [] lst = [lst]-splitByIndices (x:xs) lst = first:splitByIndices (map (\y -> y - x) xs) rest- where (first, rest) = splitAt x lst---- | Split string into chunks divided at specified indices.-splitStringByIndices :: [Int] -> [Char] -> [[Char]]-splitStringByIndices [] lst = [lst]-splitStringByIndices (x:xs) lst =- let (first, rest) = splitAt' x lst in- first : splitStringByIndices (map (\y -> y - x) xs) rest+ in first : splitTextBy isSep (T.dropWhile isSep rest) splitTextByIndices :: [Int] -> T.Text -> [T.Text]-splitTextByIndices ns = fmap T.pack . splitStringByIndices ns . T.unpack--splitAt' :: Int -> [Char] -> ([Char],[Char])-splitAt' _ [] = ([],[])-splitAt' n xs | n <= 0 = ([],xs)-splitAt' n (x:xs) = (x:ys,zs)- where (ys,zs) = splitAt' (n - charWidth x) xs---- | Replace each occurrence of one sublist in a list with another.-substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]-substitute _ _ [] = []-substitute [] _ xs = xs-substitute target replacement lst@(x:xs) =- case stripPrefix target lst of- Just lst' -> replacement ++ substitute target replacement lst'- Nothing -> x : substitute target replacement xs+splitTextByIndices ns = splitTextByRelIndices (zipWith (-) ns (0:ns))+ where+ splitTextByRelIndices [] t = [t]+ splitTextByRelIndices (x:xs) t =+ let (first, rest) = T.splitAt x t+ in first : splitTextByRelIndices xs rest ordNub :: (Ord a) => [a] -> [a] ordNub l = go Set.empty l@@ -253,17 +227,24 @@ stripTrailingNewlines :: T.Text -> T.Text stripTrailingNewlines = T.dropWhileEnd (== '\n') +isWS :: Char -> Bool+isWS ' ' = True+isWS '\r' = True+isWS '\n' = True+isWS '\t' = True+isWS _ = False+ -- | Remove leading and trailing space (including newlines) from string. trim :: T.Text -> T.Text-trim = T.dropAround (`elemText` " \r\n\t")+trim = T.dropAround isWS -- | Remove leading space (including newlines) from string. triml :: T.Text -> T.Text-triml = T.dropWhile (`elemText` " \r\n\t")+triml = T.dropWhile isWS -- | Remove trailing space (including newlines) from string. trimr :: T.Text -> T.Text-trimr = T.dropWhileEnd (`elemText` " \r\n\t")+trimr = T.dropWhileEnd isWS -- | Trim leading space and trailing space unless after \. trimMath :: T.Text -> T.Text@@ -274,7 +255,7 @@ | Just ('\\', _) <- T.uncons suff = T.cons (T.last pref) suff | otherwise = suff where- (pref, suff) = T.span (`elemText` " \t\n\r") t+ (pref, suff) = T.span isWS t -- | Strip leading and trailing characters from string stripFirstAndLast :: T.Text -> T.Text@@ -749,13 +730,6 @@ go xs = xs -{-# DEPRECATED underlineSpan "Use Text.Pandoc.Builder.underline instead" #-}--- | Builder for underline (deprecated).--- This probably belongs in Builder.hs in pandoc-types.--- Will be replaced once Underline is an element.-underlineSpan :: Inlines -> Inlines-underlineSpan = B.underline- -- | Set of HTML elements that are represented as Span with a class equal as -- the element tag itself. htmlSpanLikeElements :: Set.Set T.Text@@ -1038,12 +1012,16 @@ -- -- | Return appropriate user data directory for platform. We use--- XDG_DATA_HOME (or its default value), but fall back to the--- legacy user data directory ($HOME/.pandoc on *nix) if this is--- missing.-defaultUserDataDirs :: IO [FilePath]-defaultUserDataDirs = E.catch (do+-- XDG_DATA_HOME (or its default value), but for backwards compatibility,+-- we fall back to the legacy user data directory ($HOME/.pandoc on *nix)+-- if the XDG_DATA_HOME is missing and this exists. If neither directory+-- is present, we return the XDG data directory.+defaultUserDataDir :: IO FilePath+defaultUserDataDir = do xdgDir <- getXdgDirectory XdgData "pandoc" legacyDir <- getAppUserDataDirectory "pandoc"- return $ ordNub [xdgDir, legacyDir])- (\(_ :: E.SomeException) -> return [])+ xdgExists <- doesDirectoryExist xdgDir+ legacyDirExists <- doesDirectoryExist legacyDir+ if not xdgExists && legacyDirExists+ then return legacyDir+ else return xdgDir
src/Text/Pandoc/Templates.hs view
@@ -81,8 +81,6 @@ case format of "native" -> return "" "csljson" -> return ""- "bibtex" -> return ""- "biblatex" -> return "" "json" -> return "" "docx" -> return "" "fb2" -> return ""
src/Text/Pandoc/UTF8.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.UTF8@@ -40,67 +39,65 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.IO as TIO import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Prelude hiding (getContents, putStr, putStrLn, readFile, writeFile) import System.IO hiding (getContents, hGetContents, hPutStr, hPutStrLn, putStr, putStrLn, readFile, writeFile)-import qualified System.IO as IO -readFile :: FilePath -> IO String+readFile :: FilePath -> IO Text readFile f = do h <- openFile (encodePath f) ReadMode hGetContents h -getContents :: IO String+getContents :: IO Text getContents = hGetContents stdin -writeFileWith :: Newline -> FilePath -> String -> IO ()+writeFileWith :: Newline -> FilePath -> Text -> IO () writeFileWith eol f s = withFile (encodePath f) WriteMode $ \h -> hPutStrWith eol h s -writeFile :: FilePath -> String -> IO ()+writeFile :: FilePath -> Text -> IO () writeFile = writeFileWith nativeNewline -putStrWith :: Newline -> String -> IO ()+putStrWith :: Newline -> Text -> IO () putStrWith eol s = hPutStrWith eol stdout s -putStr :: String -> IO ()+putStr :: Text -> IO () putStr = putStrWith nativeNewline -putStrLnWith :: Newline -> String -> IO ()+putStrLnWith :: Newline -> Text -> IO () putStrLnWith eol s = hPutStrLnWith eol stdout s -putStrLn :: String -> IO ()+putStrLn :: Text -> IO () putStrLn = putStrLnWith nativeNewline -hPutStrWith :: Newline -> Handle -> String -> IO ()+hPutStrWith :: Newline -> Handle -> Text -> IO () hPutStrWith eol h s = hSetNewlineMode h (NewlineMode eol eol) >>- hSetEncoding h utf8 >> IO.hPutStr h s+ hSetEncoding h utf8 >> TIO.hPutStr h s -hPutStr :: Handle -> String -> IO ()+hPutStr :: Handle -> Text -> IO () hPutStr = hPutStrWith nativeNewline -hPutStrLnWith :: Newline -> Handle -> String -> IO ()+hPutStrLnWith :: Newline -> Handle -> Text -> IO () hPutStrLnWith eol h s = hSetNewlineMode h (NewlineMode eol eol) >>- hSetEncoding h utf8 >> IO.hPutStrLn h s+ hSetEncoding h utf8 >> TIO.hPutStrLn h s -hPutStrLn :: Handle -> String -> IO ()+hPutStrLn :: Handle -> Text -> IO () hPutStrLn = hPutStrLnWith nativeNewline -hGetContents :: Handle -> IO String-hGetContents = fmap toString . B.hGetContents--- hGetContents h = hSetEncoding h utf8_bom--- >> hSetNewlineMode h universalNewlineMode--- >> IO.hGetContents h+hGetContents :: Handle -> IO Text+hGetContents = fmap toText . B.hGetContents -- | Convert UTF8-encoded ByteString to Text, also -- removing '\r' characters.-toText :: B.ByteString -> T.Text+toText :: B.ByteString -> Text toText = T.decodeUtf8 . filterCRs . dropBOM where dropBOM bs = if "\xEF\xBB\xBF" `B.isPrefixOf` bs@@ -128,7 +125,7 @@ toStringLazy :: BL.ByteString -> String toStringLazy = TL.unpack . toTextLazy -fromText :: T.Text -> B.ByteString+fromText :: Text -> B.ByteString fromText = T.encodeUtf8 fromTextLazy :: TL.Text -> BL.ByteString
src/Text/Pandoc/Writers/BibTeX.hs view
@@ -25,7 +25,11 @@ import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Citeproc.BibTeX as BibTeX import Text.Pandoc.Citeproc.MetaValue (metaValueToReference)-import Text.Pandoc.Writers.Shared (lookupMetaString)+import Text.Pandoc.Writers.Shared (lookupMetaString, defField,+ addVariablesToContext)+import Text.DocLayout (render, vcat)+import Text.DocTemplates (Context(..))+import Text.Pandoc.Templates (renderTemplate) -- | Write BibTeX based on the references metadata from a Pandoc document. writeBibTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text@@ -43,6 +47,15 @@ let refs = case lookupMeta "references" meta of Just (MetaList xs) -> mapMaybe metaValueToReference xs _ -> []- return $ mconcat $- map (BibTeX.writeBibtexString opts variant mblang) refs+ let main = vcat $ map (BibTeX.writeBibtexString opts variant mblang) refs+ let context = defField "body" main+ $ addVariablesToContext opts (mempty :: Context Text)+ let colwidth = if writerWrapText opts == WrapAuto+ then Just $ writerColumns opts+ else Nothing+ return $ render colwidth $+ case writerTemplate opts of+ Nothing -> main+ Just tpl -> renderTemplate tpl context+
src/Text/Pandoc/Writers/CslJson.hs view
@@ -46,11 +46,11 @@ locale <- case getLocale lang of Left e -> throwError $ PandocCiteprocError e Right l -> return l- case lookupMeta "references" meta of- Just (MetaList rs) -> return $ (UTF8.toText $- toCslJson locale (mapMaybe metaValueToReference rs))- <> "\n"- _ -> throwError $ PandocAppError "No references field"+ let rs = case lookupMeta "references" meta of+ Just (MetaList xs) -> xs+ _ -> []+ return $ UTF8.toText+ (toCslJson locale (mapMaybe metaValueToReference rs)) <> "\n" fromInlines :: [Inline] -> CslJson Text fromInlines = foldMap fromInline . B.fromList
src/Text/Pandoc/Writers/Docx.hs view
@@ -31,6 +31,7 @@ import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList) import qualified Data.Set as Set import qualified Data.Text as T+import Data.Text (Text) import qualified Data.Text.Lazy as TL import Data.Time.Clock.POSIX import Data.Digest.Pure.SHA (sha1, showDigest)@@ -57,19 +58,19 @@ import Text.Pandoc.Writers.Shared import Text.Printf (printf) import Text.TeXMath-import Text.XML.Light as XML-import Text.XML.Light.Cursor as XMLC import Text.Pandoc.Writers.OOXML+import Text.Pandoc.XML.Light as XML+import Data.Generics (mkT, everywhere) data ListMarker = NoMarker | BulletMarker | NumberMarker ListNumberStyle ListNumberDelim Int deriving (Show, Read, Eq, Ord) -listMarkerToId :: ListMarker -> String+listMarkerToId :: ListMarker -> Text listMarkerToId NoMarker = "990" listMarkerToId BulletMarker = "991"-listMarkerToId (NumberMarker sty delim n) =+listMarkerToId (NumberMarker sty delim n) = T.pack $ '9' : '9' : styNum : delimNum : show n where styNum = case sty of DefaultStyle -> '2'@@ -106,8 +107,8 @@ , envListLevel :: Int , envListNumId :: Int , envInDel :: Bool- , envChangesAuthor :: T.Text- , envChangesDate :: T.Text+ , envChangesAuthor :: Text+ , envChangesDate :: Text , envPrintWidth :: Integer } @@ -125,9 +126,9 @@ data WriterState = WriterState{ stFootnotes :: [Element]- , stComments :: [([(T.Text, T.Text)], [Inline])]- , stSectionIds :: Set.Set T.Text- , stExternalLinks :: M.Map String String+ , stComments :: [([(Text, Text)], [Inline])]+ , stSectionIds :: Set.Set Text+ , stExternalLinks :: M.Map Text Text , stImages :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString) , stLists :: [ListMarker] , stInsId :: Int@@ -164,18 +165,18 @@ type WS m = ReaderT WriterEnv (StateT WriterState m) -renumIdMap :: Int -> [Element] -> M.Map String String+renumIdMap :: Int -> [Element] -> M.Map Text Text renumIdMap _ [] = M.empty renumIdMap n (e:es) | Just oldId <- findAttr (QName "Id" Nothing Nothing) e =- M.insert oldId ("rId" ++ show n) (renumIdMap (n+1) es)+ M.insert oldId ("rId" <> tshow n) (renumIdMap (n+1) es) | otherwise = renumIdMap n es -replaceAttr :: (QName -> Bool) -> String -> [XML.Attr] -> [XML.Attr]+replaceAttr :: (QName -> Bool) -> Text -> [XML.Attr] -> [XML.Attr] replaceAttr f val = map $ \a -> if f (attrKey a) then XML.Attr (attrKey a) val else a -renumId :: (QName -> Bool) -> M.Map String String -> Element -> Element+renumId :: (QName -> Bool) -> M.Map Text Text -> Element -> Element renumId f renumMap e | Just oldId <- findAttrBy f e , Just newId <- M.lookup oldId renumMap =@@ -184,18 +185,12 @@ e { elAttribs = attrs' } | otherwise = e -renumIds :: (QName -> Bool) -> M.Map String String -> [Element] -> [Element]+renumIds :: (QName -> Bool) -> M.Map Text Text -> [Element] -> [Element] renumIds f renumMap = map (renumId f renumMap) -findAttrTextBy :: (QName -> Bool) -> Element -> Maybe T.Text-findAttrTextBy x = fmap T.pack . findAttrBy x--lookupAttrTextBy :: (QName -> Bool) -> [XML.Attr] -> Maybe T.Text-lookupAttrTextBy x = fmap T.pack . lookupAttrBy x- -- | Certain characters are invalid in XML even if escaped. -- See #1992-stripInvalidChars :: T.Text -> T.Text+stripInvalidChars :: Text -> Text stripInvalidChars = T.filter isValidChar -- | See XML reference@@ -217,7 +212,7 @@ let doc' = Pandoc meta blocks' username <- P.lookupEnv "USERNAME"- utctime <- P.getCurrentTime+ utctime <- P.getTimestamp oldUserDataDir <- P.getUserDataDir P.setUserDataDir Nothing res <- P.readDefaultDataFile "reference.docx"@@ -234,11 +229,11 @@ -- Gets the template size let mbpgsz = mbsectpr >>= filterElementName (wname (=="pgSz"))- let mbAttrSzWidth = mbpgsz >>= lookupAttrTextBy ((=="w") . qName) . elAttribs+ let mbAttrSzWidth = mbpgsz >>= lookupAttrBy ((=="w") . qName) . elAttribs let mbpgmar = mbsectpr >>= filterElementName (wname (=="pgMar"))- let mbAttrMarLeft = mbpgmar >>= lookupAttrTextBy ((=="left") . qName) . elAttribs- let mbAttrMarRight = mbpgmar >>= lookupAttrTextBy ((=="right") . qName) . elAttribs+ let mbAttrMarLeft = mbpgmar >>= lookupAttrBy ((=="left") . qName) . elAttribs+ let mbAttrMarRight = mbpgmar >>= lookupAttrBy ((=="right") . qName) . elAttribs -- Get the available area (converting the size and the margins to int and -- doing the difference@@ -250,25 +245,22 @@ -- styles mblang <- toLang $ getLang opts meta+ -- TODO FIXME avoid this generic traversal!+ -- lang is in w:docDefaults / w:rPr / w:lang let addLang :: Element -> Element- addLang e = case (\l -> XMLC.toTree . go (T.unpack $ renderLang l) $- XMLC.fromElement e) <$> mblang of- Just (Elem e') -> e'- _ -> e -- return original- where go :: String -> Cursor -> Cursor- go l cursor = case XMLC.findRec (isLangElt . current) cursor of- Nothing -> cursor- Just t -> XMLC.modifyContent (setval l) t- setval :: String -> Content -> Content- setval l (Elem e') = Elem $ e'{ elAttribs = map (setvalattr l) $- elAttribs e' }- setval _ x = x- setvalattr :: String -> XML.Attr -> XML.Attr- setvalattr l (XML.Attr qn@(QName "val" _ _) _) = XML.Attr qn l- setvalattr _ x = x- isLangElt (Elem e') = qName (elName e') == "lang"- isLangElt _ = False+ addLang = case mblang of+ Nothing -> id+ Just l -> everywhere (mkT (go (renderLang l)))+ where+ go :: Text -> Element -> Element+ go l e'+ | qName (elName e') == "lang"+ = e'{ elAttribs = map (setvalattr l) $ elAttribs e' }+ | otherwise = e' + setvalattr l (XML.Attr qn@(QName "val" _ _) _) = XML.Attr qn l+ setvalattr _ x = x+ let stylepath = "word/styles.xml" styledoc <- addLang <$> parseXml refArchive distArchive stylepath @@ -337,12 +329,13 @@ -- [Content_Types].xml let mkOverrideNode (part', contentType') = mknode "Override"- [("PartName",part'),("ContentType",contentType')] ()+ [("PartName", T.pack part')+ ,("ContentType", contentType')] () let mkImageOverride (_, imgpath, mbMimeType, _) =- mkOverrideNode ("/word/" ++ imgpath,- maybe "application/octet-stream" T.unpack mbMimeType)+ mkOverrideNode ("/word/" <> imgpath,+ fromMaybe "application/octet-stream" mbMimeType) let mkMediaOverride imgpath =- mkOverrideNode ('/':imgpath, T.unpack $ getMimeTypeDef imgpath)+ mkOverrideNode ("/" <> imgpath, getMimeTypeDef imgpath) let overrides = map mkOverrideNode ( [("/word/webSettings.xml", "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")@@ -369,13 +362,14 @@ ,("/word/footnotes.xml", "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml") ] ++- map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,+ map (\x -> (maybe "" (T.unpack . ("/word/" <>)) (extractTarget x), "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) headers ++- map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,+ map (\x -> (maybe "" (T.unpack . ("/word/" <>)) (extractTarget x), "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) footers) ++ map mkImageOverride imgs ++- [ mkMediaOverride (eRelativePath e) | e <- zEntries refArchive- , "word/media/" `isPrefixOf` eRelativePath e ]+ [ mkMediaOverride (eRelativePath e)+ | e <- zEntries refArchive+ , "word/media/" `isPrefixOf` eRelativePath e ] let defaultnodes = [mknode "Default" [("Extension","xml"),("ContentType","application/xml")] (),@@ -421,7 +415,7 @@ let renumHeaders = renumIds (\q -> qName q == "Id") idMap headers let renumFooters = renumIds (\q -> qName q == "Id") idMap footers let baserels = baserels' ++ renumHeaders ++ renumFooters- let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()+ let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",T.pack ident),("Target",T.pack path)] () let imgrels = map toImgRel imgs let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] () let linkrels = map toLinkRel $ M.toList $ stExternalLinks st@@ -489,10 +483,10 @@ numbering <- parseXml refArchive distArchive numpath let newNumElts = mkNumbering (stLists st) let pandocAdded e =- case findAttrTextBy ((== "abstractNumId") . qName) e >>= safeRead of+ case findAttrBy ((== "abstractNumId") . qName) e >>= safeRead of Just numid -> numid >= (990 :: Int) Nothing ->- case findAttrTextBy ((== "numId") . qName) e >>= safeRead of+ case findAttrBy ((== "numId") . qName) e >>= safeRead of Just numid -> numid >= (1000 :: Int) Nothing -> False let oldElts = filter (not . pandocAdded) $ onlyElems (elContent numbering)@@ -514,7 +508,7 @@ let extraCoreProps = ["subject","lang","category","description"] let extraCorePropsMap = M.fromList $ zip extraCoreProps ["dc:subject","dc:language","cp:category","dc:description"]- let lookupMetaString' :: T.Text -> Meta -> T.Text+ let lookupMetaString' :: Text -> Meta -> Text lookupMetaString' key' meta' = case key' of "description" -> T.intercalate "_x000d_\n" (map stringify $ lookupMetaBlocks "description" meta')@@ -530,21 +524,21 @@ : mktnode "dc:creator" [] (T.intercalate "; " (map stringify $ docAuthors meta)) : [ mktnode (M.findWithDefault "" k extraCorePropsMap) [] (lookupMetaString' k meta) | k <- M.keys (unMeta meta), k `elem` extraCoreProps]- ++ mknode "cp:keywords" [] (T.unpack $ T.intercalate ", " keywords)+ ++ mknode "cp:keywords" [] (T.intercalate ", " keywords) : (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x- ]) (formatTime defaultTimeLocale "%FT%XZ" utctime)+ ]) (T.pack $ formatTime defaultTimeLocale "%FT%XZ" utctime) let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps -- docProps/custom.xml- let customProperties :: [(String, String)]- customProperties = [ (T.unpack k, T.unpack $ lookupMetaString k meta)+ let customProperties :: [(Text, Text)]+ customProperties = [ (k, lookupMetaString k meta) | k <- M.keys (unMeta meta) , k `notElem` (["title", "author", "keywords"] ++ extraCoreProps)] let mkCustomProp (k, v) pid = mknode "property" [("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")- ,("pid", show pid)+ ,("pid", tshow pid) ,("name", k)] $ mknode "vt:lpwstr" [] v let customPropsPath = "docProps/custom.xml" let customProps = mknode "Properties"@@ -594,7 +588,8 @@ fontTableEntry <- entryFromArchive refArchive "word/fontTable.xml" webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml" headerFooterEntries <- mapM (entryFromArchive refArchive . ("word/" ++)) $- mapMaybe extractTarget (headers ++ footers)+ mapMaybe (fmap T.unpack . extractTarget)+ (headers ++ footers) let miscRelEntries = [ e | e <- zEntries refArchive , "word/_rels/" `isPrefixOf` eRelativePath e , ".xml.rels" `isSuffixOf` eRelativePath e@@ -620,8 +615,8 @@ let styleId = T.filter (not . isSpace) s in mknode "w:style" [ ("w:type", "paragraph") , ("w:customStyle", "1")- , ("w:styleId", T.unpack styleId)]- [ mknode "w:name" [("w:val", T.unpack s)] ()+ , ("w:styleId", styleId)]+ [ mknode "w:name" [("w:val", s)] () , mknode "w:basedOn" [("w:val","BodyText")] () , mknode "w:qFormat" [] () ]@@ -631,8 +626,8 @@ let styleId = T.filter (not . isSpace) s in mknode "w:style" [ ("w:type", "character") , ("w:customStyle", "1")- , ("w:styleId", T.unpack styleId)]- [ mknode "w:name" [("w:val", T.unpack s)] ()+ , ("w:styleId", styleId)]+ [ mknode "w:name" [("w:val", s)] () , mknode "w:basedOn" [("w:val","BodyTextChar")] () ] @@ -643,13 +638,14 @@ toStyle toktype | hasStyleName (fromString $ show toktype) (smCharStyle sm) = Nothing | otherwise = Just $ mknode "w:style" [("w:type","character"),- ("w:customStyle","1"),("w:styleId",show toktype)]- [ mknode "w:name" [("w:val",show toktype)] ()+ ("w:customStyle","1"),("w:styleId", tshow toktype)]+ [ mknode "w:name" [("w:val", tshow toktype)] () , mknode "w:basedOn" [("w:val","VerbatimChar")] () , mknode "w:rPr" [] $- [ mknode "w:color" [("w:val",tokCol toktype)] ()+ [ mknode "w:color" [("w:val", tokCol toktype)] () | tokCol toktype /= "auto" ] ++- [ mknode "w:shd" [("w:val","clear"),("w:fill",tokBg toktype)] ()+ [ mknode "w:shd" [("w:val","clear")+ ,("w:fill",tokBg toktype)] () | tokBg toktype /= "auto" ] ++ [ mknode "w:b" [] () | tokFeature tokenBold toktype ] ++ [ mknode "w:i" [] () | tokFeature tokenItalic toktype ] ++@@ -657,10 +653,10 @@ ] tokStyles = tokenStyles style tokFeature f toktype = maybe False f $ M.lookup toktype tokStyles- tokCol toktype = maybe "auto" (drop 1 . fromColor)+ tokCol toktype = maybe "auto" (T.pack . drop 1 . fromColor) $ (tokenColor =<< M.lookup toktype tokStyles) `mplus` defaultColor style- tokBg toktype = maybe "auto" (drop 1 . fromColor)+ tokBg toktype = maybe "auto" (T.pack . drop 1 . fromColor) $ (tokenBackground =<< M.lookup toktype tokStyles) `mplus` backgroundColor style parStyle | hasStyleName "Source Code" (smParaStyle sm) = Nothing@@ -673,10 +669,11 @@ , mknode "w:pPr" [] $ mknode "w:wordWrap" [("w:val","off")] () :- maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) (backgroundColor style)+ maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill", T.pack $ drop 1 $ fromColor col)] ()]) (backgroundColor style) ] -copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry+copyChildren :: (PandocMonad m)+ => Archive -> Archive -> String -> Integer -> [Text] -> m Entry copyChildren refArchive distArchive path timestamp elNames = do ref <- parseXml refArchive distArchive path dist <- parseXml distArchive distArchive path@@ -685,7 +682,7 @@ } where strName QName{qName=name, qPrefix=prefix}- | Just p <- prefix = p++":"++name+ | Just p <- prefix = p <> ":" <> name | otherwise = name shouldCopy = (`elem` elNames) . strName cleanElem el@Element{elName=name} = Elem el{elName=name{qURI=Nothing}}@@ -706,35 +703,35 @@ mkNum :: ListMarker -> Int -> Element mkNum marker numid =- mknode "w:num" [("w:numId",show numid)]+ mknode "w:num" [("w:numId",tshow numid)] $ mknode "w:abstractNumId" [("w:val",listMarkerToId marker)] () : case marker of NoMarker -> [] BulletMarker -> [] NumberMarker _ _ start ->- map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))]- $ mknode "w:startOverride" [("w:val",show start)] ())+ map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",tshow (lvl :: Int))]+ $ mknode "w:startOverride" [("w:val",tshow start)] ()) [0..maxListLevel] mkAbstractNum :: ListMarker -> Integer -> Element mkAbstractNum marker nsid = mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)]- $ mknode "w:nsid" [("w:val", printf "%8x" nsid)] ()+ $ mknode "w:nsid" [("w:val", T.pack $ printf "%8x" nsid)] () : mknode "w:multiLevelType" [("w:val","multilevel")] () : map (mkLvl marker) [0..maxListLevel] mkLvl :: ListMarker -> Int -> Element mkLvl marker lvl =- mknode "w:lvl" [("w:ilvl",show lvl)] $+ mknode "w:lvl" [("w:ilvl",tshow lvl)] $ [ mknode "w:start" [("w:val",start)] () | marker /= NoMarker && marker /= BulletMarker ] ++ [ mknode "w:numFmt" [("w:val",fmt)] ()- , mknode "w:lvlText" [("w:val",lvltxt)] ()+ , mknode "w:lvlText" [("w:val", lvltxt)] () , mknode "w:lvlJc" [("w:val","left")] () , mknode "w:pPr" []- [ mknode "w:ind" [ ("w:left",show $ lvl * step + step)- , ("w:hanging",show (hang :: Int))+ [ mknode "w:ind" [ ("w:left",tshow $ lvl * step + step)+ , ("w:hanging",tshow (hang :: Int)) ] () ] ]@@ -743,8 +740,8 @@ NoMarker -> ("bullet"," ","1") BulletMarker -> ("bullet",bulletFor lvl,"1") NumberMarker st de n -> (styleFor st lvl- ,patternFor de ("%" ++ show (lvl + 1))- ,show n)+ ,patternFor de ("%" <> tshow (lvl + 1))+ ,tshow n) step = 720 hang = 480 bulletFor 0 = "\x2022" -- filled circle@@ -767,9 +764,9 @@ styleFor DefaultStyle 5 = "lowerRoman" styleFor DefaultStyle x = styleFor DefaultStyle (x `mod` 6) styleFor _ _ = "decimal"- patternFor OneParen s = s ++ ")"- patternFor TwoParens s = "(" ++ s ++ ")"- patternFor _ s = s ++ "."+ patternFor OneParen s = s <> ")"+ patternFor TwoParens s = "(" <> s <> ")"+ patternFor _ s = s <> "." getNumId :: (PandocMonad m) => WS m Int getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists@@ -777,8 +774,8 @@ makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element] makeTOC opts = do- let depth = "1-"++show (writerTOCDepth opts)- let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u"+ let depth = "1-" <> tshow (writerTOCDepth opts)+ let tocCmd = "TOC \\o \"" <> depth <> "\" \\h \\z \\u" tocTitle <- gets stTocTitle title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle]) return@@ -831,7 +828,7 @@ let toComment (kvs, ils) = do annotation <- inlinesToOpenXML opts ils return $- mknode "w:comment" [('w':':':T.unpack k,T.unpack v) | (k,v) <- kvs]+ mknode "w:comment" [("w:" <> k, v) | (k,v) <- kvs] [ mknode "w:p" [] $ map Elem [ mknode "w:pPr" []@@ -867,24 +864,24 @@ pStyleM styleName = do pStyleMap <- gets (smParaStyle . stStyleMaps) let sty' = getStyleIdFromName styleName pStyleMap- return $ mknode "w:pStyle" [("w:val", T.unpack $ fromStyleId sty')] ()+ return $ mknode "w:pStyle" [("w:val", fromStyleId sty')] () rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element rStyleM styleName = do cStyleMap <- gets (smCharStyle . stStyleMaps) let sty' = getStyleIdFromName styleName cStyleMap- return $ mknode "w:rStyle" [("w:val", T.unpack $ fromStyleId sty')] ()+ return $ mknode "w:rStyle" [("w:val", fromStyleId sty')] () -getUniqueId :: (PandocMonad m) => WS m String+getUniqueId :: (PandocMonad m) => WS m Text -- the + 20 is to ensure that there are no clashes with the rIds -- already in word/document.xml.rel getUniqueId = do n <- gets stCurId modify $ \st -> st{stCurId = n + 1}- return $ show n+ return $ tshow n -- | Key for specifying user-defined docx styles.-dynamicStyleKey :: T.Text+dynamicStyleKey :: Text dynamicStyleKey = "custom-style" -- | Convert a Pandoc block element to OpenXML.@@ -979,7 +976,7 @@ blockToOpenXML' opts (LineBlock lns) = blockToOpenXML opts $ linesToPara lns blockToOpenXML' _ b@(RawBlock format str) | format == Format "openxml" = return [- Text (CData CDataRaw (T.unpack str) Nothing)+ Text (CData CDataRaw str Nothing) ] | otherwise = do report $ BlockNotRendered b@@ -1036,7 +1033,7 @@ let fullrow = 5000 -- 100% specified in pct let rowwidth = fullrow * sum widths let mkgridcol w = mknode "w:gridCol"- [("w:w", show (floor (textwidth * w) :: Integer))] ()+ [("w:w", tshow (floor (textwidth * w) :: Integer))] () let hasHeader = not $ all null headers modify $ \s -> s { stInTable = False } -- for compatibility with Word <= 2007, we include a val with a bitmask@@ -1054,16 +1051,16 @@ mknode "w:tbl" [] ( mknode "w:tblPr" [] ( mknode "w:tblStyle" [("w:val","Table")] () :- mknode "w:tblW" [("w:type", "pct"), ("w:w", show rowwidth)] () :+ mknode "w:tblW" [("w:type", "pct"), ("w:w", tshow rowwidth)] () : mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0") ,("w:lastRow","0") ,("w:firstColumn","0") ,("w:lastColumn","0") ,("w:noHBand","0") ,("w:noVBand","0")- ,("w:val", printf "%04x" tblLookVal)+ ,("w:val", T.pack $ printf "%04x" tblLookVal) ] () :- [ mknode "w:tblCaption" [("w:val", T.unpack captionStr)] ()+ [ mknode "w:tblCaption" [("w:val", captionStr)] () | not (null caption) ] ) : mknode "w:tblGrid" [] (if all (==0) widths@@ -1126,7 +1123,7 @@ modify $ \st -> st{ stInList = oldInList } return $ first'' ++ rest'' -alignmentToString :: Alignment -> [Char]+alignmentToString :: Alignment -> Text alignmentToString alignment = case alignment of AlignLeft -> "left" AlignRight -> "right"@@ -1169,8 +1166,8 @@ listLevel <- asks envListLevel numid <- asks envListNumId let listPr = [mknode "w:numPr" []- [ mknode "w:ilvl" [("w:val",show listLevel)] ()- , mknode "w:numId" [("w:val",show numid)] () ] | listLevel >= 0 && not displayMathPara]+ [ mknode "w:ilvl" [("w:val",tshow listLevel)] ()+ , mknode "w:numId" [("w:val",tshow numid)] () ] | listLevel >= 0 && not displayMathPara] return $ case listPr ++ squashProps props of [] -> [] ps -> [mknode "w:pPr" [] ps]@@ -1185,7 +1182,7 @@ d <- md withParaProp d p -formattedString :: PandocMonad m => T.Text -> WS m [Element]+formattedString :: PandocMonad m => Text -> WS m [Element] formattedString str = -- properly handle soft hyphens case splitTextBy (=='\173') str of@@ -1194,7 +1191,7 @@ sh <- formattedRun [mknode "w:softHyphen" [] ()] intercalate sh <$> mapM formattedString' ws -formattedString' :: PandocMonad m => T.Text -> WS m [Element]+formattedString' :: PandocMonad m => Text -> WS m [Element] formattedString' str = do inDel <- asks envInDel formattedRun [ mktnode (if inDel then "w:delText" else "w:t")@@ -1226,7 +1223,7 @@ mknode "w:r" [] (mknode "w:t" [("xml:space","preserve")]- ("\t" :: String))] ++)+ ("\t" :: Text))] ++) <$> inlinesToOpenXML opts ils inlineToOpenXML' opts (Span ("",["csl-indent"],[]) ils) = inlinesToOpenXML opts ils@@ -1236,17 +1233,17 @@ let ident' = fromMaybe ident (lookup "id" kvs) kvs' = filter (("id" /=) . fst) kvs modify $ \st -> st{ stComments = (("id",ident'):kvs', ils) : stComments st }- return [ Elem $ mknode "w:commentRangeStart" [("w:id", T.unpack ident')] () ]+ return [ Elem $ mknode "w:commentRangeStart" [("w:id", ident')] () ] inlineToOpenXML' _ (Span (ident,["comment-end"],kvs) _) = -- prefer the "id" in kvs, since that is the one produced by the docx -- reader. let ident' = fromMaybe ident (lookup "id" kvs) in return . map Elem $- [ mknode "w:commentRangeEnd" [("w:id", T.unpack ident')] ()+ [ mknode "w:commentRangeEnd" [("w:id", ident')] () , mknode "w:r" [] [ mknode "w:rPr" [] [ mknode "w:rStyle" [("w:val", "CommentReference")] () ]- , mknode "w:commentReference" [("w:id", T.unpack ident')] () ]+ , mknode "w:commentReference" [("w:id", ident')] () ] ] inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do stylemod <- case lookup dynamicStyleKey kvs of@@ -1270,8 +1267,8 @@ defaultAuthor <- asks envChangesAuthor let author = fromMaybe defaultAuthor (lookup "author" kvs) let mdate = lookup "date" kvs- return $ ("w:author", T.unpack author) :- maybe [] (\date -> [("w:date", T.unpack date)]) mdate+ return $ ("w:author", author) :+ maybe [] (\date -> [("w:date", date)]) mdate insmod <- if "insertion" `elem` classes then do changeAuthorDate <- getChangeAuthorDate@@ -1281,7 +1278,7 @@ x <- f return [Elem $ mknode "w:ins"- (("w:id", show insId) : changeAuthorDate) x]+ (("w:id", tshow insId) : changeAuthorDate) x] else return id delmod <- if "deletion" `elem` classes then do@@ -1291,7 +1288,7 @@ return $ \f -> local (\env->env{envInDel=True}) $ do x <- f return [Elem $ mknode "w:del"- (("w:id", show delId) : changeAuthorDate) x]+ (("w:id", tshow delId) : changeAuthorDate) x] else return id contents <- insmod $ delmod $ dirmod $ stylemod $ pmod $ inlinesToOpenXML opts ils@@ -1322,7 +1319,7 @@ inlineToOpenXML' _ LineBreak = return [Elem br] inlineToOpenXML' _ il@(RawInline f str) | f == Format "openxml" = return- [Text (CData CDataRaw (T.unpack str) Nothing)]+ [Text (CData CDataRaw str Nothing)] | otherwise = do report $ InlineNotRendered il return []@@ -1335,7 +1332,7 @@ when (mathType == DisplayMath) setFirstPara res <- (lift . lift) (convertMath writeOMML mathType str) case res of- Right r -> return [Elem r]+ Right r -> return [Elem $ fromXLElement r] Left il -> inlineToOpenXML' opts il inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst inlineToOpenXML' opts (Code attrs str) = do@@ -1348,7 +1345,7 @@ mknode "w:r" [] [ mknode "w:rPr" [] $ maybeToList (lookup toktype tokTypesMap)- , mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ]+ , mknode "w:t" [("xml:space","preserve")] tok ] withTextPropM (rStyleM "Verbatim Char") $ if isNothing (writerHighlightStyle opts) then unhighlighted@@ -1365,7 +1362,7 @@ let notemarker = mknode "w:r" [] [ mknode "w:rPr" [] footnoteStyle , mknode "w:footnoteRef" [] () ]- let notemarkerXml = RawInline (Format "openxml") $ T.pack $ ppElement notemarker+ let notemarkerXml = RawInline (Format "openxml") $ ppElement notemarker let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : Space : ils) : xs insertNoteRef (Para ils : xs) = Para (notemarkerXml : Space : ils) : xs insertNoteRef xs = Para [notemarkerXml] : xs@@ -1384,17 +1381,17 @@ inlineToOpenXML' opts (Link _ txt (T.uncons -> Just ('#', xs),_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt return- [ Elem $ mknode "w:hyperlink" [("w:anchor", T.unpack $ toBookmarkName xs)] contents ]+ [ Elem $ mknode "w:hyperlink" [("w:anchor", toBookmarkName xs)] contents ] -- external link: inlineToOpenXML' opts (Link _ txt (src,_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt extlinks <- gets stExternalLinks- id' <- case M.lookup (T.unpack src) extlinks of+ id' <- case M.lookup src extlinks of Just i -> return i Nothing -> do- i <- ("rId"++) `fmap` getUniqueId+ i <- ("rId" <>) <$> getUniqueId modify $ \st -> st{ stExternalLinks =- M.insert (T.unpack src) i extlinks }+ M.insert src i extlinks } return i return [ Elem $ mknode "w:hyperlink" [("r:id",id')] contents ] inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do@@ -1414,17 +1411,17 @@ ,("noChangeAspect","1")] () nvPicPr = mknode "pic:nvPicPr" [] [ mknode "pic:cNvPr"- [("descr",T.unpack src),("id","0"),("name","Picture")] ()+ [("descr",src),("id","0"),("name","Picture")] () , cNvPicPr ] blipFill = mknode "pic:blipFill" []- [ mknode "a:blip" [("r:embed",ident)] ()+ [ mknode "a:blip" [("r:embed",T.pack ident)] () , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ] xfrm = mknode "a:xfrm" [] [ mknode "a:off" [("x","0"),("y","0")] ()- , mknode "a:ext" [("cx",show xemu)- ,("cy",show yemu)] () ]+ , mknode "a:ext" [("cx",tshow xemu)+ ,("cy",tshow yemu)] () ] prstGeom = mknode "a:prstGeom" [("prst","rect")] $ mknode "a:avLst" [] () ln = mknode "a:ln" [("w","9525")]@@ -1445,12 +1442,12 @@ imgElt = mknode "w:r" [] $ mknode "w:drawing" [] $ mknode "wp:inline" []- [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()+ [ mknode "wp:extent" [("cx",tshow xemu),("cy",tshow yemu)] () , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] () , mknode "wp:docPr"- [ ("descr", T.unpack $ stringify alt)- , ("title", T.unpack title)+ [ ("descr", stringify alt)+ , ("title", title) , ("id","1") , ("name","Picture") ] ()@@ -1463,7 +1460,7 @@ Just imgData -> return [Elem $ generateImgElt imgData] Nothing -> ( do --try (img, mt) <- P.fetchItem src- ident <- ("rId"++) `fmap` getUniqueId+ ident <- ("rId" <>) <$> getUniqueId let imgext = case mt >>= extensionFromMimeType of@@ -1477,10 +1474,10 @@ Just Svg -> ".svg" Just Emf -> ".emf" Nothing -> ""- imgpath = "media/" <> ident <> T.unpack imgext- mbMimeType = mt <|> getMimeType imgpath+ imgpath = "media/" <> ident <> imgext+ mbMimeType = mt <|> getMimeType (T.unpack imgpath) - imgData = (ident, imgpath, mbMimeType, img)+ imgData = (T.unpack ident, T.unpack imgpath, mbMimeType, img) if T.null imgext then -- without an extension there is no rule for content type@@ -1538,20 +1535,20 @@ , envTextProperties = EnvProps textStyle textProps' } -wrapBookmark :: (PandocMonad m) => T.Text -> [Content] -> WS m [Content]+wrapBookmark :: (PandocMonad m) => Text -> [Content] -> WS m [Content] wrapBookmark "" contents = return contents wrapBookmark ident contents = do id' <- getUniqueId let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')- ,("w:name", T.unpack $ toBookmarkName ident)] ()+ ,("w:name", toBookmarkName ident)] () bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] () return $ Elem bookmarkStart : contents ++ [Elem bookmarkEnd] -- Word imposes a 40 character limit on bookmark names and requires -- that they begin with a letter. So we just use a hash of the -- identifier when otherwise we'd have an illegal bookmark name.-toBookmarkName :: T.Text -> T.Text+toBookmarkName :: Text -> Text toBookmarkName s | Just (c, _) <- T.uncons s , isLetter c
src/Text/Pandoc/Writers/EPUB.hs view
@@ -24,12 +24,13 @@ gets, lift, modify) import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as B8-import Data.Char (isAlphaNum, isAscii, isDigit, toLower)+import Data.Char (isAlphaNum, isAscii, isDigit) import Data.List (isInfixOf, isPrefixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe, isNothing, mapMaybe, isJust) import qualified Data.Set as Set-import qualified Data.Text as TS+import qualified Data.Text as T+import Data.Text (Text) import qualified Data.Text.Lazy as TL import Network.HTTP (urlEncode) import System.FilePath (takeExtension, takeFileName, makeRelative)@@ -48,15 +49,13 @@ ObfuscationMethod (NoObfuscation), WrapOption (..), WriterOptions (..)) import Text.Pandoc.Shared (makeSections, normalizeDate, renderTags',- safeRead, stringify, trim, uniqueIdent, tshow)+ stringify, uniqueIdent, tshow) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.UUID (getRandomUUID) import Text.Pandoc.Walk (query, walk, walkM) import Text.Pandoc.Writers.HTML (writeHtmlStringForEPUB) import Text.Printf (printf)-import Text.XML.Light (Attr (..), Element (..), Node (..), QName (..),- add_attrs, lookupAttr, node, onlyElems, parseXML,- ppElement, showElement, strContent, unode, unqual)+import Text.Pandoc.XML.Light import Text.Pandoc.XML (escapeStringForXML) import Text.DocTemplates (FromContext(lookupContext), Context(..), ToContext(toVal), Val(..))@@ -68,69 +67,72 @@ data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))] , stMediaNextId :: Int- , stEpubSubdir :: String+ , stEpubSubdir :: FilePath } type E m = StateT EPUBState m data EPUBMetadata = EPUBMetadata{- epubIdentifier :: [Identifier]- , epubTitle :: [Title]- , epubDate :: [Date]- , epubLanguage :: String- , epubCreator :: [Creator]- , epubContributor :: [Creator]- , epubSubject :: [String]- , epubDescription :: Maybe String- , epubType :: Maybe String- , epubFormat :: Maybe String- , epubPublisher :: Maybe String- , epubSource :: Maybe String- , epubRelation :: Maybe String- , epubCoverage :: Maybe String- , epubRights :: Maybe String- , epubCoverImage :: Maybe String- , epubStylesheets :: [FilePath]- , epubPageDirection :: Maybe ProgressionDirection- , epubIbooksFields :: [(String, String)]- , epubCalibreFields :: [(String, String)]+ epubIdentifier :: [Identifier]+ , epubTitle :: [Title]+ , epubDate :: [Date]+ , epubLanguage :: Text+ , epubCreator :: [Creator]+ , epubContributor :: [Creator]+ , epubSubject :: [Text]+ , epubDescription :: Maybe Text+ , epubType :: Maybe Text+ , epubFormat :: Maybe Text+ , epubPublisher :: Maybe Text+ , epubSource :: Maybe Text+ , epubRelation :: Maybe Text+ , epubCoverage :: Maybe Text+ , epubRights :: Maybe Text+ , epubBelongsToCollection :: Maybe Text+ , epubGroupPosition :: Maybe Text+ , epubCoverImage :: Maybe FilePath+ , epubStylesheets :: [FilePath]+ , epubPageDirection :: Maybe ProgressionDirection+ , epubIbooksFields :: [(Text, Text)]+ , epubCalibreFields :: [(Text, Text)] } deriving Show data Date = Date{- dateText :: String- , dateEvent :: Maybe String+ dateText :: Text+ , dateEvent :: Maybe Text } deriving Show data Creator = Creator{- creatorText :: String- , creatorRole :: Maybe String- , creatorFileAs :: Maybe String+ creatorText :: Text+ , creatorRole :: Maybe Text+ , creatorFileAs :: Maybe Text } deriving Show data Identifier = Identifier{- identifierText :: String- , identifierScheme :: Maybe String+ identifierText :: Text+ , identifierScheme :: Maybe Text } deriving Show data Title = Title{- titleText :: String- , titleFileAs :: Maybe String- , titleType :: Maybe String+ titleText :: Text+ , titleFileAs :: Maybe Text+ , titleType :: Maybe Text } deriving Show data ProgressionDirection = LTR | RTL deriving Show -dcName :: String -> QName+dcName :: Text -> QName dcName n = QName n Nothing (Just "dc") -dcNode :: Node t => String -> t -> Element+dcNode :: Node t => Text -> t -> Element dcNode = node . dcName -opfName :: String -> QName+opfName :: Text -> QName opfName n = QName n Nothing (Just "opf") -toId :: FilePath -> String-toId = map (\x -> if isAlphaNum x || x == '-' || x == '_'+toId :: FilePath -> Text+toId = T.pack .+ map (\x -> if isAlphaNum x || x == '-' || x == '_' then x else '_') . takeFileName @@ -138,8 +140,8 @@ removeNote (Note _) = Str "" removeNote x = x -toVal' :: String -> Val TS.Text-toVal' = toVal . TS.pack+toVal' :: Text -> Val T.Text+toVal' = toVal mkEntry :: PandocMonad m => FilePath -> B.ByteString -> E m Entry mkEntry path content = do@@ -158,32 +160,37 @@ getEPUBMetadata :: PandocMonad m => WriterOptions -> Meta -> E m EPUBMetadata getEPUBMetadata opts meta = do let md = metadataFromMeta opts meta- let elts = maybe [] (onlyElems . parseXML) $ writerEpubMetadata opts+ elts <- case writerEpubMetadata opts of+ Nothing -> return []+ Just t -> case parseXMLContents (TL.fromStrict t) of+ Left msg -> throwError $+ PandocXMLError "epub metadata" msg+ Right ns -> return (onlyElems ns) let md' = foldr addMetadataFromXML md elts let addIdentifier m = if null (epubIdentifier m) then do randomId <- getRandomUUID- return $ m{ epubIdentifier = [Identifier (show randomId) Nothing] }+ return $ m{ epubIdentifier = [Identifier (tshow randomId) Nothing] } else return m let addLanguage m =- if null (epubLanguage m)+ if T.null (epubLanguage m) then case lookupContext "lang" (writerVariables opts) of- Just x -> return m{ epubLanguage = TS.unpack x }+ Just x -> return m{ epubLanguage = x } Nothing -> do mLang <- lift $ P.lookupEnv "LANG" let localeLang = case mLang of Just lang ->- TS.map (\c -> if c == '_' then '-' else c) $- TS.takeWhile (/='.') lang+ T.map (\c -> if c == '_' then '-' else c) $+ T.takeWhile (/='.') lang Nothing -> "en-US"- return m{ epubLanguage = TS.unpack localeLang }+ return m{ epubLanguage = localeLang } else return m let fixDate m = if null (epubDate m) then do- currentTime <- lift P.getCurrentTime+ currentTime <- lift P.getTimestamp return $ m{ epubDate = [ Date{ dateText = showDateTimeISO8601 currentTime , dateEvent = Nothing } ] }@@ -193,7 +200,7 @@ then return m else do let authors' = map stringify $ docAuthors meta- let toAuthor name = Creator{ creatorText = TS.unpack name+ let toAuthor name = Creator{ creatorText = name , creatorRole = Just "aut" , creatorFileAs = Nothing } return $ m{ epubCreator = map toAuthor authors' ++ epubCreator m }@@ -235,35 +242,37 @@ | name == "relation" = md { epubRelation = Just $ strContent e } | name == "coverage" = md { epubCoverage = Just $ strContent e } | name == "rights" = md { epubRights = Just $ strContent e }+ | name == "belongs-to-collection" = md { epubBelongsToCollection = Just $ strContent e }+ | name == "group-position" = md { epubGroupPosition = Just $ strContent e } | otherwise = md where getAttr n = lookupAttr (opfName n) attrs addMetadataFromXML e@(Element (QName "meta" _ _) attrs _ _) md = case getAttr "property" of- Just s | "ibooks:" `isPrefixOf` s ->- md{ epubIbooksFields = (drop 7 s, strContent e) :+ Just s | "ibooks:" `T.isPrefixOf` s ->+ md{ epubIbooksFields = (T.drop 7 s, strContent e) : epubIbooksFields md } _ -> case getAttr "name" of- Just s | "calibre:" `isPrefixOf` s ->+ Just s | "calibre:" `T.isPrefixOf` s -> md{ epubCalibreFields =- (drop 8 s, fromMaybe "" $ getAttr "content") :+ (T.drop 8 s, fromMaybe "" $ getAttr "content") : epubCalibreFields md } _ -> md where getAttr n = lookupAttr (unqual n) attrs addMetadataFromXML _ md = md -metaValueToString :: MetaValue -> String-metaValueToString (MetaString s) = TS.unpack s-metaValueToString (MetaInlines ils) = TS.unpack $ stringify ils-metaValueToString (MetaBlocks bs) = TS.unpack $ stringify bs+metaValueToString :: MetaValue -> Text+metaValueToString (MetaString s) = s+metaValueToString (MetaInlines ils) = stringify ils+metaValueToString (MetaBlocks bs) = stringify bs metaValueToString (MetaBool True) = "true" metaValueToString (MetaBool False) = "false" metaValueToString _ = "" metaValueToPaths :: MetaValue -> [FilePath]-metaValueToPaths (MetaList xs) = map metaValueToString xs-metaValueToPaths x = [metaValueToString x]+metaValueToPaths (MetaList xs) = map (T.unpack . metaValueToString) xs+metaValueToPaths x = [T.unpack $ metaValueToString x] -getList :: TS.Text -> Meta -> (MetaValue -> a) -> [a]+getList :: T.Text -> Meta -> (MetaValue -> a) -> [a] getList s meta handleMetaValue = case lookupMeta s meta of Just (MetaList xs) -> map handleMetaValue xs@@ -287,7 +296,7 @@ , titleType = metaValueToString <$> M.lookup "type" m } handleMetaValue mv = Title (metaValueToString mv) Nothing Nothing -getCreator :: TS.Text -> Meta -> [Creator]+getCreator :: T.Text -> Meta -> [Creator] getCreator s meta = getList s meta handleMetaValue where handleMetaValue (MetaMap m) = Creator{ creatorText = maybe "" metaValueToString $ M.lookup "text" m@@ -295,7 +304,7 @@ , creatorRole = metaValueToString <$> M.lookup "role" m } handleMetaValue mv = Creator (metaValueToString mv) Nothing Nothing -getDate :: TS.Text -> Meta -> [Date]+getDate :: T.Text -> Meta -> [Date] getDate s meta = getList s meta handleMetaValue where handleMetaValue (MetaMap m) = Date{ dateText = fromMaybe "" $@@ -304,7 +313,7 @@ handleMetaValue mv = Date { dateText = fromMaybe "" $ normalizeDate' $ metaValueToString mv , dateEvent = Nothing } -simpleList :: TS.Text -> Meta -> [String]+simpleList :: T.Text -> Meta -> [Text] simpleList s meta = case lookupMeta s meta of Just (MetaList xs) -> map metaValueToString xs@@ -313,26 +322,28 @@ metadataFromMeta :: WriterOptions -> Meta -> EPUBMetadata metadataFromMeta opts meta = EPUBMetadata{- epubIdentifier = identifiers- , epubTitle = titles- , epubDate = date- , epubLanguage = language- , epubCreator = creators- , epubContributor = contributors- , epubSubject = subjects- , epubDescription = description- , epubType = epubtype- , epubFormat = format- , epubPublisher = publisher- , epubSource = source- , epubRelation = relation- , epubCoverage = coverage- , epubRights = rights- , epubCoverImage = coverImage- , epubStylesheets = stylesheets- , epubPageDirection = pageDirection- , epubIbooksFields = ibooksFields- , epubCalibreFields = calibreFields+ epubIdentifier = identifiers+ , epubTitle = titles+ , epubDate = date+ , epubLanguage = language+ , epubCreator = creators+ , epubContributor = contributors+ , epubSubject = subjects+ , epubDescription = description+ , epubType = epubtype+ , epubFormat = format+ , epubPublisher = publisher+ , epubSource = source+ , epubRelation = relation+ , epubCoverage = coverage+ , epubRights = rights+ , epubBelongsToCollection = belongsToCollection+ , epubGroupPosition = groupPosition+ , epubCoverImage = coverImage+ , epubStylesheets = stylesheets+ , epubPageDirection = pageDirection+ , epubIbooksFields = ibooksFields+ , epubCalibreFields = calibreFields } where identifiers = getIdentifier meta titles = getTitle meta@@ -350,30 +361,31 @@ relation = metaValueToString <$> lookupMeta "relation" meta coverage = metaValueToString <$> lookupMeta "coverage" meta rights = metaValueToString <$> lookupMeta "rights" meta- coverImage =- (TS.unpack <$> lookupContext "epub-cover-image"- (writerVariables opts))+ belongsToCollection = metaValueToString <$> lookupMeta "belongs-to-collection" meta+ groupPosition = metaValueToString <$> lookupMeta "group-position" meta+ coverImage = T.unpack <$>+ lookupContext "epub-cover-image" (writerVariables opts) `mplus` (metaValueToString <$> lookupMeta "cover-image" meta) mCss = lookupMeta "css" meta <|> lookupMeta "stylesheet" meta stylesheets = maybe [] metaValueToPaths mCss ++ case lookupContext "css" (writerVariables opts) of- Just xs -> map TS.unpack xs+ Just xs -> map T.unpack xs Nothing -> case lookupContext "css" (writerVariables opts) of- Just x -> [TS.unpack x]+ Just x -> [T.unpack x] Nothing -> []- pageDirection = case map toLower . metaValueToString <$>+ pageDirection = case T.toLower . metaValueToString <$> lookupMeta "page-progression-direction" meta of Just "ltr" -> Just LTR Just "rtl" -> Just RTL _ -> Nothing ibooksFields = case lookupMeta "ibooks" meta of Just (MetaMap mp)- -> M.toList $ M.mapKeys TS.unpack $ M.map metaValueToString mp+ -> M.toList $ M.map metaValueToString mp _ -> [] calibreFields = case lookupMeta "calibre" meta of Just (MetaMap mp)- -> M.toList $ M.mapKeys TS.unpack $ M.map metaValueToString mp+ -> M.toList $ M.map metaValueToString mp _ -> [] -- | Produce an EPUB2 file from a Pandoc document.@@ -399,9 +411,11 @@ writeEPUB epubVersion opts doc = do let epubSubdir = writerEpubSubdirectory opts -- sanity check on epubSubdir- unless (TS.all (\c -> isAscii c && isAlphaNum c) epubSubdir) $+ unless (T.all (\c -> isAscii c && isAlphaNum c) epubSubdir) $ throwError $ PandocEpubSubdirectoryError epubSubdir- let initState = EPUBState { stMediaPaths = [], stMediaNextId = 0, stEpubSubdir = TS.unpack epubSubdir }+ let initState = EPUBState { stMediaPaths = []+ , stMediaNextId = 0+ , stEpubSubdir = T.unpack epubSubdir } evalStateT (pandocToEPUB epubVersion opts doc) initState pandocToEPUB :: PandocMonad m@@ -425,7 +439,7 @@ [] -> case epubTitle metadata of [] -> "UNTITLED" (x:_) -> titleText x- x -> TS.unpack $ stringify x+ x -> stringify x -- stylesheet stylesheets <- case epubStylesheets metadata of@@ -447,7 +461,8 @@ (ListVal $ map (\e -> toVal' $ (if useprefix then "../" else "") <>- makeRelative epubSubdir (eRelativePath e))+ T.pack+ (makeRelative epubSubdir (eRelativePath e))) stylesheetEntries) mempty @@ -476,18 +491,19 @@ case imageSize opts' (B.toStrict imgContent) of Right sz -> return $ sizeInPixels sz Left err' -> (0, 0) <$ report- (CouldNotDetermineImageSize (TS.pack img) err')+ (CouldNotDetermineImageSize (T.pack img) err') cpContent <- lift $ writeHtml opts'{ writerVariables = Context (M.fromList [ ("coverpage", toVal' "true"), ("pagetitle", toVal $- escapeStringForXML $ TS.pack plainTitle),- ("cover-image", toVal' coverImageName),+ escapeStringForXML plainTitle),+ ("cover-image",+ toVal' $ T.pack coverImageName), ("cover-image-width", toVal' $- show coverImageWidth),+ tshow coverImageWidth), ("cover-image-height", toVal' $- show coverImageHeight)]) <>+ tshow coverImageHeight)]) <> cssvars True <> vars } (Pandoc meta []) coverEntry <- mkEntry "text/cover.xhtml" cpContent@@ -503,7 +519,7 @@ ("titlepage", toVal' "true"), ("body-type", toVal' "frontmatter"), ("pagetitle", toVal $- escapeStringForXML $ TS.pack plainTitle)])+ escapeStringForXML plainTitle)]) <> cssvars True <> vars } (Pandoc meta []) tpEntry <- mkEntry "text/title_page.xhtml" tpContent@@ -512,7 +528,7 @@ let matchingGlob f = do xs <- lift $ P.glob f when (null xs) $- report $ CouldNotFetchResource (TS.pack f) "glob did not match any font files"+ report $ CouldNotFetchResource (T.pack f) "glob did not match any font files" return xs let mkFontEntry f = mkEntry ("fonts/" ++ takeFileName f) =<< lift (P.readFileLazy f)@@ -559,13 +575,13 @@ let chapters' = secsToChapters secs - let extractLinkURL' :: Int -> Inline -> [(TS.Text, TS.Text)]+ let extractLinkURL' :: Int -> Inline -> [(T.Text, T.Text)] extractLinkURL' num (Span (ident, _, _) _)- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)] extractLinkURL' num (Link (ident, _, _) _ _)- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)] extractLinkURL' num (Image (ident, _, _) _ _)- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)] extractLinkURL' num (RawInline fmt raw) | isHtmlFormat fmt = foldr (\tag ->@@ -573,18 +589,18 @@ TagOpen{} -> case fromAttrib "id" tag of "" -> id- x -> ((x, TS.pack (showChapter num) <> "#" <> x):)+ x -> ((x, showChapter num <> "#" <> x):) _ -> id) [] (parseTags raw) extractLinkURL' _ _ = [] - let extractLinkURL :: Int -> Block -> [(TS.Text, TS.Text)]+ let extractLinkURL :: Int -> Block -> [(T.Text, T.Text)] extractLinkURL num (Div (ident, _, _) _)- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)] extractLinkURL num (Header _ (ident, _, _) _)- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)] extractLinkURL num (Table (ident,_,_) _ _ _ _ _)- | not (TS.null ident) = [(ident, TS.pack (showChapter num) <> "#" <> ident)]+ | not (T.null ident) = [(ident, showChapter num <> "#" <> ident)] extractLinkURL num (RawBlock fmt raw) | isHtmlFormat fmt = foldr (\tag ->@@ -592,7 +608,7 @@ TagOpen{} -> case fromAttrib "id" tag of "" -> id- x -> ((x, TS.pack (showChapter num) <> "#" <> x):)+ x -> ((x, showChapter num <> "#" <> x):) _ -> id) [] (parseTags raw) extractLinkURL num b = query (extractLinkURL' num) b@@ -603,7 +619,7 @@ let fixInternalReferences :: Inline -> Inline fixInternalReferences (Link attr lab (src, tit))- | Just ('#', xs) <- TS.uncons src = case lookup xs reftable of+ | Just ('#', xs) <- T.uncons src = case lookup xs reftable of Just ys -> Link attr lab (ys, tit) Nothing -> Link attr lab (src, tit) fixInternalReferences x = x@@ -616,7 +632,7 @@ chapters' let chapToEntry num (Chapter bs) =- mkEntry ("text/" ++ showChapter num) =<<+ mkEntry ("text/" ++ T.unpack (showChapter num)) =<< writeHtml opts'{ writerVariables = Context (M.fromList [("body-type", toVal' bodyType),@@ -663,12 +679,12 @@ let chapterNode ent = unode "item" ! ([("id", toId $ makeRelative epubSubdir $ eRelativePath ent),- ("href", makeRelative epubSubdir+ ("href", T.pack $ makeRelative epubSubdir $ eRelativePath ent), ("media-type", "application/xhtml+xml")] ++ case props ent of [] -> []- xs -> [("properties", unwords xs)])+ xs -> [("properties", T.unwords xs)]) $ () let chapterRefNode ent = unode "itemref" !@@ -677,17 +693,17 @@ let pictureNode ent = unode "item" ! [("id", toId $ makeRelative epubSubdir $ eRelativePath ent),- ("href", makeRelative epubSubdir+ ("href", T.pack $ makeRelative epubSubdir $ eRelativePath ent), ("media-type",- maybe "application/octet-stream" TS.unpack+ fromMaybe "application/octet-stream" $ mediaTypeOf $ eRelativePath ent)] $ () let fontNode ent = unode "item" ! [("id", toId $ makeRelative epubSubdir $ eRelativePath ent),- ("href", makeRelative epubSubdir+ ("href", T.pack $ makeRelative epubSubdir $ eRelativePath ent),- ("media-type", maybe "" TS.unpack $+ ("media-type", fromMaybe "" $ getMimeType $ eRelativePath ent)] $ () let tocTitle = maybe plainTitle@@ -695,8 +711,8 @@ uuid <- case epubIdentifier metadata of (x:_) -> return $ identifierText x -- use first identifier as UUID [] -> throwError $ PandocShouldNeverHappenError "epubIdentifier is null" -- shouldn't happen- currentTime <- lift P.getCurrentTime- let contentsData = UTF8.fromStringLazy $ ppTopElement $+ currentTime <- lift P.getTimestamp+ let contentsData = UTF8.fromTextLazy $ TL.fromStrict $ ppTopElement $ unode "package" ! ([("version", case version of EPUB2 -> "2.0"@@ -714,7 +730,8 @@ ,("media-type","application/xhtml+xml")] ++ [("properties","nav") | epub3 ]) $ () ] ++- [ unode "item" ! [("id","stylesheet" ++ show n), ("href",fp)+ [ unode "item" ! [("id","stylesheet" <> tshow n)+ , ("href", T.pack fp) ,("media-type","text/css")] $ () | (n :: Int, fp) <- zip [1..] (map (makeRelative epubSubdir . eRelativePath)@@ -759,7 +776,7 @@ let tocLevel = writerTOCDepth opts let navPointNode :: PandocMonad m- => (Int -> [Inline] -> TS.Text -> [Element] -> Element)+ => (Int -> [Inline] -> T.Text -> [Element] -> Element) -> Block -> StateT Int m [Element] navPointNode formatter (Div (ident,_,_) (Header lvl (_,_,kvs) ils : children)) =@@ -769,7 +786,7 @@ n <- get modify (+1) let num = fromMaybe "" $ lookup "number" kvs- let tit = if writerNumberSections opts && not (TS.null num)+ let tit = if writerNumberSections opts && not (T.null num) then Span ("", ["section-header-number"], []) [Str num] : Space : ils else ils@@ -783,21 +800,21 @@ concat <$> mapM (navPointNode formatter) bs navPointNode _ _ = return [] - let navMapFormatter :: Int -> [Inline] -> TS.Text -> [Element] -> Element+ let navMapFormatter :: Int -> [Inline] -> T.Text -> [Element] -> Element navMapFormatter n tit src subs = unode "navPoint" !- [("id", "navPoint-" ++ show n)] $- [ unode "navLabel" $ unode "text" $ TS.unpack $ stringify tit- , unode "content" ! [("src", "text/" <> TS.unpack src)] $ ()+ [("id", "navPoint-" <> tshow n)] $+ [ unode "navLabel" $ unode "text" $ stringify tit+ , unode "content" ! [("src", "text/" <> src)] $ () ] ++ subs let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $- [ unode "navLabel" $ unode "text" (TS.unpack $ stringify $ docTitle' meta)+ [ unode "navLabel" $ unode "text" (stringify $ docTitle' meta) , unode "content" ! [("src", "text/title_page.xhtml")] $ () ] navMap <- lift $ evalStateT (concat <$> mapM (navPointNode navMapFormatter) secs) 1- let tocData = UTF8.fromStringLazy $ ppTopElement $+ let tocData = B.fromStrict $ UTF8.fromText $ ppTopElement $ unode "ncx" ! [("version","2005-1") ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $ [ unode "head" $@@ -819,23 +836,24 @@ ] tocEntry <- mkEntry "toc.ncx" tocData - let navXhtmlFormatter :: Int -> [Inline] -> TS.Text -> [Element] -> Element+ let navXhtmlFormatter :: Int -> [Inline] -> T.Text -> [Element] -> Element navXhtmlFormatter n tit src subs = unode "li" !- [("id", "toc-li-" ++ show n)] $+ [("id", "toc-li-" <> tshow n)] $ (unode "a" !- [("href", "text/" <> TS.unpack src)]+ [("href", "text/" <> src)] $ titElements) : case subs of [] -> [] (_:_) -> [unode "ol" ! [("class","toc")] $ subs]- where titElements = parseXML titRendered+ where titElements = either (const []) id $+ parseXMLContents (TL.fromStrict titRendered) titRendered = case P.runPure (writeHtmlStringForEPUB version opts{ writerTemplate = Nothing , writerVariables = Context (M.fromList [("pagetitle", toVal $- escapeStringForXML $ TS.pack plainTitle)])+ escapeStringForXML plainTitle)]) <> writerVariables opts} (Pandoc nullMeta [Plain $ walk clean tit])) of@@ -850,7 +868,7 @@ tocBlocks <- lift $ evalStateT (concat <$> mapM (navPointNode navXhtmlFormatter) secs) 1 let navBlocks = [RawBlock (Format "html")- $ TS.pack $ showElement $ -- prettyprinting introduces bad spaces+ $ showElement $ -- prettyprinting introduces bad spaces unode navtag ! ([("epub:type","toc") | epub3] ++ [("id","toc")]) $ [ unode "h1" ! [("id","toc-title")] $ tocTitle@@ -860,21 +878,21 @@ [ unode "a" ! [("href", "text/title_page.xhtml") ,("epub:type", "titlepage")] $- ("Title Page" :: String) ] :+ ("Title Page" :: Text) ] : [ unode "li" [ unode "a" ! [("href", "text/cover.xhtml") ,("epub:type", "cover")] $- ("Cover" :: String)] |+ ("Cover" :: Text)] | isJust (epubCoverImage metadata) ] ++ [ unode "li" [ unode "a" ! [("href", "#toc") ,("epub:type", "toc")] $- ("Table of Contents" :: String)+ ("Table of Contents" :: Text) ] | writerTableOfContents opts ] else []- let landmarks = [RawBlock (Format "html") $ TS.pack $ ppElement $+ let landmarks = [RawBlock (Format "html") $ ppElement $ unode "nav" ! [("epub:type","landmarks") ,("id","landmarks") ,("hidden","hidden")] $@@ -895,22 +913,22 @@ UTF8.fromStringLazy "application/epub+zip" -- container.xml- let containerData = UTF8.fromStringLazy $ ppTopElement $+ let containerData = B.fromStrict $ UTF8.fromText $ ppTopElement $ unode "container" ! [("version","1.0") ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $ unode "rootfiles" $ unode "rootfile" ! [("full-path", (if null epubSubdir then ""- else epubSubdir ++ "/") ++ "content.opf")+ else T.pack epubSubdir <> "/") <> "content.opf") ,("media-type","application/oebps-package+xml")] $ () containerEntry <- mkEntry "META-INF/container.xml" containerData -- com.apple.ibooks.display-options.xml- let apple = UTF8.fromStringLazy $ ppTopElement $+ let apple = B.fromStrict $ UTF8.fromText $ ppTopElement $ unode "display_options" $ unode "platform" ! [("name","*")] $- unode "option" ! [("name","specified-fonts")] $ ("true" :: String)+ unode "option" ! [("name","specified-fonts")] $ ("true" :: Text) appleEntry <- mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple -- construct archive@@ -931,8 +949,9 @@ ++ descriptionNodes ++ typeNodes ++ formatNodes ++ publisherNodes ++ sourceNodes ++ relationNodes ++ coverageNodes ++ rightsNodes ++ coverImageNodes- ++ modifiedNodes- withIds base f = concat . zipWith f (map (\x -> base ++ ('-' : show x))+ ++ modifiedNodes ++ belongsToCollectionNodes+ withIds base f = concat . zipWith f (map (\x -> base <>+ T.cons '-' (tshow x)) ([1..] :: [Int])) identifierNodes = withIds "epub-id" toIdentifierNode $ epubIdentifier md@@ -946,9 +965,9 @@ (x:_) -> [dcNode "date" ! [("id","epub-date")] $ dateText x] ibooksNodes = map ibooksNode (epubIbooksFields md)- ibooksNode (k, v) = unode "meta" ! [("property", "ibooks:" ++ k)] $ v+ ibooksNode (k, v) = unode "meta" ! [("property", "ibooks:" <> k)] $ v calibreNodes = map calibreNode (epubCalibreFields md)- calibreNode (k, v) = unode "meta" ! [("name", "calibre:" ++ k),+ calibreNode (k, v) = unode "meta" ! [("name", "calibre:" <> k), ("content", v)] $ () languageNodes = [dcTag "language" $ epubLanguage md] creatorNodes = withIds "epub-creator" (toCreatorNode "creator") $@@ -970,7 +989,16 @@ $ epubCoverImage md modifiedNodes = [ unode "meta" ! [("property", "dcterms:modified")] $ showDateTimeISO8601 currentTime | version == EPUB3 ]- dcTag n s = unode ("dc:" ++ n) s+ belongsToCollectionNodes = + maybe []+ (\belongsToCollection -> (unode "meta" ! [("property", "belongs-to-collection"), ("id", "epub-id-1")] $ belongsToCollection )+ :+ [unode "meta" ! [("refines", "#epub-id-1"), ("property", "collection-type")] $ ("series" :: Text) ])+ (epubBelongsToCollection md)+++ maybe []+ (\groupPosition -> [unode "meta" ! [("refines", "#epub-id-1"), ("property", "group-position")] $ groupPosition ])+ (epubGroupPosition md)+ dcTag n s = unode ("dc:" <> n) s dcTag' n s = [dcTag n s] toIdentifierNode id' (Identifier txt scheme) | version == EPUB2 = [dcNode "identifier" !@@ -978,7 +1006,7 @@ txt] | otherwise = (dcNode "identifier" ! [("id",id')] $ txt) : maybe [] ((\x -> [unode "meta" !- [ ("refines",'#':id')+ [ ("refines","#" <> id') , ("property","identifier-type") , ("scheme","onix:codelist5") ]@@ -994,10 +1022,10 @@ (creatorRole creator >>= toRelator)) $ creatorText creator] | otherwise = [dcNode s ! [("id",id')] $ creatorText creator] ++ maybe [] (\x -> [unode "meta" !- [("refines",'#':id'),("property","file-as")] $ x])+ [("refines","#" <> id'),("property","file-as")] $ x]) (creatorFileAs creator) ++ maybe [] (\x -> [unode "meta" !- [("refines",'#':id'),("property","role"),+ [("refines","#" <> id'),("property","role"), ("scheme","marc:relators")] $ x]) (creatorRole creator >>= toRelator) toTitleNode id' title@@ -1009,16 +1037,16 @@ | otherwise = [dcNode "title" ! [("id",id')] $ titleText title] ++ maybe [] (\x -> [unode "meta" !- [("refines",'#':id'),("property","file-as")] $ x])+ [("refines","#" <> id'),("property","file-as")] $ x]) (titleFileAs title) ++ maybe [] (\x -> [unode "meta" !- [("refines",'#':id'),("property","title-type")] $ x])+ [("refines","#" <> id'),("property","title-type")] $ x]) (titleType title) toDateNode id' date = [dcNode "date" ! (("id",id') : maybe [] (\x -> [("opf:event",x)]) (dateEvent date)) $ dateText date]- schemeToOnix :: String -> String+ schemeToOnix :: Text -> Text schemeToOnix "ISBN-10" = "02" schemeToOnix "GTIN-13" = "03" schemeToOnix "UPC" = "04"@@ -1036,48 +1064,48 @@ schemeToOnix "OLCC" = "28" schemeToOnix _ = "01" -showDateTimeISO8601 :: UTCTime -> String-showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"+showDateTimeISO8601 :: UTCTime -> Text+showDateTimeISO8601 = T.pack . formatTime defaultTimeLocale "%FT%TZ" transformTag :: PandocMonad m- => Tag TS.Text- -> E m (Tag TS.Text)+ => Tag T.Text+ -> E m (Tag T.Text) transformTag tag@(TagOpen name attr) | name `elem` ["video", "source", "img", "audio"] && isNothing (lookup "data-external" attr) = do let src = fromAttrib "src" tag let poster = fromAttrib "poster" tag- newsrc <- modifyMediaRef $ TS.unpack src- newposter <- modifyMediaRef $ TS.unpack poster+ newsrc <- modifyMediaRef $ T.unpack src+ newposter <- modifyMediaRef $ T.unpack poster let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++- [("src", "../" <> newsrc) | not (TS.null newsrc)] ++- [("poster", "../" <> newposter) | not (TS.null newposter)]+ [("src", "../" <> newsrc) | not (T.null newsrc)] +++ [("poster", "../" <> newposter) | not (T.null newposter)] return $ TagOpen name attr' transformTag tag = return tag modifyMediaRef :: PandocMonad m => FilePath- -> E m TS.Text+ -> E m T.Text modifyMediaRef "" = return "" modifyMediaRef oldsrc = do media <- gets stMediaPaths case lookup oldsrc media of- Just (n,_) -> return $ TS.pack n+ Just (n,_) -> return $ T.pack n Nothing -> catchError- (do (img, mbMime) <- P.fetchItem $ TS.pack oldsrc- let ext = maybe (takeExtension (takeWhile (/='?') oldsrc)) TS.unpack+ (do (img, mbMime) <- P.fetchItem $ T.pack oldsrc+ let ext = maybe (takeExtension (takeWhile (/='?') oldsrc)) T.unpack (("." <>) <$> (mbMime >>= extensionFromMimeType)) newName <- getMediaNextNewName ext let newPath = "media/" ++ newName entry <- mkEntry newPath (B.fromChunks . (:[]) $ img) modify $ \st -> st{ stMediaPaths = (oldsrc, (newPath, Just entry)):media}- return $ TS.pack newPath)+ return $ T.pack newPath) (\e -> do- report $ CouldNotFetchResource (TS.pack oldsrc) (tshow e)- return $ TS.pack oldsrc)+ report $ CouldNotFetchResource (T.pack oldsrc) (tshow e)+ return $ T.pack oldsrc) -getMediaNextNewName :: PandocMonad m => String -> E m String+getMediaNextNewName :: PandocMonad m => FilePath -> E m FilePath getMediaNextNewName ext = do nextId <- gets stMediaNextId modify $ \st -> st { stMediaNextId = nextId + 1 }@@ -1104,11 +1132,11 @@ -> Inline -> E m Inline transformInline _opts (Image attr lab (src,tit)) = do- newsrc <- modifyMediaRef $ TS.unpack src+ newsrc <- modifyMediaRef $ T.unpack src return $ Image attr lab ("../" <> newsrc, tit) transformInline opts x@(Math t m) | WebTeX url <- writerHTMLMathMethod opts = do- newsrc <- modifyMediaRef (TS.unpack url <> urlEncode (TS.unpack m))+ newsrc <- modifyMediaRef (T.unpack url <> urlEncode (T.unpack m)) let mathclass = if t == DisplayMath then "display" else "inline" return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] ("../" <> newsrc, "")]@@ -1119,40 +1147,26 @@ return $ RawInline fmt (renderTags' tags') transformInline _ x = return x -(!) :: (t -> Element) -> [(String, String)] -> t -> Element+(!) :: (t -> Element) -> [(Text, Text)] -> t -> Element (!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n) --- | Version of 'ppTopElement' that specifies UTF-8 encoding.-ppTopElement :: Element -> String-ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity . ppElement- -- unEntity removes numeric entities introduced by ppElement- -- (kindlegen seems to choke on these).- where unEntity [] = ""- unEntity ('&':'#':xs) =- let (ds,ys) = break (==';') xs- rest = drop 1 ys- in case safeRead (TS.pack $ "'\\" <> ds <> "'") of- Just x -> x : unEntity rest- Nothing -> '&':'#':unEntity xs- unEntity (x:xs) = x : unEntity xs- mediaTypeOf :: FilePath -> Maybe MimeType mediaTypeOf x = let mediaPrefixes = ["image", "video", "audio"] in case getMimeType x of- Just y | any (`TS.isPrefixOf` y) mediaPrefixes -> Just y+ Just y | any (`T.isPrefixOf` y) mediaPrefixes -> Just y _ -> Nothing -- Returns filename for chapter number.-showChapter :: Int -> String-showChapter = printf "ch%03d.xhtml"+showChapter :: Int -> Text+showChapter = T.pack . printf "ch%03d.xhtml" -- Add identifiers to any headers without them. addIdentifiers :: WriterOptions -> [Block] -> [Block] addIdentifiers opts bs = evalState (mapM go bs) Set.empty where go (Header n (ident,classes,kvs) ils) = do ids <- get- let ident' = if TS.null ident+ let ident' = if T.null ident then uniqueIdent (writerExtensions opts) ils ids else ident modify $ Set.insert ident'@@ -1160,27 +1174,27 @@ go x = return x -- Variant of normalizeDate that allows partial dates: YYYY, YYYY-MM-normalizeDate' :: String -> Maybe String-normalizeDate' = fmap TS.unpack . go . trim . TS.pack+normalizeDate' :: Text -> Maybe Text+normalizeDate' = go . T.strip where go xs- | TS.length xs == 4 -- YYY- , TS.all isDigit xs = Just xs- | (y, s) <- TS.splitAt 4 xs -- YYY-MM- , Just ('-', m) <- TS.uncons s- , TS.length m == 2- , TS.all isDigit y && TS.all isDigit m = Just xs+ | T.length xs == 4 -- YYY+ , T.all isDigit xs = Just xs+ | (y, s) <- T.splitAt 4 xs -- YYY-MM+ , Just ('-', m) <- T.uncons s+ , T.length m == 2+ , T.all isDigit y && T.all isDigit m = Just xs | otherwise = normalizeDate xs -toRelator :: String -> Maybe String+toRelator :: Text -> Maybe Text toRelator x | x `elem` relators = Just x- | otherwise = lookup (map toLower x) relatorMap+ | otherwise = lookup (T.toLower x) relatorMap -relators :: [String]+relators :: [Text] relators = map snd relatorMap -relatorMap :: [(String, String)]+relatorMap :: [(Text, Text)] relatorMap = [("abridger", "abr") ,("actor", "act")
src/Text/Pandoc/Writers/FB2.hs view
@@ -19,29 +19,29 @@ module Text.Pandoc.Writers.FB2 (writeFB2) where import Control.Monad (zipWithM)-import Control.Monad.Except (catchError)+import Control.Monad.Except (catchError, throwError) import Control.Monad.State.Strict (StateT, evalStateT, get, gets, lift, liftM, modify) import Data.ByteString.Base64 (encode) import Data.Char (isAscii, isControl, isSpace) import Data.Either (lefts, rights) import Data.List (intercalate)-import Data.Text (Text, pack)+import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE import Network.HTTP (urlEncode)-import Text.XML.Light-import qualified Text.XML.Light as X-import qualified Text.XML.Light.Cursor as XC-import qualified Text.XML.Light.Input as XI+import Text.Pandoc.XML.Light as X import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import qualified Text.Pandoc.Class.PandocMonad as P import Text.Pandoc.Definition+import Text.Pandoc.Error (PandocError(..)) import Text.Pandoc.Logging import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def) import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, makeSections, tshow, stringify) import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable)+import Data.Generics (everywhere, mkT) -- | Data to be written at the end of the document: -- (foot)notes, URLs, references, images.@@ -86,7 +86,7 @@ (imgs,missing) <- get >>= (lift . fetchImages . imagesToFetch) let body' = replaceImagesWithAlt missing body let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)- return $ pack $ xml_head ++ showContent fb2_xml ++ "\n"+ return $ xml_head <> showContent fb2_xml <> "\n" where xml_head = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" fb2_attrs =@@ -98,8 +98,8 @@ description :: PandocMonad m => Meta -> FBM m Content description meta' = do let genre = case lookupMetaString "genre" meta' of- "" -> el "genre" ("unrecognised" :: String)- s -> el "genre" (T.unpack s)+ "" -> el "genre" ("unrecognised" :: Text)+ s -> el "genre" s bt <- booktitle meta' let as = authors meta' dd <- docdate meta'@@ -110,7 +110,7 @@ Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s] Just (MetaString s) -> [el "lang" $ iso639 s] _ -> []- where iso639 = T.unpack . T.takeWhile (/= '-') -- Convert BCP 47 to ISO 639+ where iso639 = T.takeWhile (/= '-') -- Convert BCP 47 to ISO 639 let coverimage url = do let img = Image nullAttr mempty (url, "") im <- insertImage InlineImage img@@ -122,7 +122,7 @@ return $ el "description" [ el "title-info" (genre : (as ++ bt ++ annotation ++ dd ++ coverpage ++ lang))- , el "document-info" [el "program-used" ("pandoc" :: String)]+ , el "document-info" [el "program-used" ("pandoc" :: Text)] ] booktitle :: PandocMonad m => Meta -> FBM m [Content]@@ -135,15 +135,15 @@ author :: [Inline] -> [Content] author ss =- let ws = words . cMap plain $ ss- email = el "email" <$> take 1 (filter ('@' `elem`) ws)- ws' = filter ('@' `notElem`) ws+ let ws = T.words $ mconcat $ map plain ss+ email = el "email" <$> take 1 (filter (T.any (=='@')) ws)+ ws' = filter (not . T.any (== '@')) ws names = case ws' of [nickname] -> [ el "nickname" nickname ] [fname, lname] -> [ el "first-name" fname , el "last-name" lname ] (fname:rest) -> [ el "first-name" fname- , el "middle-name" (concat . init $ rest)+ , el "middle-name" (T.concat . init $ rest) , el "last-name" (last rest) ] [] -> [] in list $ el "author" (names ++ email)@@ -204,7 +204,7 @@ el "body" ([uattr "name" "notes"], map renderFN (reverse fns)) where renderFN (n, idstr, cs) =- let fn_texts = el "title" (el "p" (show n)) : cs+ let fn_texts = el "title" (el "p" (tshow n)) : cs in el "section" ([uattr "id" idstr], fn_texts) -- | Fetch images and encode them for the FictionBook XML.@@ -280,7 +280,7 @@ where types = ["text","image","audio","video","application","message","multipart"] valid c = isAscii c && not (isControl c) && not (isSpace c) &&- c `notElem` ("()<>@,;:\\\"/[]?=" :: String)+ c `notElem` ("()<>@,;:\\\"/[]?=" :: [Char]) footnoteID :: Int -> Text footnoteID i = "n" <> tshow i@@ -304,10 +304,13 @@ = insertImage NormalImage (Image atr alt (src,tit)) blockToXml (Para ss) = list . el "p" <$> cMapM toXml ss blockToXml (CodeBlock _ s) = return . spaceBeforeAfter .- map (el "p" . el "code" . T.unpack) . T.lines $ s+ map (el "p" . el "code") . T.lines $ s blockToXml (RawBlock f str) = if f == Format "fb2"- then return $ XI.parseXML str+ then+ case parseXMLContents (TL.fromStrict str) of+ Left msg -> throwError $ PandocXMLError "" msg+ Right nds -> return nds else return [] blockToXml (Div _ bs) = cMapM blockToXml bs blockToXml (BlockQuote bs) = list . el "cite" <$> cMapM blockToXml bs@@ -341,11 +344,11 @@ c <- el "emphasis" <$> cMapM toXml caption return [el "table" (hd <> bd), el "p" c] where- mkrow :: PandocMonad m => String -> [[Block]] -> [Alignment] -> FBM m Content+ mkrow :: PandocMonad m => Text -> [[Block]] -> [Alignment] -> FBM m Content mkrow tag cells aligns' = el "tr" <$> mapM (mkcell tag) (zip cells aligns') --- mkcell :: PandocMonad m => String -> ([Block], Alignment) -> FBM m Content+ mkcell :: PandocMonad m => Text -> ([Block], Alignment) -> FBM m Content mkcell tag (cell, align) = do cblocks <- cMapM blockToXml cell return $ el tag ([align_attr align], cblocks)@@ -419,7 +422,7 @@ inner <- cMapM toXml ss return $ [txt "“"] ++ inner ++ [txt "”"] toXml (Cite _ ss) = cMapM toXml ss -- FIXME: support citation styles-toXml (Code _ s) = return [el "code" $ T.unpack s]+toXml (Code _ s) = return [el "code" s] toXml Space = return [txt " "] toXml SoftBreak = return [txt "\n"] toXml LineBreak = return [txt "\n"]@@ -451,7 +454,7 @@ let imgurl = url <> T.pack (urlEncode $ T.unpack formula) let img = Image nullAttr alt (imgurl, "") insertImage immode img- _ -> return [el "code" $ T.unpack formula]+ _ -> return [el "code" formula] insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content] insertImage immode (Image _ alt (url,ttl)) = do@@ -466,31 +469,16 @@ el "image" $ [ attr ("l","href") ("#" <> fname) , attr ("l","type") (tshow immode)- , uattr "alt" (T.pack $ cMap plain alt) ]+ , uattr "alt" (mconcat $ map plain alt) ] ++ ttlattr insertImage _ _ = error "unexpected inline instead of image" replaceImagesWithAlt :: [Text] -> Content -> Content-replaceImagesWithAlt missingHrefs body =- let cur = XC.fromContent body- cur' = replaceAll cur- in XC.toTree . XC.root $ cur'+replaceImagesWithAlt missingHrefs = everywhere (mkT go) where- --- replaceAll :: XC.Cursor -> XC.Cursor- replaceAll c =- let n = XC.current c- c' = if isImage n && isMissing n- then XC.modifyContent replaceNode c- else c- in case XC.nextDF c' of- (Just cnext) -> replaceAll cnext- Nothing -> c' -- end of document- --- isImage :: Content -> Bool- isImage (Elem e) = elName e == uname "image"- isImage _ = False- --+ go c = if isMissing c+ then replaceNode c+ else c isMissing (Elem img@Element{}) = let imgAttrs = elAttribs img badAttrs = map (attr ("l","href")) missingHrefs@@ -500,18 +488,18 @@ replaceNode :: Content -> Content replaceNode n@(Elem img@Element{}) = let attrs = elAttribs img- alt = getAttrVal attrs (uname "alt")+ alt = getAttrVal attrs (unqual "alt") imtype = getAttrVal attrs (qname "l" "type") in case (alt, imtype) of (Just alt', Just imtype') ->- if imtype' == show NormalImage+ if imtype' == tshow NormalImage then el "p" alt'- else txt $ T.pack alt'- (Just alt', Nothing) -> txt $ T.pack alt' -- no type attribute+ else txt alt'+ (Just alt', Nothing) -> txt alt' -- no type attribute _ -> n -- don't replace if alt text is not found replaceNode n = n --- getAttrVal :: [X.Attr] -> QName -> Maybe String+ getAttrVal :: [X.Attr] -> QName -> Maybe Text getAttrVal attrs name = case filter ((name ==) . attrKey) attrs of (a:_) -> Just (attrVal a)@@ -519,7 +507,7 @@ -- | Wrap all inlines with an XML tag (given its unqualified name).-wrap :: PandocMonad m => String -> [Inline] -> FBM m Content+wrap :: PandocMonad m => Text -> [Inline] -> FBM m Content wrap tagname inlines = el tagname `liftM` cMapM toXml inlines -- " Create a singleton list.@@ -527,31 +515,31 @@ list = (:[]) -- | Convert an 'Inline' to plaintext.-plain :: Inline -> String-plain (Str s) = T.unpack s-plain (Emph ss) = cMap plain ss-plain (Underline ss) = cMap plain ss-plain (Span _ ss) = cMap plain ss-plain (Strong ss) = cMap plain ss-plain (Strikeout ss) = cMap plain ss-plain (Superscript ss) = cMap plain ss-plain (Subscript ss) = cMap plain ss-plain (SmallCaps ss) = cMap plain ss-plain (Quoted _ ss) = cMap plain ss-plain (Cite _ ss) = cMap plain ss -- FIXME-plain (Code _ s) = T.unpack s+plain :: Inline -> Text+plain (Str s) = s+plain (Emph ss) = mconcat $ map plain ss+plain (Underline ss) = mconcat $ map plain ss+plain (Span _ ss) = mconcat $ map plain ss+plain (Strong ss) = mconcat $ map plain ss+plain (Strikeout ss) = mconcat $ map plain ss+plain (Superscript ss) = mconcat $ map plain ss+plain (Subscript ss) = mconcat $ map plain ss+plain (SmallCaps ss) = mconcat $ map plain ss+plain (Quoted _ ss) = mconcat $ map plain ss+plain (Cite _ ss) = mconcat $ map plain ss -- FIXME+plain (Code _ s) = s plain Space = " " plain SoftBreak = " " plain LineBreak = "\n"-plain (Math _ s) = T.unpack s+plain (Math _ s) = s plain (RawInline _ _) = ""-plain (Link _ text (url,_)) = concat (map plain text ++ [" <", T.unpack url, ">"])-plain (Image _ alt _) = cMap plain alt+plain (Link _ text (url,_)) = mconcat (map plain text ++ [" <", url, ">"])+plain (Image _ alt _) = mconcat $ map plain alt plain (Note _) = "" -- FIXME -- | Create an XML element. el :: (Node t)- => String -- ^ unqualified element name+ => Text -- ^ unqualified element name -> t -- ^ node contents -> Content -- ^ XML content el name cs = Elem $ unode name cs@@ -564,22 +552,18 @@ -- | Create a plain-text XML content. txt :: Text -> Content-txt s = Text $ CData CDataText (T.unpack s) Nothing+txt s = Text $ CData CDataText s Nothing -- | Create an XML attribute with an unqualified name.-uattr :: String -> Text -> Text.XML.Light.Attr-uattr name = Attr (uname name) . T.unpack+uattr :: Text -> Text -> X.Attr+uattr name = Attr (unqual name) -- | Create an XML attribute with a qualified name from given namespace.-attr :: (String, String) -> Text -> Text.XML.Light.Attr-attr (ns, name) = Attr (qname ns name) . T.unpack---- | Unqualified name-uname :: String -> QName-uname name = QName name Nothing Nothing+attr :: (Text, Text) -> Text -> X.Attr+attr (ns, name) = Attr (qname ns name) -- | Qualified name-qname :: String -> String -> QName+qname :: Text -> Text -> QName qname ns name = QName name Nothing (Just ns) -- | Abbreviation for 'concatMap'.
src/Text/Pandoc/Writers/JATS/References.hs view
@@ -29,7 +29,7 @@ import Text.Pandoc.Options (WriterOptions) import Text.Pandoc.Shared (tshow) import Text.Pandoc.Writers.JATS.Types-import Text.Pandoc.XML (inTags)+import Text.Pandoc.XML (escapeStringForXML, inTags) import qualified Data.Text as T referencesToJATS :: PandocMonad m@@ -78,7 +78,8 @@ varInTagWith var tagName tagAttribs = case lookupVariable var ref >>= valToText of Nothing -> mempty- Just val -> inTags' tagName tagAttribs $ literal val+ Just val -> inTags' tagName tagAttribs . literal $+ escapeStringForXML val authors = case lookupVariable "author" ref of Just (NamesVal names) ->@@ -143,7 +144,9 @@ then inTags' "name" [] nameTags else nameLiteral name `inNameTag` "string-name" where- inNameTag val tag = maybe empty (inTags' tag [] . literal) val+ inNameTag mVal tag = case mVal of+ Nothing -> empty+ Just val -> inTags' tag [] . literal $ escapeStringForXML val surnamePrefix = maybe mempty (`T.snoc` ' ') $ nameNonDroppingParticle name givenSuffix = maybe mempty (T.cons ' ') $
src/Text/Pandoc/Writers/Jira.hs view
@@ -126,13 +126,13 @@ -> Text -> JiraConverter m [Jira.Block] toJiraCode (ident, classes, _attribs) code = do- let lang = case find (\c -> T.toLower c `elem` knownLanguages) classes of- Nothing -> Jira.Language "java"- Just l -> Jira.Language l let addAnchor b = if T.null ident then b else [Jira.Para (singleton (Jira.Anchor ident))] <> b- return . addAnchor . singleton $ Jira.Code lang mempty code+ return . addAnchor . 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 -- | Creates a Jira definition list toJiraDefinitionList :: PandocMonad m@@ -292,7 +292,9 @@ spanToJira :: PandocMonad m => Attr -> [Inline] -> JiraConverter m [Jira.Inline]-spanToJira (_, _classes, _) = toJiraInlines+spanToJira (ident, _classes, _attribs) inls = case ident of+ "" -> toJiraInlines inls+ _ -> (Jira.Anchor ident :) <$> toJiraInlines inls registerNotes :: PandocMonad m => [Block] -> JiraConverter m [Jira.Inline] registerNotes contents = do@@ -308,7 +310,7 @@ knownLanguages :: [Text] knownLanguages = [ "actionscript", "ada", "applescript", "bash", "c", "c#", "c++"- , "css", "erlang", "go", "groovy", "haskell", "html", "javascript"+ , "css", "erlang", "go", "groovy", "haskell", "html", "java", "javascript" , "json", "lua", "nyan", "objc", "perl", "php", "python", "r", "ruby" , "scala", "sql", "swift", "visualbasic", "xml", "yaml" ]
src/Text/Pandoc/Writers/LaTeX.hs view
@@ -18,11 +18,9 @@ writeLaTeX , writeBeamer ) where-import Control.Applicative ((<|>)) import Control.Monad.State.Strict-import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isSpace,- isPunctuation, ord)-import Data.List (foldl', intersperse, nubBy, (\\), uncons)+import Data.Char (isDigit)+import Data.List (intersperse, nubBy, (\\)) import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing) import qualified Data.Map as M import Data.Text (Text)@@ -34,7 +32,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,- styleToLaTeX, toListingsLanguage)+ styleToLaTeX) import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options@@ -44,10 +42,15 @@ import Text.Pandoc.Walk (query, walk, walkM) import Text.Pandoc.Writers.LaTeX.Caption (getCaption) import Text.Pandoc.Writers.LaTeX.Table (tableToLaTeX)+import Text.Pandoc.Writers.LaTeX.Citation (citationsToNatbib,+ citationsToBiblatex) import Text.Pandoc.Writers.LaTeX.Types (LW, WriterState (..), startingState)+import Text.Pandoc.Writers.LaTeX.Lang (toPolyglossia, toBabel)+import Text.Pandoc.Writers.LaTeX.Util (stringToLaTeX, StringContext(..),+ toLabel, inCmd,+ wrapDiv, hypertarget, labelFor,+ getListingsLanguage, mbBraced) import Text.Pandoc.Writers.Shared-import Text.Printf (printf)-import qualified Data.Text.Normalize as Normalize import qualified Text.Pandoc.Writers.AnnotatedTable as Ann -- | Convert Pandoc to LaTeX.@@ -241,154 +244,6 @@ Nothing -> main Just tpl -> renderTemplate tpl context' -data StringContext = TextString- | URLString- | CodeString- deriving (Eq)---- escape things as needed for LaTeX-stringToLaTeX :: PandocMonad m => StringContext -> Text -> LW m Text-stringToLaTeX context zs = do- opts <- gets stOptions- return $ T.pack $- foldr (go opts context) mempty $ T.unpack $- if writerPreferAscii opts- then Normalize.normalize Normalize.NFD zs- else zs- where- go :: WriterOptions -> StringContext -> Char -> String -> String- go opts ctx x xs =- let ligatures = isEnabled Ext_smart opts && ctx == TextString- isUrl = ctx == URLString- mbAccentCmd =- if writerPreferAscii opts && ctx == TextString- then uncons xs >>= \(c,_) -> M.lookup c accents- else Nothing- emits s =- case mbAccentCmd of- Just cmd ->- cmd <> "{" <> s <> "}" <> drop 1 xs -- drop combining accent- Nothing -> s <> xs- emitc c =- case mbAccentCmd of- Just cmd ->- cmd <> "{" <> [c] <> "}" <> drop 1 xs -- drop combining accent- Nothing -> c : xs- emitcseq cs =- case xs of- c:_ | isLetter c- , ctx == TextString- -> cs <> " " <> xs- | isSpace c -> cs <> "{}" <> xs- | ctx == TextString- -> cs <> xs- _ -> cs <> "{}" <> xs- emitquote cs =- case xs of- '`':_ -> cs <> "\\," <> xs -- add thin space- '\'':_ -> cs <> "\\," <> xs -- add thin space- _ -> cs <> xs- in case x of- '?' | ligatures -> -- avoid ?` ligature- case xs of- '`':_ -> emits "?{}"- _ -> emitc x- '!' | ligatures -> -- avoid !` ligature- case xs of- '`':_ -> emits "!{}"- _ -> emitc x- '{' -> emits "\\{"- '}' -> emits "\\}"- '`' | ctx == CodeString -> emitcseq "\\textasciigrave"- '$' | not isUrl -> emits "\\$"- '%' -> emits "\\%"- '&' -> emits "\\&"- '_' | not isUrl -> emits "\\_"- '#' -> emits "\\#"- '-' | not isUrl -> case xs of- -- prevent adjacent hyphens from forming ligatures- ('-':_) -> emits "-\\/"- _ -> emitc '-'- '~' | not isUrl -> emitcseq "\\textasciitilde"- '^' -> emits "\\^{}"- '\\'| isUrl -> emitc '/' -- NB. / works as path sep even on Windows- | otherwise -> emitcseq "\\textbackslash"- '|' | not isUrl -> emitcseq "\\textbar"- '<' -> emitcseq "\\textless"- '>' -> emitcseq "\\textgreater"- '[' -> emits "{[}" -- to avoid interpretation as- ']' -> emits "{]}" -- optional arguments- '\'' | ctx == CodeString -> emitcseq "\\textquotesingle"- '\160' -> emits "~"- '\x200B' -> emits "\\hspace{0pt}" -- zero-width space- '\x202F' -> emits "\\,"- '\x2026' -> emitcseq "\\ldots"- '\x2018' | ligatures -> emitquote "`"- '\x2019' | ligatures -> emitquote "'"- '\x201C' | ligatures -> emitquote "``"- '\x201D' | ligatures -> emitquote "''"- '\x2014' | ligatures -> emits "---"- '\x2013' | ligatures -> emits "--"- _ | writerPreferAscii opts- -> case x of- 'ı' -> emitcseq "\\i"- 'ȷ' -> emitcseq "\\j"- 'å' -> emitcseq "\\aa"- 'Å' -> emitcseq "\\AA"- 'ß' -> emitcseq "\\ss"- 'ø' -> emitcseq "\\o"- 'Ø' -> emitcseq "\\O"- 'Ł' -> emitcseq "\\L"- 'ł' -> emitcseq "\\l"- 'æ' -> emitcseq "\\ae"- 'Æ' -> emitcseq "\\AE"- 'œ' -> emitcseq "\\oe"- 'Œ' -> emitcseq "\\OE"- '£' -> emitcseq "\\pounds"- '€' -> emitcseq "\\euro"- '©' -> emitcseq "\\copyright"- _ -> emitc x- | otherwise -> emitc x--accents :: M.Map Char String-accents = M.fromList- [ ('\779' , "\\H")- , ('\768' , "\\`")- , ('\769' , "\\'")- , ('\770' , "\\^")- , ('\771' , "\\~")- , ('\776' , "\\\"")- , ('\775' , "\\.")- , ('\772' , "\\=")- , ('\781' , "\\|")- , ('\817' , "\\b")- , ('\807' , "\\c")- , ('\783' , "\\G")- , ('\777' , "\\h")- , ('\803' , "\\d")- , ('\785' , "\\f")- , ('\778' , "\\r")- , ('\865' , "\\t")- , ('\782' , "\\U")- , ('\780' , "\\v")- , ('\774' , "\\u")- , ('\808' , "\\k")- , ('\785' , "\\newtie")- , ('\8413', "\\textcircled")- ]--toLabel :: PandocMonad m => Text -> LW m Text-toLabel z = go `fmap` stringToLaTeX URLString z- where- go = T.concatMap $ \x -> case x of- _ | (isLetter x || isDigit x) && isAscii x -> T.singleton x- | x `elemText` "_-+=:;." -> T.singleton x- | otherwise -> T.pack $ "ux" <> printf "%x" (ord x)---- | Puts contents into LaTeX command.-inCmd :: Text -> Doc Text -> Doc Text-inCmd cmd contents = char '\\' <> literal cmd <> braces contents- toSlides :: PandocMonad m => [Block] -> LW m [Block] toSlides bs = do opts <- gets stOptions@@ -500,12 +355,13 @@ else blockListToLaTeX bs modify $ \st -> st{ stIncremental = oldIncremental } linkAnchor' <- hypertarget True identifier empty- -- see #2704 for the motivation for adding \leavevmode:+ -- see #2704 for the motivation for adding \leavevmode+ -- and #7078 for \vadjust pre let linkAnchor = case bs of Para _ : _ | not (isEmpty linkAnchor')- -> "\\leavevmode" <> linkAnchor' <> "%"+ -> "\\leavevmode\\vadjust pre{" <> linkAnchor' <> "}%" _ -> linkAnchor' wrapNotes txt = if beamer && "notes" `elem` classes then "\\note" <> braces txt -- speaker notes@@ -852,81 +708,6 @@ braces txtNoNotes else empty -mapAlignment :: Text -> Text-mapAlignment a = case a of- "top" -> "T"- "top-baseline" -> "t"- "bottom" -> "b"- "center" -> "c"- _ -> a--wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text)-wrapDiv (_,classes,kvs) t = do- beamer <- gets stBeamer- let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir- lang <- toLang $ lookup "lang" kvs- let wrapColumns = if beamer && "columns" `elem` classes- then \contents ->- let valign = maybe "T" mapAlignment (lookup "align" kvs)- totalwidth = maybe [] (\x -> ["totalwidth=" <> x])- (lookup "totalwidth" kvs)- onlytextwidth = filter ("onlytextwidth" ==) classes- options = text $ T.unpack $ T.intercalate "," $- valign : totalwidth ++ onlytextwidth- in inCmd "begin" "columns" <> brackets options- $$ contents- $$ inCmd "end" "columns"- else id- wrapColumn = if beamer && "column" `elem` classes- then \contents ->- let valign =- maybe ""- (brackets . text . T.unpack . mapAlignment)- (lookup "align" kvs)- w = maybe "0.48" fromPct (lookup "width" kvs)- in inCmd "begin" "column" <>- valign <>- braces (literal w <> "\\textwidth")- $$ contents- $$ inCmd "end" "column"- else id- fromPct xs =- case T.unsnoc xs of- Just (ds, '%') -> case safeRead ds of- Just digits -> showFl (digits / 100 :: Double)- Nothing -> xs- _ -> xs- wrapDir = case lookup "dir" kvs of- Just "rtl" -> align "RTL"- Just "ltr" -> align "LTR"- _ -> id- wrapLang txt = case lang of- Just lng -> let (l, o) = toPolyglossiaEnv lng- ops = if T.null o- then ""- else brackets $ literal o- in inCmd "begin" (literal l) <> ops- $$ blankline <> txt <> blankline- $$ inCmd "end" (literal l)- Nothing -> txt- return $ wrapColumns . wrapColumn . wrapDir . wrapLang $ t--hypertarget :: PandocMonad m => Bool -> Text -> Doc Text -> LW m (Doc Text)-hypertarget _ "" x = return x-hypertarget addnewline ident x = do- ref <- literal `fmap` toLabel ident- return $ text "\\hypertarget"- <> braces ref- <> braces ((if addnewline && not (isEmpty x)- then "%" <> cr- else empty) <> x)--labelFor :: PandocMonad m => Text -> LW m (Doc Text)-labelFor "" = return empty-labelFor ident = do- ref <- literal `fmap` toLabel ident- return $ text "\\label" <> braces ref- -- | Convert list of inline elements to LaTeX. inlineListToLaTeX :: PandocMonad m => [Inline] -- ^ Inlines to convert@@ -951,10 +732,6 @@ fixInitialLineBreaks xs fixInitialLineBreaks xs = xs -isQuoted :: Inline -> Bool-isQuoted (Quoted _ _) = True-isQuoted _ = False- -- | Convert inline element to LaTeX inlineToLaTeX :: PandocMonad m => Inline -- ^ Inline to convert@@ -1015,8 +792,8 @@ st <- get let opts = stOptions st case writerCiteMethod opts of- Natbib -> citationsToNatbib cits- Biblatex -> citationsToBiblatex cits+ Natbib -> citationsToNatbib inlineListToLaTeX cits+ Biblatex -> citationsToBiblatex inlineListToLaTeX cits _ -> inlineListToLaTeX lst inlineToLaTeX (Code (_,classes,kvs) str) = do@@ -1090,6 +867,9 @@ if isEnabled Ext_smart opts then char '`' <> inner <> char '\'' else char '\x2018' <> inner <> char '\x2019'+ where+ isQuoted (Quoted _ _) = True+ isQuoted _ = False inlineToLaTeX (Str str) = do setEmptyLine False liftM literal $ stringToLaTeX TextString str@@ -1227,153 +1007,6 @@ setEmptyLine :: PandocMonad m => Bool -> LW m () setEmptyLine b = modify $ \st -> st{ stEmptyLine = b } -citationsToNatbib :: PandocMonad m => [Citation] -> LW m (Doc Text)-citationsToNatbib- [one]- = citeCommand c p s k- where- Citation { citationId = k- , citationPrefix = p- , citationSuffix = s- , citationMode = m- }- = one- c = case m of- AuthorInText -> "citet"- SuppressAuthor -> "citeyearpar"- NormalCitation -> "citep"--citationsToNatbib cits- | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits- = citeCommand "citep" p s ks- where- noPrefix = all (null . citationPrefix)- noSuffix = all (null . citationSuffix)- ismode m = all ((==) m . citationMode)- p = citationPrefix $- head cits- s = citationSuffix $- last cits- ks = T.intercalate ", " $ map citationId cits--citationsToNatbib (c:cs) | citationMode c == AuthorInText = do- author <- citeCommand "citeauthor" [] [] (citationId c)- cits <- citationsToNatbib (c { citationMode = SuppressAuthor } : cs)- return $ author <+> cits--citationsToNatbib cits = do- cits' <- mapM convertOne cits- return $ text "\\citetext{" <> foldl' combineTwo empty cits' <> text "}"- where- combineTwo a b | isEmpty a = b- | otherwise = a <> text "; " <> b- convertOne Citation { citationId = k- , citationPrefix = p- , citationSuffix = s- , citationMode = m- }- = case m of- AuthorInText -> citeCommand "citealt" p s k- SuppressAuthor -> citeCommand "citeyear" p s k- NormalCitation -> citeCommand "citealp" p s k--citeCommand :: PandocMonad m- => Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)-citeCommand c p s k = do- args <- citeArguments p s k- return $ literal ("\\" <> c) <> args--type Prefix = [Inline]-type Suffix = [Inline]-type CiteId = Text-data CiteGroup = CiteGroup Prefix Suffix [CiteId]--citeArgumentsList :: PandocMonad m- => CiteGroup -> LW m (Doc Text)-citeArgumentsList (CiteGroup _ _ []) = return empty-citeArgumentsList (CiteGroup pfxs sfxs ids) = do- pdoc <- inlineListToLaTeX pfxs- sdoc <- inlineListToLaTeX sfxs'- return $ optargs pdoc sdoc <>- braces (literal (T.intercalate "," (reverse ids)))- where sfxs' = stripLocatorBraces $ case sfxs of- (Str t : r) -> case T.uncons t of- Just (x, xs)- | T.null xs- , isPunctuation x -> dropWhile (== Space) r- | isPunctuation x -> Str xs : r- _ -> sfxs- _ -> sfxs- optargs pdoc sdoc = case (isEmpty pdoc, isEmpty sdoc) of- (True, True ) -> empty- (True, False) -> brackets sdoc- (_ , _ ) -> brackets pdoc <> brackets sdoc--citeArguments :: PandocMonad m- => [Inline] -> [Inline] -> Text -> LW m (Doc Text)-citeArguments p s k = citeArgumentsList (CiteGroup p s [k])---- strip off {} used to define locator in pandoc-citeproc; see #5722-stripLocatorBraces :: [Inline] -> [Inline]-stripLocatorBraces = walk go- where go (Str xs) = Str $ T.filter (\c -> c /= '{' && c /= '}') xs- go x = x--citationsToBiblatex :: PandocMonad m => [Citation] -> LW m (Doc Text)-citationsToBiblatex- [one]- = citeCommand cmd p s k- where- Citation { citationId = k- , citationPrefix = p- , citationSuffix = s- , citationMode = m- } = one- cmd = case m of- SuppressAuthor -> "autocite*"- AuthorInText -> "textcite"- NormalCitation -> "autocite"--citationsToBiblatex (c:cs)- | all (\cit -> null (citationPrefix cit) && null (citationSuffix cit)) (c:cs)- = do- let cmd = case citationMode c of- SuppressAuthor -> "\\autocite*"- AuthorInText -> "\\textcite"- NormalCitation -> "\\autocite"- return $ text cmd <>- braces (literal (T.intercalate "," (map citationId (c:cs))))- | otherwise- = do- let cmd = case citationMode c of- SuppressAuthor -> "\\autocites*"- AuthorInText -> "\\textcites"- NormalCitation -> "\\autocites"-- groups <- mapM citeArgumentsList (reverse (foldl' grouper [] (c:cs)))-- return $ text cmd <> mconcat groups-- where grouper prev cit = case prev of- ((CiteGroup oPfx oSfx ids):rest)- | null oSfx && null pfx -> CiteGroup oPfx sfx (cid:ids) : rest- _ -> CiteGroup pfx sfx [cid] : prev- where pfx = citationPrefix cit- sfx = citationSuffix cit- cid = citationId cit--citationsToBiblatex _ = return empty---- Determine listings language from list of class attributes.-getListingsLanguage :: [Text] -> Maybe Text-getListingsLanguage xs- = foldr ((<|>) . toListingsLanguage) Nothing xs--mbBraced :: Text -> Text-mbBraced x = if not (T.all isAlphaNum x)- then "{" <> x <> "}"- else x- -- Extract a key from divs and spans extract :: Text -> Block -> [Text] extract key (Div attr _) = lookKey key attr@@ -1391,174 +1024,4 @@ lookKey :: Text -> Attr -> [Text] lookKey key (_,_,kvs) = maybe [] T.words $ lookup key kvs --- In environments \Arabic instead of \arabic is used-toPolyglossiaEnv :: Lang -> (Text, Text)-toPolyglossiaEnv l =- case toPolyglossia l of- ("arabic", o) -> ("Arabic", o)- x -> x --- Takes a list of the constituents of a BCP 47 language code and--- converts it to a Polyglossia (language, options) tuple--- http://mirrors.ctan.org/macros/latex/contrib/polyglossia/polyglossia.pdf-toPolyglossia :: Lang -> (Text, Text)-toPolyglossia (Lang "ar" _ "DZ" _) = ("arabic", "locale=algeria")-toPolyglossia (Lang "ar" _ "IQ" _) = ("arabic", "locale=mashriq")-toPolyglossia (Lang "ar" _ "JO" _) = ("arabic", "locale=mashriq")-toPolyglossia (Lang "ar" _ "LB" _) = ("arabic", "locale=mashriq")-toPolyglossia (Lang "ar" _ "LY" _) = ("arabic", "locale=libya")-toPolyglossia (Lang "ar" _ "MA" _) = ("arabic", "locale=morocco")-toPolyglossia (Lang "ar" _ "MR" _) = ("arabic", "locale=mauritania")-toPolyglossia (Lang "ar" _ "PS" _) = ("arabic", "locale=mashriq")-toPolyglossia (Lang "ar" _ "SY" _) = ("arabic", "locale=mashriq")-toPolyglossia (Lang "ar" _ "TN" _) = ("arabic", "locale=tunisia")-toPolyglossia (Lang "de" _ _ vars)- | "1901" `elem` vars = ("german", "spelling=old")-toPolyglossia (Lang "de" _ "AT" vars)- | "1901" `elem` vars = ("german", "variant=austrian, spelling=old")-toPolyglossia (Lang "de" _ "AT" _) = ("german", "variant=austrian")-toPolyglossia (Lang "de" _ "CH" vars)- | "1901" `elem` vars = ("german", "variant=swiss, spelling=old")-toPolyglossia (Lang "de" _ "CH" _) = ("german", "variant=swiss")-toPolyglossia (Lang "de" _ _ _) = ("german", "")-toPolyglossia (Lang "dsb" _ _ _) = ("lsorbian", "")-toPolyglossia (Lang "el" _ "polyton" _) = ("greek", "variant=poly")-toPolyglossia (Lang "en" _ "AU" _) = ("english", "variant=australian")-toPolyglossia (Lang "en" _ "CA" _) = ("english", "variant=canadian")-toPolyglossia (Lang "en" _ "GB" _) = ("english", "variant=british")-toPolyglossia (Lang "en" _ "NZ" _) = ("english", "variant=newzealand")-toPolyglossia (Lang "en" _ "UK" _) = ("english", "variant=british")-toPolyglossia (Lang "en" _ "US" _) = ("english", "variant=american")-toPolyglossia (Lang "grc" _ _ _) = ("greek", "variant=ancient")-toPolyglossia (Lang "hsb" _ _ _) = ("usorbian", "")-toPolyglossia (Lang "la" _ _ vars)- | "x-classic" `elem` vars = ("latin", "variant=classic")-toPolyglossia (Lang "pt" _ "BR" _) = ("portuguese", "variant=brazilian")-toPolyglossia (Lang "sl" _ _ _) = ("slovenian", "")-toPolyglossia x = (commonFromBcp47 x, "")---- Takes a list of the constituents of a BCP 47 language code and--- converts it to a Babel language string.--- http://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf--- List of supported languages (slightly outdated):--- http://tug.ctan.org/language/hyph-utf8/doc/generic/hyph-utf8/hyphenation.pdf-toBabel :: Lang -> Text-toBabel (Lang "de" _ "AT" vars)- | "1901" `elem` vars = "austrian"- | otherwise = "naustrian"-toBabel (Lang "de" _ "CH" vars)- | "1901" `elem` vars = "swissgerman"- | otherwise = "nswissgerman"-toBabel (Lang "de" _ _ vars)- | "1901" `elem` vars = "german"- | otherwise = "ngerman"-toBabel (Lang "dsb" _ _ _) = "lowersorbian"-toBabel (Lang "el" _ _ vars)- | "polyton" `elem` vars = "polutonikogreek"-toBabel (Lang "en" _ "AU" _) = "australian"-toBabel (Lang "en" _ "CA" _) = "canadian"-toBabel (Lang "en" _ "GB" _) = "british"-toBabel (Lang "en" _ "NZ" _) = "newzealand"-toBabel (Lang "en" _ "UK" _) = "british"-toBabel (Lang "en" _ "US" _) = "american"-toBabel (Lang "fr" _ "CA" _) = "canadien"-toBabel (Lang "fra" _ _ vars)- | "aca" `elem` vars = "acadian"-toBabel (Lang "grc" _ _ _) = "polutonikogreek"-toBabel (Lang "hsb" _ _ _) = "uppersorbian"-toBabel (Lang "la" _ _ vars)- | "x-classic" `elem` vars = "classiclatin"-toBabel (Lang "pt" _ "BR" _) = "brazilian"-toBabel (Lang "sl" _ _ _) = "slovene"-toBabel x = commonFromBcp47 x---- Takes a list of the constituents of a BCP 47 language code--- and converts it to a string shared by Babel and Polyglossia.--- https://tools.ietf.org/html/bcp47#section-2.1-commonFromBcp47 :: Lang -> Text-commonFromBcp47 (Lang "sr" "Cyrl" _ _) = "serbianc"-commonFromBcp47 (Lang "zh" "Latn" _ vars)- | "pinyin" `elem` vars = "pinyin"-commonFromBcp47 (Lang l _ _ _) = fromIso l- where- fromIso "af" = "afrikaans"- fromIso "am" = "amharic"- fromIso "ar" = "arabic"- fromIso "as" = "assamese"- fromIso "ast" = "asturian"- fromIso "bg" = "bulgarian"- fromIso "bn" = "bengali"- fromIso "bo" = "tibetan"- fromIso "br" = "breton"- fromIso "ca" = "catalan"- fromIso "cy" = "welsh"- fromIso "cs" = "czech"- fromIso "cop" = "coptic"- fromIso "da" = "danish"- fromIso "dv" = "divehi"- fromIso "el" = "greek"- fromIso "en" = "english"- fromIso "eo" = "esperanto"- fromIso "es" = "spanish"- fromIso "et" = "estonian"- fromIso "eu" = "basque"- fromIso "fa" = "farsi"- fromIso "fi" = "finnish"- fromIso "fr" = "french"- fromIso "fur" = "friulan"- fromIso "ga" = "irish"- fromIso "gd" = "scottish"- fromIso "gez" = "ethiopic"- fromIso "gl" = "galician"- fromIso "he" = "hebrew"- fromIso "hi" = "hindi"- fromIso "hr" = "croatian"- fromIso "hu" = "magyar"- fromIso "hy" = "armenian"- fromIso "ia" = "interlingua"- fromIso "id" = "indonesian"- fromIso "ie" = "interlingua"- fromIso "is" = "icelandic"- fromIso "it" = "italian"- fromIso "jp" = "japanese"- fromIso "km" = "khmer"- fromIso "kmr" = "kurmanji"- fromIso "kn" = "kannada"- fromIso "ko" = "korean"- fromIso "la" = "latin"- fromIso "lo" = "lao"- fromIso "lt" = "lithuanian"- fromIso "lv" = "latvian"- fromIso "ml" = "malayalam"- fromIso "mn" = "mongolian"- fromIso "mr" = "marathi"- fromIso "nb" = "norsk"- fromIso "nl" = "dutch"- fromIso "nn" = "nynorsk"- fromIso "no" = "norsk"- fromIso "nqo" = "nko"- fromIso "oc" = "occitan"- fromIso "pa" = "panjabi"- fromIso "pl" = "polish"- fromIso "pms" = "piedmontese"- fromIso "pt" = "portuguese"- fromIso "rm" = "romansh"- fromIso "ro" = "romanian"- fromIso "ru" = "russian"- fromIso "sa" = "sanskrit"- fromIso "se" = "samin"- fromIso "sk" = "slovak"- fromIso "sq" = "albanian"- fromIso "sr" = "serbian"- fromIso "sv" = "swedish"- fromIso "syr" = "syriac"- fromIso "ta" = "tamil"- fromIso "te" = "telugu"- fromIso "th" = "thai"- fromIso "ti" = "ethiopic"- fromIso "tk" = "turkmen"- fromIso "tr" = "turkish"- fromIso "uk" = "ukrainian"- fromIso "ur" = "urdu"- fromIso "vi" = "vietnamese"- fromIso _ = ""
+ src/Text/Pandoc/Writers/LaTeX/Citation.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+ Module : Text.Pandoc.Writers.LaTeX.Citation+ Copyright : Copyright (C) 2006-2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable+-}+module Text.Pandoc.Writers.LaTeX.Citation+ ( citationsToNatbib,+ citationsToBiblatex+ ) where++import Data.Text (Text)+import Data.Char (isPunctuation)+import qualified Data.Text as T+import Text.Pandoc.Class.PandocMonad (PandocMonad)+import Text.Pandoc.Definition+import Data.List (foldl')+import Text.DocLayout (Doc, brackets, empty, (<+>), text, isEmpty, literal,+ braces)+import Text.Pandoc.Walk+import Text.Pandoc.Writers.LaTeX.Types ( LW )++citationsToNatbib :: PandocMonad m+ => ([Inline] -> LW m (Doc Text))+ -> [Citation]+ -> LW m (Doc Text)+citationsToNatbib inlineListToLaTeX [one]+ = citeCommand inlineListToLaTeX c p s k+ where+ Citation { citationId = k+ , citationPrefix = p+ , citationSuffix = s+ , citationMode = m+ }+ = one+ c = case m of+ AuthorInText -> "citet"+ SuppressAuthor -> "citeyearpar"+ NormalCitation -> "citep"++citationsToNatbib inlineListToLaTeX cits+ | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits+ = citeCommand inlineListToLaTeX "citep" p s ks+ where+ noPrefix = all (null . citationPrefix)+ noSuffix = all (null . citationSuffix)+ ismode m = all ((==) m . citationMode)+ p = citationPrefix $+ head cits+ s = citationSuffix $+ last cits+ ks = T.intercalate ", " $ map citationId cits++citationsToNatbib inlineListToLaTeX (c:cs)+ | citationMode c == AuthorInText = do+ author <- citeCommand inlineListToLaTeX "citeauthor" [] [] (citationId c)+ cits <- citationsToNatbib inlineListToLaTeX+ (c { citationMode = SuppressAuthor } : cs)+ return $ author <+> cits++citationsToNatbib inlineListToLaTeX cits = do+ cits' <- mapM convertOne cits+ return $ text "\\citetext{" <> foldl' combineTwo empty cits' <> text "}"+ where+ citeCommand' = citeCommand inlineListToLaTeX+ combineTwo a b | isEmpty a = b+ | otherwise = a <> text "; " <> b+ convertOne Citation { citationId = k+ , citationPrefix = p+ , citationSuffix = s+ , citationMode = m+ }+ = case m of+ AuthorInText -> citeCommand' "citealt" p s k+ SuppressAuthor -> citeCommand' "citeyear" p s k+ NormalCitation -> citeCommand' "citealp" p s k++citeCommand :: PandocMonad m+ => ([Inline] -> LW m (Doc Text))+ -> Text+ -> [Inline]+ -> [Inline]+ -> Text+ -> LW m (Doc Text)+citeCommand inlineListToLaTeX c p s k = do+ args <- citeArguments inlineListToLaTeX p s k+ return $ literal ("\\" <> c) <> args++type Prefix = [Inline]+type Suffix = [Inline]+type CiteId = Text+data CiteGroup = CiteGroup Prefix Suffix [CiteId]++citeArgumentsList :: PandocMonad m+ => ([Inline] -> LW m (Doc Text))+ -> CiteGroup+ -> LW m (Doc Text)+citeArgumentsList _inlineListToLaTeX (CiteGroup _ _ []) = return empty+citeArgumentsList inlineListToLaTeX (CiteGroup pfxs sfxs ids) = do+ pdoc <- inlineListToLaTeX pfxs+ sdoc <- inlineListToLaTeX sfxs'+ return $ optargs pdoc sdoc <>+ braces (literal (T.intercalate "," (reverse ids)))+ where sfxs' = stripLocatorBraces $ case sfxs of+ (Str t : r) -> case T.uncons t of+ Just (x, xs)+ | T.null xs+ , isPunctuation x -> dropWhile (== Space) r+ | isPunctuation x -> Str xs : r+ _ -> sfxs+ _ -> sfxs+ optargs pdoc sdoc = case (isEmpty pdoc, isEmpty sdoc) of+ (True, True ) -> empty+ (True, False) -> brackets sdoc+ (_ , _ ) -> brackets pdoc <> brackets sdoc++citeArguments :: PandocMonad m+ => ([Inline] -> LW m (Doc Text))+ -> [Inline]+ -> [Inline]+ -> Text+ -> LW m (Doc Text)+citeArguments inlineListToLaTeX p s k =+ citeArgumentsList inlineListToLaTeX (CiteGroup p s [k])++-- strip off {} used to define locator in pandoc-citeproc; see #5722+stripLocatorBraces :: [Inline] -> [Inline]+stripLocatorBraces = walk go+ where go (Str xs) = Str $ T.filter (\c -> c /= '{' && c /= '}') xs+ go x = x++citationsToBiblatex :: PandocMonad m+ => ([Inline] -> LW m (Doc Text))+ -> [Citation] -> LW m (Doc Text)+citationsToBiblatex inlineListToLaTeX [one]+ = citeCommand inlineListToLaTeX cmd p s k+ where+ Citation { citationId = k+ , citationPrefix = p+ , citationSuffix = s+ , citationMode = m+ } = one+ cmd = case m of+ SuppressAuthor -> "autocite*"+ AuthorInText -> "textcite"+ NormalCitation -> "autocite"++citationsToBiblatex inlineListToLaTeX (c:cs)+ | all (\cit -> null (citationPrefix cit) && null (citationSuffix cit)) (c:cs)+ = do+ let cmd = case citationMode c of+ SuppressAuthor -> "\\autocite*"+ AuthorInText -> "\\textcite"+ NormalCitation -> "\\autocite"+ return $ text cmd <>+ braces (literal (T.intercalate "," (map citationId (c:cs))))+ | otherwise+ = do+ let cmd = case citationMode c of+ SuppressAuthor -> "\\autocites*"+ AuthorInText -> "\\textcites"+ NormalCitation -> "\\autocites"++ groups <- mapM (citeArgumentsList inlineListToLaTeX)+ (reverse (foldl' grouper [] (c:cs)))++ return $ text cmd <> mconcat groups++ where grouper prev cit = case prev of+ ((CiteGroup oPfx oSfx ids):rest)+ | null oSfx && null pfx -> CiteGroup oPfx sfx (cid:ids) : rest+ _ -> CiteGroup pfx sfx [cid] : prev+ where pfx = citationPrefix cit+ sfx = citationSuffix cit+ cid = citationId cit++citationsToBiblatex _ _ = return empty
+ src/Text/Pandoc/Writers/LaTeX/Lang.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{- |+ Module : Text.Pandoc.Writers.LaTeX.Lang+ Copyright : Copyright (C) 2006-2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable+-}+module Text.Pandoc.Writers.LaTeX.Lang+ ( toPolyglossiaEnv,+ toPolyglossia,+ toBabel+ ) where+import Data.Text (Text)+import Text.Pandoc.BCP47 (Lang (..))+++-- In environments \Arabic instead of \arabic is used+toPolyglossiaEnv :: Lang -> (Text, Text)+toPolyglossiaEnv l =+ case toPolyglossia l of+ ("arabic", o) -> ("Arabic", o)+ x -> x++-- Takes a list of the constituents of a BCP 47 language code and+-- converts it to a Polyglossia (language, options) tuple+-- http://mirrors.ctan.org/macros/latex/contrib/polyglossia/polyglossia.pdf+toPolyglossia :: Lang -> (Text, Text)+toPolyglossia (Lang "ar" _ "DZ" _) = ("arabic", "locale=algeria")+toPolyglossia (Lang "ar" _ "IQ" _) = ("arabic", "locale=mashriq")+toPolyglossia (Lang "ar" _ "JO" _) = ("arabic", "locale=mashriq")+toPolyglossia (Lang "ar" _ "LB" _) = ("arabic", "locale=mashriq")+toPolyglossia (Lang "ar" _ "LY" _) = ("arabic", "locale=libya")+toPolyglossia (Lang "ar" _ "MA" _) = ("arabic", "locale=morocco")+toPolyglossia (Lang "ar" _ "MR" _) = ("arabic", "locale=mauritania")+toPolyglossia (Lang "ar" _ "PS" _) = ("arabic", "locale=mashriq")+toPolyglossia (Lang "ar" _ "SY" _) = ("arabic", "locale=mashriq")+toPolyglossia (Lang "ar" _ "TN" _) = ("arabic", "locale=tunisia")+toPolyglossia (Lang "de" _ _ vars)+ | "1901" `elem` vars = ("german", "spelling=old")+toPolyglossia (Lang "de" _ "AT" vars)+ | "1901" `elem` vars = ("german", "variant=austrian, spelling=old")+toPolyglossia (Lang "de" _ "AT" _) = ("german", "variant=austrian")+toPolyglossia (Lang "de" _ "CH" vars)+ | "1901" `elem` vars = ("german", "variant=swiss, spelling=old")+toPolyglossia (Lang "de" _ "CH" _) = ("german", "variant=swiss")+toPolyglossia (Lang "de" _ _ _) = ("german", "")+toPolyglossia (Lang "dsb" _ _ _) = ("lsorbian", "")+toPolyglossia (Lang "el" _ "polyton" _) = ("greek", "variant=poly")+toPolyglossia (Lang "en" _ "AU" _) = ("english", "variant=australian")+toPolyglossia (Lang "en" _ "CA" _) = ("english", "variant=canadian")+toPolyglossia (Lang "en" _ "GB" _) = ("english", "variant=british")+toPolyglossia (Lang "en" _ "NZ" _) = ("english", "variant=newzealand")+toPolyglossia (Lang "en" _ "UK" _) = ("english", "variant=british")+toPolyglossia (Lang "en" _ "US" _) = ("english", "variant=american")+toPolyglossia (Lang "grc" _ _ _) = ("greek", "variant=ancient")+toPolyglossia (Lang "hsb" _ _ _) = ("usorbian", "")+toPolyglossia (Lang "la" _ _ vars)+ | "x-classic" `elem` vars = ("latin", "variant=classic")+toPolyglossia (Lang "pt" _ "BR" _) = ("portuguese", "variant=brazilian")+toPolyglossia (Lang "sl" _ _ _) = ("slovenian", "")+toPolyglossia x = (commonFromBcp47 x, "")++-- Takes a list of the constituents of a BCP 47 language code and+-- converts it to a Babel language string.+-- http://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf+-- List of supported languages (slightly outdated):+-- http://tug.ctan.org/language/hyph-utf8/doc/generic/hyph-utf8/hyphenation.pdf+toBabel :: Lang -> Text+toBabel (Lang "de" _ "AT" vars)+ | "1901" `elem` vars = "austrian"+ | otherwise = "naustrian"+toBabel (Lang "de" _ "CH" vars)+ | "1901" `elem` vars = "swissgerman"+ | otherwise = "nswissgerman"+toBabel (Lang "de" _ _ vars)+ | "1901" `elem` vars = "german"+ | otherwise = "ngerman"+toBabel (Lang "dsb" _ _ _) = "lowersorbian"+toBabel (Lang "el" _ _ vars)+ | "polyton" `elem` vars = "polutonikogreek"+toBabel (Lang "en" _ "AU" _) = "australian"+toBabel (Lang "en" _ "CA" _) = "canadian"+toBabel (Lang "en" _ "GB" _) = "british"+toBabel (Lang "en" _ "NZ" _) = "newzealand"+toBabel (Lang "en" _ "UK" _) = "british"+toBabel (Lang "en" _ "US" _) = "american"+toBabel (Lang "fr" _ "CA" _) = "canadien"+toBabel (Lang "fra" _ _ vars)+ | "aca" `elem` vars = "acadian"+toBabel (Lang "grc" _ _ _) = "polutonikogreek"+toBabel (Lang "hsb" _ _ _) = "uppersorbian"+toBabel (Lang "la" _ _ vars)+ | "x-classic" `elem` vars = "classiclatin"+toBabel (Lang "pt" _ "BR" _) = "brazilian"+toBabel (Lang "sl" _ _ _) = "slovene"+toBabel x = commonFromBcp47 x++-- Takes a list of the constituents of a BCP 47 language code+-- and converts it to a string shared by Babel and Polyglossia.+-- https://tools.ietf.org/html/bcp47#section-2.1+commonFromBcp47 :: Lang -> Text+commonFromBcp47 (Lang "sr" "Cyrl" _ _) = "serbianc"+commonFromBcp47 (Lang "zh" "Latn" _ vars)+ | "pinyin" `elem` vars = "pinyin"+commonFromBcp47 (Lang l _ _ _) = fromIso l+ where+ fromIso "af" = "afrikaans"+ fromIso "am" = "amharic"+ fromIso "ar" = "arabic"+ fromIso "as" = "assamese"+ fromIso "ast" = "asturian"+ fromIso "bg" = "bulgarian"+ fromIso "bn" = "bengali"+ fromIso "bo" = "tibetan"+ fromIso "br" = "breton"+ fromIso "ca" = "catalan"+ fromIso "cy" = "welsh"+ fromIso "cs" = "czech"+ fromIso "cop" = "coptic"+ fromIso "da" = "danish"+ fromIso "dv" = "divehi"+ fromIso "el" = "greek"+ fromIso "en" = "english"+ fromIso "eo" = "esperanto"+ fromIso "es" = "spanish"+ fromIso "et" = "estonian"+ fromIso "eu" = "basque"+ fromIso "fa" = "farsi"+ fromIso "fi" = "finnish"+ fromIso "fr" = "french"+ fromIso "fur" = "friulan"+ fromIso "ga" = "irish"+ fromIso "gd" = "scottish"+ fromIso "gez" = "ethiopic"+ fromIso "gl" = "galician"+ fromIso "he" = "hebrew"+ fromIso "hi" = "hindi"+ fromIso "hr" = "croatian"+ fromIso "hu" = "magyar"+ fromIso "hy" = "armenian"+ fromIso "ia" = "interlingua"+ fromIso "id" = "indonesian"+ fromIso "ie" = "interlingua"+ fromIso "is" = "icelandic"+ fromIso "it" = "italian"+ fromIso "ja" = "japanese"+ fromIso "km" = "khmer"+ fromIso "kmr" = "kurmanji"+ fromIso "kn" = "kannada"+ fromIso "ko" = "korean"+ fromIso "la" = "latin"+ fromIso "lo" = "lao"+ fromIso "lt" = "lithuanian"+ fromIso "lv" = "latvian"+ fromIso "ml" = "malayalam"+ fromIso "mn" = "mongolian"+ fromIso "mr" = "marathi"+ fromIso "nb" = "norsk"+ fromIso "nl" = "dutch"+ fromIso "nn" = "nynorsk"+ fromIso "no" = "norsk"+ fromIso "nqo" = "nko"+ fromIso "oc" = "occitan"+ fromIso "pa" = "panjabi"+ fromIso "pl" = "polish"+ fromIso "pms" = "piedmontese"+ fromIso "pt" = "portuguese"+ fromIso "rm" = "romansh"+ fromIso "ro" = "romanian"+ fromIso "ru" = "russian"+ fromIso "sa" = "sanskrit"+ fromIso "se" = "samin"+ fromIso "sk" = "slovak"+ fromIso "sq" = "albanian"+ fromIso "sr" = "serbian"+ fromIso "sv" = "swedish"+ fromIso "syr" = "syriac"+ fromIso "ta" = "tamil"+ fromIso "te" = "telugu"+ fromIso "th" = "thai"+ fromIso "ti" = "ethiopic"+ fromIso "tk" = "turkmen"+ fromIso "tr" = "turkish"+ fromIso "uk" = "ukrainian"+ fromIso "ur" = "urdu"+ fromIso "vi" = "vietnamese"+ fromIso _ = ""
+ src/Text/Pandoc/Writers/LaTeX/Util.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+ Module : Text.Pandoc.Writers.LaTeX.Util+ Copyright : Copyright (C) 2006-2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable+-}+module Text.Pandoc.Writers.LaTeX.Util (+ stringToLaTeX+ , StringContext(..)+ , toLabel+ , inCmd+ , wrapDiv+ , hypertarget+ , labelFor+ , getListingsLanguage+ , mbBraced+ )+where++import Control.Applicative ((<|>))+import Text.Pandoc.Class (PandocMonad, toLang)+import Text.Pandoc.Options (WriterOptions(..), isEnabled)+import Text.Pandoc.Writers.LaTeX.Types (LW, WriterState(..))+import Text.Pandoc.Writers.LaTeX.Lang (toPolyglossiaEnv)+import Text.Pandoc.Highlighting (toListingsLanguage)+import Text.DocLayout+import Text.Pandoc.Definition+import Text.Pandoc.ImageSize (showFl)+import Control.Monad.State.Strict (gets)+import Data.Text (Text)+import qualified Data.Text as T+import Text.Pandoc.Extensions (Extension(Ext_smart))+import Data.Char (isLetter, isSpace, isDigit, isAscii, ord, isAlphaNum)+import Text.Printf (printf)+import Text.Pandoc.Shared (safeRead, elemText)+import qualified Data.Text.Normalize as Normalize+import Data.List (uncons)++data StringContext = TextString+ | URLString+ | CodeString+ deriving (Eq)++-- escape things as needed for LaTeX+stringToLaTeX :: PandocMonad m => StringContext -> Text -> LW m Text+stringToLaTeX context zs = do+ opts <- gets stOptions+ return $ T.pack $+ foldr (go opts context) mempty $ T.unpack $+ if writerPreferAscii opts+ then Normalize.normalize Normalize.NFD zs+ else zs+ where+ go :: WriterOptions -> StringContext -> Char -> String -> String+ go opts ctx x xs =+ let ligatures = isEnabled Ext_smart opts && ctx == TextString+ isUrl = ctx == URLString+ mbAccentCmd =+ if writerPreferAscii opts && ctx == TextString+ then uncons xs >>= \(c,_) -> lookupAccent c+ else Nothing+ emits s =+ case mbAccentCmd of+ Just cmd ->+ cmd <> "{" <> s <> "}" <> drop 1 xs -- drop combining accent+ Nothing -> s <> xs+ emitc c =+ case mbAccentCmd of+ Just cmd ->+ cmd <> "{" <> [c] <> "}" <> drop 1 xs -- drop combining accent+ Nothing -> c : xs+ emitcseq cs =+ case xs of+ c:_ | isLetter c+ , ctx == TextString+ -> cs <> " " <> xs+ | isSpace c -> cs <> "{}" <> xs+ | ctx == TextString+ -> cs <> xs+ _ -> cs <> "{}" <> xs+ emitquote cs =+ case xs of+ '`':_ -> cs <> "\\," <> xs -- add thin space+ '\'':_ -> cs <> "\\," <> xs -- add thin space+ _ -> cs <> xs+ in case x of+ '?' | ligatures -> -- avoid ?` ligature+ case xs of+ '`':_ -> emits "?{}"+ _ -> emitc x+ '!' | ligatures -> -- avoid !` ligature+ case xs of+ '`':_ -> emits "!{}"+ _ -> emitc x+ '{' -> emits "\\{"+ '}' -> emits "\\}"+ '`' | ctx == CodeString -> emitcseq "\\textasciigrave"+ '$' | not isUrl -> emits "\\$"+ '%' -> emits "\\%"+ '&' -> emits "\\&"+ '_' | not isUrl -> emits "\\_"+ '#' -> emits "\\#"+ '-' | not isUrl -> case xs of+ -- prevent adjacent hyphens from forming ligatures+ ('-':_) -> emits "-\\/"+ _ -> emitc '-'+ '~' | not isUrl -> emitcseq "\\textasciitilde"+ '^' -> emits "\\^{}"+ '\\'| isUrl -> emitc '/' -- NB. / works as path sep even on Windows+ | otherwise -> emitcseq "\\textbackslash"+ '|' | not isUrl -> emitcseq "\\textbar"+ '<' -> emitcseq "\\textless"+ '>' -> emitcseq "\\textgreater"+ '[' -> emits "{[}" -- to avoid interpretation as+ ']' -> emits "{]}" -- optional arguments+ '\'' | ctx == CodeString -> emitcseq "\\textquotesingle"+ '\160' -> emits "~"+ '\x200B' -> emits "\\hspace{0pt}" -- zero-width space+ '\x202F' -> emits "\\,"+ '\x2026' -> emitcseq "\\ldots"+ '\x2018' | ligatures -> emitquote "`"+ '\x2019' | ligatures -> emitquote "'"+ '\x201C' | ligatures -> emitquote "``"+ '\x201D' | ligatures -> emitquote "''"+ '\x2014' | ligatures -> emits "---"+ '\x2013' | ligatures -> emits "--"+ _ | writerPreferAscii opts+ -> case x of+ 'ı' -> emitcseq "\\i"+ 'ȷ' -> emitcseq "\\j"+ 'å' -> emitcseq "\\aa"+ 'Å' -> emitcseq "\\AA"+ 'ß' -> emitcseq "\\ss"+ 'ø' -> emitcseq "\\o"+ 'Ø' -> emitcseq "\\O"+ 'Ł' -> emitcseq "\\L"+ 'ł' -> emitcseq "\\l"+ 'æ' -> emitcseq "\\ae"+ 'Æ' -> emitcseq "\\AE"+ 'œ' -> emitcseq "\\oe"+ 'Œ' -> emitcseq "\\OE"+ '£' -> emitcseq "\\pounds"+ '€' -> emitcseq "\\euro"+ '©' -> emitcseq "\\copyright"+ _ -> emitc x+ | otherwise -> emitc x++lookupAccent :: Char -> Maybe String+lookupAccent '\779' = Just "\\H"+lookupAccent '\768' = Just "\\`"+lookupAccent '\769' = Just "\\'"+lookupAccent '\770' = Just "\\^"+lookupAccent '\771' = Just "\\~"+lookupAccent '\776' = Just "\\\""+lookupAccent '\775' = Just "\\."+lookupAccent '\772' = Just "\\="+lookupAccent '\781' = Just "\\|"+lookupAccent '\817' = Just "\\b"+lookupAccent '\807' = Just "\\c"+lookupAccent '\783' = Just "\\G"+lookupAccent '\777' = Just "\\h"+lookupAccent '\803' = Just "\\d"+lookupAccent '\785' = Just "\\f"+lookupAccent '\778' = Just "\\r"+lookupAccent '\865' = Just "\\t"+lookupAccent '\782' = Just "\\U"+lookupAccent '\780' = Just "\\v"+lookupAccent '\774' = Just "\\u"+lookupAccent '\808' = Just "\\k"+lookupAccent '\8413' = Just "\\textcircled"+lookupAccent _ = Nothing++toLabel :: PandocMonad m => Text -> LW m Text+toLabel z = go `fmap` stringToLaTeX URLString z+ where+ go = T.concatMap $ \x -> case x of+ _ | (isLetter x || isDigit x) && isAscii x -> T.singleton x+ | x `elemText` "_-+=:;." -> T.singleton x+ | otherwise -> T.pack $ "ux" <> printf "%x" (ord x)++-- | Puts contents into LaTeX command.+inCmd :: Text -> Doc Text -> Doc Text+inCmd cmd contents = char '\\' <> literal cmd <> braces contents++mapAlignment :: Text -> Text+mapAlignment a = case a of+ "top" -> "T"+ "top-baseline" -> "t"+ "bottom" -> "b"+ "center" -> "c"+ _ -> a++wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text)+wrapDiv (_,classes,kvs) t = do+ beamer <- gets stBeamer+ let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir+ lang <- toLang $ lookup "lang" kvs+ let wrapColumns = if beamer && "columns" `elem` classes+ then \contents ->+ let valign = maybe "T" mapAlignment (lookup "align" kvs)+ totalwidth = maybe [] (\x -> ["totalwidth=" <> x])+ (lookup "totalwidth" kvs)+ onlytextwidth = filter ("onlytextwidth" ==) classes+ options = text $ T.unpack $ T.intercalate "," $+ valign : totalwidth ++ onlytextwidth+ in inCmd "begin" "columns" <> brackets options+ $$ contents+ $$ inCmd "end" "columns"+ else id+ wrapColumn = if beamer && "column" `elem` classes+ then \contents ->+ let valign =+ maybe ""+ (brackets . text . T.unpack . mapAlignment)+ (lookup "align" kvs)+ w = maybe "0.48" fromPct (lookup "width" kvs)+ in inCmd "begin" "column" <>+ valign <>+ braces (literal w <> "\\textwidth")+ $$ contents+ $$ inCmd "end" "column"+ else id+ fromPct xs =+ case T.unsnoc xs of+ Just (ds, '%') -> case safeRead ds of+ Just digits -> showFl (digits / 100 :: Double)+ Nothing -> xs+ _ -> xs+ wrapDir = case lookup "dir" kvs of+ Just "rtl" -> align "RTL"+ Just "ltr" -> align "LTR"+ _ -> id+ wrapLang txt = case lang of+ Just lng -> let (l, o) = toPolyglossiaEnv lng+ ops = if T.null o+ then ""+ else brackets $ literal o+ in inCmd "begin" (literal l) <> ops+ $$ blankline <> txt <> blankline+ $$ inCmd "end" (literal l)+ Nothing -> txt+ return $ wrapColumns . wrapColumn . wrapDir . wrapLang $ t++hypertarget :: PandocMonad m => Bool -> Text -> Doc Text -> LW m (Doc Text)+hypertarget _ "" x = return x+hypertarget addnewline ident x = do+ ref <- literal `fmap` toLabel ident+ return $ text "\\hypertarget"+ <> braces ref+ <> braces ((if addnewline && not (isEmpty x)+ then "%" <> cr+ else empty) <> x)++labelFor :: PandocMonad m => Text -> LW m (Doc Text)+labelFor "" = return empty+labelFor ident = do+ ref <- literal `fmap` toLabel ident+ return $ text "\\label" <> braces ref++-- Determine listings language from list of class attributes.+getListingsLanguage :: [Text] -> Maybe Text+getListingsLanguage xs+ = foldr ((<|>) . toListingsLanguage) Nothing xs++mbBraced :: Text -> Text+mbBraced x = if not (T.all isAlphaNum x)+ then "{" <> x <> "}"+ else x++
src/Text/Pandoc/Writers/Markdown.hs view
@@ -14,7 +14,7 @@ Conversion of 'Pandoc' documents to markdown-formatted plain text. -Markdown: <http://daringfireball.net/projects/markdown/>+Markdown: <https://daringfireball.net/projects/markdown/> -} module Text.Pandoc.Writers.Markdown ( writeMarkdown,@@ -22,15 +22,13 @@ writePlain) where import Control.Monad.Reader import Control.Monad.State.Strict-import Data.Char (isAlphaNum) import Data.Default-import Data.List (find, intersperse, sortOn, transpose)+import Data.List (intersperse, sortOn, transpose) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T-import Network.HTTP (urlEncode) import Text.HTML.TagSoup (Tag (..), isTagText, parseTags) import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import Text.Pandoc.Definition@@ -44,59 +42,11 @@ import Text.DocTemplates (Val(..), Context(..), FromContext(..)) import Text.Pandoc.Walk import Text.Pandoc.Writers.HTML (writeHtml5String)-import Text.Pandoc.Writers.Math (texMathToInlines)-import Text.Pandoc.XML (toHtml5Entities)-import Data.Coerce (coerce)--type Notes = [[Block]]-type Ref = (Text, Target, Attr)-type Refs = [Ref]--type MD m = ReaderT WriterEnv (StateT WriterState m)--evalMD :: PandocMonad m => MD m a -> WriterEnv -> WriterState -> m a-evalMD md env st = evalStateT (runReaderT md env) st--data WriterEnv = WriterEnv { envInList :: Bool- , envVariant :: MarkdownVariant- , envRefShortcutable :: Bool- , envBlockLevel :: Int- , envEscapeSpaces :: Bool- }--data MarkdownVariant =- PlainText- | Commonmark- | Markdown- deriving (Show, Eq)--instance Default WriterEnv- where def = WriterEnv { envInList = False- , envVariant = Markdown- , envRefShortcutable = True- , envBlockLevel = 0- , envEscapeSpaces = False- }--data WriterState = WriterState { stNotes :: Notes- , stPrevRefs :: Refs- , stRefs :: Refs- , stKeys :: M.Map Key- (M.Map (Target, Attr) Int)- , stLastIdx :: Int- , stIds :: Set.Set Text- , stNoteNum :: Int- }--instance Default WriterState- where def = WriterState{ stNotes = []- , stPrevRefs = []- , stRefs = []- , stKeys = M.empty- , stLastIdx = 0- , stIds = Set.empty- , stNoteNum = 1- }+import Text.Pandoc.Writers.Markdown.Inline (inlineListToMarkdown)+import Text.Pandoc.Writers.Markdown.Types (MarkdownVariant(..),+ WriterState(..),+ WriterEnv(..),+ Ref, Refs, MD, evalMD) -- | Convert Pandoc to Markdown. writeMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> m Text@@ -297,49 +247,6 @@ then hang (writerTabStop opts) (marker <> spacer) contents else marker <> spacer <> contents --- | Escape special characters for Markdown.-escapeText :: WriterOptions -> Text -> Text-escapeText opts = T.pack . go . T.unpack- where- go [] = []- go (c:cs) =- case c of- '<' | isEnabled Ext_all_symbols_escapable opts ->- '\\' : '<' : go cs- | otherwise -> "<" ++ go cs- '>' | isEnabled Ext_all_symbols_escapable opts ->- '\\' : '>' : go cs- | otherwise -> ">" ++ go cs- '@' | isEnabled Ext_citations opts ->- case cs of- (d:_)- | isAlphaNum d || d == '_'- -> '\\':'@':go cs- _ -> '@':go cs- _ | c `elem` ['\\','`','*','_','[',']','#'] ->- '\\':c:go cs- '|' | isEnabled Ext_pipe_tables opts -> '\\':'|':go cs- '^' | isEnabled Ext_superscript opts -> '\\':'^':go cs- '~' | isEnabled Ext_subscript opts ||- isEnabled Ext_strikeout opts -> '\\':'~':go cs- '$' | isEnabled Ext_tex_math_dollars opts -> '\\':'$':go cs- '\'' | isEnabled Ext_smart opts -> '\\':'\'':go cs- '"' | isEnabled Ext_smart opts -> '\\':'"':go cs- '-' | isEnabled Ext_smart opts ->- case cs of- '-':_ -> '\\':'-':go cs- _ -> '-':go cs- '.' | isEnabled Ext_smart opts ->- case cs of- '.':'.':rest -> '\\':'.':'.':'.':go rest- _ -> '.':go cs- _ -> case cs of- '_':x:xs- | isEnabled Ext_intraword_underscores opts- , isAlphaNum c- , isAlphaNum x -> c : '_' : x : go xs- _ -> c : go cs- attrsToMarkdown :: Attr -> Doc Text attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys] where attribId = case attribs of@@ -912,495 +819,7 @@ | otherwise = RawBlock "markdown" " \n" mconcat <$> mapM (blockToMarkdown opts) (fixBlocks blocks) -getKey :: Doc Text -> Key-getKey = toKey . render Nothing--findUsableIndex :: [Text] -> Int -> Int-findUsableIndex lbls i = if tshow i `elem` lbls- then findUsableIndex lbls (i + 1)- else i--getNextIndex :: PandocMonad m => MD m Int-getNextIndex = do- prevRefs <- gets stPrevRefs- refs <- gets stRefs- i <- (+ 1) <$> gets stLastIdx- modify $ \s -> s{ stLastIdx = i }- let refLbls = map (\(r,_,_) -> r) $ prevRefs ++ refs- return $ findUsableIndex refLbls i---- | Get reference for target; if none exists, create unique one and return.--- Prefer label if possible; otherwise, generate a unique key.-getReference :: PandocMonad m => Attr -> Doc Text -> Target -> MD m Text-getReference attr label target = do- refs <- gets stRefs- case find (\(_,t,a) -> t == target && a == attr) refs of- Just (ref, _, _) -> return ref- Nothing -> do- keys <- gets stKeys- let key = getKey label- let rawkey = coerce key- case M.lookup key keys of- Nothing -> do -- no other refs with this label- (lab', idx) <- if T.null rawkey ||- T.length rawkey > 999 ||- T.any (\c -> c == '[' || c == ']') rawkey- then do- i <- getNextIndex- return (tshow i, i)- else- return (render Nothing label, 0)- modify (\s -> s{- stRefs = (lab', target, attr) : refs,- stKeys = M.insert (getKey label)- (M.insert (target, attr) idx mempty)- (stKeys s) })- return lab'-- Just km -> -- we have refs with this label- case M.lookup (target, attr) km of- Just i -> do- let lab' = render Nothing $- label <> if i == 0- then mempty- else literal (tshow i)- -- make sure it's in stRefs; it may be- -- a duplicate that was printed in a previous- -- block:- when ((lab', target, attr) `notElem` refs) $- modify (\s -> s{- stRefs = (lab', target, attr) : refs })- return lab'- Nothing -> do -- but this one is to a new target- i <- getNextIndex- let lab' = tshow i- modify (\s -> s{- stRefs = (lab', target, attr) : refs,- stKeys = M.insert key- (M.insert (target, attr) i km)- (stKeys s) })- return lab'---- | Convert list of Pandoc inline elements to markdown.-inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m (Doc Text)-inlineListToMarkdown opts lst = do- inlist <- asks envInList- go (if inlist then avoidBadWrapsInList lst else lst)- where go [] = return empty- go (i:is) = case i of- Link {} -> case is of- -- If a link is followed by another link, or '[', '(' or ':'- -- then we don't shortcut- Link {}:_ -> unshortcutable- Space:Link {}:_ -> unshortcutable- Space:(Str(thead -> Just '[')):_ -> unshortcutable- Space:(RawInline _ (thead -> Just '[')):_ -> unshortcutable- Space:(Cite _ _):_ -> unshortcutable- SoftBreak:Link {}:_ -> unshortcutable- SoftBreak:(Str(thead -> Just '[')):_ -> unshortcutable- SoftBreak:(RawInline _ (thead -> Just '[')):_ -> unshortcutable- SoftBreak:(Cite _ _):_ -> unshortcutable- LineBreak:Link {}:_ -> unshortcutable- LineBreak:(Str(thead -> Just '[')):_ -> unshortcutable- LineBreak:(RawInline _ (thead -> Just '[')):_ -> unshortcutable- LineBreak:(Cite _ _):_ -> unshortcutable- (Cite _ _):_ -> unshortcutable- Str (thead -> Just '['):_ -> unshortcutable- Str (thead -> Just '('):_ -> unshortcutable- Str (thead -> Just ':'):_ -> unshortcutable- (RawInline _ (thead -> Just '[')):_ -> unshortcutable- (RawInline _ (thead -> Just '(')):_ -> unshortcutable- (RawInline _ (thead -> Just ':')):_ -> unshortcutable- (RawInline _ (T.stripPrefix " [" -> Just _ )):_ -> unshortcutable- _ -> shortcutable- _ -> shortcutable- where shortcutable = liftM2 (<>) (inlineToMarkdown opts i) (go is)- unshortcutable = do- iMark <- local- (\env -> env { envRefShortcutable = False })- (inlineToMarkdown opts i)- fmap (iMark <>) (go is)- thead = fmap fst . T.uncons--isSp :: Inline -> Bool-isSp Space = True-isSp SoftBreak = True-isSp _ = False--avoidBadWrapsInList :: [Inline] -> [Inline]-avoidBadWrapsInList [] = []-avoidBadWrapsInList (s:Str (T.uncons -> Just ('>',cs)):xs) | isSp s =- Str (" >" <> cs) : avoidBadWrapsInList xs-avoidBadWrapsInList [s, Str (T.uncons -> Just (c, cs))]- | T.null cs && isSp s && c `elem` ['-','*','+'] = [Str $ T.pack [' ', c]]-avoidBadWrapsInList (s:Str (T.uncons -> Just (c, cs)):Space:xs)- | T.null cs && isSp s && c `elem` ['-','*','+'] =- Str (T.pack [' ', c]) : Space : avoidBadWrapsInList xs-avoidBadWrapsInList (s:Str cs:Space:xs)- | isSp s && isOrderedListMarker cs =- Str (" " <> cs) : Space : avoidBadWrapsInList xs-avoidBadWrapsInList [s, Str cs]- | isSp s && isOrderedListMarker cs = [Str $ " " <> cs]-avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs--isOrderedListMarker :: Text -> Bool-isOrderedListMarker xs = not (T.null xs) && (T.last xs `elem` ['.',')']) &&- isRight (runParser (anyOrderedListMarker >> eof)- defaultParserState "" xs)--isRight :: Either a b -> Bool-isRight (Right _) = True-isRight (Left _) = False---- | Convert Pandoc inline element to markdown.-inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m (Doc Text)-inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) =- case lookup "data-emoji" kvs of- Just emojiname | isEnabled Ext_emoji opts ->- return $ ":" <> literal emojiname <> ":"- _ -> inlineToMarkdown opts (Str s)-inlineToMarkdown opts (Span attrs ils) = do- variant <- asks envVariant- contents <- inlineListToMarkdown opts ils- return $ case attrs of- (_,["csl-block"],_) -> (cr <>)- (_,["csl-left-margin"],_) -> (cr <>)- (_,["csl-indent"],_) -> (cr <>)- _ -> id- $ case variant of- PlainText -> contents- _ | attrs == nullAttr -> contents- | isEnabled Ext_bracketed_spans opts ->- let attrs' = if attrs /= nullAttr- then attrsToMarkdown attrs- else empty- in "[" <> contents <> "]" <> attrs'- | isEnabled Ext_raw_html opts ||- isEnabled Ext_native_spans opts ->- tagWithAttrs "span" attrs <> contents <> literal "</span>"- | otherwise -> contents-inlineToMarkdown _ (Emph []) = return empty-inlineToMarkdown opts (Emph lst) = do- variant <- asks envVariant- contents <- inlineListToMarkdown opts lst- return $ case variant of- PlainText- | isEnabled Ext_gutenberg opts -> "_" <> contents <> "_"- | otherwise -> contents- _ -> "*" <> contents <> "*"-inlineToMarkdown _ (Underline []) = return empty-inlineToMarkdown opts (Underline lst) = do- variant <- asks envVariant- contents <- inlineListToMarkdown opts lst- case variant of- PlainText -> return contents- _ | isEnabled Ext_bracketed_spans opts ->- return $ "[" <> contents <> "]" <> "{.ul}"- | isEnabled Ext_native_spans opts ->- return $ tagWithAttrs "span" ("", ["underline"], [])- <> contents- <> literal "</span>"- | isEnabled Ext_raw_html opts ->- return $ "<u>" <> contents <> "</u>"- | otherwise -> inlineToMarkdown opts (Emph lst)-inlineToMarkdown _ (Strong []) = return empty-inlineToMarkdown opts (Strong lst) = do- variant <- asks envVariant- case variant of- PlainText ->- inlineListToMarkdown opts $- if isEnabled Ext_gutenberg opts- then capitalize lst- else lst- _ -> do- contents <- inlineListToMarkdown opts lst- return $ "**" <> contents <> "**"-inlineToMarkdown _ (Strikeout []) = return empty-inlineToMarkdown opts (Strikeout lst) = do- contents <- inlineListToMarkdown opts lst- return $ if isEnabled Ext_strikeout opts- then "~~" <> contents <> "~~"- else if isEnabled Ext_raw_html opts- then "<s>" <> contents <> "</s>"- else contents-inlineToMarkdown _ (Superscript []) = return empty-inlineToMarkdown opts (Superscript lst) =- local (\env -> env {envEscapeSpaces = envVariant env == Markdown}) $ do- contents <- inlineListToMarkdown opts lst- if isEnabled Ext_superscript opts- then return $ "^" <> contents <> "^"- else if isEnabled Ext_raw_html opts- then return $ "<sup>" <> contents <> "</sup>"- else- case traverse toSuperscriptInline lst of- Just xs' | not (writerPreferAscii opts)- -> inlineListToMarkdown opts xs'- _ -> do- let rendered = render Nothing contents- return $- case mapM toSuperscript (T.unpack rendered) of- Just r -> literal $ T.pack r- Nothing -> literal $ "^(" <> rendered <> ")"-inlineToMarkdown _ (Subscript []) = return empty-inlineToMarkdown opts (Subscript lst) =- local (\env -> env {envEscapeSpaces = envVariant env == Markdown}) $ do- contents <- inlineListToMarkdown opts lst- if isEnabled Ext_subscript opts- then return $ "~" <> contents <> "~"- else if isEnabled Ext_raw_html opts- then return $ "<sub>" <> contents <> "</sub>"- else- case traverse toSubscriptInline lst of- Just xs' | not (writerPreferAscii opts)- -> inlineListToMarkdown opts xs'- _ -> do- let rendered = render Nothing contents- return $- case mapM toSuperscript (T.unpack rendered) of- Just r -> literal $ T.pack r- Nothing -> literal $ "_(" <> rendered <> ")"-inlineToMarkdown opts (SmallCaps lst) = do- variant <- asks envVariant- if variant /= PlainText &&- (isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)- then inlineToMarkdown opts (Span ("",["smallcaps"],[]) lst)- else inlineListToMarkdown opts $ capitalize lst-inlineToMarkdown opts (Quoted SingleQuote lst) = do- contents <- inlineListToMarkdown opts lst- return $ if isEnabled Ext_smart opts- then "'" <> contents <> "'"- else- if writerPreferAscii opts- then "‘" <> contents <> "’"- else "‘" <> contents <> "’"-inlineToMarkdown opts (Quoted DoubleQuote lst) = do- contents <- inlineListToMarkdown opts lst- return $ if isEnabled Ext_smart opts- then "\"" <> contents <> "\""- else- if writerPreferAscii opts- then "“" <> contents <> "”"- 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 marker = T.replicate (longest + 1) "`"- let spacer = if longest == 0 then "" else " "- let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr- then attrsToMarkdown attr- else empty- variant <- asks envVariant- case variant of- PlainText -> return $ literal str- _ -> return $ literal- (marker <> spacer <> str <> spacer <> marker) <> attrs-inlineToMarkdown opts (Str str) = do- variant <- asks envVariant- let str' = (if writerPreferAscii opts- then toHtml5Entities- else id) .- (if isEnabled Ext_smart opts- then unsmartify opts- else id) .- (if variant == PlainText- then id- else escapeText opts) $ str- return $ literal str'-inlineToMarkdown opts (Math InlineMath str) =- case writerHTMLMathMethod opts of- WebTeX url -> inlineToMarkdown opts- (Image nullAttr [Str str] (url <> T.pack (urlEncode $ T.unpack str), str))- _ | isEnabled Ext_tex_math_dollars opts ->- return $ "$" <> literal str <> "$"- | isEnabled Ext_tex_math_single_backslash opts ->- return $ "\\(" <> literal str <> "\\)"- | isEnabled Ext_tex_math_double_backslash opts ->- return $ "\\\\(" <> literal str <> "\\\\)"- | otherwise -> do- variant <- asks envVariant- texMathToInlines InlineMath str >>=- inlineListToMarkdown opts .- (if variant == PlainText then makeMathPlainer else id)-inlineToMarkdown opts (Math DisplayMath str) =- case writerHTMLMathMethod opts of- WebTeX url -> (\x -> blankline <> x <> blankline) `fmap`- inlineToMarkdown opts (Image nullAttr [Str str]- (url <> T.pack (urlEncode $ T.unpack str), str))- _ | isEnabled Ext_tex_math_dollars opts ->- return $ "$$" <> literal str <> "$$"- | isEnabled Ext_tex_math_single_backslash opts ->- return $ "\\[" <> literal str <> "\\]"- | isEnabled Ext_tex_math_double_backslash opts ->- return $ "\\\\[" <> literal str <> "\\\\]"- | otherwise -> (\x -> cr <> x <> cr) `fmap`- (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)- variant <- asks envVariant- let Format fmt = f- let rawAttribInline = return $- literal (T.replicate numticks "`") <> literal str <>- literal (T.replicate numticks "`") <> literal "{=" <> literal fmt <> literal "}"- let renderEmpty = mempty <$ report (InlineNotRendered il)- case variant of- PlainText -> renderEmpty- Commonmark- | f `elem` ["gfm", "commonmark", "commonmark_x", "markdown"]- -> return $ literal str- Markdown- | f `elem` ["markdown", "markdown_github", "markdown_phpextra",- "markdown_mmd", "markdown_strict"]- -> return $ literal str- _ | isEnabled Ext_raw_attribute opts -> rawAttribInline- | f `elem` ["html", "html5", "html4"]- , isEnabled Ext_raw_html opts- -> return $ literal str- | f `elem` ["latex", "tex"]- , isEnabled Ext_raw_tex opts- -> return $ literal str- _ -> renderEmpty---inlineToMarkdown opts LineBreak = do- variant <- asks envVariant- if variant == PlainText || isEnabled Ext_hard_line_breaks opts- then return cr- else return $- if isEnabled Ext_escaped_line_breaks opts- then "\\" <> cr- else " " <> cr-inlineToMarkdown _ Space = do- escapeSpaces <- asks envEscapeSpaces- return $ if escapeSpaces then "\\ " else space-inlineToMarkdown opts SoftBreak = do- escapeSpaces <- asks envEscapeSpaces- let space' = if escapeSpaces then "\\ " else space- return $ case writerWrapText opts of- WrapNone -> space'- WrapAuto -> space'- WrapPreserve -> cr-inlineToMarkdown opts (Cite [] lst) = inlineListToMarkdown opts lst-inlineToMarkdown opts (Cite (c:cs) lst)- | not (isEnabled Ext_citations opts) = inlineListToMarkdown opts lst- | otherwise =- if citationMode c == AuthorInText- then do- suffs <- inlineListToMarkdown opts $ citationSuffix c- rest <- mapM convertOne cs- let inbr = suffs <+> joincits rest- br = if isEmpty inbr then empty else char '[' <> inbr <> char ']'- return $ literal ("@" <> citationId c) <+> br- else do- cits <- mapM convertOne (c:cs)- return $ literal "[" <> joincits cits <> literal "]"- where- joincits = hcat . intersperse (literal "; ") . filter (not . isEmpty)- convertOne Citation { citationId = k- , citationPrefix = pinlines- , citationSuffix = sinlines- , citationMode = m }- = do- pdoc <- inlineListToMarkdown opts pinlines- sdoc <- inlineListToMarkdown opts sinlines- let k' = literal (modekey m <> "@" <> k)- r = case sinlines of- Str (T.uncons -> Just (y,_)):_ | y `elem` (",;]@" :: String) -> k' <> sdoc- _ -> k' <+> sdoc- return $ pdoc <+> r- modekey SuppressAuthor = "-"- modekey _ = ""-inlineToMarkdown opts lnk@(Link attr txt (src, tit)) = do- variant <- asks envVariant- linktext <- inlineListToMarkdown opts txt- let linktitle = if T.null tit- then empty- else literal $ " \"" <> tit <> "\""- let srcSuffix = fromMaybe src (T.stripPrefix "mailto:" src)- let useAuto = isURI src &&- case txt of- [Str s] | escapeURI s == srcSuffix -> True- _ -> False- let useRefLinks = writerReferenceLinks opts && not useAuto- shortcutable <- asks envRefShortcutable- let useShortcutRefLinks = shortcutable &&- isEnabled Ext_shortcut_reference_links opts- reftext <- if useRefLinks- then literal <$> getReference attr linktext (src, tit)- else return mempty- case variant of- PlainText- | useAuto -> return $ literal srcSuffix- | otherwise -> return linktext- _ | useAuto -> return $ "<" <> literal srcSuffix <> ">"- | useRefLinks ->- let first = "[" <> linktext <> "]"- second = if getKey linktext == getKey reftext- then if useShortcutRefLinks- then ""- else "[]"- else "[" <> reftext <> "]"- in return $ first <> second- | isEnabled Ext_raw_html opts- , not (isEnabled Ext_link_attributes opts)- , attr /= nullAttr -> -- use raw HTML to render attributes- literal . T.strip <$>- writeHtml5String opts{ writerTemplate = Nothing }- (Pandoc nullMeta [Plain [lnk]])- | otherwise -> return $- "[" <> linktext <> "](" <> literal src <> linktitle <> ")" <>- linkAttributes opts attr-inlineToMarkdown opts img@(Image attr alternate (source, tit))- | isEnabled Ext_raw_html opts &&- not (isEnabled Ext_link_attributes opts) &&- attr /= nullAttr = -- use raw HTML- literal . T.strip <$>- writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [img]])- | otherwise = do- variant <- asks envVariant- let txt = if null alternate || alternate == [Str source]- -- to prevent autolinks- then [Str ""]- else alternate- linkPart <- inlineToMarkdown opts (Link attr txt (source, tit))- return $ case variant of- PlainText -> "[" <> linkPart <> "]"- _ -> "!" <> linkPart-inlineToMarkdown opts (Note contents) = do- modify (\st -> st{ stNotes = contents : stNotes st })- st <- get- let ref = literal $ writerIdentifierPrefix opts <> tshow (stNoteNum st + length (stNotes st) - 1)- if isEnabled Ext_footnotes opts- then return $ "[^" <> ref <> "]"- else return $ "[" <> ref <> "]"--makeMathPlainer :: [Inline] -> [Inline]-makeMathPlainer = walk go- where- go (Emph xs) = Span nullAttr xs- go x = x- lineBreakToSpace :: Inline -> Inline lineBreakToSpace LineBreak = Space lineBreakToSpace SoftBreak = Space lineBreakToSpace x = x--toSubscriptInline :: Inline -> Maybe Inline-toSubscriptInline Space = Just Space-toSubscriptInline (Span attr ils) = Span attr <$> traverse toSubscriptInline ils-toSubscriptInline (Str s) = Str . T.pack <$> traverse toSubscript (T.unpack s)-toSubscriptInline LineBreak = Just LineBreak-toSubscriptInline SoftBreak = Just SoftBreak-toSubscriptInline _ = Nothing--toSuperscriptInline :: Inline -> Maybe Inline-toSuperscriptInline Space = Just Space-toSuperscriptInline (Span attr ils) = Span attr <$> traverse toSuperscriptInline ils-toSuperscriptInline (Str s) = Str . T.pack <$> traverse toSuperscript (T.unpack s)-toSuperscriptInline LineBreak = Just LineBreak-toSuperscriptInline SoftBreak = Just SoftBreak-toSuperscriptInline _ = Nothing
+ src/Text/Pandoc/Writers/Markdown/Inline.hs view
@@ -0,0 +1,601 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+{- |+ Module : Text.Pandoc.Writers.Markdown.Inline+ Copyright : Copyright (C) 2006-2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable+-}+module Text.Pandoc.Writers.Markdown.Inline (+ inlineListToMarkdown+ ) where+import Control.Monad.Reader+import Control.Monad.State.Strict+import Data.Char (isAlphaNum, isDigit)+import Data.List (find, intersperse)+import qualified Data.Map as M+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Network.HTTP (urlEncode)+import Text.Pandoc.Class.PandocMonad (PandocMonad, report)+import Text.Pandoc.Definition+import Text.Pandoc.Logging+import Text.Pandoc.Options+import Text.Pandoc.Parsing hiding (blankline, blanklines, char, space)+import Text.DocLayout+import Text.Pandoc.Shared+import Text.Pandoc.Writers.Shared+import Text.Pandoc.Walk+import Text.Pandoc.Writers.HTML (writeHtml5String)+import Text.Pandoc.Writers.Math (texMathToInlines)+import Text.Pandoc.XML (toHtml5Entities)+import Data.Coerce (coerce)+import Text.Pandoc.Writers.Markdown.Types (MarkdownVariant(..),+ WriterState(..),+ WriterEnv(..), MD)++-- | Escape special characters for Markdown.+escapeText :: WriterOptions -> Text -> Text+escapeText opts = T.pack . go . T.unpack+ where+ go [] = []+ go (c:cs) =+ case c of+ '<' | isEnabled Ext_all_symbols_escapable opts ->+ '\\' : '<' : go cs+ | otherwise -> "<" ++ go cs+ '>' | isEnabled Ext_all_symbols_escapable opts ->+ '\\' : '>' : go cs+ | otherwise -> ">" ++ go cs+ '@' | isEnabled Ext_citations opts ->+ case cs of+ (d:_)+ | isAlphaNum d || d == '_'+ -> '\\':'@':go cs+ _ -> '@':go cs+ _ | c `elem` ['\\','`','*','_','[',']','#'] ->+ '\\':c:go cs+ '|' | isEnabled Ext_pipe_tables opts -> '\\':'|':go cs+ '^' | isEnabled Ext_superscript opts -> '\\':'^':go cs+ '~' | isEnabled Ext_subscript opts ||+ isEnabled Ext_strikeout opts -> '\\':'~':go cs+ '$' | isEnabled Ext_tex_math_dollars opts -> '\\':'$':go cs+ '\'' | isEnabled Ext_smart opts -> '\\':'\'':go cs+ '"' | isEnabled Ext_smart opts -> '\\':'"':go cs+ '-' | isEnabled Ext_smart opts ->+ case cs of+ '-':_ -> '\\':'-':go cs+ _ -> '-':go cs+ '.' | isEnabled Ext_smart opts ->+ case cs of+ '.':'.':rest -> '\\':'.':'.':'.':go rest+ _ -> '.':go cs+ _ -> case cs of+ '_':x:xs+ | isEnabled Ext_intraword_underscores opts+ , isAlphaNum c+ , isAlphaNum x -> c : '_' : x : go xs+ _ -> c : go cs++attrsToMarkdown :: Attr -> Doc Text+attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]+ where attribId = case attribs of+ ("",_,_) -> empty+ (i,_,_) -> "#" <> escAttr i+ attribClasses = case attribs of+ (_,[],_) -> empty+ (_,cs,_) -> hsep $+ map (escAttr . ("."<>))+ cs+ attribKeys = case attribs of+ (_,_,[]) -> empty+ (_,_,ks) -> hsep $+ map (\(k,v) -> escAttr k+ <> "=\"" <>+ escAttr v <> "\"") ks+ escAttr = mconcat . map escAttrChar . T.unpack+ escAttrChar '"' = literal "\\\""+ escAttrChar '\\' = literal "\\\\"+ escAttrChar c = literal $ T.singleton c++linkAttributes :: WriterOptions -> Attr -> Doc Text+linkAttributes opts attr =+ if isEnabled Ext_link_attributes opts && attr /= nullAttr+ then attrsToMarkdown attr+ else empty++getKey :: Doc Text -> Key+getKey = toKey . render Nothing++findUsableIndex :: [Text] -> Int -> Int+findUsableIndex lbls i = if tshow i `elem` lbls+ then findUsableIndex lbls (i + 1)+ else i++getNextIndex :: PandocMonad m => MD m Int+getNextIndex = do+ prevRefs <- gets stPrevRefs+ refs <- gets stRefs+ i <- (+ 1) <$> gets stLastIdx+ modify $ \s -> s{ stLastIdx = i }+ let refLbls = map (\(r,_,_) -> r) $ prevRefs ++ refs+ return $ findUsableIndex refLbls i++-- | Get reference for target; if none exists, create unique one and return.+-- Prefer label if possible; otherwise, generate a unique key.+getReference :: PandocMonad m => Attr -> Doc Text -> Target -> MD m Text+getReference attr label target = do+ refs <- gets stRefs+ case find (\(_,t,a) -> t == target && a == attr) refs of+ Just (ref, _, _) -> return ref+ Nothing -> do+ keys <- gets stKeys+ let key = getKey label+ let rawkey = coerce key+ case M.lookup key keys of+ Nothing -> do -- no other refs with this label+ (lab', idx) <- if T.null rawkey ||+ T.length rawkey > 999 ||+ T.any (\c -> c == '[' || c == ']') rawkey+ then do+ i <- getNextIndex+ return (tshow i, i)+ else+ return (render Nothing label, 0)+ modify (\s -> s{+ stRefs = (lab', target, attr) : refs,+ stKeys = M.insert (getKey label)+ (M.insert (target, attr) idx mempty)+ (stKeys s) })+ return lab'++ Just km -> -- we have refs with this label+ case M.lookup (target, attr) km of+ Just i -> do+ let lab' = render Nothing $+ label <> if i == 0+ then mempty+ else literal (tshow i)+ -- make sure it's in stRefs; it may be+ -- a duplicate that was printed in a previous+ -- block:+ when ((lab', target, attr) `notElem` refs) $+ modify (\s -> s{+ stRefs = (lab', target, attr) : refs })+ return lab'+ Nothing -> do -- but this one is to a new target+ i <- getNextIndex+ let lab' = tshow i+ modify (\s -> s{+ stRefs = (lab', target, attr) : refs,+ stKeys = M.insert key+ (M.insert (target, attr) i km)+ (stKeys s) })+ return lab'++-- | Convert list of Pandoc inline elements to markdown.+inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m (Doc Text)+inlineListToMarkdown opts lst = do+ inlist <- asks envInList+ go (if inlist then avoidBadWrapsInList lst else lst)+ where go [] = return empty+ go (x@Math{}:y@(Str t):zs)+ | T.all isDigit (T.take 1 t) -- starts with digit -- see #7058+ = liftM2 (<>) (inlineToMarkdown opts x)+ (go (RawInline (Format "html") "<!-- -->" : y : zs))+ go (i:is) = case i of+ Link {} -> case is of+ -- If a link is followed by another link, or '[', '(' or ':'+ -- then we don't shortcut+ Link {}:_ -> unshortcutable+ Space:Link {}:_ -> unshortcutable+ Space:(Str(thead -> Just '[')):_ -> unshortcutable+ Space:(RawInline _ (thead -> Just '[')):_ -> unshortcutable+ Space:(Cite _ _):_ -> unshortcutable+ SoftBreak:Link {}:_ -> unshortcutable+ SoftBreak:(Str(thead -> Just '[')):_ -> unshortcutable+ SoftBreak:(RawInline _ (thead -> Just '[')):_ -> unshortcutable+ SoftBreak:(Cite _ _):_ -> unshortcutable+ LineBreak:Link {}:_ -> unshortcutable+ LineBreak:(Str(thead -> Just '[')):_ -> unshortcutable+ LineBreak:(RawInline _ (thead -> Just '[')):_ -> unshortcutable+ LineBreak:(Cite _ _):_ -> unshortcutable+ (Cite _ _):_ -> unshortcutable+ Str (thead -> Just '['):_ -> unshortcutable+ Str (thead -> Just '('):_ -> unshortcutable+ Str (thead -> Just ':'):_ -> unshortcutable+ (RawInline _ (thead -> Just '[')):_ -> unshortcutable+ (RawInline _ (thead -> Just '(')):_ -> unshortcutable+ (RawInline _ (thead -> Just ':')):_ -> unshortcutable+ (RawInline _ (T.stripPrefix " [" -> Just _ )):_ -> unshortcutable+ _ -> shortcutable+ _ -> shortcutable+ where shortcutable = liftM2 (<>) (inlineToMarkdown opts i) (go is)+ unshortcutable = do+ iMark <- local+ (\env -> env { envRefShortcutable = False })+ (inlineToMarkdown opts i)+ fmap (iMark <>) (go is)+ thead = fmap fst . T.uncons++isSp :: Inline -> Bool+isSp Space = True+isSp SoftBreak = True+isSp _ = False++avoidBadWrapsInList :: [Inline] -> [Inline]+avoidBadWrapsInList [] = []+avoidBadWrapsInList (s:Str (T.uncons -> Just ('>',cs)):xs) | isSp s =+ Str (" >" <> cs) : avoidBadWrapsInList xs+avoidBadWrapsInList [s, Str (T.uncons -> Just (c, cs))]+ | T.null cs && isSp s && c `elem` ['-','*','+'] = [Str $ T.pack [' ', c]]+avoidBadWrapsInList (s:Str (T.uncons -> Just (c, cs)):Space:xs)+ | T.null cs && isSp s && c `elem` ['-','*','+'] =+ Str (T.pack [' ', c]) : Space : avoidBadWrapsInList xs+avoidBadWrapsInList (s:Str cs:Space:xs)+ | isSp s && isOrderedListMarker cs =+ Str (" " <> cs) : Space : avoidBadWrapsInList xs+avoidBadWrapsInList [s, Str cs]+ | isSp s && isOrderedListMarker cs = [Str $ " " <> cs]+avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs++isOrderedListMarker :: Text -> Bool+isOrderedListMarker xs = not (T.null xs) && (T.last xs `elem` ['.',')']) &&+ isRight (runParser (anyOrderedListMarker >> eof)+ defaultParserState "" xs)+ where+ isRight (Right _) = True+ isRight (Left _) = False++-- | Convert Pandoc inline element to markdown.+inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m (Doc Text)+inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) =+ case lookup "data-emoji" kvs of+ Just emojiname | isEnabled Ext_emoji opts ->+ return $ ":" <> literal emojiname <> ":"+ _ -> inlineToMarkdown opts (Str s)+inlineToMarkdown opts (Span attrs ils) = do+ variant <- asks envVariant+ contents <- inlineListToMarkdown opts ils+ return $ case attrs of+ (_,["csl-block"],_) -> (cr <>)+ (_,["csl-left-margin"],_) -> (cr <>)+ (_,["csl-indent"],_) -> (cr <>)+ _ -> id+ $ case variant of+ PlainText -> contents+ _ | attrs == nullAttr -> contents+ | isEnabled Ext_bracketed_spans opts ->+ let attrs' = if attrs /= nullAttr+ then attrsToMarkdown attrs+ else empty+ in "[" <> contents <> "]" <> attrs'+ | isEnabled Ext_raw_html opts ||+ isEnabled Ext_native_spans opts ->+ tagWithAttrs "span" attrs <> contents <> literal "</span>"+ | otherwise -> contents+inlineToMarkdown _ (Emph []) = return empty+inlineToMarkdown opts (Emph lst) = do+ variant <- asks envVariant+ contents <- inlineListToMarkdown opts lst+ return $ case variant of+ PlainText+ | isEnabled Ext_gutenberg opts -> "_" <> contents <> "_"+ | otherwise -> contents+ _ -> "*" <> contents <> "*"+inlineToMarkdown _ (Underline []) = return empty+inlineToMarkdown opts (Underline lst) = do+ variant <- asks envVariant+ contents <- inlineListToMarkdown opts lst+ case variant of+ PlainText -> return contents+ _ | isEnabled Ext_bracketed_spans opts ->+ return $ "[" <> contents <> "]" <> "{.ul}"+ | isEnabled Ext_native_spans opts ->+ return $ tagWithAttrs "span" ("", ["underline"], [])+ <> contents+ <> literal "</span>"+ | isEnabled Ext_raw_html opts ->+ return $ "<u>" <> contents <> "</u>"+ | otherwise -> inlineToMarkdown opts (Emph lst)+inlineToMarkdown _ (Strong []) = return empty+inlineToMarkdown opts (Strong lst) = do+ variant <- asks envVariant+ case variant of+ PlainText ->+ inlineListToMarkdown opts $+ if isEnabled Ext_gutenberg opts+ then capitalize lst+ else lst+ _ -> do+ contents <- inlineListToMarkdown opts lst+ return $ "**" <> contents <> "**"+inlineToMarkdown _ (Strikeout []) = return empty+inlineToMarkdown opts (Strikeout lst) = do+ contents <- inlineListToMarkdown opts lst+ return $ if isEnabled Ext_strikeout opts+ then "~~" <> contents <> "~~"+ else if isEnabled Ext_raw_html opts+ then "<s>" <> contents <> "</s>"+ else contents+inlineToMarkdown _ (Superscript []) = return empty+inlineToMarkdown opts (Superscript lst) =+ local (\env -> env {envEscapeSpaces = envVariant env == Markdown}) $ do+ contents <- inlineListToMarkdown opts lst+ if isEnabled Ext_superscript opts+ then return $ "^" <> contents <> "^"+ else if isEnabled Ext_raw_html opts+ then return $ "<sup>" <> contents <> "</sup>"+ else+ case traverse toSuperscriptInline lst of+ Just xs' | not (writerPreferAscii opts)+ -> inlineListToMarkdown opts xs'+ _ -> do+ let rendered = render Nothing contents+ return $+ case mapM toSuperscript (T.unpack rendered) of+ Just r -> literal $ T.pack r+ Nothing -> literal $ "^(" <> rendered <> ")"+inlineToMarkdown _ (Subscript []) = return empty+inlineToMarkdown opts (Subscript lst) =+ local (\env -> env {envEscapeSpaces = envVariant env == Markdown}) $ do+ contents <- inlineListToMarkdown opts lst+ if isEnabled Ext_subscript opts+ then return $ "~" <> contents <> "~"+ else if isEnabled Ext_raw_html opts+ then return $ "<sub>" <> contents <> "</sub>"+ else+ case traverse toSubscriptInline lst of+ Just xs' | not (writerPreferAscii opts)+ -> inlineListToMarkdown opts xs'+ _ -> do+ let rendered = render Nothing contents+ return $+ case mapM toSuperscript (T.unpack rendered) of+ Just r -> literal $ T.pack r+ Nothing -> literal $ "_(" <> rendered <> ")"+inlineToMarkdown opts (SmallCaps lst) = do+ variant <- asks envVariant+ if variant /= PlainText &&+ (isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)+ then inlineToMarkdown opts (Span ("",["smallcaps"],[]) lst)+ else inlineListToMarkdown opts $ capitalize lst+inlineToMarkdown opts (Quoted SingleQuote lst) = do+ contents <- inlineListToMarkdown opts lst+ return $ if isEnabled Ext_smart opts+ then "'" <> contents <> "'"+ else+ if writerPreferAscii opts+ then "‘" <> contents <> "’"+ else "‘" <> contents <> "’"+inlineToMarkdown opts (Quoted DoubleQuote lst) = do+ contents <- inlineListToMarkdown opts lst+ return $ if isEnabled Ext_smart opts+ then "\"" <> contents <> "\""+ else+ if writerPreferAscii opts+ then "“" <> contents <> "”"+ 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 marker = T.replicate (longest + 1) "`"+ let spacer = if longest == 0 then "" else " "+ let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr+ then attrsToMarkdown attr+ else empty+ variant <- asks envVariant+ case variant of+ PlainText -> return $ literal str+ _ -> return $ literal+ (marker <> spacer <> str <> spacer <> marker) <> attrs+inlineToMarkdown opts (Str str) = do+ variant <- asks envVariant+ let str' = (if writerPreferAscii opts+ then toHtml5Entities+ else id) .+ (if isEnabled Ext_smart opts+ then unsmartify opts+ else id) .+ (if variant == PlainText+ then id+ else escapeText opts) $ str+ return $ literal str'+inlineToMarkdown opts (Math InlineMath str) =+ case writerHTMLMathMethod opts of+ WebTeX url -> inlineToMarkdown opts+ (Image nullAttr [Str str] (url <> T.pack (urlEncode $ T.unpack str), str))+ _ | isEnabled Ext_tex_math_dollars opts ->+ return $ "$" <> literal str <> "$"+ | isEnabled Ext_tex_math_single_backslash opts ->+ return $ "\\(" <> literal str <> "\\)"+ | isEnabled Ext_tex_math_double_backslash opts ->+ return $ "\\\\(" <> literal str <> "\\\\)"+ | otherwise -> do+ variant <- asks envVariant+ texMathToInlines InlineMath str >>=+ inlineListToMarkdown opts .+ (if variant == PlainText then makeMathPlainer else id)+inlineToMarkdown opts (Math DisplayMath str) =+ case writerHTMLMathMethod opts of+ WebTeX url -> (\x -> blankline <> x <> blankline) `fmap`+ inlineToMarkdown opts (Image nullAttr [Str str]+ (url <> T.pack (urlEncode $ T.unpack str), str))+ _ | isEnabled Ext_tex_math_dollars opts ->+ return $ "$$" <> literal str <> "$$"+ | isEnabled Ext_tex_math_single_backslash opts ->+ return $ "\\[" <> literal str <> "\\]"+ | isEnabled Ext_tex_math_double_backslash opts ->+ return $ "\\\\[" <> literal str <> "\\\\]"+ | otherwise -> (\x -> cr <> x <> cr) `fmap`+ (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)+ variant <- asks envVariant+ let Format fmt = f+ let rawAttribInline = return $+ literal (T.replicate numticks "`") <> literal str <>+ literal (T.replicate numticks "`") <> literal "{=" <> literal fmt <> literal "}"+ let renderEmpty = mempty <$ report (InlineNotRendered il)+ case variant of+ PlainText -> renderEmpty+ Commonmark+ | f `elem` ["gfm", "commonmark", "commonmark_x", "markdown"]+ -> return $ literal str+ Markdown+ | f `elem` ["markdown", "markdown_github", "markdown_phpextra",+ "markdown_mmd", "markdown_strict"]+ -> return $ literal str+ _ | isEnabled Ext_raw_attribute opts -> rawAttribInline+ | f `elem` ["html", "html5", "html4"]+ , isEnabled Ext_raw_html opts+ -> return $ literal str+ | f `elem` ["latex", "tex"]+ , isEnabled Ext_raw_tex opts+ -> return $ literal str+ _ -> renderEmpty+++inlineToMarkdown opts LineBreak = do+ variant <- asks envVariant+ if variant == PlainText || isEnabled Ext_hard_line_breaks opts+ then return cr+ else return $+ if isEnabled Ext_escaped_line_breaks opts+ then "\\" <> cr+ else " " <> cr+inlineToMarkdown _ Space = do+ escapeSpaces <- asks envEscapeSpaces+ return $ if escapeSpaces then "\\ " else space+inlineToMarkdown opts SoftBreak = do+ escapeSpaces <- asks envEscapeSpaces+ let space' = if escapeSpaces then "\\ " else space+ return $ case writerWrapText opts of+ WrapNone -> space'+ WrapAuto -> space'+ WrapPreserve -> cr+inlineToMarkdown opts (Cite [] lst) = inlineListToMarkdown opts lst+inlineToMarkdown opts (Cite (c:cs) lst)+ | not (isEnabled Ext_citations opts) = inlineListToMarkdown opts lst+ | otherwise =+ if citationMode c == AuthorInText+ then do+ suffs <- inlineListToMarkdown opts $ citationSuffix c+ rest <- mapM convertOne cs+ let inbr = suffs <+> joincits rest+ br = if isEmpty inbr then empty else char '[' <> inbr <> char ']'+ return $ literal ("@" <> citationId c) <+> br+ else do+ cits <- mapM convertOne (c:cs)+ return $ literal "[" <> joincits cits <> literal "]"+ where+ joincits = hcat . intersperse (literal "; ") . filter (not . isEmpty)+ convertOne Citation { citationId = k+ , citationPrefix = pinlines+ , citationSuffix = sinlines+ , citationMode = m }+ = do+ pdoc <- inlineListToMarkdown opts pinlines+ sdoc <- inlineListToMarkdown opts sinlines+ let k' = literal (modekey m <> "@" <> k)+ r = case sinlines of+ Str (T.uncons -> Just (y,_)):_ | y `elem` (",;]@" :: String) -> k' <> sdoc+ _ -> k' <+> sdoc+ return $ pdoc <+> r+ modekey SuppressAuthor = "-"+ modekey _ = ""+inlineToMarkdown opts lnk@(Link attr txt (src, tit)) = do+ variant <- asks envVariant+ linktext <- inlineListToMarkdown opts txt+ let linktitle = if T.null tit+ then empty+ else literal $ " \"" <> tit <> "\""+ let srcSuffix = fromMaybe src (T.stripPrefix "mailto:" src)+ let useAuto = isURI src &&+ case txt of+ [Str s] | escapeURI s == srcSuffix -> True+ _ -> False+ let useRefLinks = writerReferenceLinks opts && not useAuto+ shortcutable <- asks envRefShortcutable+ let useShortcutRefLinks = shortcutable &&+ isEnabled Ext_shortcut_reference_links opts+ reftext <- if useRefLinks+ then literal <$> getReference attr linktext (src, tit)+ else return mempty+ case variant of+ PlainText+ | useAuto -> return $ literal srcSuffix+ | otherwise -> return linktext+ _ | useAuto -> return $ "<" <> literal srcSuffix <> ">"+ | useRefLinks ->+ let first = "[" <> linktext <> "]"+ second = if getKey linktext == getKey reftext+ then if useShortcutRefLinks+ then ""+ else "[]"+ else "[" <> reftext <> "]"+ in return $ first <> second+ | isEnabled Ext_raw_html opts+ , not (isEnabled Ext_link_attributes opts)+ , attr /= nullAttr -> -- use raw HTML to render attributes+ literal . T.strip <$>+ writeHtml5String opts{ writerTemplate = Nothing }+ (Pandoc nullMeta [Plain [lnk]])+ | otherwise -> return $+ "[" <> linktext <> "](" <> literal src <> linktitle <> ")" <>+ linkAttributes opts attr+inlineToMarkdown opts img@(Image attr alternate (source, tit))+ | isEnabled Ext_raw_html opts &&+ not (isEnabled Ext_link_attributes opts) &&+ attr /= nullAttr = -- use raw HTML+ literal . T.strip <$>+ writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [img]])+ | otherwise = do+ variant <- asks envVariant+ let txt = if null alternate || alternate == [Str source]+ -- to prevent autolinks+ then [Str ""]+ else alternate+ linkPart <- inlineToMarkdown opts (Link attr txt (source, tit))+ return $ case variant of+ PlainText -> "[" <> linkPart <> "]"+ _ -> "!" <> linkPart+inlineToMarkdown opts (Note contents) = do+ modify (\st -> st{ stNotes = contents : stNotes st })+ st <- get+ let ref = literal $ writerIdentifierPrefix opts <> tshow (stNoteNum st + length (stNotes st) - 1)+ if isEnabled Ext_footnotes opts+ then return $ "[^" <> ref <> "]"+ else return $ "[" <> ref <> "]"++makeMathPlainer :: [Inline] -> [Inline]+makeMathPlainer = walk go+ where+ go (Emph xs) = Span nullAttr xs+ go x = x++toSubscriptInline :: Inline -> Maybe Inline+toSubscriptInline Space = Just Space+toSubscriptInline (Span attr ils) = Span attr <$> traverse toSubscriptInline ils+toSubscriptInline (Str s) = Str . T.pack <$> traverse toSubscript (T.unpack s)+toSubscriptInline LineBreak = Just LineBreak+toSubscriptInline SoftBreak = Just SoftBreak+toSubscriptInline _ = Nothing++toSuperscriptInline :: Inline -> Maybe Inline+toSuperscriptInline Space = Just Space+toSuperscriptInline (Span attr ils) = Span attr <$> traverse toSuperscriptInline ils+toSuperscriptInline (Str s) = Str . T.pack <$> traverse toSuperscript (T.unpack s)+toSuperscriptInline LineBreak = Just LineBreak+toSuperscriptInline SoftBreak = Just SoftBreak+toSuperscriptInline _ = Nothing
+ src/Text/Pandoc/Writers/Markdown/Types.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+ Module : Text.Pandoc.Writers.Markdown.Types+ Copyright : Copyright (C) 2006-2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable+-}+module Text.Pandoc.Writers.Markdown.Types (+ MarkdownVariant(..),+ WriterState(..),+ WriterEnv(..),+ Notes,+ Ref,+ Refs,+ MD,+ evalMD+ ) where+import Control.Monad.Reader+import Control.Monad.State.Strict+import Data.Default+import qualified Data.Map as M+import qualified Data.Set as Set+import Data.Text (Text)+import Text.Pandoc.Parsing (Key)+import Text.Pandoc.Class.PandocMonad (PandocMonad)+import Text.Pandoc.Definition++type Notes = [[Block]]+type Ref = (Text, Target, Attr)+type Refs = [Ref]++type MD m = ReaderT WriterEnv (StateT WriterState m)++evalMD :: PandocMonad m => MD m a -> WriterEnv -> WriterState -> m a+evalMD md env st = evalStateT (runReaderT md env) st++data WriterEnv = WriterEnv { envInList :: Bool+ , envVariant :: MarkdownVariant+ , envRefShortcutable :: Bool+ , envBlockLevel :: Int+ , envEscapeSpaces :: Bool+ }++data MarkdownVariant =+ PlainText+ | Commonmark+ | Markdown+ deriving (Show, Eq)++instance Default WriterEnv+ where def = WriterEnv { envInList = False+ , envVariant = Markdown+ , envRefShortcutable = True+ , envBlockLevel = 0+ , envEscapeSpaces = False+ }++data WriterState = WriterState { stNotes :: Notes+ , stPrevRefs :: Refs+ , stRefs :: Refs+ , stKeys :: M.Map Key+ (M.Map (Target, Attr) Int)+ , stLastIdx :: Int+ , stIds :: Set.Set Text+ , stNoteNum :: Int+ }++instance Default WriterState+ where def = WriterState{ stNotes = []+ , stPrevRefs = []+ , stRefs = []+ , stKeys = M.empty+ , stLastIdx = 0+ , stIds = Set.empty+ , stNoteNum = 1+ }++
src/Text/Pandoc/Writers/ODT.hs view
@@ -13,7 +13,7 @@ -} module Text.Pandoc.Writers.ODT ( writeODT ) where import Codec.Archive.Zip-import Control.Monad.Except (catchError)+import Control.Monad.Except (catchError, throwError) import Control.Monad.State.Strict import qualified Data.ByteString.Lazy as B import Data.Generics (everywhere', mkT)@@ -27,6 +27,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang) import qualified Text.Pandoc.Class.PandocMonad as P import Text.Pandoc.Definition+import Text.Pandoc.Error (PandocError(..)) import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)@@ -35,12 +36,13 @@ import Text.Pandoc.Shared (stringify, pandocVersion, tshow) import Text.Pandoc.Writers.Shared (lookupMetaString, lookupMetaBlocks, fixDisplayMath)-import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy)+import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toTextLazy) import Text.Pandoc.Walk import Text.Pandoc.Writers.OpenDocument (writeOpenDocument) import Text.Pandoc.XML+import Text.Pandoc.XML.Light import Text.TeXMath-import Text.XML.Light+import qualified Text.XML.Light as XL newtype ODTState = ODTState { stEntries :: [Entry] }@@ -66,7 +68,7 @@ pandocToODT opts doc@(Pandoc meta _) = do let title = docTitle meta let authors = docAuthors meta- utctime <- P.getCurrentTime+ utctime <- P.getTimestamp lang <- toLang (getLang opts meta) refArchive <- case writerReferenceDoc opts of@@ -172,24 +174,27 @@ updateStyleWithLang Nothing arch = return arch updateStyleWithLang (Just lang) arch = do epochtime <- floor `fmap` lift P.getPOSIXTime- return arch{ zEntries = [if eRelativePath e == "styles.xml"- then case parseXMLDoc- (toStringLazy (fromEntry e)) of- Nothing -> e- Just d ->- toEntry "styles.xml" epochtime- ( fromStringLazy- . ppTopElement- . addLang lang $ d )- else e- | e <- zEntries arch] }+ entries <- mapM (\e -> if eRelativePath e == "styles.xml"+ then case parseXMLElement+ (toTextLazy (fromEntry e)) of+ Left msg -> throwError $+ PandocXMLError "styles.xml" msg+ Right d -> return $+ toEntry "styles.xml" epochtime+ ( fromTextLazy+ . TL.fromStrict+ . ppTopElement+ . addLang lang $ d )+ else return e) (zEntries arch)+ return arch{ zEntries = entries } +-- TODO FIXME avoid this generic traversal! addLang :: Lang -> Element -> Element addLang lang = everywhere' (mkT updateLangAttr) where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) _)- = Attr n (T.unpack $ langLanguage lang)+ = Attr n (langLanguage lang) updateLangAttr (Attr n@(QName "country" _ (Just "fo")) _)- = Attr n (T.unpack $ langRegion lang)+ = Attr n (langRegion lang) updateLangAttr x = x -- | transform both Image and Math elements@@ -235,8 +240,8 @@ case writeMathML dt <$> readTeX math of Left _ -> return $ Math t math Right r -> do- let conf = useShortEmptyTags (const False) defaultConfigPP- let mathml = ppcTopElement conf r+ let conf = XL.useShortEmptyTags (const False) XL.defaultConfigPP+ let mathml = XL.ppcTopElement conf r epochtime <- floor `fmap` lift P.getPOSIXTime let dirname = "Formula-" ++ show (length entries) ++ "/" let fname = dirname ++ "content.xml"
src/Text/Pandoc/Writers/OOXML.hs view
@@ -29,32 +29,32 @@ import Text.Pandoc.Error import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BL8 import Data.Maybe (mapMaybe) import qualified Data.Text as T+import Data.Text (Text) import Text.Pandoc.Class.PandocMonad (PandocMonad) import qualified Text.Pandoc.UTF8 as UTF8-import Text.XML.Light as XML+import Text.Pandoc.XML.Light -mknode :: Node t => String -> [(String,String)] -> t -> Element+mknode :: Node t => Text -> [(Text,Text)] -> t -> Element mknode s attrs = add_attrs (map (\(k,v) -> Attr (nodename k) v) attrs) . node (nodename s) -mktnode :: String -> [(String,String)] -> T.Text -> Element-mktnode s attrs = mknode s attrs . T.unpack+mktnode :: Text -> [(Text,Text)] -> T.Text -> Element+mktnode s attrs = mknode s attrs -nodename :: String -> QName+nodename :: Text -> QName nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix }- where (name, prefix) = case break (==':') s of- (xs,[]) -> (xs, Nothing)- (ys, _:zs) -> (zs, Just ys)+ where (name, prefix) = case T.break (==':') s of+ (xs,ys) -> case T.uncons ys of+ Nothing -> (xs, Nothing)+ Just (_,zs) -> (zs, Just xs) toLazy :: B.ByteString -> BL.ByteString toLazy = BL.fromChunks . (:[]) renderXml :: Element -> BL.ByteString-renderXml elt = BL8.pack "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" <>- UTF8.fromStringLazy (showElement elt)+renderXml elt = BL.fromStrict (UTF8.fromText (showTopElement elt)) parseXml :: PandocMonad m => Archive -> Archive -> String -> m Element parseXml refArchive distArchive relpath =@@ -62,32 +62,32 @@ findEntryByPath relpath distArchive of Nothing -> throwError $ PandocSomeError $ T.pack relpath <> " missing in reference file"- Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of- Nothing -> throwError $ PandocSomeError $- T.pack relpath <> " corrupt in reference file"- Just d -> return d+ Just e -> case parseXMLElement . UTF8.toTextLazy . fromEntry $ e of+ Left msg ->+ throwError $ PandocXMLError (T.pack relpath) msg+ Right d -> return d -- Copied from Util -attrToNSPair :: XML.Attr -> Maybe (String, String)-attrToNSPair (XML.Attr (QName s _ (Just "xmlns")) val) = Just (s, val)+attrToNSPair :: Attr -> Maybe (Text, Text)+attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val) attrToNSPair _ = Nothing elemToNameSpaces :: Element -> NameSpaces elemToNameSpaces = mapMaybe attrToNSPair . elAttribs -elemName :: NameSpaces -> String -> String -> QName+elemName :: NameSpaces -> Text -> Text -> QName elemName ns prefix name =- QName name (lookup prefix ns) (if null prefix then Nothing else Just prefix)+ QName name (lookup prefix ns) (if T.null prefix then Nothing else Just prefix) -isElem :: NameSpaces -> String -> String -> Element -> Bool+isElem :: NameSpaces -> Text -> Text -> Element -> Bool isElem ns prefix name element = let ns' = ns ++ elemToNameSpaces element in qName (elName element) == name && qURI (elName element) == lookup prefix ns' -type NameSpaces = [(String, String)]+type NameSpaces = [(Text, Text)] -- | Scales the image to fit the page -- sizes are passed in emu
src/Text/Pandoc/Writers/Org.hs view
@@ -213,24 +213,34 @@ -- | Convert bullet list item (list of blocks) to Org. bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text) bulletListItemToOrg items = do- contents <- blockListToOrg items+ exts <- gets $ writerExtensions . stOptions+ contents <- blockListToOrg (taskListItemToOrg exts items) return $ hang 2 "- " contents $$ if endsWithPlain items then cr else blankline - -- | Convert ordered list item (a list of blocks) to Org. orderedListItemToOrg :: PandocMonad m => Text -- ^ marker for list item -> [Block] -- ^ list item (list of blocks) -> Org m (Doc Text) orderedListItemToOrg marker items = do- contents <- blockListToOrg items+ exts <- gets $ writerExtensions . stOptions+ contents <- blockListToOrg (taskListItemToOrg exts items) return $ hang (T.length marker + 1) (literal marker <> space) contents $$ if endsWithPlain items then cr else blankline++-- | Convert a list item containing text starting with @U+2610 BALLOT BOX@+-- or @U+2612 BALLOT BOX WITH X@ to org checkbox syntax (e.g. @[X]@).+taskListItemToOrg :: Extensions -> [Block] -> [Block]+taskListItemToOrg = handleTaskListItem toOrg+ where+ toOrg (Str "☐" : Space : is) = Str "[ ]" : Space : is+ toOrg (Str "☒" : Space : is) = Str "[X]" : Space : is+ toOrg is = is -- | Convert definition list item (label, list of blocks) to Org. definitionListItemToOrg :: PandocMonad m
src/Text/Pandoc/Writers/Powerpoint/Output.hs view
@@ -20,15 +20,16 @@ import Control.Monad.Reader import Control.Monad.State import Codec.Archive.Zip-import Data.Char (toUpper) import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse) import Data.Default+import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Read import Data.Time (formatTime, defaultTimeLocale) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime) import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)-import Text.XML.Light+import Text.Pandoc.XML.Light as XML import Text.Pandoc.Definition import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Class.PandocMonad (PandocMonad)@@ -47,6 +48,7 @@ import Text.TeXMath import Text.Pandoc.Writers.Math (convertMath) import Text.Pandoc.Writers.Powerpoint.Presentation+import Text.Pandoc.Shared (tshow) import Skylighting (fromColor) -- |The 'EMU' type is used to specify sizes in English Metric Units.@@ -77,15 +79,19 @@ getPresentationSize refArchive distArchive = do entry <- findEntryByPath "ppt/presentation.xml" refArchive `mplus` findEntryByPath "ppt/presentation.xml" distArchive- presElement <- parseXMLDoc $ UTF8.toStringLazy $ fromEntry entry+ presElement <- either (const Nothing) return $+ parseXMLElement $ UTF8.toTextLazy $ fromEntry entry let ns = elemToNameSpaces presElement sldSize <- findChild (elemName ns "p" "sldSz") presElement cxS <- findAttr (QName "cx" Nothing Nothing) sldSize cyS <- findAttr (QName "cy" Nothing Nothing) sldSize- (cx, _) <- listToMaybe $ reads cxS :: Maybe (Integer, String)- (cy, _) <- listToMaybe $ reads cyS :: Maybe (Integer, String)+ cx <- readTextAsInteger cxS+ cy <- readTextAsInteger cyS return (cx `div` 12700, cy `div` 12700) +readTextAsInteger :: Text -> Maybe Integer+readTextAsInteger = either (const Nothing) (Just . fst) . Data.Text.Read.decimal+ data WriterEnv = WriterEnv { envRefArchive :: Archive , envDistArchive :: Archive , envUTCTime :: UTCTime@@ -159,9 +165,6 @@ -------------------------------------------------------------------- -findAttrText :: QName -> Element -> Maybe T.Text-findAttrText n = fmap T.pack . findAttr n- monospaceFont :: Monad m => P m T.Text monospaceFont = do vars <- writerVariables <$> asks envOpts@@ -169,10 +172,9 @@ Just s -> return s Nothing -> return "Courier" --- Kept as string for XML.Light-fontSizeAttributes :: Monad m => RunProps -> P m [(String, String)]+fontSizeAttributes :: Monad m => RunProps -> P m [(Text, Text)] fontSizeAttributes RunProps { rPropForceSize = Just sz } =- return [("sz", show $ sz * 100)]+ return [("sz", tshow $ sz * 100)] fontSizeAttributes _ = return [] copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive@@ -310,7 +312,7 @@ Nothing -> toArchive . BL.fromStrict <$> P.readDataFile "reference.pptx" - utctime <- P.getCurrentTime+ utctime <- P.getTimestamp presSize <- case getPresentationSize refArchive distArchive of Just sz -> return sz@@ -363,7 +365,7 @@ shapeHasId ns ident element | Just nvSpPr <- findChild (elemName ns "p" "nvSpPr") element , Just cNvPr <- findChild (elemName ns "p" "cNvPr") nvSpPr- , Just nm <- findAttrText (QName "id" Nothing Nothing) cNvPr =+ , Just nm <- findAttr (QName "id" Nothing Nothing) cNvPr = nm == ident | otherwise = False @@ -394,10 +396,10 @@ ext <- findChild (elemName ns "a" "ext") xfrm cxS <- findAttr (QName "cx" Nothing Nothing) ext cyS <- findAttr (QName "cy" Nothing Nothing) ext- (x, _) <- listToMaybe $ reads xS- (y, _) <- listToMaybe $ reads yS- (cx, _) <- listToMaybe $ reads cxS- (cy, _) <- listToMaybe $ reads cyS+ x <- readTextAsInteger xS+ y <- readTextAsInteger yS+ cx <- readTextAsInteger cxS+ cy <- readTextAsInteger cyS return ((x `div` 12700, y `div` 12700), (cx `div` 12700, cy `div` 12700)) | otherwise = Nothing@@ -428,7 +430,7 @@ Nothing -> do let mbSz = findChild (elemName ns "p" "nvSpPr") sp >>= findChild (elemName ns "p" "cNvPr") >>=- findAttrText (QName "id" Nothing Nothing) >>=+ findAttr (QName "id" Nothing Nothing) >>= flip getMasterShapeDimensionsById master case mbSz of Just sz' -> return sz'@@ -448,8 +450,8 @@ fn _ = True replaceNamedChildren :: NameSpaces- -> String- -> String+ -> Text+ -> Text -> [Element] -> Element -> Element@@ -652,10 +654,10 @@ ] , mknode "p:spPr" [] [ mknode "a:xfrm" []- [ mknode "a:off" [("x", show $ 12700 * x),- ("y", show $ 12700 * (y + cy - captionHeight))] ()- , mknode "a:ext" [("cx", show $ 12700 * cx),- ("cy", show $ 12700 * captionHeight)] ()+ [ mknode "a:off" [("x", tshow $ 12700 * x),+ ("y", tshow $ 12700 * (y + cy - captionHeight))] ()+ , mknode "a:ext" [("cx", tshow $ 12700 * cx),+ ("cy", tshow $ 12700 * captionHeight)] () ] , mknode "a:prstGeom" [("prst", "rect")] [ mknode "a:avLst" [] ()@@ -704,11 +706,13 @@ ,("noChangeAspect","1")] () -- cNvPr will contain the link information so we do that separately, -- and register the link if necessary.- let cNvPrAttr = [("descr", mInfoFilePath mInfo), ("id","0"),("name","Picture 1")]+ let cNvPrAttr = [("descr", T.pack $ mInfoFilePath mInfo),+ ("id","0"),+ ("name","Picture 1")] cNvPr <- case picPropLink picProps of Just link -> do idNum <- registerLink link return $ mknode "p:cNvPr" cNvPrAttr $- mknode "a:hlinkClick" [("r:id", "rId" <> show idNum)] ()+ mknode "a:hlinkClick" [("r:id", "rId" <> tshow idNum)] () Nothing -> return $ mknode "p:cNvPr" cNvPrAttr () let nvPicPr = mknode "p:nvPicPr" [] [ cNvPr@@ -716,13 +720,13 @@ , mknode "p:nvPr" [] ()] let blipFill = mknode "p:blipFill" [] [ mknode "a:blip" [("r:embed", "rId" <>- show (mInfoLocalId mInfo))] ()+ tshow (mInfoLocalId mInfo))] () , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ] let xfrm = mknode "a:xfrm" []- [ mknode "a:off" [("x",show xoff'), ("y",show yoff')] ()- , mknode "a:ext" [("cx",show dimX')- ,("cy",show dimY')] () ]+ [ mknode "a:off" [("x", tshow xoff'), ("y", tshow yoff')] ()+ , mknode "a:ext" [("cx", tshow dimX')+ ,("cy", tshow dimY')] () ] let prstGeom = mknode "a:prstGeom" [("prst","rect")] $ mknode "a:avLst" [] () let ln = mknode "a:ln" [("w","9525")]@@ -761,7 +765,7 @@ Just DoubleStrike -> [("strike", "dblStrike")] Nothing -> []) <> (case rBaseline rpr of- Just n -> [("baseline", show n)]+ Just n -> [("baseline", tshow n)] Nothing -> []) <> (case rCap rpr of Just NoCapitals -> [("cap", "none")]@@ -778,43 +782,44 @@ return $ case link of InternalTarget _ -> let linkAttrs =- [ ("r:id", "rId" <> show idNum)+ [ ("r:id", "rId" <> tshow idNum) , ("action", "ppaction://hlinksldjump") ] in [mknode "a:hlinkClick" linkAttrs ()] -- external ExternalTarget _ -> let linkAttrs =- [ ("r:id", "rId" <> show idNum)+ [ ("r:id", "rId" <> tshow idNum) ] in [mknode "a:hlinkClick" linkAttrs ()] Nothing -> return [] let colorContents = case rSolidFill rpr of Just color -> case fromColor color of- '#':hx -> [mknode "a:solidFill" []- [mknode "a:srgbClr" [("val", map toUpper hx)] ()]- ]+ '#':hx ->+ [mknode "a:solidFill" []+ [mknode "a:srgbClr"+ [("val", T.toUpper $ T.pack hx)] ()]] _ -> [] Nothing -> [] codeFont <- monospaceFont let codeContents =- [mknode "a:latin" [("typeface", T.unpack codeFont)] () | rPropCode rpr]+ [mknode "a:latin" [("typeface", codeFont)] () | rPropCode rpr] let propContents = linkProps <> colorContents <> codeContents return [Elem $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents- , mknode "a:t" [] $ T.unpack s+ , mknode "a:t" [] s ]] paraElemToElements (MathElem mathType texStr) = do isInSpkrNotes <- asks envInSpeakerNotes if isInSpkrNotes then paraElemToElements $ Run def $ unTeXString texStr else do res <- convertMath writeOMML mathType (unTeXString texStr)- case res of+ case fromXLElement <$> res of Right r -> return [Elem $ mknode "a14:m" [] $ addMathInfo r] Left (Str s) -> paraElemToElements (Run def s) Left _ -> throwError $ PandocShouldNeverHappenError "non-string math fallback" paraElemToElements (RawOOXMLParaElem str) = return- [Text (CData CDataRaw (T.unpack str) Nothing)]+ [Text (CData CDataRaw str Nothing)] -- This is a bit of a kludge -- really requires adding an option to@@ -822,9 +827,10 @@ -- step at a time. addMathInfo :: Element -> Element addMathInfo element =- let mathspace = Attr { attrKey = QName "m" Nothing (Just "xmlns")- , attrVal = "http://schemas.openxmlformats.org/officeDocument/2006/math"- }+ let mathspace =+ Attr { attrKey = QName "m" Nothing (Just "xmlns")+ , attrVal = "http://schemas.openxmlformats.org/officeDocument/2006/math"+ } in add_attr mathspace element -- We look through the element to see if it contains an a14:m@@ -847,13 +853,13 @@ paragraphToElement :: PandocMonad m => Paragraph -> P m Element paragraphToElement par = do let- attrs = [("lvl", show $ pPropLevel $ paraProps par)] <>+ attrs = [("lvl", tshow $ pPropLevel $ paraProps par)] <> (case pPropMarginLeft (paraProps par) of- Just px -> [("marL", show $ pixelsToEmu px)]+ Just px -> [("marL", tshow $ pixelsToEmu px)] Nothing -> [] ) <> (case pPropIndent (paraProps par) of- Just px -> [("indent", show $ pixelsToEmu px)]+ Just px -> [("indent", tshow $ pixelsToEmu px)] Nothing -> [] ) <> (case pPropAlign (paraProps par) of@@ -865,7 +871,7 @@ props = [] <> (case pPropSpaceBefore $ paraProps par of Just px -> [mknode "a:spcBef" [] [- mknode "a:spcPts" [("val", show $ 100 * px)] ()+ mknode "a:spcPts" [("val", tshow $ 100 * px)] () ] ] Nothing -> []@@ -908,7 +914,7 @@ shapeToElements layout (GraphicFrame tbls cptn) = map Elem <$> graphicFrameToElements layout tbls cptn shapeToElements _ (RawOOXMLShape str) = return- [Text (CData CDataRaw (T.unpack str) Nothing)]+ [Text (CData CDataRaw str Nothing)] shapeToElements layout shp = do element <- shapeToElement layout shp return [Elem element]@@ -940,8 +946,10 @@ [mknode "p:ph" [("idx", "1")] ()] ] , mknode "p:xfrm" []- [ mknode "a:off" [("x", show $ 12700 * x), ("y", show $ 12700 * y)] ()- , mknode "a:ext" [("cx", show $ 12700 * cx), ("cy", show $ 12700 * cy)] ()+ [ mknode "a:off" [("x", tshow $ 12700 * x),+ ("y", tshow $ 12700 * y)] ()+ , mknode "a:ext" [("cx", tshow $ 12700 * cx),+ ("cy", tshow $ 12700 * cy)] () ] ] <> elements @@ -955,7 +963,7 @@ refArchive <- asks envRefArchive distArchive <- asks envDistArchive tblStyleLst <- parseXml refArchive distArchive "ppt/tableStyles.xml"- return $ findAttrText (QName "def" Nothing Nothing) tblStyleLst+ return $ findAttr (QName "def" Nothing Nothing) tblStyleLst graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do@@ -993,7 +1001,7 @@ let mkrow border cells = mknode "a:tr" [("h", "0")] $ map (mkcell border) cells let mkgridcol w = mknode "a:gridCol"- [("w", show ((12700 * w) :: Integer))] ()+ [("w", tshow ((12700 * w) :: Integer))] () let hasHeader = not (all null hdrCells) mbDefTblStyle <- getDefaultTableStyle@@ -1002,7 +1010,7 @@ , ("bandRow", if tblPrBandRow tblPr then "1" else "0") ] (case mbDefTblStyle of Nothing -> []- Just sty -> [mknode "a:tableStyleId" [] $ T.unpack sty])+ Just sty -> [mknode "a:tableStyleId" [] sty]) return $ mknode "a:graphic" [] [mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")]@@ -1035,7 +1043,7 @@ -- if it's a named PHType, we want to check that the attribute -- value matches. Just phElem | (PHType tp) <- phType ->- case findAttrText (QName "type" Nothing Nothing) phElem of+ case findAttr (QName "type" Nothing Nothing) phElem of Just tp' -> tp == tp' Nothing -> False -- if it's an ObjType, we want to check that there is NO@@ -1202,7 +1210,7 @@ , Just txBody <- findChild (elemName ns "p" "txBody") sp , Just p <- findChild (elemName ns "a" "p") txBody , Just fld <- findChild (elemName ns "a" "fld") p- , Just fldId <- findAttrText (QName "id" Nothing Nothing) fld =+ , Just fldId <- findAttr (QName "id" Nothing Nothing) fld = return fldId | otherwise = throwError $ PandocSomeError@@ -1281,11 +1289,11 @@ [ mknode "a:bodyPr" [] () , mknode "a:lstStyle" [] () , mknode "a:p" []- [ mknode "a:fld" [ ("id", T.unpack fieldId)+ [ mknode "a:fld" [ ("id", fieldId) , ("type", "slidenum") ] [ mknode "a:rPr" [("lang", "en-US")] ()- , mknode "a:t" [] (show pgNum)+ , mknode "a:t" [] (tshow pgNum) ] , mknode "a:endParaRPr" [("lang", "en-US")] () ]@@ -1337,7 +1345,7 @@ Just n -> return n Nothing -> throwError $ PandocShouldNeverHappenError $- "Slide Id " <> T.pack (show sldId) <> " not found."+ "Slide Id " <> tshow sldId <> " not found." slideNum :: PandocMonad m => Slide -> P m Int slideNum slide = getSlideIdNum $ slideId slide@@ -1354,7 +1362,7 @@ slideToRelId slide = do n <- slideNum slide offset <- asks envSlideIdOffset- return $ "rId" <> T.pack (show $ n + offset)+ return $ "rId" <> tshow (n + offset) data Relationship = Relationship { relId :: Int@@ -1366,13 +1374,11 @@ elementToRel element | elName element == QName "Relationship" (Just "http://schemas.openxmlformats.org/package/2006/relationships") Nothing = do rId <- findAttr (QName "Id" Nothing Nothing) element- numStr <- stripPrefix "rId" rId- num <- case reads numStr :: [(Int, String)] of- (n, _) : _ -> Just n- [] -> Nothing- type' <- findAttrText (QName "Type" Nothing Nothing) element+ numStr <- T.stripPrefix "rId" rId+ num <- fromIntegral <$> readTextAsInteger numStr+ type' <- findAttr (QName "Type" Nothing Nothing) element target <- findAttr (QName "Target" Nothing Nothing) element- return $ Relationship num type' target+ return $ Relationship num type' (T.unpack target) | otherwise = Nothing slideToPresRel :: PandocMonad m => Slide -> P m Relationship@@ -1461,10 +1467,9 @@ topLevelRelsEntry = elemToEntry "_rels/.rels" $ relsToElement topLevelRels relToElement :: Relationship -> Element-relToElement rel = mknode "Relationship" [ ("Id", "rId" <>- show (relId rel))- , ("Type", T.unpack $ relType rel)- , ("Target", relTarget rel) ] ()+relToElement rel = mknode "Relationship" [ ("Id", "rId" <> tshow (relId rel))+ , ("Type", relType rel)+ , ("Target", T.pack $ relTarget rel) ] () relsToElement :: [Relationship] -> Element relsToElement rels = mknode "Relationships"@@ -1499,7 +1504,8 @@ Just element | Just notesIdNum <- mbNotesIdNum -> Just <$> elemToEntry- ("ppt/notesSlides/notesSlide" <> show notesIdNum <> ".xml")+ ("ppt/notesSlides/notesSlide" <> show notesIdNum <>+ ".xml") element _ -> return Nothing @@ -1512,7 +1518,7 @@ [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")] [ mknode "Relationship" [ ("Id", "rId2") , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")- , ("Target", "../slides/slide" <> show idNum <> ".xml")+ , ("Target", "../slides/slide" <> tshow idNum <> ".xml") ] () , mknode "Relationship" [ ("Id", "rId1") , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")@@ -1545,15 +1551,15 @@ linkRelElement (rIdNum, InternalTarget targetId) = do targetIdNum <- getSlideIdNum targetId return $- mknode "Relationship" [ ("Id", "rId" <> show rIdNum)+ mknode "Relationship" [ ("Id", "rId" <> tshow rIdNum) , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")- , ("Target", "slide" <> show targetIdNum <> ".xml")+ , ("Target", "slide" <> tshow targetIdNum <> ".xml") ] () linkRelElement (rIdNum, ExternalTarget (url, _)) = return $- mknode "Relationship" [ ("Id", "rId" <> show rIdNum)+ mknode "Relationship" [ ("Id", "rId" <> tshow rIdNum) , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")- , ("Target", T.unpack url)+ , ("Target", url) , ("TargetMode", "External") ] () @@ -1565,10 +1571,10 @@ let ext = fromMaybe "" (mInfoExt mInfo) in mknode "Relationship" [ ("Id", "rId" <>- show (mInfoLocalId mInfo))+ tshow (mInfoLocalId mInfo)) , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image") , ("Target", "../media/image" <>- show (mInfoGlobalId mInfo) <> T.unpack ext)+ tshow (mInfoGlobalId mInfo) <> ext) ] () speakerNotesSlideRelElement :: PandocMonad m => Slide -> P m (Maybe Element)@@ -1578,7 +1584,7 @@ return $ case M.lookup idNum mp of Nothing -> Nothing Just n ->- let target = "../notesSlides/notesSlide" <> show n <> ".xml"+ let target = "../notesSlides/notesSlide" <> tshow n <> ".xml" in Just $ mknode "Relationship" [ ("Id", "rId2") , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesSlide")@@ -1617,9 +1623,9 @@ slideToSldIdElement :: PandocMonad m => Slide -> P m Element slideToSldIdElement slide = do n <- slideNum slide- let id' = show $ n + 255+ let id' = tshow $ n + 255 rId <- slideToRelId slide- return $ mknode "p:sldId" [("id", id'), ("r:id", T.unpack rId)] ()+ return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] () presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element presentationToSldIdLst (Presentation _ slides) = do@@ -1644,7 +1650,7 @@ notesMasterElem = mknode "p:notesMasterIdLst" [] [ mknode "p:NotesMasterId"- [("r:id", "rId" <> show notesMasterRId)]+ [("r:id", "rId" <> tshow notesMasterRId)] () ] @@ -1700,17 +1706,17 @@ ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/") ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")] $- mknode "dc:title" [] (maybe "" T.unpack $ dcTitle docProps)+ mknode "dc:title" [] (fromMaybe "" $ dcTitle docProps) :- mknode "dc:creator" [] (maybe "" T.unpack $ dcCreator docProps)+ mknode "dc:creator" [] (fromMaybe "" $ dcCreator docProps) :- mknode "cp:keywords" [] (T.unpack keywords)- : ( [mknode "dc:subject" [] $ maybe "" T.unpack $ dcSubject docProps | isJust (dcSubject docProps)])- <> ( [mknode "dc:description" [] $ maybe "" T.unpack $ dcDescription docProps | isJust (dcDescription docProps)])- <> ( [mknode "cp:category" [] $ maybe "" T.unpack $ cpCategory docProps | isJust (cpCategory docProps)])+ mknode "cp:keywords" [] keywords+ : ( [mknode "dc:subject" [] $ fromMaybe "" $ dcSubject docProps | isJust (dcSubject docProps)])+ <> ( [mknode "dc:description" [] $ fromMaybe "" $ dcDescription docProps | isJust (dcDescription docProps)])+ <> ( [mknode "cp:category" [] $ fromMaybe "" $ cpCategory docProps | isJust (cpCategory docProps)]) <> (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x- , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x- ]) (formatTime defaultTimeLocale "%FT%XZ" utctime)+ , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x+ ]) (T.pack $ formatTime defaultTimeLocale "%FT%XZ" utctime) docPropsToEntry :: PandocMonad m => DocProps -> P m Entry docPropsToEntry docProps = docPropsElement docProps >>=@@ -1721,8 +1727,8 @@ docCustomPropsElement docProps = do let mkCustomProp (k, v) pid = mknode "property" [("fmtid","{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")- ,("pid", show pid)- ,("name", T.unpack k)] $ mknode "vt:lpwstr" [] (T.unpack v)+ ,("pid", tshow pid)+ ,("name", k)] $ mknode "vt:lpwstr" [] v return $ mknode "Properties" [("xmlns","http://schemas.openxmlformats.org/officeDocument/2006/custom-properties") ,("xmlns:vt","http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")@@ -1741,7 +1747,7 @@ distArchive <- asks envDistArchive viewPrElement <- parseXml refArchive distArchive "ppt/viewProps.xml" -- remove "lastView" if it exists:- let notLastView :: Text.XML.Light.Attr -> Bool+ let notLastView :: XML.Attr -> Bool notLastView attr = qName (attrKey attr) /= "lastView" return $@@ -1753,15 +1759,15 @@ defaultContentTypeToElem :: DefaultContentType -> Element defaultContentTypeToElem dct = mknode "Default"- [("Extension", T.unpack $ defContentTypesExt dct),- ("ContentType", T.unpack $ defContentTypesType dct)]+ [("Extension", defContentTypesExt dct),+ ("ContentType", defContentTypesType dct)] () overrideContentTypeToElem :: OverrideContentType -> Element overrideContentTypeToElem oct = mknode "Override"- [("PartName", overrideContentTypesPart oct),- ("ContentType", T.unpack $ overrideContentTypesType oct)]+ [("PartName", T.pack $ overrideContentTypesPart oct),+ ("ContentType", overrideContentTypesType oct)] () contentTypesToElement :: ContentTypes -> Element@@ -1819,7 +1825,8 @@ getSpeakerNotesFilePaths = do mp <- asks envSpeakerNotesIdMap let notesIdNums = M.elems mp- return $ map (\n -> "ppt/notesSlides/notesSlide" <> show n <> ".xml") notesIdNums+ return $ map (\n -> "ppt/notesSlides/notesSlide" <> show n <> ".xml")+ notesIdNums presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes presentationToContentTypes p@(Presentation _ slides) = do@@ -1883,11 +1890,11 @@ | otherwise = Nothing -- Kept as String for XML.Light-autoNumAttrs :: ListAttributes -> [(String, String)]+autoNumAttrs :: ListAttributes -> [(Text, Text)] autoNumAttrs (startNum, numStyle, numDelim) = numAttr <> typeAttr where- numAttr = [("startAt", show startNum) | startNum /= 1]+ numAttr = [("startAt", tshow startNum) | startNum /= 1] typeAttr = [("type", typeString <> delimString)] typeString = case numStyle of Decimal -> "arabic"
src/Text/Pandoc/XML.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.XML Copyright : Copyright (C) 2006-2021 John MacFarlane@@ -123,23 +122,20 @@ -- Unescapes XML entities fromEntities :: Text -> Text-fromEntities = T.pack . fromEntities'+fromEntities t+ = let (x, y) = T.break (== '&') t+ in if T.null y+ then t+ else x <>+ let (ent, rest) = T.break (\c -> isSpace c || c == ';') y+ rest' = case T.uncons rest of+ Just (';',ys) -> ys+ _ -> rest+ ent' = T.drop 1 ent <> ";"+ in case T.pack <$> lookupEntity (T.unpack ent') of+ Just c -> c <> fromEntities rest'+ Nothing -> ent <> fromEntities rest -fromEntities' :: Text -> String-fromEntities' (T.uncons -> Just ('&', xs)) =- case lookupEntity $ T.unpack ent' of- Just c -> c <> fromEntities' rest- Nothing -> "&" <> fromEntities' xs- where (ent, rest) = case T.break (\c -> isSpace c || c == ';') xs of- (zs,T.uncons -> Just (';',ys)) -> (zs,ys)- (zs, ys) -> (zs,ys)- ent'- | Just ys <- T.stripPrefix "#X" ent = "#x" <> ys -- workaround tagsoup bug- | Just ('#', _) <- T.uncons ent = ent- | otherwise = ent <> ";"-fromEntities' t = case T.uncons t of- Just (x, xs) -> x : fromEntities' xs- Nothing -> "" html5Attributes :: Set.Set Text html5Attributes = Set.fromList
+ src/Text/Pandoc/XML/Light.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{- |+ Module : Text.Pandoc.XML.Light+ Copyright : Copyright (C) 2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable++xml-light, which we used in pandoc's the XML-based readers, has+some limitations: in particular, it produces nodes with String+instead of Text, and the parser falls over on processing instructions+(see #7091).++This module exports much of the API of xml-light, but using Text instead+of String. In addition, the xml-light parsers are replaced by xml-conduit's+well-tested parser. (The xml-conduit types are mapped to types+isomorphic to xml-light's, to avoid the need for massive code modifications+elsewhere.) Bridge functions to map xml-light types to this module's+types are also provided (since libraries like texmath still use xml-light).++Another advantage of the xml-conduit parser is that it gives us+detailed information on xml parse errors.++In the future we may want to move to using xml-conduit or another+xml library in the code base, but this change gives us+better performance and accuracy without much change in the+code that used xml-light.+-}+module Text.Pandoc.XML.Light+ ( module Text.Pandoc.XML.Light.Types+ , module Text.Pandoc.XML.Light.Proc+ , module Text.Pandoc.XML.Light.Output+ -- * Replacement for xml-light's Text.XML.Input+ , parseXMLElement+ , parseXMLContents+ ) where++import qualified Control.Exception as E+import qualified Text.XML as Conduit+import Text.XML.Unresolved (InvalidEventStream(..))+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Map as M+import Data.Maybe (mapMaybe)+import Text.Pandoc.XML.Light.Types+import Text.Pandoc.XML.Light.Proc+import Text.Pandoc.XML.Light.Output++-- Drop in replacement for parseXMLDoc in xml-light.+parseXMLElement :: TL.Text -> Either T.Text Element+parseXMLElement t =+ elementToElement . Conduit.documentRoot <$>+ either (Left . T.pack . E.displayException) Right+ (Conduit.parseText Conduit.def{ Conduit.psRetainNamespaces = True } t)++parseXMLContents :: TL.Text -> Either T.Text [Content]+parseXMLContents t =+ case Conduit.parseText Conduit.def{ Conduit.psRetainNamespaces = True } t of+ Left e ->+ case E.fromException e of+ Just (ContentAfterRoot _) ->+ elContent <$> parseXMLElement ("<wrapper>" <> t <> "</wrapper>")+ _ -> Left . T.pack . E.displayException $ e+ Right x -> Right [Elem . elementToElement . Conduit.documentRoot $ x]++elementToElement :: Conduit.Element -> Element+elementToElement (Conduit.Element name attribMap nodes) =+ Element (nameToQname name) attrs (mapMaybe nodeToContent nodes) Nothing+ where+ attrs = map (\(n,v) -> Attr (nameToQname n) v) $+ M.toList attribMap+ nameToQname (Conduit.Name localName mbns mbpref) =+ case mbpref of+ Nothing ->+ case T.stripPrefix "xmlns:" localName of+ Just rest -> QName rest mbns (Just "xmlns")+ Nothing -> QName localName mbns mbpref+ _ -> QName localName mbns mbpref++nodeToContent :: Conduit.Node -> Maybe Content+nodeToContent (Conduit.NodeElement el) =+ Just (Elem (elementToElement el))+nodeToContent (Conduit.NodeContent t) =+ Just (Text (CData CDataText t Nothing))+nodeToContent _ = Nothing+
+ src/Text/Pandoc/XML/Light/Output.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{- |+ Module : Text.Pandoc.XML.Light.Output+ Copyright : Copyright (C) 2007 Galois, Inc., 2021 John MacFarlane+ License : GNU GPL, version 2 or above+++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable++ This code is based on code from xml-light, released under the BSD3 license.+ We use a text Builder instead of ShowS.+-}+module Text.Pandoc.XML.Light.Output+ ( -- * Replacement for xml-light's Text.XML.Output+ ppTopElement+ , ppElement+ , ppContent+ , ppcElement+ , ppcContent+ , showTopElement+ , showElement+ , showContent+ , useShortEmptyTags+ , defaultConfigPP+ , ConfigPP(..)+ ) where++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (Builder, singleton, fromText, toLazyText)+import Text.Pandoc.XML.Light.Types++--+-- duplicates functinos from Text.XML.Output+--++-- | The XML 1.0 header+xmlHeader :: Text+xmlHeader = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"+++--------------------------------------------------------------------------------+data ConfigPP = ConfigPP+ { shortEmptyTag :: QName -> Bool+ , prettify :: Bool+ }++-- | Default pretty orinting configuration.+-- * Always use abbreviate empty tags.+defaultConfigPP :: ConfigPP+defaultConfigPP = ConfigPP { shortEmptyTag = const True+ , prettify = False+ }++-- | The predicate specifies for which empty tags we should use XML's+-- abbreviated notation <TAG />. This is useful if we are working with+-- some XML-ish standards (such as certain versions of HTML) where some+-- empty tags should always be displayed in the <TAG></TAG> form.+useShortEmptyTags :: (QName -> Bool) -> ConfigPP -> ConfigPP+useShortEmptyTags p c = c { shortEmptyTag = p }+++-- | Specify if we should use extra white-space to make document more readable.+-- WARNING: This adds additional white-space to text elements,+-- and so it may change the meaning of the document.+useExtraWhiteSpace :: Bool -> ConfigPP -> ConfigPP+useExtraWhiteSpace p c = c { prettify = p }++-- | A configuration that tries to make things pretty+-- (possibly at the cost of changing the semantics a bit+-- through adding white space.)+prettyConfigPP :: ConfigPP+prettyConfigPP = useExtraWhiteSpace True defaultConfigPP+++--------------------------------------------------------------------------------+++-- | Pretty printing renders XML documents faithfully,+-- with the exception that whitespace may be added\/removed+-- in non-verbatim character data.+ppTopElement :: Element -> Text+ppTopElement = ppcTopElement prettyConfigPP++-- | Pretty printing elements+ppElement :: Element -> Text+ppElement = ppcElement prettyConfigPP++-- | Pretty printing content+ppContent :: Content -> Text+ppContent = ppcContent prettyConfigPP++-- | Pretty printing renders XML documents faithfully,+-- with the exception that whitespace may be added\/removed+-- in non-verbatim character data.+ppcTopElement :: ConfigPP -> Element -> Text+ppcTopElement c e = T.unlines [xmlHeader,ppcElement c e]++-- | Pretty printing elements+ppcElement :: ConfigPP -> Element -> Text+ppcElement c = TL.toStrict . toLazyText . ppElementS c mempty++-- | Pretty printing content+ppcContent :: ConfigPP -> Content -> Text+ppcContent c = TL.toStrict . toLazyText . ppContentS c mempty++ppcCData :: ConfigPP -> CData -> Text+ppcCData c = TL.toStrict . toLazyText . ppCDataS c mempty++type Indent = Builder++-- | Pretty printing content using ShowT+ppContentS :: ConfigPP -> Indent -> Content -> Builder+ppContentS c i x = case x of+ Elem e -> ppElementS c i e+ Text t -> ppCDataS c i t+ CRef r -> showCRefS r++ppElementS :: ConfigPP -> Indent -> Element -> Builder+ppElementS c i e = i <> tagStart (elName e) (elAttribs e) <>+ (case elContent e of+ [] | "?" `T.isPrefixOf` qName name -> fromText " ?>"+ | shortEmptyTag c name -> fromText " />"+ [Text t] -> singleton '>' <> ppCDataS c mempty t <> tagEnd name+ cs -> singleton '>' <> nl <>+ mconcat (map ((<> nl) . ppContentS c (sp <> i)) cs) <>+ i <> tagEnd name+ where (nl,sp) = if prettify c then ("\n"," ") else ("","")+ )+ where name = elName e++ppCDataS :: ConfigPP -> Indent -> CData -> Builder+ppCDataS c i t = i <> if cdVerbatim t /= CDataText || not (prettify c)+ then showCDataS t+ else foldr cons mempty (T.unpack (showCData t))+ where cons :: Char -> Builder -> Builder+ cons '\n' ys = singleton '\n' <> i <> ys+ cons y ys = singleton y <> ys++++--------------------------------------------------------------------------------++-- | Adds the <?xml?> header.+showTopElement :: Element -> Text+showTopElement c = xmlHeader <> showElement c++showContent :: Content -> Text+showContent = ppcContent defaultConfigPP++showElement :: Element -> Text+showElement = ppcElement defaultConfigPP++showCData :: CData -> Text+showCData = ppcCData defaultConfigPP++-- Note: crefs should not contain '&', ';', etc.+showCRefS :: Text -> Builder+showCRefS r = singleton '&' <> fromText r <> singleton ';'++-- | Convert a text element to characters.+showCDataS :: CData -> Builder+showCDataS cd =+ case cdVerbatim cd of+ CDataText -> escStr (cdData cd)+ CDataVerbatim -> fromText "<![CDATA[" <> escCData (cdData cd) <>+ fromText "]]>"+ CDataRaw -> fromText (cdData cd)++--------------------------------------------------------------------------------+escCData :: Text -> Builder+escCData t+ | "]]>" `T.isPrefixOf` t =+ fromText "]]]]><![CDATA[>" <> fromText (T.drop 3 t)+escCData t+ = case T.uncons t of+ Nothing -> mempty+ Just (c,t') -> singleton c <> escCData t'++escChar :: Char -> Builder+escChar c = case c of+ '<' -> fromText "<"+ '>' -> fromText ">"+ '&' -> fromText "&"+ '"' -> fromText """+ -- we use ' instead of ' because IE apparently has difficulties+ -- rendering ' in xhtml.+ -- Reported by Rohan Drape <rohan.drape@gmail.com>.+ '\'' -> fromText "'"+ _ -> singleton c++ {- original xml-light version:+ -- NOTE: We escape '\r' explicitly because otherwise they get lost+ -- when parsed back in because of then end-of-line normalization rules.+ _ | isPrint c || c == '\n' -> singleton c+ | otherwise -> showText "&#" . showsT oc . singleton ';'+ where oc = ord c+ -}++escStr :: Text -> Builder+escStr cs = if T.any needsEscape cs+ then mconcat (map escChar (T.unpack cs))+ else fromText cs+ where+ needsEscape '<' = True+ needsEscape '>' = True+ needsEscape '&' = True+ needsEscape '"' = True+ needsEscape '\'' = True+ needsEscape _ = False++tagEnd :: QName -> Builder+tagEnd qn = fromText "</" <> showQName qn <> singleton '>'++tagStart :: QName -> [Attr] -> Builder+tagStart qn as = singleton '<' <> showQName qn <> as_str+ where as_str = if null as+ then mempty+ else mconcat (map showAttr as)++showAttr :: Attr -> Builder+showAttr (Attr qn v) = singleton ' ' <> showQName qn <>+ singleton '=' <>+ singleton '"' <> escStr v <> singleton '"'++showQName :: QName -> Builder+showQName q =+ case qPrefix q of+ Nothing -> fromText (qName q)+ Just p -> fromText p <> singleton ':' <> fromText (qName q)
+ src/Text/Pandoc/XML/Light/Proc.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{- |+ Module : Text.Pandoc.XML.Light.Proc+ Copyright : Copyright (C) 2007 Galois, Inc., 2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable++ This code is taken from xml-light, released under the BSD3 license.+-}+module Text.Pandoc.XML.Light.Proc+ ( + -- * Replacement for xml-light's Text.XML.Proc+ strContent+ , onlyElems+ , elChildren+ , onlyText+ , findChildren+ , filterChildren+ , filterChildrenName+ , findChild+ , filterChild+ , filterChildName+ , findElement+ , filterElement+ , filterElementName+ , findElements+ , filterElements+ , filterElementsName+ , findAttr+ , lookupAttr+ , lookupAttrBy+ , findAttrBy+ ) where++import Data.Text (Text)+import Data.Maybe (listToMaybe)+import Data.List(find)+import Text.Pandoc.XML.Light.Types++--+-- copied from xml-light Text.XML.Proc+--++-- | Get the text value of an XML element. This function+-- ignores non-text elements, and concatenates all text elements.+strContent :: Element -> Text+strContent = mconcat . map cdData . onlyText . elContent++-- | Select only the elements from a list of XML content.+onlyElems :: [Content] -> [Element]+onlyElems xs = [ x | Elem x <- xs ]++-- | Select only the elements from a parent.+elChildren :: Element -> [Element]+elChildren e = [ x | Elem x <- elContent e ]++-- | Select only the text from a list of XML content.+onlyText :: [Content] -> [CData]+onlyText xs = [ x | Text x <- xs ]++-- | Find all immediate children with the given name.+findChildren :: QName -> Element -> [Element]+findChildren q e = filterChildren ((q ==) . elName) e++-- | Filter all immediate children wrt a given predicate.+filterChildren :: (Element -> Bool) -> Element -> [Element]+filterChildren p e = filter p (onlyElems (elContent e))+++-- | Filter all immediate children wrt a given predicate over their names.+filterChildrenName :: (QName -> Bool) -> Element -> [Element]+filterChildrenName p e = filter (p.elName) (onlyElems (elContent e))+++-- | Find an immediate child with the given name.+findChild :: QName -> Element -> Maybe Element+findChild q e = listToMaybe (findChildren q e)++-- | Find an immediate child with the given name.+filterChild :: (Element -> Bool) -> Element -> Maybe Element+filterChild p e = listToMaybe (filterChildren p e)++-- | Find an immediate child with name matching a predicate.+filterChildName :: (QName -> Bool) -> Element -> Maybe Element+filterChildName p e = listToMaybe (filterChildrenName p e)++-- | Find the left-most occurrence of an element matching given name.+findElement :: QName -> Element -> Maybe Element+findElement q e = listToMaybe (findElements q e)++-- | Filter the left-most occurrence of an element wrt. given predicate.+filterElement :: (Element -> Bool) -> Element -> Maybe Element+filterElement p e = listToMaybe (filterElements p e)++-- | Filter the left-most occurrence of an element wrt. given predicate.+filterElementName :: (QName -> Bool) -> Element -> Maybe Element+filterElementName p e = listToMaybe (filterElementsName p e)++-- | Find all non-nested occurances of an element.+-- (i.e., once we have found an element, we do not search+-- for more occurances among the element's children).+findElements :: QName -> Element -> [Element]+findElements qn e = filterElementsName (qn==) e++-- | Find all non-nested occurrences of an element wrt. given predicate.+-- (i.e., once we have found an element, we do not search+-- for more occurances among the element's children).+filterElements :: (Element -> Bool) -> Element -> [Element]+filterElements p e+ | p e = [e]+ | otherwise = concatMap (filterElements p) $ onlyElems $ elContent e++-- | Find all non-nested occurences of an element wrt a predicate over element names.+-- (i.e., once we have found an element, we do not search+-- for more occurances among the element's children).+filterElementsName :: (QName -> Bool) -> Element -> [Element]+filterElementsName p e = filterElements (p.elName) e++-- | Lookup the value of an attribute.+findAttr :: QName -> Element -> Maybe Text+findAttr x e = lookupAttr x (elAttribs e)++-- | Lookup attribute name from list.+lookupAttr :: QName -> [Attr] -> Maybe Text+lookupAttr x = lookupAttrBy (x ==)++-- | Lookup the first attribute whose name satisfies the given predicate.+lookupAttrBy :: (QName -> Bool) -> [Attr] -> Maybe Text+lookupAttrBy p as = attrVal `fmap` find (p . attrKey) as++-- | Lookup the value of the first attribute whose name+-- satisfies the given predicate.+findAttrBy :: (QName -> Bool) -> Element -> Maybe Text+findAttrBy p e = lookupAttrBy p (elAttribs e)++
+ src/Text/Pandoc/XML/Light/Types.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{- |+ Module : Text.Pandoc.XML.Light.Types+ Copyright : Copyright (C) 2007 Galois, Inc., 2021 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable++ This code is taken from xml-light, released under the BSD3 license.+ It has been modified to use Text instead of String, and the fromXL*+ functions have been added.+-}+module Text.Pandoc.XML.Light.Types+ ( -- * Basic types, duplicating those from xml-light but with Text+ -- instead of String+ Line+ , Content(..)+ , Element(..)+ , Attr(..)+ , CData(..)+ , CDataKind(..)+ , QName(..)+ , Node(..)+ , unode+ , unqual+ , add_attr+ , add_attrs+ -- * Conversion functions from xml-light types+ , fromXLQName+ , fromXLCData+ , fromXLElement+ , fromXLAttr+ , fromXLContent+ ) where++import Data.Text (Text)+import qualified Data.Text as T+import Data.Data (Data)+import Data.Typeable (Typeable)+import qualified Text.XML.Light as XL++--+-- type definitions lightly modified from xml-light+--++-- | A line is an Integer+type Line = Integer++-- | XML content+data Content = Elem Element+ | Text CData+ | CRef Text+ deriving (Show, Typeable, Data)++-- | XML elements+data Element = Element {+ elName :: QName,+ elAttribs :: [Attr],+ elContent :: [Content],+ elLine :: Maybe Line+ } deriving (Show, Typeable, Data)++-- | XML attributes+data Attr = Attr {+ attrKey :: QName,+ attrVal :: Text+ } deriving (Eq, Ord, Show, Typeable, Data)++-- | XML CData+data CData = CData {+ cdVerbatim :: CDataKind,+ cdData :: Text,+ cdLine :: Maybe Line+ } deriving (Show, Typeable, Data)++data CDataKind+ = CDataText -- ^ Ordinary character data; pretty printer escapes &, < etc.+ | CDataVerbatim -- ^ Unescaped character data; pretty printer embeds it in <![CDATA[..+ | CDataRaw -- ^ As-is character data; pretty printer passes it along without any escaping or CDATA wrap-up.+ deriving ( Eq, Show, Typeable, Data )++-- | XML qualified names+data QName = QName {+ qName :: Text,+ qURI :: Maybe Text,+ qPrefix :: Maybe Text+ } deriving (Show, Typeable, Data)+++instance Eq QName where+ q1 == q2 = compare q1 q2 == EQ++instance Ord QName where+ compare q1 q2 =+ case compare (qName q1) (qName q2) of+ EQ -> case (qURI q1, qURI q2) of+ (Nothing,Nothing) -> compare (qPrefix q1) (qPrefix q2)+ (u1,u2) -> compare u1 u2+ x -> x++class Node t where+ node :: QName -> t -> Element++instance Node ([Attr],[Content]) where+ node n (attrs,cont) = Element { elName = n+ , elAttribs = attrs+ , elContent = cont+ , elLine = Nothing+ }++instance Node [Attr] where node n as = node n (as,[]::[Content])+instance Node Attr where node n a = node n [a]+instance Node () where node n () = node n ([]::[Attr])++instance Node [Content] where node n cs = node n ([]::[Attr],cs)+instance Node Content where node n c = node n [c]+instance Node ([Attr],Content) where node n (as,c) = node n (as,[c])+instance Node (Attr,Content) where node n (a,c) = node n ([a],[c])++instance Node ([Attr],[Element]) where+ node n (as,cs) = node n (as,map Elem cs)++instance Node ([Attr],Element) where node n (as,c) = node n (as,[c])+instance Node (Attr,Element) where node n (a,c) = node n ([a],c)+instance Node [Element] where node n es = node n ([]::[Attr],es)+instance Node Element where node n e = node n [e]++instance Node ([Attr],[CData]) where+ node n (as,cs) = node n (as,map Text cs)++instance Node ([Attr],CData) where node n (as,c) = node n (as,[c])+instance Node (Attr,CData) where node n (a,c) = node n ([a],c)+instance Node [CData] where node n es = node n ([]::[Attr],es)+instance Node CData where node n e = node n [e]++instance Node ([Attr],Text) where+ node n (as,t) = node n (as, CData { cdVerbatim = CDataText+ , cdData = t+ , cdLine = Nothing })++instance Node (Attr,Text ) where node n (a,t) = node n ([a],t)+instance Node Text where node n t = node n ([]::[Attr],t)++-- | Create node with unqualified name+unode :: Node t => Text -> t -> Element+unode = node . unqual++unqual :: Text -> QName+unqual x = QName x Nothing Nothing++-- | Add an attribute to an element.+add_attr :: Attr -> Element -> Element+add_attr a e = add_attrs [a] e++-- | Add some attributes to an element.+add_attrs :: [Attr] -> Element -> Element+add_attrs as e = e { elAttribs = as ++ elAttribs e }++--+-- conversion from xml-light+--++fromXLQName :: XL.QName -> QName+fromXLQName qn = QName { qName = T.pack $ XL.qName qn+ , qURI = T.pack <$> XL.qURI qn+ , qPrefix = T.pack <$> XL.qPrefix qn }++fromXLCData :: XL.CData -> CData+fromXLCData cd = CData { cdVerbatim = case XL.cdVerbatim cd of+ XL.CDataText -> CDataText+ XL.CDataVerbatim -> CDataVerbatim+ XL.CDataRaw -> CDataRaw+ , cdData = T.pack $ XL.cdData cd+ , cdLine = XL.cdLine cd }++fromXLElement :: XL.Element -> Element+fromXLElement el = Element { elName = fromXLQName $ XL.elName el+ , elAttribs = map fromXLAttr $ XL.elAttribs el+ , elContent = map fromXLContent $ XL.elContent el+ , elLine = XL.elLine el }++fromXLAttr :: XL.Attr -> Attr+fromXLAttr (XL.Attr qn s) = Attr (fromXLQName qn) (T.pack s)++fromXLContent :: XL.Content -> Content+fromXLContent (XL.Elem el) = Elem $ fromXLElement el+fromXLContent (XL.Text cd) = Text $ fromXLCData cd+fromXLContent (XL.CRef s) = CRef (T.pack s)++
stack.yaml view
@@ -5,25 +5,13 @@ packages: - '.' extra-deps:-- pandoc-types-1.22-- rfc5051-0.2-- haddock-library-1.9.0-- skylighting-0.10.2-- skylighting-core-0.10.2-- hslua-1.1.2-- jira-wiki-markup-1.3.2-- HsYAML-aeson-0.2.0.0-- commonmark-0.1.1.3-- commonmark-extensions-0.2.0.4-- commonmark-pandoc-0.2.0.1-- doctemplates-0.9-- texmath-0.12.1-- citeproc-0.3.0.5-# - citeproc:-# git: https://github.com/jgm/citeproc.git-# commit: d44e24696ab444090d0e63e321c3a573f68b2e74+- hslua-1.3.0+- hslua-module-path-0.1.0+#- citeproc:+# git: https://github.com/jgm/citeproc.git+# commit: feb3b7580c6738eec3b23921f7c1739cfba611aa ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules-resolver: lts-16.23+resolver: lts-17.5 nix: packages: [zlib]
test/Tests/Command.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TupleSections #-} {- | Module : Tests.Command Copyright : © 2006-2021 John MacFarlane@@ -10,19 +10,18 @@ Run commands, and test results, defined in markdown files. -}-module Tests.Command (findPandoc, runTest, tests)+module Tests.Command (runTest, tests) where -import Prelude import Data.Algorithm.Diff+import System.Environment.Executable (getExecutablePath) import qualified Data.ByteString as BS import qualified Data.Text as T-import Data.List (isSuffixOf, intercalate)-import Data.Maybe (catMaybes)+import Data.List (isSuffixOf) import System.Directory import qualified System.Environment as Env import System.Exit-import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>))+import System.FilePath (takeDirectory, (</>)) import System.IO (hPutStr, stderr) import System.IO.Unsafe (unsafePerformIO) import System.Process@@ -34,27 +33,21 @@ import qualified Text.Pandoc.UTF8 as UTF8 -- | Run a test with and return output.-execTest :: FilePath -- ^ Path to pandoc+execTest :: String -- ^ Path to test executable -> String -- ^ Shell command -> String -- ^ Input text -> IO (ExitCode, String) -- ^ Exit code and actual output-execTest pandocpath cmd inp = do+execTest testExePath cmd inp = do mldpath <- Env.lookupEnv "LD_LIBRARY_PATH" mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH"- let findDynlibDir [] = Nothing- findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"- findDynlibDir (_:xs) = findDynlibDir xs- let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $- takeDirectory $ takeWhile (/=' ') cmd)- let dynlibEnv = [("DYLD_LIBRARY_PATH",- intercalate ":" $ catMaybes [mbDynlibDir, mdyldpath])- ,("LD_LIBRARY_PATH",- intercalate ":" $ catMaybes [mbDynlibDir, mldpath])]- let env' = dynlibEnv ++ [("PATH",takeDirectory pandocpath),("TMP","."),- ("LANG","en_US.UTF-8"),- ("HOME", "./"),- ("pandoc_datadir", "..")]- let pr = (shell cmd){ env = Just env' }+ let env' = ("PATH",takeDirectory testExePath) :+ ("TMP",".") :+ ("LANG","en_US.UTF-8") :+ ("HOME", "./") :+ ("pandoc_datadir", "..") :+ maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath +++ maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath+ 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 let out = filter (/= '\r') $ err' ++ out'@@ -63,15 +56,23 @@ ExitSuccess -> return () return (ec, out) +pandocToEmulate :: Bool -> String -> String+pandocToEmulate True ('p':'a':'n':'d':'o':'c':cs) =+ "test-pandoc --emulate" ++ pandocToEmulate False cs+pandocToEmulate False ('|':' ':'p':'a':'n':'d':'o':'c':cs) =+ "| " ++ "test-pandoc --emulate" ++ pandocToEmulate False cs+pandocToEmulate _ (c:cs) = c : pandocToEmulate False cs+pandocToEmulate _ [] = []+ -- | Run a test, return True if test passed.-runTest :: String -- ^ Title of test- -> FilePath -- ^ Path to pandoc+runTest :: String -- ^ Path to test executable+ -> String -- ^ Title of test -> String -- ^ Shell command -> String -- ^ Input text -> String -- ^ Expected output -> TestTree-runTest testname pandocpath cmd inp norm = testCase testname $ do- (ec, out) <- execTest pandocpath cmd inp+runTest testExePath testname cmd inp norm = testCase testname $ do+ (ec, out) <- execTest testExePath cmd inp result <- if ec == ExitSuccess then if out == norm@@ -82,12 +83,13 @@ else return $ TestError ec assertBool (show result) (result == TestPassed) -tests :: FilePath -> TestTree+tests :: TestTree {-# NOINLINE tests #-}-tests pandocPath = unsafePerformIO $ do+tests = unsafePerformIO $ do files <- filter (".md" `isSuffixOf`) <$> getDirectoryContents "command"- let cmds = map (extractCommandTest pandocPath) files+ testExePath <- getExecutablePath+ let cmds = map (extractCommandTest testExePath) files return $ testGroup "Command:" cmds isCodeBlock :: Block -> Bool@@ -103,7 +105,7 @@ dropPercent xs = xs runCommandTest :: FilePath -> FilePath -> Int -> String -> TestTree-runCommandTest pandocpath fp num code =+runCommandTest testExePath fp num code = goldenTest testname getExpected getActual compareValues updateGolden where testname = "#" <> show num@@ -116,7 +118,7 @@ input = unlines inplines norm = unlines normlines getExpected = return norm- getActual = snd <$> execTest pandocpath cmd input+ getActual = snd <$> execTest testExePath cmd input compareValues expected actual | actual == expected = return Nothing | otherwise = return $ Just $ "--- test/command/" ++ fp ++ "\n+++ " ++@@ -128,14 +130,14 @@ let cmdline = "% " <> cmd let x = cmdline <> "\n" <> input <> "^D\n" <> norm let y = cmdline <> "\n" <> input <> "^D\n" <> newnorm- let updated = T.unpack $ T.replace (T.pack x) (T.pack y) (T.pack raw)+ let updated = T.replace (T.pack x) (T.pack y) raw UTF8.writeFile fp' updated extractCommandTest :: FilePath -> FilePath -> TestTree-extractCommandTest pandocpath fp = unsafePerformIO $ do+extractCommandTest testExePath fp = unsafePerformIO $ do contents <- UTF8.toText <$> BS.readFile ("command" </> fp) Pandoc _ blocks <- runIOorExplode (readMarkdown def{ readerExtensions = pandocExtensions } contents) let codeblocks = map extractCode $ filter isCodeBlock blocks- let cases = zipWith (runCommandTest pandocpath fp) [1..] codeblocks+ let cases = zipWith (runCommandTest testExePath fp) [1..] codeblocks return $ testGroup fp cases
test/Tests/Helpers.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {- | Module : Tests.Helpers@@ -15,7 +14,6 @@ module Tests.Helpers ( test , TestResult(..) , showDiff- , findPandoc , (=?>) , purely , ToString(..)@@ -23,14 +21,10 @@ ) where -import Prelude import Data.Algorithm.Diff import qualified Data.Map as M import Data.Text (Text, unpack)-import System.Directory-import System.Environment.Executable (getExecutablePath) import System.Exit-import System.FilePath import Test.Tasty import Test.Tasty.HUnit import Text.Pandoc.Builder (Blocks, Inlines, doc, plain)@@ -41,7 +35,7 @@ import Text.Pandoc.Writers.Native (writeNative) import Text.Printf -test :: (ToString a, ToString b, ToString c)+test :: (ToString a, ToString b, ToString c, HasCallStack) => (a -> b) -- ^ function to test -> String -- ^ name of test case -> (a, c) -- ^ (input, expected value)@@ -85,34 +79,6 @@ printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds showDiff (l,r) (Both _ _ : ds) = showDiff (l+1,r+1) ds---- | Find pandoc executable relative to test-pandoc-findPandoc :: IO FilePath-findPandoc = do- testExePath <- getExecutablePath- let pandocDir =- case reverse (splitDirectories (takeDirectory testExePath)) of- -- cabalv2 with --disable-optimization- "test-pandoc" : "build" : "noopt" : "test-pandoc" : "t" : ps- -> joinPath (reverse ps) </>- "x" </> "pandoc" </> "noopt" </> "build" </> "pandoc"- -- cabalv2 without --disable-optimization- "test-pandoc" : "build" : "test-pandoc" : "t" : ps- -> joinPath (reverse ps) </>- "x" </> "pandoc" </> "build" </> "pandoc"- -- cabalv1- "test-pandoc" : "build" : ps- -> joinPath (reverse ps) </> "build" </> "pandoc"- _ -> error "findPandoc: could not find pandoc executable"- let pandocPath = pandocDir </> "pandoc"-#ifdef _WINDOWS- <.> "exe"-#endif- found <- doesFileExist pandocPath- if found- then return pandocPath- else error $ "findPandoc: could not find pandoc executable at "- ++ pandocPath vividize :: Diff String -> String vividize (Both s _) = " " ++ s
test/Tests/Lua.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- |@@ -14,7 +13,6 @@ -} module Tests.Lua ( runLuaTest, tests ) where -import Prelude import Control.Monad (when) import System.FilePath ((</>)) import Test.Tasty (TestTree, localOption)
test/Tests/Lua/Module.hs view
@@ -25,6 +25,8 @@ ("lua" </> "module" </> "pandoc-list.lua") , testPandocLua "pandoc.mediabag" ("lua" </> "module" </> "pandoc-mediabag.lua")+ , testPandocLua "pandoc.path"+ ("lua" </> "module" </> "pandoc-path.lua") , testPandocLua "pandoc.types" ("lua" </> "module" </> "pandoc-types.lua") , testPandocLua "pandoc.util"
test/Tests/Old.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TupleSections #-} {- | Module : Tests.Old Copyright : © 2006-2021 John MacFarlane@@ -12,18 +12,17 @@ -} module Tests.Old (tests) where -import Prelude import Data.Algorithm.Diff-import Data.List (intercalate)-import Data.Maybe (catMaybes) import System.Exit-import System.FilePath (joinPath, splitDirectories, (<.>), (</>))+import System.FilePath ((<.>), (</>)) import qualified System.Environment as Env+import System.Environment.Executable (getExecutablePath) import Text.Pandoc.Process (pipeProcess) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Golden.Advanced (goldenTest) import Tests.Helpers hiding (test) import qualified Text.Pandoc.UTF8 as UTF8+import qualified Data.Text as T tests :: FilePath -> [TestTree] tests pandocPath =@@ -233,7 +232,7 @@ -- makes sure file is fully closed after reading readFile' :: FilePath -> IO String readFile' f = do s <- UTF8.readFile f- return $! (length s `seq` s)+ return $! (T.length s `seq` T.unpack s) lhsWriterTests :: FilePath -> String -> [TestTree] lhsWriterTests pandocPath format@@ -322,25 +321,26 @@ getActual = do mldpath <- Env.lookupEnv "LD_LIBRARY_PATH" mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH"- let mbDynlibDir = findDynlibDir (reverse $- splitDirectories pandocPath)- let dynlibEnv = [("DYLD_LIBRARY_PATH", intercalate ":" $ catMaybes [mbDynlibDir, mdyldpath])- ,("LD_LIBRARY_PATH", intercalate ":" $ catMaybes [mbDynlibDir, mldpath])]- let env = dynlibEnv ++- [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]- (ec, out) <- pipeProcess (Just env) pandocPath options mempty+ let env = ("TMP",".") :+ ("LANG","en_US.UTF-8") :+ ("HOME", "./") :+ maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath +++ maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath++ (ec, out) <- pipeProcess (Just env) pandocPath+ ("--emulate":options) mempty if ec == ExitSuccess then return $ filter (/='\r') . normalizer $ UTF8.toStringLazy out -- filter \r so the tests will work on Windows machines else fail $ "Pandoc failed with error code " ++ show ec- updateGolden = UTF8.writeFile norm+ updateGolden = UTF8.writeFile norm . T.pack options = ["--data-dir=../data","--quiet"] ++ [inp] ++ opts compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String) compareValues norm options expected actual = do- pandocPath <- findPandoc- let cmd = pandocPath ++ " " ++ unwords options+ testExePath <- getExecutablePath+ let cmd = testExePath ++ " --emulate " ++ unwords options let dash = replicate 72 '-' let diff = getDiff (lines actual) (lines expected) if expected == actual@@ -350,8 +350,3 @@ "\n--- " ++ norm ++ "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) diff ++ dash--findDynlibDir :: [FilePath] -> Maybe FilePath-findDynlibDir [] = Nothing-findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"-findDynlibDir (_:xs) = findDynlibDir xs
test/Tests/Readers/Creole.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Creole@@ -14,7 +13,6 @@ -} module Tests.Readers.Creole (tests) where -import Prelude import Data.Text (Text) import qualified Data.Text as T import Test.Tasty
test/Tests/Readers/Docx.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Docx@@ -13,7 +12,6 @@ -} module Tests.Readers.Docx (tests) where -import Prelude import Codec.Archive.Zip import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B
test/Tests/Readers/DokuWiki.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- |@@ -14,7 +13,6 @@ -} module Tests.Readers.DokuWiki (tests) where -import Prelude import Data.Text (Text) import qualified Data.Text as T import Test.Tasty
test/Tests/Readers/EPUB.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {- | Module : Tests.Readers.EPUB Copyright : © 2006-2021 John MacFarlane@@ -12,7 +11,6 @@ -} module Tests.Readers.EPUB (tests) where -import Prelude import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import Test.Tasty
test/Tests/Readers/FB2.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {- | Module : Tests.Readers.FB2 Copyright : © 2018-2020 Alexander Krotov@@ -12,7 +11,6 @@ -} module Tests.Readers.FB2 (tests) where -import Prelude import Test.Tasty import Tests.Helpers import Test.Tasty.Golden (goldenVsString)
test/Tests/Readers/HTML.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.HTML@@ -13,7 +12,6 @@ -} module Tests.Readers.HTML (tests) where -import Prelude import Data.Text (Text) import qualified Data.Text as T import Test.Tasty
test/Tests/Readers/JATS.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.JATS@@ -13,7 +12,6 @@ -} module Tests.Readers.JATS (tests) where -import Prelude import Data.Text (Text) import Test.Tasty import Tests.Helpers@@ -90,6 +88,7 @@ "<p>\n\ \ <inline-formula><alternatives>\n\ \ <tex-math><![CDATA[\\sigma|_{\\{x\\}}]]></tex-math>\n\+ \ </alternatives></inline-formula>\n\ \</p>" =?> para (math "\\sigma|_{\\{x\\}}") , test jats "math ml only" $
test/Tests/Readers/Jira.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- |@@ -35,6 +34,9 @@ [ testGroup "para" [ "Simple sentence" =: "Hello, World!" =?> para "Hello, World!"++ , "leading blank lines" =:+ "\n\ntext" =?> para "text" ] , testGroup "header"@@ -131,6 +133,10 @@ [ "external" =: "[Example|https://example.org]" =?> para (link "https://example.org" "" "Example")++ , "URL in alias" =:+ "[See https://example.com|https://example.com]" =?>+ para (link "https://example.com" "" "See https://example.com") , "email" =: "[mailto:me@example.org]" =?>
test/Tests/Readers/LaTeX.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.LaTeX@@ -13,14 +12,9 @@ -} module Tests.Readers.LaTeX (tests) where -import Prelude import Data.Text (Text) import qualified Data.Text as T-import qualified Text.Pandoc.UTF8 as UTF8-import Text.Pandoc.Readers.LaTeX (tokenize, untokenize) import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary ()@@ -49,21 +43,8 @@ where toRow = Row nullAttr . map simpleCell -tokUntokRt :: String -> Bool-tokUntokRt s = untokenize (tokenize "random" t) == t- where t = T.pack s- tests :: [TestTree]-tests = [ testGroup "tokenization"- [ testCase "tokenizer round trip on test case" $ do- orig <- T.pack <$> UTF8.readFile "../test/latex-reader.latex"- let new = untokenize $ tokenize "../test/latex-reader.latex"- orig- assertEqual "untokenize . tokenize is identity" orig new- , testProperty "untokenize . tokenize is identity" tokUntokRt- ]-- , testGroup "basic"+tests = [ testGroup "basic" [ "simple" =: "word" =?> para "word" , "space" =:
test/Tests/Readers/Man.hs view
@@ -13,7 +13,6 @@ -} module Tests.Readers.Man (tests) where -import Prelude import Data.Text (Text) import Test.Tasty import Tests.Helpers
test/Tests/Readers/Markdown.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Markdown@@ -13,7 +12,6 @@ -} module Tests.Readers.Markdown (tests) where -import Prelude import Data.Text (Text, unpack) import qualified Data.Text as T import Test.Tasty
test/Tests/Readers/Muse.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Muse@@ -13,7 +12,6 @@ -} module Tests.Readers.Muse (tests) where -import Prelude import Data.List (intersperse) import Data.Monoid (Any (..)) import Data.Text (Text)
test/Tests/Readers/Odt.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Odt@@ -14,7 +13,6 @@ -} module Tests.Readers.Odt (tests) where -import Prelude import Control.Monad (liftM) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B
test/Tests/Readers/Org/Block.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Block@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Block (tests) where -import Prelude import Test.Tasty (TestTree, testGroup) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:), spcSep)
test/Tests/Readers/Org/Block/CodeBlock.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Block.CodeBlock@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Block.CodeBlock (tests) where -import Prelude import Test.Tasty (TestTree) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:), spcSep)
test/Tests/Readers/Org/Block/Figure.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Block.Figure@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Block.Figure (tests) where -import Prelude import Test.Tasty (TestTree) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:))
test/Tests/Readers/Org/Block/Header.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Block.Header@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Block.Header (tests) where -import Prelude import Test.Tasty (TestTree, testGroup) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:), spcSep, tagSpan)
test/Tests/Readers/Org/Block/List.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Block.Header@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Block.List (tests) where -import Prelude import Test.Tasty (TestTree) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:), spcSep)@@ -119,6 +117,19 @@ , "- " ] =?> bulletList [ plain "", plain "" ]++ , "Task list" =:+ T.unlines [ "- [ ] nope"+ , "- [X] yup"+ , "- [-] started"+ , " 1. [X] sure"+ , " 2. [ ] nuh-uh"+ ] =?>+ bulletList [ plain "☐ nope", plain "☒ yup"+ , mconcat [ plain "☐ started"+ , orderedList [plain "☒ sure", plain "☐ nuh-uh"]+ ]+ ] , "Simple Ordered List" =: ("1. Item1\n" <>
test/Tests/Readers/Org/Block/Table.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Block.Table@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Block.Table (tests) where -import Prelude import Test.Tasty (TestTree) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:), spcSep)
test/Tests/Readers/Org/Directive.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Directive@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Directive (tests) where -import Prelude import Data.Time (UTCTime (UTCTime), secondsToDiffTime) import Data.Time.Calendar (Day (ModifiedJulianDay)) import Test.Tasty (TestTree, testGroup)
test/Tests/Readers/Org/Inline.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Inline@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Inline (tests) where -import Prelude import Data.List (intersperse) import Test.Tasty (TestTree, testGroup) import Tests.Helpers ((=?>))
test/Tests/Readers/Org/Inline/Citation.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Inline.Citation@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Inline.Citation (tests) where -import Prelude import Test.Tasty (TestTree, testGroup) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:))@@ -117,6 +115,46 @@ , citationHash = 0 } in (para $ cite [citation] "citep:pandoc")++ , "multiple simple citations" =:+ "citep:picard,riker" =?>+ let picard = Citation+ { citationId = "picard"+ , citationPrefix = mempty+ , citationSuffix = mempty+ , citationMode = NormalCitation+ , citationNoteNum = 0+ , citationHash = 0+ }+ riker = Citation+ { citationId = "riker"+ , citationPrefix = mempty+ , citationSuffix = mempty+ , citationMode = NormalCitation+ , citationNoteNum = 0+ , citationHash = 0+ }+ in (para $ cite [picard,riker] "citep:picard,riker")++ , "multiple simple citations succeeded by comma" =:+ "citep:picard,riker," =?>+ let picard = Citation+ { citationId = "picard"+ , citationPrefix = mempty+ , citationSuffix = mempty+ , citationMode = NormalCitation+ , citationNoteNum = 0+ , citationHash = 0+ }+ riker = Citation+ { citationId = "riker"+ , citationPrefix = mempty+ , citationSuffix = mempty+ , citationMode = NormalCitation+ , citationNoteNum = 0+ , citationHash = 0+ }+ in (para $ cite [picard,riker] "citep:picard,riker" <> str ",") , "extended citation" =: "[[citep:Dominik201408][See page 20::, for example]]" =?>
test/Tests/Readers/Org/Inline/Note.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Inline.Note@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Inline.Note (tests) where -import Prelude import Test.Tasty (TestTree) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:))
test/Tests/Readers/Org/Inline/Smart.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Inline.Smart@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Inline.Smart (tests) where -import Prelude import Data.Text (Text) import Test.Tasty (TestTree) import Tests.Helpers ((=?>), purely, test)
test/Tests/Readers/Org/Meta.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Meta@@ -13,7 +12,6 @@ -} module Tests.Readers.Org.Meta (tests) where -import Prelude import Test.Tasty (TestTree, testGroup) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:), spcSep)
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Shared@@ -18,7 +17,6 @@ , tagSpan ) where -import Prelude import Data.List (intersperse) import Data.Text (Text) import Tests.Helpers (ToString, purely, test)
test/Tests/Readers/RST.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- |@@ -14,7 +13,6 @@ -} module Tests.Readers.RST (tests) where -import Prelude import Data.Text (Text) import qualified Data.Text as T import Test.Tasty
test/Tests/Readers/Txt2Tags.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Txt2Tags@@ -14,7 +13,6 @@ -} module Tests.Readers.Txt2Tags (tests) where -import Prelude import Data.List (intersperse) import Data.Text (Text) import qualified Data.Text as T
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Shared@@ -13,7 +12,6 @@ -} module Tests.Shared (tests) where -import Prelude import System.FilePath.Posix (joinPath) import Test.Tasty import Test.Tasty.HUnit (assertBool, testCase, (@?=))
test/Tests/Writers/AnnotatedTable.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Writers.AnnotatedTable
test/Tests/Writers/AsciiDoc.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.AsciiDoc (tests) where -import Prelude import Data.Text (unpack) import Test.Tasty import Tests.Helpers
test/Tests/Writers/ConTeXt.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.ConTeXt (tests) where -import Prelude import Data.Text (unpack, pack) import Test.Tasty import Test.Tasty.QuickCheck
test/Tests/Writers/Docbook.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.Docbook (tests) where -import Prelude import Data.Text (unpack) import Test.Tasty import Tests.Helpers
test/Tests/Writers/Docx.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE NoImplicitPrelude #-} module Tests.Writers.Docx (tests) where -import Prelude import Text.Pandoc import Test.Tasty import Tests.Writers.OOXML
test/Tests/Writers/FB2.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.FB2 (tests) where -import Prelude import Test.Tasty import Tests.Helpers import Text.Pandoc
test/Tests/Writers/HTML.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.HTML (tests) where -import Prelude import Data.Text (unpack) import Test.Tasty import Tests.Helpers
test/Tests/Writers/JATS.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.JATS (tests) where -import Prelude import Data.Text (unpack) import Test.Tasty import Tests.Helpers
test/Tests/Writers/Jira.hs view
@@ -3,6 +3,7 @@ import Data.Text (unpack) import Test.Tasty+import Test.Tasty.HUnit (HasCallStack) import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary ()@@ -12,7 +13,7 @@ jira = unpack . purely (writeJira def) . toPandoc infix 4 =:-(=:) :: (ToString a, ToPandoc a)+(=:) :: (ToString a, ToPandoc a, HasCallStack) => String -> (a, String) -> TestTree (=:) = test jira @@ -60,6 +61,22 @@ , "user link with user as description" =: linkWith ("", ["user-account"], []) "~johndoe" "" "~johndoe" =?> "[~johndoe]"+ ]++ , testGroup "spans"+ [ "id is used as anchor" =:+ spanWith ("unicorn", [], []) (str "Unicorn") =?>+ "{anchor:unicorn}Unicorn"+ ]++ , testGroup "code"+ [ "code block with known language" =:+ codeBlockWith ("", ["java"], []) "Book book = new Book(\"Algebra\")" =?>+ "{code:java}\nBook book = new Book(\"Algebra\")\n{code}"++ , "code block without language" =:+ codeBlockWith ("", [], []) "preformatted\n text.\n" =?>+ "{noformat}\npreformatted\n text.\n{noformat}" ] ] ]
test/Tests/Writers/LaTeX.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.LaTeX (tests) where -import Prelude import Data.Text (unpack) import Test.Tasty import Tests.Helpers
test/Tests/Writers/Markdown.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Tests.Writers.Markdown (tests) where -import Prelude import Data.Text (unpack) import Test.Tasty import Tests.Helpers
test/Tests/Writers/Ms.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.Ms (tests) where -import Prelude import Test.Tasty import Tests.Helpers import Text.Pandoc
test/Tests/Writers/Muse.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.Muse (tests) where
test/Tests/Writers/Native.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE NoImplicitPrelude #-} module Tests.Writers.Native (tests) where -import Prelude import Data.Text (unpack) import Test.Tasty import Test.Tasty.QuickCheck
test/Tests/Writers/OOXML.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.OOXML (ooxmlTest) where -import Prelude import Text.Pandoc import Test.Tasty import Test.Tasty.Golden.Advanced@@ -45,7 +43,8 @@ displayDiff :: Content -> Content -> String displayDiff elemA elemB =- showDiff (1,1) $ getDiff (lines $ ppContent elemA) (lines $ ppContent elemB)+ showDiff (1,1)+ (getDiff (lines $ showContent elemA) (lines $ showContent elemB)) goldenArchive :: FilePath -> IO Archive goldenArchive fp = toArchive . BL.fromStrict <$> BS.readFile fp
test/Tests/Writers/Org.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.Org (tests) where -import Prelude+import Data.Text as T import Test.Tasty import Tests.Helpers import Text.Pandoc@@ -11,17 +10,51 @@ infix 4 =: (=:) :: (ToString a, ToPandoc a)- => String -> (a, String) -> TestTree-(=:) = test (purely (writeOrg def . toPandoc))+ => String -> (a, Text) -> TestTree+(=:) = test org +defopts :: WriterOptions+defopts = def+ { writerExtensions = getDefaultExtensions "org"+ }++org :: (ToPandoc a) => a -> Text+org = orgWithOpts defopts++orgWithOpts :: (ToPandoc a) => WriterOptions -> a -> Text+orgWithOpts opts x = purely (writeOrg opts) $ toPandoc x++ tests :: [TestTree]-tests = [ testGroup "links"- -- See http://orgmode.org/manual/Internal-links.html#Internal-links- [ "simple link"- =: link "/url" "" "foo"- =?> "[[/url][foo]]"- , "internal link to anchor"- =: link "#my-custom-id" "" "#my-custom-id"- =?> "[[#my-custom-id]]"+tests =+ [ testGroup "links"+ -- See http://orgmode.org/manual/Internal-links.html#Internal-links+ [ "simple link"+ =: link "/url" "" "foo"+ =?> "[[/url][foo]]"+ , "internal link to anchor"+ =: link "#my-custom-id" "" "#my-custom-id"+ =?> "[[#my-custom-id]]"+ ]++ , testGroup "lists"+ [ "bullet task list"+ =: bulletList [plain "☐ a", plain "☒ b"]+ =?> T.unlines+ [ "- [ ] a"+ , "- [X] b" ]- ]+ , "ordered task list"+ =: orderedList [plain ("☐" <> space <> "a"), plain "☒ b"]+ =?> T.unlines+ [ "1. [ ] a"+ , "2. [X] b"+ ]+ , test (orgWithOpts def) "bullet without task_lists" $+ bulletList [plain "☐ a", plain "☒ b"]+ =?> T.unlines+ [ "- ☐ a"+ , "- ☒ b"+ ]+ ]+ ]
test/Tests/Writers/Plain.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.Plain (tests) where -import Prelude import Test.Tasty import Tests.Helpers import Text.Pandoc
test/Tests/Writers/Powerpoint.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE NoImplicitPrelude #-} module Tests.Writers.Powerpoint (tests) where -import Prelude import Tests.Writers.OOXML (ooxmlTest) import Text.Pandoc import Test.Tasty
test/Tests/Writers/RST.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.RST (tests) where -import Prelude import Control.Monad.Identity import Test.Tasty import Test.Tasty.HUnit
test/Tests/Writers/TEI.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Tests.Writers.TEI (tests) where -import Prelude import Test.Tasty import Tests.Helpers import Text.Pandoc
test/command/5321.md view
@@ -4,7 +4,7 @@ <caption> <p>bar</p> </caption>- <graphic xlink:href="foo.png" xlink:alt-text="baz">+ <graphic xlink:href="foo.png" xlink:alt-text="baz" /> </fig> ^D [Para [Image ("fig-1",[],[]) [Str "bar"] ("foo.png","fig:")]]@@ -17,7 +17,7 @@ <title>foo</title> <p>bar</p> </caption>- <graphic xlink:href="foo.png" xlink:alt-text="baz">+ <graphic xlink:href="foo.png" xlink:alt-text="baz" /> </fig> ^D [Para [Image ("fig-1",[],[]) [Str "foo",LineBreak,Str "bar"] ("foo.png","fig:")]]
test/command/5686.md view
@@ -4,6 +4,6 @@ This part does not make it to the html output. ^D-[Para [Str "FOO",RawInline (Format "tex") "\\t0BAR"]+[Para [Str "FOO",RawInline (Format "tex") "\\t0",Str "BAR"] ,Para [Str "This",Space,Str "part",Space,Str "does",Space,Str "not",Space,Str "make",Space,Str "it",Space,Str "to",Space,Str "the",Space,Str "html",Space,Str "output."]] ```
+ test/command/7058.md view
@@ -0,0 +1,6 @@+```+% pandoc -f latex -t markdown+5\(-\)8 \(x\)+^D+5$-$`<!-- -->`{=html}8 $x$+```
+ test/command/7064.md view
@@ -0,0 +1,32 @@+```+% pandoc -f rst -t html+.. csv-table:: Changes+ :header: "Version", "Date", "Description"+ :widths: 15, 15, 70+ :delim: $++ 0.1.0 $ 18/02/2013 $ Initial Release+^D+<table>+<caption>Changes</caption>+<colgroup>+<col style="width: 15%" />+<col style="width: 15%" />+<col style="width: 70%" />+</colgroup>+<thead>+<tr class="header">+<th>Version</th>+<th>Date</th>+<th>Description</th>+</tr>+</thead>+<tbody>+<tr class="odd">+<td>0.1.0</td>+<td>18/02/2013</td>+<td>Initial Release</td>+</tr>+</tbody>+</table>+```
+ test/command/7067.md view
@@ -0,0 +1,90 @@+```+% pandoc -t biblatex+---+references:+- id: garaud+ author:+ - family: Garaud+ given: Marcel+ container-title: Bulletin de la Societé des antiquaires de l’Ouest+ collection-title: 4+ issued:+ - year: 1967+ language: fr-FR+ page: 11-27+ title: Recherches sur les défrichements dans la Gâtine poitevine aux XI^e^ et XII^e^ siècles+ type: article-journal+ volume: 9+...+^D+@article{garaud,+ author = {Garaud, Marcel},+ title = {Recherches sur les défrichements dans la Gâtine poitevine aux+ XI\textsuperscript{e} et XII\textsuperscript{e} siècles},+ journal = {Bulletin de la Societé des antiquaires de l’Ouest},+ series = {4},+ volume = {9},+ pages = {11-27},+ date = {1967},+ langid = {fr-FR}+}+```++```+% pandoc -t bibtex+---+references:+- id: garaud+ author:+ - family: Garaud+ given: Marcel+ container-title: Bulletin de la Société des antiquaires de l’Ouest+ collection-title: 4+ issued:+ - year: 1967+ language: fr-FR+ page: 11-27+ title: Recherches sur les défrichements dans la Gâtine poitevine aux XI^e^ et XII^e^ siècles+ type: article-journal+ volume: 9+...+^D+@article{garaud,+ author = {Garaud, Marcel},+ title = {{Recherches sur les défrichements dans la Gâtine poitevine+ aux XI\textsuperscript{e} et XII\textsuperscript{e} siècles}},+ journal = {Bulletin de la Société des antiquaires de l’Ouest},+ series = {4},+ volume = {9},+ pages = {11-27},+ year = {1967}+}+```++This tests the titlecasing of a word with an accented second letter:+```+% pandoc -t bibtex+---+references:+- id: garaud+ author:+ - family: Garaud+ given: Marcel+ container-title: English Journal+ issued:+ - year: 1967+ language: en-US+ title: Research on the défrichements in the Gâtine poitevine+ type: article-journal+ volume: 9+...+^D+@article{garaud,+ author = {Garaud, Marcel},+ title = {Research on the Défrichements in the {Gâtine} Poitevine},+ journal = {English Journal},+ volume = {9},+ year = {1967}+}+```+
+ test/command/7080.md view
@@ -0,0 +1,8 @@+```+% pandoc -f markdown_mmd -t native+![][image]++[image]: image.png width=100px height=150px+^D+[Para [Image ("",[],[("width","100px"),("height","150px")]) [] ("image.png","")]]+```
+ test/command/7092.md view
@@ -0,0 +1,8 @@+```+% pandoc -flatex+raw_tex -t native+\newcommand{\em}[1]{\emph{#1}}++\em{\parseMe{foo}}+^D+[Para [Emph [RawInline (Format "latex") "\\parseMe{foo}"]]]+```
+ test/command/7099.md view
@@ -0,0 +1,18 @@+```+% pandoc -f html -t native --verbose+<iframe src=""></iframe>+^D+[INFO] Skipped '<iframe src></iframe>' at input line 1 column 16+[]+```++```+% pandoc -f html -t native --verbose+<iframe src="h:invalid@url"></iframe>+^D+[INFO] Fetching h:invalid@url...+[WARNING] Could not fetch resource 'h:invalid@url': Could not fetch h:invalid@url+ InvalidUrlException "h:invalid@url" "Invalid scheme"+[INFO] Skipped '<iframe src="h:invalid@url"></iframe>' at input line 1 column 29+[]+```
+ test/command/7112.md view
@@ -0,0 +1,15 @@+```+% pandoc -f rst+.. csv-table::++ setting, ``echo PATH="path"``+^D+<table>+<tbody>+<tr class="odd">+<td>setting</td>+<td><code>echo PATH="path"</code></td>+</tr>+</tbody>+</table>+```
+ test/command/7129.md view
@@ -0,0 +1,27 @@+```+% pandoc -f latex -t native+\begin{tabular}{ll} \hline+ FOO & BAR \\ \hline+ foo & \verb|b&r| \\ \hline+\end{tabular}+^D+[Table ("",[],[]) (Caption Nothing+ [])+ [(AlignLeft,ColWidthDefault)+ ,(AlignLeft,ColWidthDefault)]+ (TableHead ("",[],[])+ [Row ("",[],[])+ [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)+ [Plain [Str "FOO"]]+ ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)+ [Plain [Str "BAR"]]]])+ [(TableBody ("",[],[]) (RowHeadColumns 0)+ []+ [Row ("",[],[])+ [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)+ [Plain [Str "foo"]]+ ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)+ [Plain [Code ("",[],[]) "b&r"]]]])]+ (TableFoot ("",[],[])+ [])]+```
test/command/biblatex-baez-article.md view
@@ -67,7 +67,7 @@ title: "Higher-dimensional algebra V: 2-groups" title-short: Higher-dimensional algebra V type: article-journal- url: "http://arxiv.org/abs/math/0307200v3"+ url: "https://arxiv.org/abs/math/0307200v3" version: 3 volume: 12 ---
test/command/biblatex-baez-online.md view
@@ -61,7 +61,7 @@ title: "Higher-dimensional algebra V: 2-groups" title-short: Higher-dimensional algebra V type: webpage- url: "http://arxiv.org/abs/math/0307200v3"+ url: "https://arxiv.org/abs/math/0307200v3" version: 3 ---
test/command/biblatex-cotton.md view
@@ -43,9 +43,9 @@ --- nocite: "[@*]" references:-- annote: A book entry with author authors and an edition field. By- default, long author and editor lists are automatically truncated.- This is configurable+- annote: A book entry with `\arabic{author}`{=latex} authors and an+ edition field. By default, long author and editor lists are+ automatically truncated. This is configurable author: - family: Cotton given: Frank Albert
test/command/biblatex-itzhaki.md view
@@ -74,7 +74,7 @@ language: en-US title: Some remarks on '[t Hooft's]{.nocase} S-matrix for black holes type: webpage- url: "http://arxiv.org/abs/hep-th/9603067"+ url: "https://arxiv.org/abs/hep-th/9603067" version: 1 ---
test/command/biblatex-murray.md view
@@ -55,8 +55,9 @@ --- nocite: "[@*]" references:-- annote: An article entry with author authors. By default, long author- and editor lists are automatically truncated. This is configurable+- annote: An article entry with `\arabic{author}`{=latex} authors. By+ default, long author and editor lists are automatically truncated.+ This is configurable author: - family: Hostetler given: Michael J.
test/command/biblatex-wassenberg.md view
@@ -75,7 +75,7 @@ language: en-US title: Faster radix sort via virtual memory and write-combining type: webpage- url: "http://arxiv.org/abs/1008.2849v1"+ url: "https://arxiv.org/abs/1008.2849v1" version: 1 ---
test/command/biblatex-wilde.md view
@@ -58,7 +58,7 @@ people" title-short: The importance of being earnest type: book- url: "http://books.google.com?id=4HIWAAAAYAAJ"+ url: "https://books.google.com?id=4HIWAAAAYAAJ" ---
test/docbook-reader.docbook view
@@ -1,6 +1,11 @@ <?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.4//EN"- "http://www.oasis-open.org/docbook/xml/4.4/docbookx.dtd">+"http://www.oasis-open.org/docbook/xml/4.4/docbookx.dtd"+[+<!ENTITY GHC "GHC" >+<!ENTITY let "LET" >+<!ENTITY case "CASE" >+]> <article> <articleinfo> <title>Pandoc Test Suite</title>
test/docx/golden/block_quotes.docx view
binary file changed (10092 → 10071 bytes)
test/docx/golden/codeblock.docx view
binary file changed (9944 → 9920 bytes)
test/docx/golden/comments.docx view
binary file changed (10279 → 10258 bytes)
test/docx/golden/custom_style_no_reference.docx view
binary file changed (10042 → 10021 bytes)
test/docx/golden/custom_style_preserve.docx view
binary file changed (10666 → 10650 bytes)
test/docx/golden/custom_style_reference.docx view
binary file changed (12434 → 12403 bytes)
test/docx/golden/definition_list.docx view
binary file changed (9941 → 9920 bytes)
test/docx/golden/document-properties-short-desc.docx view
binary file changed (9947 → 9925 bytes)
test/docx/golden/document-properties.docx view
binary file changed (10423 → 10404 bytes)
test/docx/golden/headers.docx view
binary file changed (10080 → 10059 bytes)
test/docx/golden/image.docx view
binary file changed (26758 → 26736 bytes)
test/docx/golden/inline_code.docx view
binary file changed (9880 → 9859 bytes)
test/docx/golden/inline_formatting.docx view
binary file changed (10060 → 10038 bytes)
test/docx/golden/inline_images.docx view
binary file changed (26816 → 26793 bytes)
test/docx/golden/link_in_notes.docx view
binary file changed (10101 → 10081 bytes)
test/docx/golden/links.docx view
binary file changed (10276 → 10251 bytes)
test/docx/golden/lists.docx view
binary file changed (10352 → 10332 bytes)
test/docx/golden/lists_continuing.docx view
binary file changed (10143 → 10123 bytes)
test/docx/golden/lists_multiple_initial.docx view
binary file changed (10232 → 10210 bytes)
test/docx/golden/lists_restarting.docx view
binary file changed (10144 → 10122 bytes)
test/docx/golden/nested_anchors_in_header.docx view
binary file changed (10239 → 10216 bytes)
test/docx/golden/notes.docx view
binary file changed (10046 → 10028 bytes)
test/docx/golden/raw-blocks.docx view
binary file changed (9980 → 9960 bytes)
test/docx/golden/raw-bookmarks.docx view
binary file changed (10115 → 10094 bytes)
test/docx/golden/table_one_row.docx view
binary file changed (9932 → 9908 bytes)
test/docx/golden/table_with_list_cell.docx view
binary file changed (10249 → 10227 bytes)
test/docx/golden/tables.docx view
binary file changed (10266 → 10244 bytes)
test/docx/golden/track_changes_deletion.docx view
binary file changed (9924 → 9903 bytes)
test/docx/golden/track_changes_insertion.docx view
binary file changed (9907 → 9886 bytes)
test/docx/golden/track_changes_move.docx view
binary file changed (9941 → 9920 bytes)
test/docx/golden/track_changes_scrubbed_metadata.docx view
binary file changed (10053 → 10032 bytes)
test/docx/golden/unicode.docx view
binary file changed (9865 → 9845 bytes)
test/docx/golden/verbatim_subsuper.docx view
binary file changed (9913 → 9892 bytes)
test/jats-reader.native view
@@ -1,4 +1,4 @@-Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Space,Str "MacFarlane"]]),("title",MetaInlines [Str "Pandoc",Space,Str "Test",Space,Str "Suite"])]})+Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Space,Str "MacFarlane"],MetaInlines [Str "Anonymous"]]),("title",MetaInlines [Str "Pandoc",Space,Str "Test",Space,Str "Suite"])]}) [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "set",Space,Str "of",Space,Str "tests",Space,Str "for",Space,Str "pandoc.",Space,Str "Most",Space,Str "of",Space,Str "them",Space,Str "are",Space,Str "adapted",Space,Str "from",Space,Str "John",Space,Str "Gruber's",Space,Str "markdown",Space,Str "test",Space,Str "suite."] ,Header 1 ("headers",[],[]) [Str "Headers"] ,Header 2 ("level-2-with-an-embedded-link",[],[]) [Str "Level",Space,Str "2",Space,Str "with",Space,Str "an",SoftBreak,Link ("",[],[]) [Str "embedded",SoftBreak,Str "link"] ("/url","")]
test/jats-reader.xml view
@@ -20,6 +20,7 @@ <surname>MacFarlane</surname> <given-names>John</given-names> </name>+ </contrib> <contrib contrib-type="author"> <name> <surname>Anonymous</surname>
test/lhs-test.latex view
@@ -6,8 +6,8 @@ ]{article} \usepackage{amsmath,amssymb} \usepackage{lmodern}-\usepackage{ifxetex,ifluatex}-\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex+\usepackage{iftex}+\ifPDFTeX \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage{textcomp} % provide euro and other symbols@@ -81,7 +81,7 @@ \providecommand{\tightlist}{% \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} \setcounter{secnumdepth}{-\maxdimen} % remove section numbering-\ifluatex+\ifLuaTeX \usepackage{selnolig} % disable illegal ligatures \fi
test/lhs-test.latex+lhs view
@@ -6,8 +6,8 @@ ]{article} \usepackage{amsmath,amssymb} \usepackage{lmodern}-\usepackage{ifxetex,ifluatex}-\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex+\usepackage{iftex}+\ifPDFTeX \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage{textcomp} % provide euro and other symbols@@ -48,7 +48,7 @@ \providecommand{\tightlist}{% \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} \setcounter{secnumdepth}{-\maxdimen} % remove section numbering-\ifluatex+\ifLuaTeX \usepackage{selnolig} % disable illegal ligatures \fi
+ test/lua/module/pandoc-path.lua view
@@ -0,0 +1,44 @@+local tasty = require 'tasty'+local path = require 'pandoc.path'++local assert = tasty.assert+local test = tasty.test_case+local group = tasty.test_group++return {+ group 'path separator' {+ test('is string', function ()+ assert.are_same(type(path.separator), 'string')+ end),+ test('is slash or backslash', function ()+ assert.is_truthy(path.separator:match '^[/\\]$')+ end),+ },+ group 'search path separator' {+ test('is string', function ()+ assert.are_same(type(path.search_path_separator), 'string')+ end),+ test('is colon or semicolon', function ()+ assert.is_truthy(path.search_path_separator:match '^[:;]$')+ end)+ },+ group 'module' {+ test('check function existence', function ()+ local functions = {+ 'directory',+ 'filename',+ 'is_absolute',+ 'is_relative',+ 'join',+ 'make_relative',+ 'normalize',+ 'split',+ 'split_extension',+ 'split_search_path',+ }+ for _, f in ipairs(functions) do+ assert.are_equal(type(path[f]), 'function')+ end+ end)+ }+}
test/pptx/code-custom.pptx view
binary file changed (28230 → 28184 bytes)
test/pptx/code-custom_templated.pptx view
binary file changed (395524 → 395477 bytes)
test/pptx/code.pptx view
binary file changed (28229 → 28183 bytes)
test/pptx/code_templated.pptx view
binary file changed (395522 → 395477 bytes)
test/pptx/document-properties-short-desc.pptx view
binary file changed (27012 → 26967 bytes)
test/pptx/document-properties-short-desc_templated.pptx view
binary file changed (394298 → 394253 bytes)
test/pptx/document-properties.pptx view
binary file changed (27417 → 27375 bytes)
test/pptx/document-properties_templated.pptx view
binary file changed (394701 → 394656 bytes)
test/pptx/endnotes.pptx view
binary file changed (26969 → 26928 bytes)
test/pptx/endnotes_templated.pptx view
binary file changed (394262 → 394219 bytes)
test/pptx/endnotes_toc.pptx view
binary file changed (27892 → 27747 bytes)
test/pptx/endnotes_toc_templated.pptx view
binary file changed (395186 → 395041 bytes)
test/pptx/images.pptx view
binary file changed (44626 → 44579 bytes)
test/pptx/images_templated.pptx view
binary file changed (411916 → 411870 bytes)
test/pptx/inline_formatting.pptx view
binary file changed (26156 → 26121 bytes)
test/pptx/inline_formatting_templated.pptx view
binary file changed (393447 → 393412 bytes)
test/pptx/lists.pptx view
binary file changed (27056 → 27015 bytes)
test/pptx/lists_templated.pptx view
binary file changed (394349 → 394307 bytes)
test/pptx/raw_ooxml.pptx view
binary file changed (26948 → 26908 bytes)
test/pptx/raw_ooxml_templated.pptx view
binary file changed (394240 → 394198 bytes)
test/pptx/remove_empty_slides.pptx view
binary file changed (44073 → 44025 bytes)
test/pptx/remove_empty_slides_templated.pptx view
binary file changed (411359 → 411311 bytes)
test/pptx/slide_breaks.pptx view
binary file changed (28582 → 28531 bytes)
test/pptx/slide_breaks_slide_level_1.pptx view
binary file changed (27751 → 27705 bytes)
test/pptx/slide_breaks_slide_level_1_templated.pptx view
binary file changed (395045 → 395000 bytes)
test/pptx/slide_breaks_templated.pptx view
binary file changed (395875 → 395825 bytes)
test/pptx/slide_breaks_toc.pptx view
binary file changed (29539 → 29481 bytes)
test/pptx/slide_breaks_toc_templated.pptx view
binary file changed (396833 → 396776 bytes)
test/pptx/speaker_notes.pptx view
binary file changed (35444 → 35360 bytes)
test/pptx/speaker_notes_after_metadata.pptx view
binary file changed (31683 → 31636 bytes)
test/pptx/speaker_notes_after_metadata_templated.pptx view
binary file changed (398964 → 398915 bytes)
test/pptx/speaker_notes_afterheader.pptx view
binary file changed (30700 → 30657 bytes)
test/pptx/speaker_notes_afterheader_templated.pptx view
binary file changed (397988 → 397943 bytes)
test/pptx/speaker_notes_afterseps.pptx view
binary file changed (51612 → 51548 bytes)
test/pptx/speaker_notes_afterseps_templated.pptx view
binary file changed (418903 → 418834 bytes)
test/pptx/speaker_notes_templated.pptx view
binary file changed (402736 → 402650 bytes)
test/pptx/start_numbering_at.pptx view
binary file changed (27031 → 26991 bytes)
test/pptx/start_numbering_at_templated.pptx view
binary file changed (394323 → 394283 bytes)
test/pptx/tables.pptx view
binary file changed (27573 → 27532 bytes)
test/pptx/tables_templated.pptx view
binary file changed (394868 → 394827 bytes)
test/pptx/two_column.pptx view
binary file changed (26075 → 26038 bytes)
test/pptx/two_column_templated.pptx view
binary file changed (393366 → 393327 bytes)
test/test-pandoc.hs view
@@ -1,9 +1,13 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wall #-} module Main where -import Prelude+import System.Environment (getArgs)+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@@ -46,12 +50,11 @@ import qualified Tests.Writers.RST import qualified Tests.Writers.AnnotatedTable import qualified Tests.Writers.TEI-import Tests.Helpers (findPandoc) import Text.Pandoc.Shared (inDirectory) tests :: FilePath -> TestTree tests pandocPath = testGroup "pandoc tests"- [ Tests.Command.tests pandocPath+ [ Tests.Command.tests , testGroup "Old" (Tests.Old.tests pandocPath) , testGroup "Shared" Tests.Shared.tests , testGroup "Writers"@@ -102,7 +105,15 @@ main :: IO () main = do setLocaleEncoding utf8- inDirectory "test" $ do- fp <- findPandoc- putStrLn $ "Using pandoc executable at " ++ fp- defaultMain $ tests fp+ args <- getArgs+ case args of+ "--emulate":args' -> -- emulate pandoc executable+ E.catch+ (parseOptionsFromArgs options defaultOpts "pandoc" args' >>=+ convertWithOpts)+ (handleError . Left)+ _ -> inDirectory "test" $ do+ fp <- getExecutablePath+ -- putStrLn $ "Using pandoc executable at " ++ fp+ defaultMain $ tests fp+
test/txt2tags.native view
@@ -37,7 +37,7 @@ ,Para [Link ("",[],[]) [Str "mailto:user@domain.com"] ("user@domain.com",""),SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com"] ("user@domain.com",""),Str ".",SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com"] ("user@domain.com",""),Str ".",Space,Str "any",Space,Str "text.",SoftBreak,Str "any",Space,Str "text:",Space,Link ("",[],[]) [Str "mailto:user@domain.com"] ("user@domain.com",""),Str ".",Space,Str "any",Space,Str "text.",SoftBreak,Link ("",[],[]) [Str "label"] ("user@domain.com",""),SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com?subject=bla"] ("user@domain.com?subject=bla",""),SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com?subject=bla"] ("user@domain.com?subject=bla",""),Str ".",SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com?subject=bla"] ("user@domain.com?subject=bla",""),Str ",",SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com?subject=bla&cc=otheruser@domain.com"] ("user@domain.com?subject=bla&cc=otheruser@domain.com",""),SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com?subject=bla&cc=otheruser@domain.com"] ("user@domain.com?subject=bla&cc=otheruser@domain.com",""),Str ".",SoftBreak,Link ("",[],[]) [Str "mailto:user@domain.com?subject=bla&cc=otheruser@domain.com"] ("user@domain.com?subject=bla&cc=otheruser@domain.com",""),Str ",",SoftBreak,Link ("",[],[]) [Str "label"] ("user@domain.com?subject=bla&cc=otheruser@domain.com",""),Str ".",SoftBreak,Link ("",[],[]) [Str "label"] ("user@domain.com?subject=bla&cc=otheruser@domain.com.",""),Str ".",SoftBreak,Link ("",[],[]) [Str "http://www.domain.com"] ("http://www.domain.com",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir/"] ("http://www.domain.com/dir/",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir///"] ("http://www.domain.com/dir///",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com."] ("http://www.domain.com.",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com,"] ("http://www.domain.com,",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com."] ("http://www.domain.com.",""),Space,Str "any",Space,Str "text.",SoftBreak,Link ("",[],[]) [Str "http://www.domain.com,"] ("http://www.domain.com,",""),Space,Str "any",Space,Str "text.",SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir/."] ("http://www.domain.com/dir/.",""),Space,Str "any",Space,Str "text.",SoftBreak,Str "any",Space,Str "text:",Space,Link ("",[],[]) [Str "http://www.domain.com."] ("http://www.domain.com.",""),Space,Str "any",Space,Str "text.",SoftBreak,Str "any",Space,Str "text:",Space,Link ("",[],[]) [Str "http://www.domain.com/dir/."] ("http://www.domain.com/dir/.",""),Space,Str "any",Space,Str "text.",SoftBreak,Str "any",Space,Str "text:",Space,Link ("",[],[]) [Str "http://www.domain.com/dir/index.html."] ("http://www.domain.com/dir/index.html.",""),Space,Str "any",Space,Str "text.",SoftBreak,Str "any",Space,Str "text:",Space,Link ("",[],[]) [Str "http://www.domain.com/dir/index.html,"] ("http://www.domain.com/dir/index.html,",""),Space,Str "any",Space,Str "text.",SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir/#anchor"] ("http://www.domain.com/dir/#anchor",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir/index.html#anchor"] ("http://www.domain.com/dir/index.html#anchor",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir/index.html#anchor."] ("http://www.domain.com/dir/index.html#anchor.",""),SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir/#anchor."] ("http://www.domain.com/dir/#anchor.",""),Space,Str "any",Space,Str "text.",SoftBreak,Link ("",[],[]) [Str "http://www.domain.com/dir/index.html#anchor."] ("http://www.domain.com/dir/index.html#anchor.",""),Space,Str "any",Space,Str "text.",SoftBreak,Str "any",Space,Str "text:",Space,Link ("",[],[]) [Str "http://www.domain.com/dir/#anchor."] ("http://www.domain.com/dir/#anchor.",""),Space,Str "any",Space,Str "text.",SoftBreak,Str "any",Space,Str "text:",Space,Link ("",[],[]) [Str "http://www.domain.com/dir/index.html#anchor."] ("http://www.domain.com/dir/index.html#anchor.",""),Space,Str "any",Space,Str "text.",SoftBreak,Link ("",[],[]) [Str "http://domain.com?a=a@a.a&b=a+b+c."] ("http://domain.com?a=a@a.a&b=a+b+c.",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com?a=a@a.a&b=a+b+c,"] ("http://domain.com?a=a@a.a&b=a+b+c,",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com/bla.cgi?a=a@a.a&b=a+b+c."] ("http://domain.com/bla.cgi?a=a@a.a&b=a+b+c.",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com/bla.cgi?a=a@a.a&b=a+b+c@."] ("http://domain.com/bla.cgi?a=a@a.a&b=a+b+c@.",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com?a=a@a.a&b=a+b+c.#anchor"] ("http://domain.com?a=a@a.a&b=a+b+c.#anchor",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com/bla.cgi?a=a@a.a&b=a+b+c.#anchor"] ("http://domain.com/bla.cgi?a=a@a.a&b=a+b+c.#anchor",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com/bla.cgi?a=a@a.a&b=a+b+c@.#anchor"] ("http://domain.com/bla.cgi?a=a@a.a&b=a+b+c@.#anchor",""),SoftBreak,Link ("",[],[]) [Str "http://user:password@domain.com/bla.html."] ("http://user:password@domain.com/bla.html.",""),SoftBreak,Link ("",[],[]) [Str "http://user:password@domain.com/dir/."] ("http://user:password@domain.com/dir/.",""),SoftBreak,Link ("",[],[]) [Str "http://user:password@domain.com."] ("http://user:password@domain.com.",""),SoftBreak,Link ("",[],[]) [Str "http://user:@domain.com."] ("http://user:@domain.com.",""),SoftBreak,Link ("",[],[]) [Str "http://user@domain.com."] ("http://user@domain.com.",""),SoftBreak,Link ("",[],[]) [Str "http://user:password@domain.com/bla.cgi?a=a@a.a&b=a+b+c.#anchor"] ("http://user:password@domain.com/bla.cgi?a=a@a.a&b=a+b+c.#anchor",""),SoftBreak,Link ("",[],[]) [Str "http://user:password@domain.com/bla.cgi?a=a@a.a&b=a+b+c@#anchor"] ("http://user:password@domain.com/bla.cgi?a=a@a.a&b=a+b+c@#anchor",""),SoftBreak,Link ("",[],[]) [Str "label"] ("www.domain.com",""),SoftBreak,Str "[",Space,Str "label",Space,Link ("",[],[]) [Str "www.domain.com"] ("www.domain.com",""),Str "]",SoftBreak,Link ("",[],[]) [Str "label",Space] ("www.domain.com",""),SoftBreak,Link ("",[],[]) [Str "anchor",Space] ("http://www.domain.com/dir/index.html#anchor.",""),SoftBreak,Link ("",[],[]) [Str "login",Space] ("http://user:password@domain.com/bla.html",""),SoftBreak,Link ("",[],[]) [Str "form",Space] ("http://www.domain.com/bla.cgi?a=a@a.a&b=a+b+c.",""),SoftBreak,Link ("",[],[]) [Str "form",Space,Str "&",Space,Str "anchor"] ("http://www.domain.com/bla.cgi?a=a@a.a&b=a+b+c.#anchor",""),SoftBreak,Link ("",[],[]) [Str "login",Space,Str "&",Space,Str "form",Space] ("http://user:password@domain.com/bla.cgi?a=a@a.a&b=a+b+c.",""),SoftBreak,Link ("",[],[]) [Str "local",Space,Str "link",Space,Str "up",Space] ("..",""),SoftBreak,Link ("",[],[]) [Str "local",Space,Str "link",Space,Str "file",Space] ("bla.html",""),SoftBreak,Link ("",[],[]) [Str "local",Space,Str "link",Space,Str "anchor",Space] ("#anchor",""),SoftBreak,Link ("",[],[]) [Str "local",Space,Str "link",Space,Str "file/anchor"] ("bla.html#anchor",""),SoftBreak,Link ("",[],[]) [Str "local",Space,Str "link",Space,Str "file/anchor"] ("bla.html#anchor.",""),SoftBreak,Link ("",[],[]) [Str "local",Space,Str "link",Space,Str "img",Space] ("abc.gif",""),SoftBreak,Link ("",[],[]) [Str "www.fake.com"] ("www.domain.com",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm"] ("http://domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm?a=/%22&b=+.@*_-"] ("http://domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm?a=/%22&b=+.@*_-",""),SoftBreak,Link ("",[],[]) [Str "http://domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm?a=/%22&b=+.@*_-#anchor_"] ("http://domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm?a=/%22&b=+.@*_-#anchor_",""),Str "-1%.",SoftBreak,Link ("",[],[]) [Str "http://foo._user-9:pass!#$%&*()+word@domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm?a=/%22&b=+.@*_-#anchor_"] ("http://foo._user-9:pass!#$%&*()+word@domain.com:8080/~user/_st-r@a=n$g,e/index%20new.htm?a=/%22&b=+.@*_-#anchor_",""),Str "-1%.",SoftBreak,Link ("",[],[]) [Str "http://L1.com"] ("http://L1.com",""),Space,Str "!",Space,Link ("",[],[]) [Str "mailto:L2@www.com"] ("L2@www.com",""),Space,Str "!",Space,Link ("",[],[]) [Str "L3"] ("www.com",""),Space,Str "!",Space,Link ("",[],[]) [Str "L4"] ("w@ww.com",""),Space,Str "!",Space,Link ("",[],[]) [Str "www.L5.com"] ("www.L5.com",""),SoftBreak,Link ("",[],[]) [Str "www.domain.com"] ("www.domain.com",""),SoftBreak,Link ("",[],[]) [Str "www2.domain.com"] ("www2.domain.com",""),SoftBreak,Link ("",[],[]) [Str "ftp.domain.com"] ("ftp.domain.com",""),SoftBreak,Link ("",[],[]) [Str "WWW.DOMAIN.COM"] ("WWW.DOMAIN.COM",""),SoftBreak,Link ("",[],[]) [Str "FTP.DOMAIN.COM"] ("FTP.DOMAIN.COM",""),SoftBreak,Link ("",[],[]) [Str "label"] ("www.domain.com",""),SoftBreak,Link ("",[],[]) [Str "label"] ("ftp.domain.com",""),SoftBreak,Link ("",[],[]) [Str "label"] ("WWW.DOMAIN.COM",""),SoftBreak,Link ("",[],[]) [Str "label"] ("FTP.DOMAIN.COM",""),SoftBreak,Str "[label",Space,Link ("",[],[]) [Str "www.domain.com"] ("www.domain.com",""),Space,Str "]",SoftBreak,Str "[label]",Space,Link ("",[],[]) [Str "www.domain.com"] ("www.domain.com",""),Str "]"] ,Header 1 ("image",[],[]) [Str "Image"] ,Para [Image ("",[],[]) [] ("img.png","")]-,Para [Link ("",[],[]) [Image ("",[],[]) [] ("img.png","")] ("http://txt2tags.org","")]+,Para [Link ("",[],[]) [Image ("",[],[]) [] ("img.png","")] ("https://txt2tags.org","")] ,Para [Image ("",[],[]) [] ("img.png",""),Space,Str "Image",Space,Str "at",Space,Str "the",Space,Str "line",Space,Str "beginning."] ,Para [Str "Image",Space,Str "in",Space,Str "the",Space,Str "middle",Space,Image ("",[],[]) [] ("img.png",""),Space,Str "of",Space,Str "the",Space,Str "line."] ,Para [Str "Image",Space,Str "at",Space,Str "the",Space,Str "line",Space,Str "end.",Space,Image ("",[],[]) [] ("img.png","")]
test/txt2tags.t2t view
@@ -270,7 +270,7 @@ [img.png] %%% Syntax: Image pointing to a link: [[img] link]-[[img.png] http://txt2tags.org]+[[img.png] https://txt2tags.org] %%% Align: Image position is preserved when inside paragraph [img.png] Image at the line beginning.
test/writer.jats_archiving view
@@ -24,7 +24,7 @@ <string-name>Anonymous</string-name> </contrib> </contrib-group>-<pub-date pub-type="epub" iso-8601-date="2006-07-17">+<pub-date date-type="pub" publication-format="electronic" iso-8601-date="2006-07-17"> <day>17</day> <month>7</month> <year>2006</year>
test/writer.jats_publishing view
@@ -24,7 +24,7 @@ <string-name>Anonymous</string-name> </contrib> </contrib-group>-<pub-date pub-type="epub" iso-8601-date="2006-07-17">+<pub-date date-type="pub" publication-format="electronic" iso-8601-date="2006-07-17"> <day>17</day> <month>7</month> <year>2006</year>
test/writer.jira view
@@ -33,11 +33,10 @@ {quote} Code in a block quote: -{code:java}+{noformat} sub status { print "working";-}-{code}+}{noformat} A list: # item one@@ -56,22 +55,20 @@ h1. {anchor:code-blocks}Code Blocks Code: -{code:java}+{noformat} ---- (should be four hyphens) sub status { print "working"; } -this code block is indented by one tab-{code}+this code block is indented by one tab{noformat} And: -{code:java}+{noformat} this code block is indented by two tabs -These should not be escaped: \$ \\ \> \[ \{-{code}+These should not be escaped: \$ \\ \> \[ \{{noformat} ---- h1. {anchor:lists}Lists h2. {anchor:unordered}Unordered@@ -236,9 +233,8 @@ contains seeds, crisp, pleasant to taste * *_orange_* orange fruit-{code:java}-{ orange code block }-{code}+{noformat}+{ orange code block }{noformat} bq. orange block quote Multiple definitions, tight:@@ -292,16 +288,14 @@ This should be a code block, though: -{code:java}+{noformat} <div> foo-</div>-{code}+</div>{noformat} As should this: -{code:java}-<div>foo</div>-{code}+{noformat}+<div>foo</div>{noformat} Now, nested: foo@@ -312,16 +306,14 @@ Code block: -{code:java}-<!-- Comment -->-{code}+{noformat}+<!-- Comment -->{noformat} Just plain comment, with trailing spaces on the line: Code: -{code:java}-<hr />-{code}+{noformat}+<hr />{noformat} Hr’s: ----@@ -478,9 +470,8 @@ This should \[not\]\[\] be a link. -{code:java}-[not]: /url-{code}+{noformat}+[not]: /url{noformat} Foo [bar|/url/]. Foo [biz|/url/].@@ -506,9 +497,8 @@ bq. Blockquoted: [http://example.com/] Auto-links should not occur here: {{<http://example.com/>}} -{code:java}-or here: <http://example.com/>-{code}+{noformat}+or here: <http://example.com/>{noformat} ---- h1. {anchor:images}Images From "Voyage dans la Lune" by Georges Melies \(1902):@@ -534,9 +524,8 @@ Subsequent blocks are indented to show that they belong to the footnote \(as with list items). -{code:java}- { <code> }-{code}+{noformat}+ { <code> }{noformat} If you want, you can indent every line, but you can also be lazy and just indent the first line of each block.
test/writer.latex view
@@ -6,8 +6,8 @@ ]{article} \usepackage{amsmath,amssymb} \usepackage{lmodern}-\usepackage{ifxetex,ifluatex}-\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex+\usepackage{iftex}+\ifPDFTeX \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage{textcomp} % provide euro and other symbols@@ -63,7 +63,7 @@ \providecommand{\tightlist}{% \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} \setcounter{secnumdepth}{-\maxdimen} % remove section numbering-\ifluatex+\ifLuaTeX \usepackage{selnolig} % disable illegal ligatures \fi
test/writers-lang-and-dir.latex view
@@ -7,8 +7,8 @@ ]{article} \usepackage{amsmath,amssymb} \usepackage{lmodern}-\usepackage{ifxetex,ifluatex}-\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex+\usepackage{iftex}+\ifPDFTeX \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage{textcomp} % provide euro and other symbols@@ -45,7 +45,7 @@ \providecommand{\tightlist}{% \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} \setcounter{secnumdepth}{-\maxdimen} % remove section numbering-\ifxetex+\ifXeTeX % Load polyglossia as late as possible: uses bidi with RTL langages (e.g. Hebrew, Arabic) \usepackage{polyglossia} \setmainlanguage[]{english}@@ -69,14 +69,14 @@ \newcommand{\textfrench}[2][]{\foreignlanguage{french}{#2}} \newenvironment{french}[2][]{\begin{otherlanguage}{french}}{\end{otherlanguage}} \fi-\ifluatex+\ifLuaTeX \usepackage{selnolig} % disable illegal ligatures \fi-\ifxetex+\ifXeTeX % Load bidi as late as possible as it modifies e.g. graphicx \usepackage{bidi} \fi-\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex+\ifPDFTeX \TeXXeTstate=1 \newcommand{\RL}[1]{\beginR #1\endR} \newcommand{\LR}[1]{\beginL #1\endL}
trypandoc/index.html view
@@ -14,7 +14,7 @@ <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha384-Tc5IQib027qvyjSMfHjOMaLkfuWVxZxUPnCJA7l2mCWNIpG9mGCD8wGNIcPD7Txa" crossorigin="anonymous"></script> <script> "use strict";-(function($) { // http://stackoverflow.com/questions/901115/how-can-i-get-query-string-values+(function($) { // https://stackoverflow.com/questions/901115/how-can-i-get-query-string-values $.QueryString = (function(a) { if (a == "") return {}; var b = {};
trypandoc/trypandoc.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Main@@ -12,26 +11,22 @@ Provides a webservice which allows to try pandoc in the browser. -} module Main where-import Prelude import Network.Wai.Handler.CGI+import Network.Wai.Middleware.Timeout (timeout) import Network.Wai-import Control.Applicative ((<$>)) import Data.Maybe (fromMaybe) import Network.HTTP.Types.Status (status200) import Network.HTTP.Types.Header (hContentType) import Network.HTTP.Types.URI (queryToQueryText) import Text.Pandoc-import Text.Pandoc.Writers.Math (defaultMathJaxURL) import Text.Pandoc.Highlighting (pygments)-import Text.Pandoc.Readers (getReader, Reader(..))-import Text.Pandoc.Writers (getWriter, Writer(..)) import Text.Pandoc.Shared (tabFilter) import Data.Aeson import qualified Data.Text as T import Data.Text (Text) main :: IO ()-main = run app+main = run $ timeout 2 app app :: Application app req respond = do