diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Readers/Org/DocumentTree.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 29 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/OpenDocument.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 22 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 5 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Shared.hs | 62 |
6 files changed, 68 insertions, 65 deletions
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 |