diff options
-rw-r--r-- | pandoc.cabal | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/App/OutputSettings.hs | 5 | ||||
-rw-r--r-- | src/Text/Pandoc/BCP47.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling.hs | 1 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/Context.hs | 31 | ||||
-rw-r--r-- | src/Text/Pandoc/Options.hs | 6 | ||||
-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 | ||||
-rw-r--r-- | stack.yaml | 4 | ||||
-rw-r--r-- | test/Tests/Writers/Powerpoint.hs | 6 |
13 files changed, 136 insertions, 51 deletions
diff --git a/pandoc.cabal b/pandoc.cabal index 892d1235a..14756844b 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -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 diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs index 04ea89eda..264eb4a65 100644 --- a/src/Text/Pandoc/App/OutputSettings.hs +++ b/src/Text/Pandoc/App/OutputSettings.hs @@ -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 diff --git a/src/Text/Pandoc/BCP47.hs b/src/Text/Pandoc/BCP47.hs index f783c0320..ce8aa99ca 100644 --- a/src/Text/Pandoc/BCP47.hs +++ b/src/Text/Pandoc/BCP47.hs @@ -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 diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs index 8a1270ab7..c37f22b8d 100644 --- a/src/Text/Pandoc/Lua/Marshaling.hs +++ b/src/Text/Pandoc/Lua/Marshaling.hs @@ -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 () diff --git a/src/Text/Pandoc/Lua/Marshaling/Context.hs b/src/Text/Pandoc/Lua/Marshaling/Context.hs new file mode 100644 index 000000000..a9cc7f38e --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshaling/Context.hs @@ -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 + diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 59546cd1b..5dc94b2ad 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -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 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) diff --git a/stack.yaml b/stack.yaml index dfa119556..e510a88e8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -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 diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs index e3f4173bd..be98fe0e7 100644 --- a/test/Tests/Writers/Powerpoint.hs +++ b/test/Tests/Writers/Powerpoint.hs @@ -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" ] |