600034d · typeable/pandoc

git.iko.soy/typeable/pandoc

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.)

commit600034d7ff83b7ece292016a1e9c232fd7ac66f7 authorMauro Bieg <mb21@users.noreply.github.com> dateThu 4 Oct 2018, 18:45 (8 years ago) parent1a6e6a3

6 files changed+68−65

compare with master

unifiedsplit

src/Text/Pandoc/Readers/Org/DocumentTree.hs+1−8 src/Text/Pandoc/Writers/Docx.hs+7−22 src/Text/Pandoc/Writers/OpenDocument.hs+4−2 src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+8−14 src/Text/Pandoc/Writers/RST.hs+1−4 src/Text/Pandoc/Writers/Shared.hs+47−15

src/Text/Pandoc/Readers/Org/DocumentTree.hs+1−8

@@ -43,7 +43,6 @@ import Text.Pandoc.Readers.Org.BlockStarts

4343import Text.Pandoc.Readers.Org.ParserState

4444import Text.Pandoc.Readers.Org.Parsing

4545

46−import qualified Data.Map as Map

4746import qualified Text.Pandoc.Builder as B

4847

4948--

@@ -58,7 +57,7 @@ documentTree :: PandocMonad m

5857documentTree blocks inline = do

5958 initialBlocks <- blocks

6059 headlines <- sequence <$> manyTill (headline blocks inline 1) eof

61− title <- fmap (getTitle . unMeta) . orgStateMeta <$> getState

60+ title <- fmap docTitle . orgStateMeta <$> getState

6261 return $ do

6362 headlines' <- headlines

6463 initialBlocks' <- initialBlocks

@@ -73,12 +72,6 @@ documentTree blocks inline = do

7372 , headlineContents = initialBlocks'

7473 , headlineChildren = headlines'

7574 }

76− where

77− getTitle :: Map.Map String MetaValue -> [Inline]

78− getTitle metamap =

79− case Map.lookup "title" metamap of

80− Just (MetaInlines inlns) -> inlns

81− _ -> []

8275

8376newtype Tag = Tag { fromTag :: String }

8477 deriving (Show, Eq)

src/Text/Pandoc/Writers/Docx.hs+7−22

@@ -66,8 +66,7 @@ import Text.Pandoc.Readers.Docx.StyleMap

6666import Text.Pandoc.Shared hiding (Element)

6767import Text.Pandoc.Walk

6868import Text.Pandoc.Writers.Math

69−import Text.Pandoc.Writers.Shared (isDisplayMath, fixDisplayMath,

70− metaValueToInlines)

69+import Text.Pandoc.Writers.Shared

7170import Text.Printf (printf)

7271import Text.TeXMath

7372import Text.XML.Light as XML

@@ -267,8 +266,9 @@ writeDocx opts doc@(Pandoc meta _) = do

267266 -- parse styledoc for heading styles

268267 let styleMaps = getStyleMaps styledoc

269268

270− let tocTitle = fromMaybe (stTocTitle defaultWriterState) $

271− metaValueToInlines <$> lookupMeta "toc-title" meta

269+ let tocTitle = case lookupMetaInlines "toc-title" meta of

270+ [] -> stTocTitle defaultWriterState

271+ ls -> ls

272272

273273 let initialSt = defaultWriterState {

274274 stStyleMaps = styleMaps

@@ -760,24 +760,9 @@ writeOpenXML opts (Pandoc meta blocks) = do

760760 let tit = docTitle meta

761761 let auths = docAuthors meta

762762 let dat = docDate meta

763− let abstract' = case lookupMeta "abstract" meta of

764− Just (MetaBlocks bs) -> bs

765− Just (MetaInlines ils) -> [Plain ils]

766− Just (MetaString s) -> [Plain [Str s]]

767− _ -> []

768− let subtitle' = case lookupMeta "subtitle" meta of

769− Just (MetaBlocks [Plain xs]) -> xs

770− Just (MetaBlocks [Para xs]) -> xs

771− Just (MetaInlines xs) -> xs

772− Just (MetaString s) -> [Str s]

773− _ -> []

774− let includeTOC = writerTableOfContents opts ||

775− case lookupMeta "toc" meta of

776− Just (MetaBlocks _) -> True

777− Just (MetaInlines _) -> True

778− Just (MetaString (_:_)) -> True

779− Just (MetaBool True) -> True

780− _ -> False

763+ let abstract' = lookupMetaBlocks "abstract" meta

764+ let subtitle' = lookupMetaInlines "subtitle" meta

765+ let includeTOC = writerTableOfContents opts || lookupMetaBool "toc" meta

781766 title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]

