aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2019-10-08 09:22:46 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2019-10-09 11:01:33 -0700
commitaceee9ca48484c300ac3519fb7991e3d22768312 (patch)
tree5beaccc4860fd5a9525514d2fe9e737e42703f73 /src/Text/Pandoc/Writers
parent1b10b5cea947cd6567c33466006c4216fde9f107 (diff)
downloadpandoc-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.hs85
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs11
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs8
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs7
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs14
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)