Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Options.WriterOptions: Change type of writerVariables to Context Text.

Browse source 
This will allow structured values.

[API change]
This commit is contained in:
John MacFarlane 2019-10-08 09:22:46 -07:00
parent 1b10b5cea9
commit aceee9ca48
13 changed files with 136 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
pandoc.cabal
View file

@ -596,6 +596,7 @@ library
Text.Pandoc.Lua.Marshaling.CommonState,
Text.Pandoc.Lua.Marshaling.MediaBag,
Text.Pandoc.Lua.Marshaling.ReaderOptions,
Text.Pandoc.Lua.Marshaling.Context,
Text.Pandoc.Lua.Marshaling.Version,
Text.Pandoc.Lua.Module.MediaBag,
Text.Pandoc.Lua.Module.Pandoc,
@ -724,6 +725,7 @@ test-suite test-pandoc
executable-path >= 0.0 && < 0.1,
zip-archive >= 0.2.3.4 && < 0.5,
xml >= 1.3.12 && < 1.4,
doctemplates >= 0.6.1 && < 0.7,
Glob >= 0.7 && < 0.11
if impl(ghc < 8.4)
hs-source-dirs: prelude

5
src/Text/Pandoc/App/OutputSettings.hs
View file

@ -20,6 +20,9 @@ module Text.Pandoc.App.OutputSettings
) where
import Prelude
import qualified Control.Exception as E
import qualified Data.Text as T
import qualified Data.Map as M
import Text.DocTemplates (Context(..), ToContext(toVal))
import Control.Monad
import Control.Monad.Except (catchError, throwError)
import Control.Monad.Trans
@ -159,6 +162,8 @@ optToOutputSettings opts = do
$ lines dztempl
return $ ("dzslides-core", dzcore) : vars
else return vars)
>>= fmap (Context . M.fromList) .
traverse (\(x,y) -> return (T.pack x, toVal (T.pack y)))
templStr <- case optTemplate opts of
_ | not standalone -> return Nothing

7
src/Text/Pandoc/BCP47.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{- |
Module : Text.Pandoc.BCP47
@ -24,6 +25,8 @@ import Data.Char (isAlphaNum, isAscii, isLetter, isLower, isUpper, toLower,
import Data.List (intercalate)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.DocTemplates (FromContext(..))
import qualified Data.Text as T
import qualified Text.Parsec as P
-- | Represents BCP 47 language/country code.
@ -41,8 +44,8 @@ renderLang lang = intercalate "-" (langLanguage lang : filter (not . null)
-- | Get the contents of the `lang` metadata field or variable.
getLang :: WriterOptions -> Meta -> Maybe String
getLang opts meta =
case lookup "lang" (writerVariables opts) of
Just s -> Just s
case lookupContext "lang" (writerVariables opts) of
Just s -> Just $ T.unpack s
_ ->
case lookupMeta "lang" meta of
Just (MetaInlines [Str s]) -> Just s

1
src/Text/Pandoc/Lua/Marshaling.hs
View file

@ -14,4 +14,5 @@ module Text.Pandoc.Lua.Marshaling () where
import Text.Pandoc.Lua.Marshaling.AST ()
import Text.Pandoc.Lua.Marshaling.CommonState ()
import Text.Pandoc.Lua.Marshaling.ReaderOptions ()
import Text.Pandoc.Lua.Marshaling.Context ()
import Text.Pandoc.Lua.Marshaling.Version ()

31
src/Text/Pandoc/Lua/Marshaling/Context.hs Normal file
View file

@ -0,0 +1,31 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module : Text.Pandoc.Lua.Marshaling.Context
Copyright : © 2012-2019 John MacFarlane
© 2017-2019 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
Marshaling instance for doctemplates Context and its components.
-}
module Text.Pandoc.Lua.Marshaling.Context () where
import qualified Foreign.Lua as Lua
import Foreign.Lua (Pushable)
import Text.DocTemplates (Context(..), Val(..))
instance Pushable a => Pushable (Context a) where
push (Context m) = Lua.push m
instance Pushable a => Pushable (Val a) where
push NullVal = Lua.push ()
push (MapVal ctx) = Lua.push ctx
push (ListVal xs) = Lua.push xs
push (SimpleVal x) = Lua.push x

6
src/Text/Pandoc/Options.hs
View file

@ -34,6 +34,8 @@ import Prelude
import Data.Char (toLower)
import Data.Data (Data)
import Data.Default
import Data.Text (Text)
import Text.DocTemplates (Context(..))
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
@ -148,7 +150,7 @@ data ReferenceLocation = EndOfBlock -- ^ End of block
-- | Options for writers
data WriterOptions = WriterOptions
{ writerTemplate :: Maybe Template -- ^ Template to use
, writerVariables :: [(String, String)] -- ^ Variables to set in template
, writerVariables :: Context Text -- ^ Variables to set in template
, writerTabStop :: Int -- ^ Tabstop for conversion btw spaces and tabs
, writerTableOfContents :: Bool -- ^ Include table of contents
, writerIncremental :: Bool -- ^ True if lists should be incremental
@ -185,7 +187,7 @@ data WriterOptions = WriterOptions
instance Default WriterOptions where
def = WriterOptions { writerTemplate = Nothing
, writerVariables = []
, writerVariables = mempty
, writerTabStop = 4
, writerTableOfContents = False
, writerIncremental = False

85
src/Text/Pandoc/Writers/EPUB.hs
View file

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

11
src/Text/Pandoc/Writers/HTML.hs
View file

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

8
src/Text/Pandoc/Writers/LaTeX.hs
View file

@ -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) $

7
src/Text/Pandoc/Writers/Powerpoint/Output.hs
View file

@ -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)]

14
src/Text/Pandoc/Writers/Shared.hs
View file

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

4
stack.yaml
View file

@ -22,7 +22,9 @@ extra-deps:
- doclayout-0.1
- HsYAML-0.2.0.0
- HsYAML-aeson-0.2.0.0
- doctemplates-0.6.1
# - doctemplates-0.6.1
- git: https://github.com/jgm/doctemplates.git
commit: b0e92bd6e32eb1a8c021598b4e8a5f25b9c5cd40
ghc-options:
"$locals": -fhide-source-paths -Wno-missing-home-modules
resolver: lts-14.6

6
test/Tests/Writers/Powerpoint.hs
View file

@ -6,6 +6,9 @@ import Tests.Writers.OOXML (ooxmlTest)
import Text.Pandoc
import Test.Tasty
import System.FilePath
import Text.DocTemplates (ToContext(toVal), Context(..))
import qualified Data.Map as M
import Data.Text (pack)
-- templating is important enough, and can break enough things, that
-- we want to run all our tests with both default formatting and a
@ -124,7 +127,8 @@ tests = groupPptxTests [ pptxTests "Inline formatting"
"pptx/code.native"
"pptx/code.pptx"
, pptxTests "inline code and code blocks, custom formatting"
def { writerVariables = [("monofont", "Consolas")] }
def { writerVariables = Context $ M.fromList
[(pack "monofont", toVal $ pack "Consolas")] }
"pptx/code.native"
"pptx/code-custom.pptx"
]