782767 subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')]

783768 authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $

src/Text/Pandoc/Writers/OpenDocument.hs+4−2

@@ -226,8 +226,10 @@ handleSpaces s

226226-- | Convert Pandoc document to string in OpenDocument format.

227227writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text

228228writeOpenDocument opts (Pandoc meta blocks) = do

229− lang <- fromMaybe (Lang "en" "US" "" []) <$>

230− toLang (metaValueToString <$> lookupMeta "lang" meta)

229+ let defLang = Lang "en" "US" "" []

230+ lang <- case lookupMetaString "lang" meta of

231+ "" -> pure defLang

232+ s -> fromMaybe defLang <$> toLang (Just s)

231233 setTranslations lang

232234 let colwidth = if writerWrapText opts == WrapAuto

233235 then Just $ writerColumns opts

src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+8−14

@@ -72,7 +72,7 @@ import Text.Pandoc.Logging

7272import Text.Pandoc.Walk

7373import Data.Time (UTCTime)

7474import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"

75−import Text.Pandoc.Writers.Shared (metaValueToInlines)

75+import Text.Pandoc.Writers.Shared (lookupMetaInlines)

7676import qualified Data.Map as M

7777import qualified Data.Set as S

7878import Data.Maybe (maybeToList, fromMaybe)

@@ -731,9 +731,9 @@ makeEndNotesSlideBlocks = do

731731 anchorSet <- M.keysSet <$> gets stAnchorMap

732732 if M.null noteIds

733733 then return []

734− else let title = case lookupMeta "notes-title" meta of

735− Just val -> metaValueToInlines val

736− Nothing -> [Str "Notes"]

734+ else let title = case lookupMetaInlines "notes-title" meta of

735+ [] -> [Str "Notes"]

736+ ls -> ls

737737 ident = Shared.uniqueIdent title anchorSet

738738 hdr = Header slideLevel (ident, [], []) title

739739 blks = concatMap (\(n, bs) -> makeNoteEntry n bs) $

@@ -744,13 +744,7 @@ getMetaSlide :: Pres (Maybe Slide)

744744getMetaSlide = do

745745 meta <- asks envMetadata

746746 title <- inlinesToParElems $ docTitle meta

747− subtitle <- inlinesToParElems $

748− case lookupMeta "subtitle" meta of

749− Just (MetaString s) -> [Str s]

750− Just (MetaInlines ils) -> ils

751− Just (MetaBlocks [Plain ils]) -> ils

752− Just (MetaBlocks [Para ils]) -> ils

753− _ -> []

747+ subtitle <- inlinesToParElems $ lookupMetaInlines "subtitle" meta

754748 authors <- mapM inlinesToParElems $ docAuthors meta

755749 date <- inlinesToParElems $ docDate meta

756750 if null title && null subtitle && null authors && null date

@@ -785,9 +779,9 @@ makeTOCSlide blks = local (\env -> env{envCurSlideId = tocSlideId}) $ do

785779 contents <- BulletList <$> mapM elementToListItem (Shared.hierarchicalize blks)

786780 meta <- asks envMetadata

787781 slideLevel <- asks envSlideLevel

788− let tocTitle = case lookupMeta "toc-title" meta of

789− Just val -> metaValueToInlines val

790− Nothing -> [Str "Table of Contents"]

782+ let tocTitle = case lookupMetaInlines "toc-title" meta of

783+ [] -> [Str "Table of Contents"]

784+ ls -> ls

791785 hdr = Header slideLevel nullAttr tocTitle

792786 blocksToSlide [hdr, contents]

793787

src/Text/Pandoc/Writers/RST.hs+1−4

@@ -82,10 +82,7 @@ pandocToRST (Pandoc meta blocks) = do

