600034d · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Add lookupMeta* functions to Text.Pandoc.Writers.Shared (#4907)

600034dMauro Bieg8 years ago

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

compare with master

unifiedsplit

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

43import Text.Pandoc.Readers.Org.ParserState

44import Text.Pandoc.Readers.Org.Parsing

46−import qualified Data.Map as Map

47import qualified Text.Pandoc.Builder as B

46import qualified Text.Pandoc.Builder as B

49--

48--

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

58documentTree blocks inline = do

57documentTree blocks inline = do

59 initialBlocks <- blocks

58 initialBlocks <- blocks

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

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

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

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

62 return $ do

61 return $ do

63 headlines' <- headlines

62 headlines' <- headlines

64 initialBlocks' <- initialBlocks

63 initialBlocks' <- initialBlocks

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

73 , headlineContents = initialBlocks'

72 , headlineContents = initialBlocks'

74 , headlineChildren = headlines'

73 , headlineChildren = headlines'

75 }

74 }

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− _ -> []

83newtype Tag = Tag { fromTag :: String }

76newtype Tag = Tag { fromTag :: String }

84 deriving (Show, Eq)

77 deriving (Show, Eq)

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

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

66import Text.Pandoc.Shared hiding (Element)

67import Text.Pandoc.Walk

68import Text.Pandoc.Writers.Math

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

69+import Text.Pandoc.Writers.Shared

70− metaValueToInlines)

71import Text.Printf (printf)

70import Text.Printf (printf)

72import Text.TeXMath

71import Text.TeXMath

73import Text.XML.Light as XML

72import Text.XML.Light as XML

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

267 -- parse styledoc for heading styles

266 -- parse styledoc for heading styles

268 let styleMaps = getStyleMaps styledoc

267 let styleMaps = getStyleMaps styledoc

269

268

270− let tocTitle = fromMaybe (stTocTitle defaultWriterState) $

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

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

270+ [] -> stTocTitle defaultWriterState

271+ ls -> ls

272

273 let initialSt = defaultWriterState {

274 stStyleMaps = styleMaps

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

760 let tit = docTitle meta

761 let auths = docAuthors meta

762 let dat = docDate meta

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

763+ let abstract' = lookupMetaBlocks "abstract" meta

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

764+ let subtitle' = lookupMetaInlines "subtitle" meta

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

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

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

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

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

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

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

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

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

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

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

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

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

228writeOpenDocument opts (Pandoc meta blocks) = do

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

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

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

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

231+ "" -> pure defLang

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

231 setTranslations lang

233 setTranslations lang

232 let colwidth = if writerWrapText opts == WrapAuto

234 let colwidth = if writerWrapText opts == WrapAuto

233 then Just $ writerColumns opts

235 then Just $ writerColumns opts

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

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

72import Text.Pandoc.Walk

73import Data.Time (UTCTime)

74import 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)

76import qualified Data.Map as M

77import qualified Data.Set as S

78import Data.Maybe (maybeToList, fromMaybe)

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

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

732 if M.null noteIds

733 then return []

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

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

735− Just val -> metaValueToInlines val

736− Nothing -> [Str "Notes"]

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

736+ ls -> ls

737 ident = Shared.uniqueIdent title anchorSet

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

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

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

744getMetaSlide = do

745 meta <- asks envMetadata

746 title <- inlinesToParElems $ docTitle meta

747− subtitle <- inlinesToParElems $

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

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− _ -> []

754 authors <- mapM inlinesToParElems $ docAuthors meta

748 authors <- mapM inlinesToParElems $ docAuthors meta

755 date <- inlinesToParElems $ docDate meta

749 date <- inlinesToParElems $ docDate meta

756 if null title && null subtitle && null authors && null date

750 if null title && null subtitle && null authors && null date

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

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

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

786 meta <- asks envMetadata

780 meta <- asks envMetadata

787 slideLevel <- asks envSlideLevel

781 slideLevel <- asks envSlideLevel

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

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

789− Just val -> metaValueToInlines val

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

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

784+ ls -> ls

791 hdr = Header slideLevel nullAttr tocTitle

785 hdr = Header slideLevel nullAttr tocTitle

792 blocksToSlide [hdr, contents]

786 blocksToSlide [hdr, contents]

793

787

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

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

82 else Nothing

83 let render' :: Doc -> Text

84 render' = render colwidth

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

85+ let subtit = lookupMetaInlines "subtitle" meta

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

87− Just (MetaInlines xs) -> xs

88− _ -> []

89 title <- titleToRST (docTitle meta) subtit

86 title <- titleToRST (docTitle meta) subtit

90 metadata <- metaToJSON opts

87 metadata <- metaToJSON opts

91 (fmap render' . blockListToRST)

88 (fmap render' . blockListToRST)

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

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

42 , fixDisplayMath

43 , unsmartify

44 , gridTable

45− , metaValueToInlines

45+ , lookupMetaBool

46− , metaValueToString

46+ , lookupMetaBlocks

47+ , lookupMetaInlines

48+ , lookupMetaString

47 , stripLeadingTrailingSpace

49 , stripLeadingTrailingSpace

48 , groffEscape

50 , groffEscape

49 )

51 )

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

63import Text.Pandoc.Options

65import Text.Pandoc.Options

64import Text.Pandoc.Pretty

66import Text.Pandoc.Pretty

65import Text.Pandoc.Shared (stringify)

67import Text.Pandoc.Shared (stringify)

66−import Text.Pandoc.Walk (query)

67import Text.Pandoc.UTF8 (toStringLazy)

68import Text.Pandoc.UTF8 (toStringLazy)

68import Text.Pandoc.XML (escapeStringForXML)

69import Text.Pandoc.XML (escapeStringForXML)

69import Text.Printf (printf)

70import Text.Printf (printf)

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

339 body $$

340 body $$

340 border '-' (repeat AlignDefault) widthsInChars

341 border '-' (repeat AlignDefault) widthsInChars

341

342

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 _ = []

348

343

349−metaValueToString :: MetaValue -> String

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]

350−metaValueToString (MetaString s) = s

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]

351−metaValueToString (MetaInlines ils) = stringify ils

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

352−metaValueToString (MetaBlocks bs) = stringify bs

384+ Just (MetaBlocks bs) -> stringify bs

353−metaValueToString (MetaBool b) = show b

385+ Just (MetaBool b) -> show b

354−metaValueToString _ = ""

386+ _ -> ""

355

387

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

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

357groffEscape :: T.Text -> T.Text

389groffEscape :: T.Text -> T.Text