From 2936967fa19e77581456189503500de4cfe502b3 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 14 May 2018 11:10:36 -0700 Subject: Docx writer: be sensitive to `toc` in YAML metadata. Closes #4645. --- src/Text/Pandoc/Writers/Docx.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 1666c0562..4f7c51a22 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -727,7 +727,7 @@ getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element] -makeTOC opts | writerTableOfContents opts = do +makeTOC opts = do let depth = "1-"++show (writerTOCDepth opts) let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u" tocTitle <- gets stTocTitle @@ -751,8 +751,6 @@ makeTOC opts | writerTableOfContents opts = do ) -- w:p ]) ])] -- w:sdt -makeTOC _ = return [] - -- | Convert Pandoc document to two lists of -- OpenXML elements (the main document and footnotes). @@ -770,6 +768,13 @@ writeOpenXML opts (Pandoc meta blocks) = do Just (MetaBlocks [Para xs]) -> xs Just (MetaInlines xs) -> xs _ -> [] + let includeTOC = writerTableOfContents opts || + case lookupMeta "toc" meta of + Just (MetaBlocks _) -> True + Just (MetaInlines _) -> True + Just (MetaString (_:_)) -> True + Just (MetaBool True) -> True + _ -> False title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)] subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')] authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $ @@ -801,7 +806,9 @@ writeOpenXML opts (Pandoc meta blocks) = do ] ++ annotation ] comments' <- mapM toComment comments - toc <- makeTOC opts + toc <- if includeTOC + then makeTOC opts + else return [] let meta' = title ++ subtitle ++ authors ++ date ++ abstract ++ toc return (meta' ++ doc', notes', comments') -- cgit v1.2.3 From f6dfb632ff38cc9dd5156297959ce8028fd766ea Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Mon, 2 Jul 2018 18:30:37 +0300 Subject: Spellcheck comments --- src/Text/Pandoc/Class.hs | 4 ++-- src/Text/Pandoc/Lua/Init.hs | 2 +- src/Text/Pandoc/Parsing.hs | 2 +- src/Text/Pandoc/Readers/Creole.hs | 2 +- src/Text/Pandoc/Readers/Docx/Parse.hs | 2 +- src/Text/Pandoc/Readers/EPUB.hs | 2 +- src/Text/Pandoc/Readers/HTML.hs | 4 ++-- src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs | 4 ++-- src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs | 2 +- src/Text/Pandoc/Readers/Odt/Generic/Utils.hs | 4 ++-- src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs | 2 +- src/Text/Pandoc/Readers/Odt/StyleReader.hs | 2 +- src/Text/Pandoc/Readers/Org/Blocks.hs | 2 +- src/Text/Pandoc/Readers/Org/Inlines.hs | 2 +- src/Text/Pandoc/Readers/Textile.hs | 2 +- src/Text/Pandoc/Readers/TikiWiki.hs | 2 +- src/Text/Pandoc/Readers/Txt2Tags.hs | 2 +- src/Text/Pandoc/Shared.hs | 2 +- src/Text/Pandoc/Writers/Docx.hs | 2 +- src/Text/Pandoc/Writers/ICML.hs | 2 +- src/Text/Pandoc/Writers/Org.hs | 2 +- src/Text/Pandoc/Writers/RST.hs | 2 +- 22 files changed, 26 insertions(+), 26 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 657a48d75..e47546dfc 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -882,10 +882,10 @@ adjustImagePath _ _ x = x -- of things that would normally be obtained through IO. data PureState = PureState { stStdGen :: StdGen , stWord8Store :: [Word8] -- should be - -- inifinite, + -- infinite, -- i.e. [1..] , stUniqStore :: [Int] -- should be - -- inifinite and + -- infinite and -- contain every -- element at most -- once, e.g. [1..] diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index c8c7fdfbd..15f90664e 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -55,7 +55,7 @@ import qualified Foreign.Lua.Module.Text as Lua import qualified Text.Pandoc.Definition as Pandoc -- | Run the lua interpreter, using pandoc's default way of environment --- initalization. +-- initialization. runPandocLua :: Lua a -> PandocIO (Either LuaException a) runPandocLua luaOp = do luaPkgParams <- luaPackageParams diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 05f4f7d36..79022d6f1 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -1289,7 +1289,7 @@ type SubstTable = M.Map Key Inlines -- unique identifier, and update the list of identifiers -- in state. Issue a warning if an explicit identifier -- is encountered that duplicates an earlier identifier --- (explict or automatically generated). +-- (explicit or automatically generated). registerHeader :: (Stream s m a, HasReaderOptions st, HasHeaderMap st, HasLogMessages st, HasIdentifierList st) => Attr -> Inlines -> ParserT s st m Attr diff --git a/src/Text/Pandoc/Readers/Creole.hs b/src/Text/Pandoc/Readers/Creole.hs index 4fd38c0fd..a337bf937 100644 --- a/src/Text/Pandoc/Readers/Creole.hs +++ b/src/Text/Pandoc/Readers/Creole.hs @@ -2,7 +2,7 @@ {- Copyright (C) 2017 Sascha Wilde - partly based on all the other readers, especialy the work by + partly based on all the other readers, especially the work by John MacFarlane and Alexander Sulfrian all bugs are solely created by me. diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 4c4c06073..99f50ba97 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -785,7 +785,7 @@ So we do this in a number of steps. If we encounter the fldchar begin tag, we start open a fldchar state variable (see state above). We add the instrtext to it as FieldInfo. Then we close that and start adding the runs when we get to separate. Then when we get to end, we produce -the Field type with approriate FieldInfo and Runs. +the Field type with appropriate FieldInfo and Runs. -} elemToParPart ns element | isElem ns "w" "r" element diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index c26447641..bfc3fc3ee 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -73,7 +73,7 @@ readEPUB opts bytes = case toArchiveOrFail bytes of -- runEPUB :: Except PandocError a -> Either PandocError a -- runEPUB = runExcept --- Note that internal reference are aggresively normalised so that all ids +-- Note that internal reference are aggressively normalised so that all ids -- are of the form "filename#id" -- archiveToEPUB :: (PandocMonad m) => ReaderOptions -> Archive -> m Pandoc diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 32a1ba5a6..df8dc1a2d 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -852,7 +852,7 @@ pInTags' tagtype tagtest parser = try $ do pSatisfy (\t -> t ~== TagOpen tagtype [] && tagtest t) mconcat <$> manyTill parser (pCloses tagtype <|> eof) --- parses p, preceeded by an optional opening tag +-- parses p, preceded by an optional opening tag -- and followed by an optional closing tags pOptInTag :: PandocMonad m => Text -> TagParser m a -> TagParser m a pOptInTag tagtype p = try $ do @@ -1281,7 +1281,7 @@ instance HasLastStrPosition HTMLState where setLastStrPos s st = st {parserState = setLastStrPos s (parserState st)} getLastStrPos = getLastStrPos . parserState --- For now we need a special verison here; the one in Shared has String type +-- For now we need a special version here; the one in Shared has String type renderTags' :: [Tag Text] -> Text renderTags' = renderTagsOptions renderOptions{ optMinimize = matchTags ["hr", "br", "img", diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs index d3db3a9e2..9e8221248 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs @@ -100,7 +100,7 @@ liftA fun a = a >>^ fun -- | Duplicate a value to subsequently feed it into different arrows. -- Can almost always be replaced with '(&&&)', 'keepingTheValue', -- or even '(|||)'. --- Aequivalent to +-- Equivalent to -- > returnA &&& returnA duplicate :: (Arrow a) => a b (b,b) duplicate = arr $ join (,) @@ -114,7 +114,7 @@ infixr 2 >>% -- | Duplicate a value and apply an arrow to the second instance. --- Aequivalent to +-- Equivalent to -- > \a -> duplicate >>> second a -- or -- > \a -> returnA &&& a diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs b/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs index 6d96897aa..e76bbf5cf 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Namespaces.hs @@ -50,7 +50,7 @@ class (Eq nsID, Ord nsID) => NameSpaceID nsID where getNamespaceID :: NameSpaceIRI -> NameSpaceIRIs nsID -> Maybe (NameSpaceIRIs nsID, nsID) - -- | Given a namespace id, lookup its IRI. May be overriden for performance. + -- | Given a namespace id, lookup its IRI. May be overridden for performance. getIRI :: nsID -> NameSpaceIRIs nsID -> Maybe NameSpaceIRI diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs index 616d9290b..722c30a33 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs @@ -61,7 +61,7 @@ import qualified Data.Foldable as F (Foldable, foldr) import Data.Maybe --- | Aequivalent to +-- | Equivalent to -- > foldr (.) id -- where '(.)' are 'id' are the ones from "Control.Category" -- and 'foldr' is the one from "Data.Foldable". @@ -72,7 +72,7 @@ import Data.Maybe composition :: (Category cat, F.Foldable f) => f (cat a a) -> cat a a composition = F.foldr (<<<) Cat.id --- | Aequivalent to +-- | Equivalent to -- > foldr (flip (.)) id -- where '(.)' are 'id' are the ones from "Control.Category" -- and 'foldr' is the one from "Data.Foldable". diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index 81392e16b..2327ea908 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -261,7 +261,7 @@ convertingExtraState v a = withSubStateF setVAsExtraState modifyWithA -- The resulting converter even behaves like an identity converter on the -- value level. -- --- Aequivalent to +-- Equivalent to -- -- > \v x a -> convertingExtraState v (returnV x >>> a) -- diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index e0444559b..fa5c2d142 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -342,7 +342,7 @@ instance Read XslUnit where readsPrec _ _ = [] -- | Rough conversion of measures into millimetres. --- Pixels and em's are actually implementation dependant/relative measures, +-- Pixels and em's are actually implementation dependent/relative measures, -- so I could not really easily calculate anything exact here even if I wanted. -- But I do not care about exactness right now, as I only use measures -- to determine if a paragraph is "indented" or not. diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 888cd9307..d2a749efb 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -743,7 +743,7 @@ latexEnd envName = try $ -- --- Footnote defintions +-- Footnote definitions -- noteBlock :: PandocMonad m => OrgParser m (F Blocks) noteBlock = try $ do diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs index 7d1568b80..b7378e3e4 100644 --- a/src/Text/Pandoc/Readers/Org/Inlines.hs +++ b/src/Text/Pandoc/Readers/Org/Inlines.hs @@ -510,7 +510,7 @@ anchor = try $ do <* string ">>" <* skipSpaces --- | Replace every char but [a-zA-Z0-9_.-:] with a hypen '-'. This mirrors +-- | Replace every char but [a-zA-Z0-9_.-:] with a hyphen '-'. This mirrors -- the org function @org-export-solidify-link-text@. solidify :: String -> String diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index bc3bcaf26..4b65be347 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -540,7 +540,7 @@ wordChunk = try $ do str :: PandocMonad m => ParserT [Char] ParserState m Inlines str = do baseStr <- hyphenedWords - -- RedCloth compliance : if parsed word is uppercase and immediatly + -- RedCloth compliance : if parsed word is uppercase and immediately -- followed by parens, parens content is unconditionally word acronym fullStr <- option baseStr $ try $ do guard $ all isUpper baseStr diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs index 333144c56..8458b05e5 100644 --- a/src/Text/Pandoc/Readers/TikiWiki.hs +++ b/src/Text/Pandoc/Readers/TikiWiki.hs @@ -167,7 +167,7 @@ table = try $ do -- return $ B.simpleTable (headers rows) $ trace ("rows: " ++ (show rows)) rows return $B.simpleTable (headers rows) rows where - -- The headers are as many empty srings as the number of columns + -- The headers are as many empty strings as the number of columns -- in the first row headers rows = map (B.plain . B.str) $replicate (length $ head rows) "" diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index bed49fd46..525e675bf 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -198,7 +198,7 @@ para = try $ do commentBlock :: T2T Blocks commentBlock = try (blockMarkupArea anyLine (const mempty) "%%%") <|> comment --- Seperator and Strong line treated the same +-- Separator and Strong line treated the same hrule :: T2T Blocks hrule = try $ do spaces diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 26b01bc90..5b011c46a 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -712,7 +712,7 @@ schemes = Set.fromList , "ws", "wss", "wtai", "wyciwyg", "xcon", "xcon-userid", "xfire" , "xmlrpc.beep", "xmlrpc.beeps", "xmpp", "xri", "ymsgr", "z39.50", "z39.50r" , "z39.50s" - -- Inofficial schemes + -- Unofficial schemes , "doi", "isbn", "javascript", "pmid" ] diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 4f7c51a22..380374bd6 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -230,7 +230,7 @@ writeDocx opts doc@(Pandoc meta _) = do let mbAttrMarLeft = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="left") . qName) let mbAttrMarRight = (elAttribs <$> mbpgmar) >>= lookupAttrBy ((=="right") . qName) - -- Get the avaible area (converting the size and the margins to int and + -- Get the available area (converting the size and the margins to int and -- doing the difference let pgContentWidth = (-) <$> (read <$> mbAttrSzWidth ::Maybe Integer) <*> ( diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 266d58007..b8fc0dc94 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -153,7 +153,7 @@ writeICML opts (Pandoc meta blocks) = do Nothing -> return main Just tpl -> renderTemplate' tpl context --- | Auxilary functions for parStylesToDoc and charStylesToDoc. +-- | Auxiliary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] contains s rule = [snd rule | (fst rule) `isInfixOf` s] diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index a71775e13..1dd825b79 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -266,7 +266,7 @@ orderedListItemToOrg marker items = do contents <- blockListToOrg items return $ hang (length marker + 1) (text marker <> space) (contents <> cr) --- | Convert defintion list item (label, list of blocks) to Org. +-- | Convert definition list item (label, list of blocks) to Org. definitionListItemToOrg :: PandocMonad m => ([Inline], [[Block]]) -> Org m Doc definitionListItemToOrg (label, defs) = do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index a2f2739a0..817fb665d 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -333,7 +333,7 @@ orderedListItemToRST marker items = do let marker' = marker ++ " " return $ hang (length marker') (text marker') $ contents <> cr --- | Convert defintion list item (label, list of blocks) to RST. +-- | Convert definition list item (label, list of blocks) to RST. definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m Doc definitionListItemToRST (label, defs) = do label' <- inlineListToRST label -- cgit v1.2.3 From 4ec02053bba3f280b63267c90f2faeafe74d5c64 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 17 Aug 2018 21:25:14 -0700 Subject: Docx writer: properly handle display math in spans. Closes #4826. This isn't a complete solution, since other nestings of display math may still cause problems, but it should work for what is by far the most common case. Note that this also involves an API change: `isDisplayMath` is now exported from Text.Pandoc.Writers.Shared. --- src/Text/Pandoc/Writers/Docx.hs | 10 ++++++---- src/Text/Pandoc/Writers/Shared.hs | 6 ++++-- 2 files changed, 10 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 380374bd6..2055ee1da 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -66,7 +66,8 @@ import Text.Pandoc.Readers.Docx.StyleMap import Text.Pandoc.Shared hiding (Element) import Text.Pandoc.Walk import Text.Pandoc.Writers.Math -import Text.Pandoc.Writers.Shared (fixDisplayMath, metaValueToInlines) +import Text.Pandoc.Writers.Shared (isDisplayMath, fixDisplayMath, + metaValueToInlines) import Text.Printf (printf) import Text.TeXMath import Text.XML.Light as XML @@ -915,9 +916,10 @@ blockToOpenXML' opts (Para lst) | null lst && not (isEnabled Ext_empty_paragraphs opts) = return [] | otherwise = do isFirstPara <- gets stFirstPara - paraProps <- getParaProps $ case lst of - [Math DisplayMath _] -> True - _ -> False + let displayMathPara = case lst of + [x] -> isDisplayMath x + _ -> False + paraProps <- getParaProps displayMathPara bodyTextStyle <- pStyleM "Body Text" let paraProps' = case paraProps of [] | isFirstPara -> [mknode "w:pPr" [] diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 2edce7deb..438a35ca4 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -38,6 +38,7 @@ module Text.Pandoc.Writers.Shared ( , resetField , defField , tagWithAttrs + , isDisplayMath , fixDisplayMath , unsmartify , gridTable @@ -187,8 +188,9 @@ tagWithAttrs tag (ident,classes,kvs) = hsep ] <> ">" isDisplayMath :: Inline -> Bool -isDisplayMath (Math DisplayMath _) = True -isDisplayMath _ = False +isDisplayMath (Math DisplayMath _) = True +isDisplayMath (Span _ [Math DisplayMath _]) = True +isDisplayMath _ = False stripLeadingTrailingSpace :: [Inline] -> [Inline] stripLeadingTrailingSpace = go . reverse . go . reverse -- cgit v1.2.3 From f736dea4ba71f81b37ff28a218115871249b35ec Mon Sep 17 00:00:00 2001 From: Mauro Bieg Date: Sat, 15 Sep 2018 20:55:23 +0200 Subject: Docx writer: add MetaString case for abstract, subtitle (#4905) fixes #4900 --- src/Text/Pandoc/Writers/Docx.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 2055ee1da..5bd7e809b 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -763,11 +763,13 @@ writeOpenXML opts (Pandoc meta blocks) = do let abstract' = case lookupMeta "abstract" meta of Just (MetaBlocks bs) -> bs Just (MetaInlines ils) -> [Plain ils] + Just (MetaString s) -> [Plain [Str s]] _ -> [] let subtitle' = case lookupMeta "subtitle" meta of Just (MetaBlocks [Plain xs]) -> xs Just (MetaBlocks [Para xs]) -> xs Just (MetaInlines xs) -> xs + Just (MetaString s) -> [Str s] _ -> [] let includeTOC = writerTableOfContents opts || case lookupMeta "toc" meta of -- cgit v1.2.3 From 600034d7ff83b7ece292016a1e9c232fd7ac66f7 Mon Sep 17 00:00:00 2001 From: Mauro Bieg Date: Thu, 4 Oct 2018 18:45:59 +0200 Subject: Add lookupMeta* functions to Text.Pandoc.Writers.Shared (#4907) Remove exported functions `metaValueToInlines`, `metaValueToString`. Add new exported functions `lookupMetaBool`, `lookupMetaBlocks`, `lookupMetaInlines`, `lookupMetaString`. Use these whenever possible for uniformity in writers. API change (major, because of removed function `metaValueToInlines`. `metaValueToString` wasn't in any released version.) --- src/Text/Pandoc/Readers/Org/DocumentTree.hs | 9 +--- src/Text/Pandoc/Writers/Docx.hs | 29 +++------- src/Text/Pandoc/Writers/OpenDocument.hs | 6 ++- src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 22 +++----- src/Text/Pandoc/Writers/RST.hs | 5 +- src/Text/Pandoc/Writers/Shared.hs | 62 ++++++++++++++++------ 6 files changed, 68 insertions(+), 65 deletions(-) (limited to 'src/Text/Pandoc/Writers/Docx.hs') diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs index c7a5f22c4..a9df3b437 100644 --- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs +++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs @@ -43,7 +43,6 @@ import Text.Pandoc.Readers.Org.BlockStarts import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing -import qualified Data.Map as Map import qualified Text.Pandoc.Builder as B -- @@ -58,7 +57,7 @@ documentTree :: PandocMonad m documentTree blocks inline = do initialBlocks <- blocks headlines <- sequence <$> manyTill (headline blocks inline 1) eof - title <- fmap (getTitle . unMeta) . orgStateMeta <$> getState + title <- fmap docTitle . orgStateMeta <$> getState return $ do headlines' <- headlines initialBlocks' <- initialBlocks @@ -73,12 +72,6 @@ documentTree blocks inline = do , headlineContents = initialBlocks' , headlineChildren = headlines' } - where - getTitle :: Map.Map String MetaValue -> [Inline] - getTitle metamap = - case Map.lookup "title" metamap of - Just (MetaInlines inlns) -> inlns - _ -> [] newtype Tag = Tag { fromTag :: String } deriving (Show, Eq) diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 5bd7e809b..524d20fd1 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -66,8 +66,7 @@ import Text.Pandoc.Readers.Docx.StyleMap import Text.Pandoc.Shared hiding (Element) import Text.Pandoc.Walk import Text.Pandoc.Writers.Math -import Text.Pandoc.Writers.Shared (isDisplayMath, fixDisplayMath, - metaValueToInlines) +import Text.Pandoc.Writers.Shared import Text.Printf (printf) import Text.TeXMath import Text.XML.Light as XML @@ -267,8 +266,9 @@ writeDocx opts doc@(Pandoc meta _) = do -- parse styledoc for heading styles let styleMaps = getStyleMaps styledoc - let tocTitle = fromMaybe (stTocTitle defaultWriterState) $ - metaValueToInlines <$> lookupMeta "toc-title" meta + let tocTitle = case lookupMetaInlines "toc-title" meta of + [] -> stTocTitle defaultWriterState + ls -> ls let initialSt = defaultWriterState { stStyleMaps = styleMaps @@ -760,24 +760,9 @@ writeOpenXML opts (Pandoc meta blocks) = do let tit = docTitle meta let auths = docAuthors meta let dat = docDate meta - let abstract' = case lookupMeta "abstract" meta of - Just (MetaBlocks bs) -> bs - Just (MetaInlines ils) -> [Plain ils] - Just (MetaString s) -> [Plain [Str s]] - _ -> [] - let subtitle' = case lookupMeta "subtitle" meta of - Just (MetaBlocks [Plain xs]) -> xs - Just (MetaBlocks [Para xs]) -> xs - Just (MetaInlines xs) -> xs - Just (MetaString s) -> [Str s] - _ -> [] - let includeTOC = writerTableOfContents opts || - case lookupMeta "toc" meta of - Just (MetaBlocks _) -> True - Just (MetaInlines _) -> True - Just (MetaString (_:_)) -> True - Just (MetaBool True) -> True - _ -> False + let abstract' = lookupMetaBlocks "abstract" meta + let subtitle' = lookupMetaInlines "subtitle" meta + let includeTOC = writerTableOfContents opts || lookupMetaBool "toc" meta title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)] subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')] authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $ diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index e3d7f2e5c..676a1acb0 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -226,8 +226,10 @@ handleSpaces s -- | Convert Pandoc document to string in OpenDocument format. writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeOpenDocument opts (Pandoc meta blocks) = do - lang <- fromMaybe (Lang "en" "US" "" []) <$> - toLang (metaValueToString <$> lookupMeta "lang" meta) + let defLang = Lang "en" "US" "" [] + lang <- case lookupMetaString "lang" meta of + "" -> pure defLang + s -> fromMaybe defLang <$> toLang (Just s) setTranslations lang let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index e14476b16..c97d8d770 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -72,7 +72,7 @@ import Text.Pandoc.Logging import Text.Pandoc.Walk import Data.Time (UTCTime) import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element" -import Text.Pandoc.Writers.Shared (metaValueToInlines) +import Text.Pandoc.Writers.Shared (lookupMetaInlines) import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe (maybeToList, fromMaybe) @@ -731,9 +731,9 @@ makeEndNotesSlideBlocks = do anchorSet <- M.keysSet <$> gets stAnchorMap if M.null noteIds then return [] - else let title = case lookupMeta "notes-title" meta of - Just val -> metaValueToInlines val - Nothing -> [Str "Notes"] + else let title = case lookupMetaInlines "notes-title" meta of + [] -> [Str "Notes"] + ls -> ls ident = Shared.uniqueIdent title anchorSet hdr = Header slideLevel (ident, [], []) title blks = concatMap (\(n, bs) -> makeNoteEntry n bs) $ @@ -744,13 +744,7 @@ getMetaSlide :: Pres (Maybe Slide) getMetaSlide = do meta <- asks envMetadata title <- inlinesToParElems $ docTitle meta - subtitle <- inlinesToParElems $ - case lookupMeta "subtitle" meta of - Just (MetaString s) -> [Str s] - Just (MetaInlines ils) -> ils - Just (MetaBlocks [Plain ils]) -> ils - Just (MetaBlocks [Para ils]) -> ils - _ -> [] + subtitle <- inlinesToParElems $ lookupMetaInlines "subtitle" meta authors <- mapM inlinesToParElems $ docAuthors meta date <- inlinesToParElems $ docDate meta if null title && null subtitle && null authors && null date @@ -785,9 +779,9 @@ makeTOCSlide blks = local (\env -> env{envCurSlideId = tocSlideId}) $ do contents <- BulletList <$> mapM elementToListItem (Shared.hierarchicalize blks) meta <- asks envMetadata slideLevel <- asks envSlideLevel - let tocTitle = case lookupMeta "toc-title" meta of - Just val -> metaValueToInlines val - Nothing -> [Str "Table of Contents"] + let tocTitle = case lookupMetaInlines "toc-title" meta of + [] -> [Str "Table of Contents"] + ls -> ls hdr = Header slideLevel nullAttr tocTitle blocksToSlide [hdr, contents] diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index b416eca59..34d5cce04 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -82,10 +82,7 @@ pandocToRST (Pandoc meta blocks) = do else Nothing let render' :: Doc -> Text render' = render colwidth - let subtit = case lookupMeta "subtitle" meta of - Just (MetaBlocks [Plain xs]) -> xs - Just (MetaInlines xs) -> xs - _ -> [] + let subtit = lookupMetaInlines "subtitle" meta title <- titleToRST (docTitle meta) subtit metadata <- metaToJSON opts (fmap render' . blockListToRST) diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 6113b0a66..323748aad 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -42,8 +42,10 @@ module Text.Pandoc.Writers.Shared ( , fixDisplayMath , unsmartify , gridTable - , metaValueToInlines - , metaValueToString + , lookupMetaBool + , lookupMetaBlocks + , lookupMetaInlines + , lookupMetaString , stripLeadingTrailingSpace , groffEscape ) @@ -63,7 +65,6 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Pretty import Text.Pandoc.Shared (stringify) -import Text.Pandoc.Walk (query) import Text.Pandoc.UTF8 (toStringLazy) import Text.Pandoc.XML (escapeStringForXML) import Text.Printf (printf) @@ -339,19 +340,50 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do body $$ border '-' (repeat AlignDefault) widthsInChars -metaValueToInlines :: MetaValue -> [Inline] -metaValueToInlines (MetaString s) = [Str s] -metaValueToInlines (MetaInlines ils) = ils -metaValueToInlines (MetaBlocks bs) = query return bs -metaValueToInlines (MetaBool b) = [Str $ show b] -metaValueToInlines _ = [] -metaValueToString :: MetaValue -> String -metaValueToString (MetaString s) = s -metaValueToString (MetaInlines ils) = stringify ils -metaValueToString (MetaBlocks bs) = stringify bs -metaValueToString (MetaBool b) = show b -metaValueToString _ = "" + +-- | Retrieve the metadata value for a given @key@ +-- and convert to Bool. +lookupMetaBool :: String -> Meta -> Bool +lookupMetaBool key meta = + case lookupMeta key meta of + Just (MetaBlocks _) -> True + Just (MetaInlines _) -> True + Just (MetaString (_:_)) -> True + Just (MetaBool True) -> True + _ -> False + +-- | Retrieve the metadata value for a given @key@ +-- and extract blocks. +lookupMetaBlocks :: String -> Meta -> [Block] +lookupMetaBlocks key meta = + case lookupMeta key meta of + Just (MetaBlocks bs) -> bs + Just (MetaInlines ils) -> [Plain ils] + Just (MetaString s) -> [Plain [Str s]] + _ -> [] + +-- | Retrieve the metadata value for a given @key@ +-- and extract inlines. +lookupMetaInlines :: String -> Meta -> [Inline] +lookupMetaInlines key meta = + case lookupMeta key meta of + Just (MetaString s) -> [Str s] + Just (MetaInlines ils) -> ils + Just (MetaBlocks [Plain ils]) -> ils + Just (MetaBlocks [Para ils]) -> ils + _ -> [] + +-- | Retrieve the metadata value for a given @key@ +-- and convert to String. +lookupMetaString :: String -> Meta -> String +lookupMetaString key meta = + case lookupMeta key meta of + Just (MetaString s) -> s + Just (MetaInlines ils) -> stringify ils + Just (MetaBlocks bs) -> stringify bs + Just (MetaBool b) -> show b + _ -> "" -- | Escape non-ASCII characters using groff \u[..] sequences. groffEscape :: T.Text -> T.Text -- cgit v1.2.3