8282 else Nothing

8383 let render' :: Doc -> Text

8484 render' = render colwidth

85− let subtit = case lookupMeta "subtitle" meta of

86− Just (MetaBlocks [Plain xs]) -> xs

87− Just (MetaInlines xs) -> xs

88− _ -> []

85+ let subtit = lookupMetaInlines "subtitle" meta

8986 title <- titleToRST (docTitle meta) subtit

9087 metadata <- metaToJSON opts

9188 (fmap render' . blockListToRST)

src/Text/Pandoc/Writers/Shared.hs+47−15

@@ -42,8 +42,10 @@ module Text.Pandoc.Writers.Shared (

4242 , fixDisplayMath

4343 , unsmartify

4444 , gridTable

45− , metaValueToInlines

46− , metaValueToString

45+ , lookupMetaBool

46+ , lookupMetaBlocks

47+ , lookupMetaInlines

48+ , lookupMetaString

4749 , stripLeadingTrailingSpace

4850 , groffEscape

4951 )

@@ -63,7 +65,6 @@ import Text.Pandoc.Definition

6365import Text.Pandoc.Options

6466import Text.Pandoc.Pretty

6567import Text.Pandoc.Shared (stringify)

66−import Text.Pandoc.Walk (query)

6768import Text.Pandoc.UTF8 (toStringLazy)

6869import Text.Pandoc.XML (escapeStringForXML)

6970import Text.Printf (printf)

@@ -339,19 +340,50 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do

339340 body $$

340341 border '-' (repeat AlignDefault) widthsInChars

341342

342−metaValueToInlines :: MetaValue -> [Inline]

343−metaValueToInlines (MetaString s) = [Str s]

344−metaValueToInlines (MetaInlines ils) = ils

345−metaValueToInlines (MetaBlocks bs) = query return bs

346−metaValueToInlines (MetaBool b) = [Str $ show b]

347−metaValueToInlines _ = []

348343

349−metaValueToString :: MetaValue -> String

350−metaValueToString (MetaString s) = s

351−metaValueToString (MetaInlines ils) = stringify ils

352−metaValueToString (MetaBlocks bs) = stringify bs

353−metaValueToString (MetaBool b) = show b

354−metaValueToString _ = ""

344+

345+-- | Retrieve the metadata value for a given @key@

346+-- and convert to Bool.

347+lookupMetaBool :: String -> Meta -> Bool

348+lookupMetaBool key meta =

349+ case lookupMeta key meta of

350+ Just (MetaBlocks _) -> True

351+ Just (MetaInlines _) -> True

352+ Just (MetaString (_:_)) -> True

353+ Just (MetaBool True) -> True

354+ _ -> False

355+

356+-- | Retrieve the metadata value for a given @key@

357+-- and extract blocks.

358+lookupMetaBlocks :: String -> Meta -> [Block]

359+lookupMetaBlocks key meta =

360+ case lookupMeta key meta of

361+ Just (MetaBlocks bs) -> bs

362+ Just (MetaInlines ils) -> [Plain ils]

363+ Just (MetaString s) -> [Plain [Str s]]

364+ _ -> []

365+

366+-- | Retrieve the metadata value for a given @key@

367+-- and extract inlines.

368+lookupMetaInlines :: String -> Meta -> [Inline]

369+lookupMetaInlines key meta =

370+ case lookupMeta key meta of

371+ Just (MetaString s) -> [Str s]

372+ Just (MetaInlines ils) -> ils

373+ Just (MetaBlocks [Plain ils]) -> ils

374+ Just (MetaBlocks [Para ils]) -> ils

375+ _ -> []

376+

377+-- | Retrieve the metadata value for a given @key@

378+-- and convert to String.

379+lookupMetaString :: String -> Meta -> String

380+lookupMetaString key meta =

381+ case lookupMeta key meta of

382+ Just (MetaString s) -> s

383+ Just (MetaInlines ils) -> stringify ils

384+ Just (MetaBlocks bs) -> stringify bs

385+ Just (MetaBool b) -> show b

386+ _ -> ""

355387

356388-- | Escape non-ASCII characters using groff \u[..] sequences.

357389groffEscape :: T.Text -> T.Text