diff options
author | John MacFarlane <jgm@berkeley.edu> | 2019-10-08 09:22:46 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2019-10-09 11:01:33 -0700 |
commit | aceee9ca48484c300ac3519fb7991e3d22768312 (patch) | |
tree | 5beaccc4860fd5a9525514d2fe9e737e42703f73 /src/Text/Pandoc/Writers | |
parent | 1b10b5cea947cd6567c33466006c4216fde9f107 (diff) | |
download | pandoc-aceee9ca48484c300ac3519fb7991e3d22768312.tar.gz |
Options.WriterOptions: Change type of writerVariables to Context Text.
This will allow structured values.
[API change]
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 85 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 11 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 8 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Output.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Shared.hs | 14 |
5 files changed, 80 insertions, 45 deletions
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index dfcb8e215..ef7ce659b 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- | Module : Text.Pandoc.Writers.EPUB @@ -58,6 +59,8 @@ import Text.XML.Light (Attr (..), Element (..), Node (..), QName (..), add_attrs, lookupAttr, node, onlyElems, parseXML, ppElement, showElement, strContent, unode, unqual) import Text.Pandoc.XML (escapeStringForXML) +import Text.DocTemplates (FromContext(lookupContext), Context(..), + ToContext(toVal), Val(..)) -- A Chapter includes a list of blocks. data Chapter = Chapter [Block] @@ -136,6 +139,9 @@ removeNote :: Inline -> Inline removeNote (Note _) = Str "" removeNote x = x +toVal' :: String -> Val TS.Text +toVal' = toVal . TS.pack + mkEntry :: PandocMonad m => FilePath -> B.ByteString -> E m Entry mkEntry path content = do epubSubdir <- gets stEpubSubdir @@ -163,8 +169,8 @@ getEPUBMetadata opts meta = do else return m let addLanguage m = if null (epubLanguage m) - then case lookup "lang" (writerVariables opts) of - Just x -> return m{ epubLanguage = x } + then case lookupContext "lang" (writerVariables opts) of + Just x -> return m{ epubLanguage = TS.unpack x } Nothing -> do mLang <- lift $ P.lookupEnv "LANG" let localeLang = @@ -345,11 +351,14 @@ metadataFromMeta opts meta = EPUBMetadata{ relation = metaValueToString <$> lookupMeta "relation" meta coverage = metaValueToString <$> lookupMeta "coverage" meta rights = metaValueToString <$> lookupMeta "rights" meta - coverImage = lookup "epub-cover-image" (writerVariables opts) `mplus` - (metaValueToString <$> lookupMeta "cover-image" meta) + coverImage = + (TS.unpack <$> lookupContext "epub-cover-image" + (writerVariables opts)) + `mplus` (metaValueToString <$> lookupMeta "cover-image" meta) mCss = lookupMeta "css" meta <|> lookupMeta "stylesheet" meta stylesheets = fromMaybe [] (metaValueToPaths <$> mCss) ++ - [f | ("css",f) <- writerVariables opts] + maybe [] (\t -> [TS.unpack t]) + (lookupContext "css" (writerVariables opts)) pageDirection = case map toLower . metaValueToString <$> lookupMeta "page-progression-direction" meta of Just "ltr" -> Just LTR @@ -424,10 +433,13 @@ pandocToEPUB version opts doc = do (\bs n -> mkEntry ("styles/stylesheet" ++ show n ++ ".css") bs) stylesheets [(1 :: Int)..] - let vars = ("epub3", if epub3 then "true" else "false") - : [(x,y) | (x,y) <- writerVariables opts, x /= "css"] + let vars = Context $ + M.delete "css" . M.insert "epub3" + (toVal' $ if epub3 then "true" else "false") $ + unContext $ writerVariables opts - let cssvars useprefix = map (\e -> ("css", + let cssvars useprefix = Context $ M.fromList $ map + (\e -> ("css", toVal' $ (if useprefix then "../" else "") @@ -457,14 +469,16 @@ pandocToEPUB version opts doc = do (CouldNotDetermineImageSize img err') cpContent <- lift $ writeHtml opts'{ writerVariables = - ("coverpage","true"): - ("pagetitle", - escapeStringForXML plainTitle): - ("cover-image", coverImage): - ("cover-image-width", show coverImageWidth): - ("cover-image-height", - show coverImageHeight): - cssvars True ++ vars } + Context (M.fromList [ + ("coverpage", toVal' "true"), + ("pagetitle", toVal' $ + escapeStringForXML plainTitle), + ("cover-image", toVal' coverImage), + ("cover-image-width", toVal' $ + show coverImageWidth), + ("cover-image-height", toVal' $ + show coverImageHeight)]) <> + cssvars True <> vars } (Pandoc meta []) coverEntry <- mkEntry "text/cover.xhtml" cpContent coverImageEntry <- mkEntry ("media/" ++ coverImage) @@ -474,10 +488,13 @@ pandocToEPUB version opts doc = do -- title page tpContent <- lift $ writeHtml opts'{ - writerVariables = ("titlepage","true"): - ("body-type", "frontmatter"): - ("pagetitle", escapeStringForXML plainTitle): - cssvars True ++ vars } + writerVariables = + Context (M.fromList [ + ("titlepage", toVal' "true"), + ("body-type", toVal' "frontmatter"), + ("pagetitle", toVal' $ + escapeStringForXML plainTitle)]) + <> cssvars True <> vars } (Pandoc meta []) tpEntry <- mkEntry "text/title_page.xhtml" tpContent @@ -564,9 +581,12 @@ pandocToEPUB version opts doc = do let chapToEntry num (Chapter bs) = mkEntry ("text/" ++ showChapter num) =<< - writeHtml opts'{ writerVariables = ("body-type", bodyType) : - ("pagetitle", showChapter num) : - cssvars True ++ vars } pdoc + writeHtml opts'{ writerVariables = + Context (M.fromList + [("body-type", toVal' bodyType), + ("pagetitle", toVal' $ + showChapter num)]) + <> cssvars True <> vars } pdoc where (pdoc, bodyType) = case bs of (Header _ (_,_,kvs) xs : _) -> @@ -776,9 +796,10 @@ pandocToEPUB version opts doc = do (writeHtmlStringForEPUB version opts{ writerTemplate = Nothing , writerVariables = - ("pagetitle", - escapeStringForXML plainTitle): - writerVariables opts} + Context (M.fromList + [("pagetitle", toVal' $ + escapeStringForXML plainTitle)]) + <> writerVariables opts} (Pandoc nullMeta [Plain $ walk clean tit])) of Left _ -> TS.pack $ stringify tit @@ -801,13 +822,13 @@ pandocToEPUB version opts doc = do then [ unode "li" [ unode "a" ! [("href", "text/cover.xhtml") ,("epub:type", "cover")] $ - "Cover"] | + ("Cover" :: String)] | isJust (epubCoverImage metadata) ] ++ [ unode "li" [ unode "a" ! [("href", "#toc") ,("epub:type", "toc")] $ - "Table of contents" + ("Table of contents" :: String) ] | writerTableOfContents opts ] else [] @@ -819,8 +840,9 @@ pandocToEPUB version opts doc = do ,("hidden","hidden")] $ [ unode "ol" landmarkItems ] ] - navData <- lift $ writeHtml opts'{ writerVariables = ("navpage","true"): - cssvars False ++ vars } + navData <- lift $ writeHtml opts'{ writerVariables = + Context (M.fromList [("navpage", toVal' "true")]) + <> cssvars False <> vars } (Pandoc (setMeta "title" (walk removeNote $ fromList $ docTitle' meta) nullMeta) (navBlocks ++ landmarks)) @@ -846,7 +868,7 @@ pandocToEPUB version opts doc = do let apple = UTF8.fromStringLazy $ ppTopElement $ unode "display_options" $ unode "platform" ! [("name","*")] $ - unode "option" ! [("name","specified-fonts")] $ "true" + unode "option" ! [("name","specified-fonts")] $ ("true" :: String) appleEntry <- mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple -- construct archive @@ -949,6 +971,7 @@ metadataElement version md currentTime = (("id",id') : maybe [] (\x -> [("opf:event",x)]) (dateEvent date)) $ dateText date] + schemeToOnix :: String -> String schemeToOnix "ISBN-10" = "02" schemeToOnix "GTIN-13" = "03" schemeToOnix "UPC" = "04" diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index c74d677e0..d7a7e19ea 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -39,6 +39,7 @@ import Data.List.Split (splitWhen) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL +import Text.DocTemplates (FromContext(lookupContext)) import Network.HTTP (urlEncode) import Network.URI (URI (..), parseURIReference) import Numeric (showHex) @@ -220,8 +221,8 @@ writeHtmlString' st opts d = do case getField "pagetitle" context of Just (s :: Text) | not (T.null s) -> return context _ -> do - let fallback = maybe "Untitled" takeBaseName $ - lookup "sourcefile" (writerVariables opts) + let fallback = maybe "Untitled" (takeBaseName . T.unpack) $ + lookupContext "sourcefile" (writerVariables opts) report $ NoTitleElement fallback return $ resetField "pagetitle" (T.pack fallback) context return $ renderTemplate tpl @@ -286,11 +287,13 @@ pandocToHtml opts (Pandoc meta blocks) = do H.link ! A.rel "stylesheet" ! A.href (toValue $ url ++ "katex.min.css") - _ -> case lookup "mathml-script" (writerVariables opts) of + _ -> case lookupContext "mathml-script" + (writerVariables opts) of Just s | not (stHtml5 st) -> H.script ! A.type_ "text/javascript" $ preEscapedString - ("/*<![CDATA[*/\n" ++ s ++ "/*]]>*/\n") + ("/*<![CDATA[*/\n" ++ T.unpack s ++ + "/*]]>*/\n") | otherwise -> mempty Nothing -> mempty let context = (if stHighlighting st diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 2ea26344a..81a3082cb 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -30,6 +30,7 @@ import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) +import Text.DocTemplates (FromContext(lookupContext)) import Text.Pandoc.BCP47 (Lang (..), getLang, renderLang) import Text.Pandoc.Class (PandocMonad, report, toLang) import Text.Pandoc.Definition @@ -146,8 +147,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do -- these have \frontmatter etc. beamer <- gets stBeamer let documentClass = - case lookup "documentclass" (writerVariables options) `mplus` - fmap stringify (lookupMeta "documentclass" meta) of + case (lookupContext "documentclass" + (writerVariables options)) `mplus` + (T.pack . stringify <$> lookupMeta "documentclass" meta) of Just x -> x Nothing | beamer -> "beamer" | otherwise -> case writerTopLevelDivision options of @@ -208,7 +210,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do defField "title-meta" (T.pack titleMeta) $ defField "author-meta" (T.pack $ intercalate "; " authorsMeta) $ - defField "documentclass" (T.pack documentClass) $ + defField "documentclass" documentClass $ defField "verbatim-in-note" (stVerbInNote st) $ defField "tables" (stTable st) $ defField "strikeout" (stStrikeout st) $ diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index 6b43fa34a..58f230a9d 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternGuards #-} {- | @@ -24,6 +25,7 @@ import Codec.Archive.Zip import Data.Char (toUpper) import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse) import Data.Default +import qualified Data.Text as T import Data.Time (formatTime, defaultTimeLocale) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime) @@ -43,6 +45,7 @@ import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isN import Text.Pandoc.ImageSize import Control.Applicative ((<|>)) import System.FilePath.Glob +import Text.DocTemplates (FromContext(lookupContext)) import Text.TeXMath import Text.Pandoc.Writers.Math (convertMath) import Text.Pandoc.Writers.Powerpoint.Presentation @@ -159,8 +162,8 @@ runP env st p = evalStateT (runReaderT p env) st monospaceFont :: Monad m => P m String monospaceFont = do vars <- writerVariables <$> asks envOpts - case lookup "monofont" vars of - Just s -> return s + case lookupContext "monofont" vars of + Just s -> return (T.unpack s) Nothing -> return "Courier" fontSizeAttributes :: Monad m => RunProps -> P m [(String, String)] diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 7d4a496f2..c294eeebb 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -39,6 +39,7 @@ module Text.Pandoc.Writers.Shared ( where import Prelude import Safe (lastMay) +import qualified Data.ByteString.Lazy as BL import Data.Maybe (fromMaybe) import Control.Monad (zipWithM) import Data.Aeson (ToJSON (..), encode) @@ -90,12 +91,15 @@ metaToContext' blockWriter inlineWriter (Meta metamap) = do -- | Add variables to a template Context, replacing any existing values. addVariablesToContext :: TemplateTarget a => WriterOptions -> Context a -> Context a -addVariablesToContext opts (Context m1) = Context (m1 `M.union` m2) +addVariablesToContext opts (Context m1) = + Context (m1 `M.union` m2 `M.union` m3) where - m2 = M.fromList $ map (\(k,v) - -> (T.pack k,SimpleVal (fromText (T.pack v)))) $ - ("meta-json", jsonrep) : writerVariables opts - jsonrep = UTF8.toStringLazy $ encode $ toJSON m1 + m2 = case traverse go (writerVariables opts) of + Just (Context x) -> x + Nothing -> mempty + m3 = M.insert "meta-json" (SimpleVal $ fromText jsonrep) mempty + go = Just . fromText + jsonrep = UTF8.toText $ BL.toStrict $ encode $ toJSON m1 metaValueToVal :: (Monad m, TemplateTarget a) => ([Block] -> m a) |