aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorMauro Bieg <mb21@users.noreply.github.com>2018-10-04 18:45:59 +0200
committerJohn MacFarlane <jgm@berkeley.edu>2018-10-04 09:45:59 -0700
commit600034d7ff83b7ece292016a1e9c232fd7ac66f7 (patch)
treeb6bc7300dd12a61ae32f664a2e38167c2552b2a0 /src/Text
parent1a6e6a3a032b70eddc945eafd67599cc071b0f6a (diff)
downloadpandoc-600034d7ff83b7ece292016a1e9c232fd7ac66f7.tar.gz
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.)
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Org/DocumentTree.hs9
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs29
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs6
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs22
-rw-r--r--src/Text/Pandoc/Writers/RST.hs5
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs62
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