diff options
author | John MacFarlane <jgm@berkeley.edu> | 2019-10-20 22:49:04 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2019-10-29 22:21:35 -0700 |
commit | 1fe97422630d4aa5644d55b0b3b41b0978b7fea0 (patch) | |
tree | 32477f9869a265d9a275651b2715b5991c6cbb4c /src/Text/Pandoc | |
parent | 4d5fd9e2fe360e47fd5beab724c612ce29aa39ee (diff) | |
download | pandoc-1fe97422630d4aa5644d55b0b3b41b0978b7fea0.tar.gz |
Changes to build with new doctemplates/doclayout.
The new version of doctemplates adds many features to pandoc's
templating system, while remaining backwards-compatible.
New features include partials and filters. Using template filters,
one can lay out data in enumerated lists and tables.
Templates are now layout-sensitive: so, for example, if a
text with soft line breaks is interpolated near the end of
a line, the text will break and wrap naturally. This makes
the templating system much more suitable for programatically
generating markdown or other plain-text files from metadata.
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/App/Opt.hs | 3 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/Context.hs | 10 | ||||
-rw-r--r-- | src/Text/Pandoc/Options.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/PDF.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/CommonMark.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 12 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/DokuWiki.hs | 11 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Ipynb.hs | 5 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/JATS.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Jira.hs | 12 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 8 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/MediaWiki.hs | 12 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/OPML.hs | 10 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 20 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Roff.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Shared.hs | 20 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Textile.hs | 13 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ZimWiki.hs | 15 | ||||
-rw-r--r-- | src/Text/Pandoc/XML.hs | 13 |
21 files changed, 114 insertions, 84 deletions
diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs index 4c08e3074..7216fa1ed 100644 --- a/src/Text/Pandoc/App/Opt.hs +++ b/src/Text/Pandoc/App/Opt.hs @@ -33,6 +33,7 @@ import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault), ObfuscationMethod (NoObfuscation), CiteMethod (Citeproc)) import Text.Pandoc.Shared (camelCaseToHyphenated) +import Text.DocLayout (render) import Text.DocTemplates (Context(..), Val(..)) import Data.Text (Text, unpack) import qualified Data.Text as T @@ -405,7 +406,7 @@ valToMetaVal :: Val Text -> MetaValue valToMetaVal (MapVal (Context m)) = MetaMap . M.mapKeys unpack . M.map valToMetaVal $ m valToMetaVal (ListVal xs) = MetaList $ map valToMetaVal xs -valToMetaVal (SimpleVal t) = MetaString (unpack t) +valToMetaVal (SimpleVal d) = MetaString (unpack $ render Nothing d) valToMetaVal NullVal = MetaString "" -- see https://github.com/jgm/pandoc/pull/4083 diff --git a/src/Text/Pandoc/Lua/Marshaling/Context.hs b/src/Text/Pandoc/Lua/Marshaling/Context.hs index a9cc7f38e..e209fbd61 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Context.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Context.hs @@ -16,16 +16,18 @@ Marshaling instance for doctemplates Context and its components. -} module Text.Pandoc.Lua.Marshaling.Context () where +import Prelude import qualified Foreign.Lua as Lua import Foreign.Lua (Pushable) -import Text.DocTemplates (Context(..), Val(..)) +import Text.DocTemplates (Context(..), Val(..), TemplateTarget) +import Text.DocLayout (render) -instance Pushable a => Pushable (Context a) where +instance (TemplateTarget a, Pushable a) => Pushable (Context a) where push (Context m) = Lua.push m -instance Pushable a => Pushable (Val a) where +instance (TemplateTarget a, 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 + push (SimpleVal d) = Lua.push $ render Nothing d diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 367a19da5..66193ef60 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -231,7 +231,7 @@ instance FromYAML ReferenceLocation where -- | Options for writers data WriterOptions = WriterOptions - { writerTemplate :: Maybe Template -- ^ Template to use + { writerTemplate :: Maybe (Template Text) -- ^ Template to use , writerVariables :: Context Text -- ^ Variables to set in template , writerTabStop :: Int -- ^ Tabstop for conversion btw spaces and tabs , writerTableOfContents :: Bool -- ^ Include table of contents diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index 1d56d79a3..31d69bc2c 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -37,6 +37,7 @@ import System.IO (stdout, hClose) import System.IO.Temp (withSystemTempDirectory, withTempDirectory, withTempFile) import qualified System.IO.Error as IE +import Text.DocLayout (literal) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError (PandocPDFProgramNotFoundError)) import Text.Pandoc.MIME (getMimeType) @@ -134,7 +135,10 @@ makeWithWkhtmltopdf program pdfargs writer opts doc@(Pandoc meta _) = do MathJax _ -> ["--run-script", "MathJax.Hub.Register.StartupHook('End Typeset', function() { window.status = 'mathjax_loaded' });", "--window-status", "mathjax_loaded"] _ -> [] - meta' <- metaToContext opts (return . stringify) (return . stringify) meta + meta' <- metaToContext opts + (return . literal . stringify) + (return . literal . stringify) + meta let toArgs (f, mbd) = maybe [] (\d -> ['-':'-':f, d]) mbd let args = pdfargs ++ mathArgs ++ concatMap toArgs [("page-size", getField "papersize" meta') diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index a572123fc..8e6e8af51 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -34,6 +34,7 @@ import Text.Pandoc.Walk (walk, walkM) import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes) import Text.Pandoc.Writers.Shared import Text.Pandoc.XML (toHtml5Entities) +import Text.DocLayout (literal, render) -- | Convert Pandoc to CommonMark. writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text @@ -50,8 +51,8 @@ writeCommonMark opts (Pandoc meta blocks) = do else [OrderedList (1, Decimal, Period) $ reverse notes] main <- blocksToCommonMark opts (blocks' ++ notes') metadata <- metaToContext opts - (fmap T.stripEnd . blocksToCommonMark opts) - (fmap T.stripEnd . inlinesToCommonMark opts) + (fmap (literal . T.stripEnd) . blocksToCommonMark opts) + (fmap (literal . T.stripEnd) . inlinesToCommonMark opts) meta let context = -- for backwards compatibility we populate toc @@ -62,7 +63,7 @@ writeCommonMark opts (Pandoc meta blocks) = do return $ case writerTemplate opts of Nothing -> main - Just tpl -> renderTemplate tpl context + Just tpl -> render Nothing $ renderTemplate tpl context softBreakToSpace :: Inline -> Inline softBreakToSpace SoftBreak = Space diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 6afa824da..6c4f92db0 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -23,6 +23,7 @@ import qualified Data.Map as M import Data.Text (Text, pack) import Data.Typeable import Foreign.Lua (Lua, Pushable) +import Text.DocLayout (render, literal) import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition import Text.Pandoc.Lua (Global (..), LuaException (LuaException), @@ -101,17 +102,18 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toString rendered <- docToCustom opts doc context <- metaToContext opts - blockListToCustom - inlineListToCustom + (fmap (literal . pack) . blockListToCustom) + (fmap (literal . pack) . inlineListToCustom) meta - return (rendered, context) + return (pack rendered, context) let (body, context) = case res of Left (LuaException msg) -> throw (PandocLuaException msg) Right x -> x - return $ pack $ + return $ case writerTemplate opts of Nothing -> body - Just tpl -> renderTemplate tpl $ setField "body" body context + Just tpl -> render Nothing $ + renderTemplate tpl $ setField "body" body context docToCustom :: WriterOptions -> Pandoc -> Lua String docToCustom opts (Pandoc (Meta metamap) blocks) = do diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index e77dfff22..8111da9ba 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -37,6 +37,7 @@ import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContent import Text.Pandoc.Shared (camelCaseToHyphenated, escapeURI, isURI, linesToPara, removeFormatting, substitute, trimr) import Text.Pandoc.Templates (renderTemplate) +import Text.DocLayout (render, literal) import Text.Pandoc.Writers.Shared (defField, metaToContext) data WriterState = WriterState { @@ -71,17 +72,17 @@ pandocToDokuWiki :: PandocMonad m => WriterOptions -> Pandoc -> DokuWiki m Text pandocToDokuWiki opts (Pandoc meta blocks) = do metadata <- metaToContext opts - (fmap trimr . blockListToDokuWiki opts) - (fmap trimr . inlineListToDokuWiki opts) + (fmap (literal . pack . trimr) . blockListToDokuWiki opts) + (fmap (literal . pack . trimr) . inlineListToDokuWiki opts) meta body <- blockListToDokuWiki opts blocks - let main = body + let main = pack body let context = defField "body" main $ defField "toc" (writerTableOfContents opts) metadata - return $ pack $ + return $ case writerTemplate opts of Nothing -> main - Just tpl -> renderTemplate tpl context + Just tpl -> render Nothing $ renderTemplate tpl context -- | Escape special characters for DokuWiki. escapeString :: String -> String diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 08d8345b0..86dcb5a43 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -42,6 +42,7 @@ import qualified Data.Text.Lazy as TL import Network.HTTP (urlEncode) import Network.URI (URI (..), parseURIReference) import Numeric (showHex) +import Text.DocLayout (render, literal) import Prelude import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent) import Text.DocTemplates (FromContext (lookupContext)) @@ -226,7 +227,7 @@ writeHtmlString' st opts d = do lookupContext "sourcefile" (writerVariables opts) report $ NoTitleElement fallback return $ resetField "pagetitle" (T.pack fallback) context - return $ renderTemplate tpl + return $ render Nothing $ renderTemplate tpl (defField "body" (renderHtml' body) context') writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html @@ -249,8 +250,8 @@ pandocToHtml opts (Pandoc meta blocks) = do let slideLevel = fromMaybe (getSlideLevel blocks) $ writerSlideLevel opts modify $ \st -> st{ stSlideLevel = slideLevel } metadata <- metaToContext opts - (fmap renderHtml' . blockListToHtml opts) - (fmap renderHtml' . inlineListToHtml opts) + (fmap (literal . renderHtml') . blockListToHtml opts) + (fmap (literal . renderHtml') . inlineListToHtml opts) meta let stringifyHTML = escapeStringForXML . stringify let authsMeta = map stringifyHTML $ docAuthors meta diff --git a/src/Text/Pandoc/Writers/Ipynb.hs b/src/Text/Pandoc/Writers/Ipynb.hs index 2d2ee320e..c58afed9d 100644 --- a/src/Text/Pandoc/Writers/Ipynb.hs +++ b/src/Text/Pandoc/Writers/Ipynb.hs @@ -39,6 +39,7 @@ import qualified Data.Text.Encoding as TE import qualified Data.ByteString.Lazy as BL import Data.Aeson.Encode.Pretty (Config(..), defConfig, encodePretty', keyOrder, Indent(Spaces)) +import Text.DocLayout (literal) writeIpynb :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeIpynb opts d = do @@ -57,9 +58,9 @@ writeIpynb opts d = do pandocToNotebook :: PandocMonad m => WriterOptions -> Pandoc -> m (Notebook NbV4) pandocToNotebook opts (Pandoc meta blocks) = do - let blockWriter bs = writeMarkdown + let blockWriter bs = literal <$> writeMarkdown opts{ writerTemplate = Nothing } (Pandoc nullMeta bs) - let inlineWriter ils = T.stripEnd <$> writeMarkdown + let inlineWriter ils = literal . T.stripEnd <$> writeMarkdown opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain ils]) let jupyterMeta = case lookupMeta "jupyter" meta of diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index c0ed15f52..44ddba9a0 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -36,7 +36,7 @@ import Text.Pandoc.Options import Text.DocLayout import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) -import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..)) +import Text.DocTemplates (Context(..), Val(..)) import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared import Text.Pandoc.XML @@ -88,7 +88,7 @@ docToJATS opts (Pandoc meta blocks) = do case getField "date" metadata of Nothing -> NullVal Just (SimpleVal (x :: Doc Text)) -> - case parseDate (T.unpack $ toText x) of + case parseDate (T.unpack $ render Nothing x) of Nothing -> NullVal Just day -> let (y,m,d) = toGregorian day diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs index 7b41468cc..79f63e229 100644 --- a/src/Text/Pandoc/Writers/Jira.hs +++ b/src/Text/Pandoc/Writers/Jira.hs @@ -29,6 +29,7 @@ import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Math (texMathToInlines) import Text.Pandoc.Writers.Shared (metaToContext, defField) import qualified Data.Text as T +import Text.DocLayout (literal, render) data WriterState = WriterState { stNotes :: [Text] -- Footnotes @@ -53,16 +54,19 @@ writeJira opts document = pandocToJira :: PandocMonad m => WriterOptions -> Pandoc -> JiraWriter m Text pandocToJira opts (Pandoc meta blocks) = do - metadata <- metaToContext opts (blockListToJira opts) - (inlineListToJira opts) meta + metadata <- metaToContext opts + (fmap literal . blockListToJira opts) + (fmap literal . inlineListToJira opts) meta body <- blockListToJira opts blocks notes <- gets $ T.intercalate "\n" . reverse . stNotes - let main = body <> if T.null notes then "" else "\n\n" <> notes + let main = body <> if T.null notes + then mempty + else T.pack "\n\n" <> notes let context = defField "body" main metadata return $ case writerTemplate opts of Nothing -> main - Just tpl -> renderTemplate tpl context + Just tpl -> render Nothing $ renderTemplate tpl context -- | Escape one character as needed for Jira. escapeCharForJira :: Char -> Text diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 491134c6c..f56b3a657 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -186,7 +186,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do ,("tmargin","margin-top") ,("bmargin","margin-bottom") ] - let toPolyObj :: Lang -> Val (Doc Text) + let toPolyObj :: Lang -> Val Text toPolyObj lang = MapVal $ Context $ M.fromList [ ("name" , SimpleVal $ text name) , ("options" , SimpleVal $ text opts) ] @@ -289,7 +289,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do ) $ maybe id (defField "polyglossia-lang" . toPolyObj) mblang $ defField "polyglossia-otherlangs" - (ListVal (map toPolyObj docLangs :: [Val (Doc Text)])) + (ListVal (map toPolyObj docLangs :: [Val Text])) $ defField "latex-dir-rtl" ((render Nothing <$> getField "dir" context) == diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 8f8b7ec14..06b6da3a5 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -112,7 +112,7 @@ pandocTitleBlock tit auths dat = hang 2 (text "% ") (vcat $ map nowrap auths) <> cr <> hang 2 (text "% ") dat <> cr -mmdTitleBlock :: Context (Doc Text) -> Doc Text +mmdTitleBlock :: Context Text -> Doc Text mmdTitleBlock (Context hashmap) = vcat $ map go $ sortBy (comparing fst) $ M.toList hashmap where go (k,v) = @@ -138,10 +138,10 @@ plainTitleBlock tit auths dat = (hcat (intersperse (text "; ") auths)) <> cr <> dat <> cr -yamlMetadataBlock :: Context (Doc Text) -> Doc Text +yamlMetadataBlock :: Context Text -> Doc Text yamlMetadataBlock v = "---" $$ (contextToYaml v) $$ "---" -contextToYaml :: Context (Doc Text) -> Doc Text +contextToYaml :: Context Text -> Doc Text contextToYaml (Context o) = vcat $ map keyvalToYaml $ sortBy (comparing fst) $ M.toList o where @@ -158,7 +158,7 @@ contextToYaml (Context o) = (_, NullVal) -> empty (k', _) -> k' <> ":" <+> hang 2 "" (valToYaml v) -valToYaml :: Val (Doc Text) -> Doc Text +valToYaml :: Val Text -> Doc Text valToYaml (ListVal xs) = vcat $ map (\v -> hang 2 "- " (valToYaml v)) xs valToYaml (MapVal c) = contextToYaml c diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index c60624d25..dc7b2575e 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -24,7 +24,7 @@ import Text.Pandoc.Definition import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.DocLayout (render) +import Text.DocLayout (render, literal) import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Shared @@ -55,21 +55,21 @@ pandocToMediaWiki :: PandocMonad m => Pandoc -> MediaWikiWriter m Text pandocToMediaWiki (Pandoc meta blocks) = do opts <- asks options metadata <- metaToContext opts - (fmap trimr . blockListToMediaWiki) - (fmap trimr . inlineListToMediaWiki) + (fmap (literal . pack . trimr) . blockListToMediaWiki) + (fmap (literal . pack . trimr) . inlineListToMediaWiki) meta body <- blockListToMediaWiki blocks notesExist <- gets stNotes let notes = if notesExist then "\n<references />" else "" - let main = body ++ notes + let main = pack $ body ++ notes let context = defField "body" main $ defField "toc" (writerTableOfContents opts) metadata - return $ pack $ + return $ case writerTemplate opts of Nothing -> main - Just tpl -> renderTemplate tpl context + Just tpl -> render Nothing $ renderTemplate tpl context -- | Escape special characters for MediaWiki. escapeString :: String -> String diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 83f64ec5e..cf6f9a037 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -36,17 +36,19 @@ writeOPML opts (Pandoc meta blocks) = do else Nothing meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta metadata <- metaToContext opts - (writeMarkdown def . Pandoc nullMeta) - (\ils -> T.stripEnd <$> writeMarkdown def (Pandoc nullMeta [Plain ils])) + (fmap literal . writeMarkdown def . Pandoc nullMeta) + (\ils -> literal . T.stripEnd <$> + writeMarkdown def (Pandoc nullMeta [Plain ils])) meta' let blocks' = makeSections False (Just 1) blocks - main <- (render colwidth . vcat) <$> mapM (blockToOPML opts) blocks' + main <- (render colwidth . vcat) <$> + mapM (blockToOPML opts) blocks' let context = defField "body" main metadata return $ (if writerPreferAscii opts then toEntities else id) $ case writerTemplate opts of Nothing -> main - Just tpl -> renderTemplate tpl context + Just tpl -> render colwidth $ renderTemplate tpl context writeHtmlInlines :: PandocMonad m => [Inline] -> m Text diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 3a5e00845..366b4cdcd 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -31,6 +31,7 @@ import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) +import Text.DocLayout (render, literal) import Text.Pandoc.Walk import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared @@ -97,11 +98,12 @@ writeRTF options doc = do . M.adjust toPlain "date" $ metamap metadata <- metaToContext options - (fmap concat . mapM (blockToRTF 0 AlignDefault)) - inlinesToRTF + (fmap (literal . T.pack . concat) . + mapM (blockToRTF 0 AlignDefault)) + (fmap (literal . T.pack) . inlinesToRTF) meta' - body <- blocksToRTF 0 AlignDefault blocks - toc <- blocksToRTF 0 AlignDefault + body <- T.pack <$> blocksToRTF 0 AlignDefault blocks + toc <- T.pack <$> blocksToRTF 0 AlignDefault [toTableOfContents options $ filter isHeaderBlock blocks] let context = defField "body" body $ defField "spacer" spacer @@ -112,12 +114,12 @@ writeRTF options doc = do -- of the toc rather than a boolean: . defField "toc" toc else id) metadata - return $ T.pack $ + return $ case writerTemplate options of - Just tpl -> renderTemplate tpl context - Nothing -> case reverse body of - ('\n':_) -> body - _ -> body ++ "\n" + Just tpl -> render Nothing $ renderTemplate tpl context + Nothing -> case T.unsnoc body of + Just (_,'\n') -> body + _ -> body <> T.singleton '\n' -- | Convert unicode characters (> 127) into rich text format representation. handleUnicode :: String -> String diff --git a/src/Text/Pandoc/Writers/Roff.hs b/src/Text/Pandoc/Writers/Roff.hs index fdd5db4dd..4dadb1073 100644 --- a/src/Text/Pandoc/Writers/Roff.hs +++ b/src/Text/Pandoc/Writers/Roff.hs @@ -98,7 +98,7 @@ escapeString escapeMode (x:xs) = characterCodeMap :: Map.Map Char String characterCodeMap = Map.fromList characterCodes -fontChange :: (IsString a, PandocMonad m) => MS m (Doc a) +fontChange :: (HasChars a, IsString a, PandocMonad m) => MS m (Doc a) fontChange = do features <- gets stFontFeatures inHeader <- gets stInHeader @@ -111,7 +111,7 @@ fontChange = do then text "\\f[R]" else text $ "\\f[" ++ filling ++ "]" -withFontFeature :: (IsString a, PandocMonad m) +withFontFeature :: (HasChars a, IsString a, PandocMonad m) => Char -> MS m (Doc a) -> MS m (Doc a) withFontFeature c action = do modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st } diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index f7af26a99..4f31cd137 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -45,6 +45,7 @@ import Control.Monad (zipWithM) import Data.Aeson (ToJSON (..), encode) import Data.Char (chr, ord, isSpace) import Data.List (groupBy, intersperse, transpose, foldl') +import Data.Text.Conversions (FromText(..)) import qualified Data.Map as M import qualified Data.Text as T import qualified Text.Pandoc.Builder as Builder @@ -55,7 +56,7 @@ import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink) import Text.Pandoc.Walk (walk) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.XML (escapeStringForXML) -import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..), +import Text.DocTemplates (Context(..), Val(..), TemplateTarget, ToContext(..), FromContext(..)) -- | Create template Context from a 'Meta' and an association list @@ -65,8 +66,8 @@ import Text.DocTemplates (Context(..), Val(..), TemplateTarget(..), -- assigned. Does nothing if 'writerTemplate' is Nothing. metaToContext :: (Monad m, TemplateTarget a) => WriterOptions - -> ([Block] -> m a) - -> ([Inline] -> m a) + -> ([Block] -> m (Doc a)) + -> ([Inline] -> m (Doc a)) -> Meta -> m (Context a) metaToContext opts blockWriter inlineWriter meta = @@ -78,8 +79,8 @@ metaToContext opts blockWriter inlineWriter meta = -- | Like 'metaToContext, but does not include variables and is -- not sensitive to 'writerTemplate'. metaToContext' :: (Monad m, TemplateTarget a) - => ([Block] -> m a) - -> ([Inline] -> m a) + => ([Block] -> m (Doc a)) + -> ([Inline] -> m (Doc a)) -> Meta -> m (Context a) metaToContext' blockWriter inlineWriter (Meta metamap) = do @@ -97,13 +98,14 @@ addVariablesToContext opts (Context m1) = m2 = case traverse go (writerVariables opts) of Just (Context x) -> x Nothing -> mempty - m3 = M.insert "meta-json" (SimpleVal $ fromText jsonrep) mempty + m3 = M.insert "meta-json" (SimpleVal $ literal $ fromText jsonrep) + mempty go = Just . fromText jsonrep = UTF8.toText $ BL.toStrict $ encode $ toJSON m1 metaValueToVal :: (Monad m, TemplateTarget a) - => ([Block] -> m a) - -> ([Inline] -> m a) + => ([Block] -> m (Doc a)) + -> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a) metaValueToVal blockWriter inlineWriter (MetaMap metamap) = @@ -111,7 +113,7 @@ metaValueToVal blockWriter inlineWriter (MetaMap metamap) = mapM (metaValueToVal blockWriter inlineWriter) metamap metaValueToVal blockWriter inlineWriter (MetaList xs) = ListVal <$> mapM (metaValueToVal blockWriter inlineWriter) xs -metaValueToVal _ _ (MetaBool True) = return $ SimpleVal $ fromText "true" +metaValueToVal _ _ (MetaBool True) = return $ SimpleVal "true" metaValueToVal _ _ (MetaBool False) = return NullVal metaValueToVal _ inlineWriter (MetaString s) = SimpleVal <$> inlineWriter (Builder.toList (Builder.text s)) diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 88507cc56..1a7c386e0 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -23,7 +23,7 @@ import Text.Pandoc.Definition import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.DocLayout (render) +import Text.DocLayout (render, literal) import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Shared @@ -51,16 +51,17 @@ writeTextile opts document = pandocToTextile :: PandocMonad m => WriterOptions -> Pandoc -> TW m Text pandocToTextile opts (Pandoc meta blocks) = do - metadata <- metaToContext opts (blockListToTextile opts) - (inlineListToTextile opts) meta + metadata <- metaToContext opts + (fmap (literal . pack) . blockListToTextile opts) + (fmap (literal . pack) . inlineListToTextile opts) meta body <- blockListToTextile opts blocks notes <- gets $ unlines . reverse . stNotes - let main = body ++ if null notes then "" else "\n\n" ++ notes + let main = pack $ body ++ if null notes then "" else "\n\n" ++ notes let context = defField "body" main metadata - return $ pack $ + return $ case writerTemplate opts of Nothing -> main - Just tpl -> renderTemplate tpl context + Just tpl -> render Nothing $ renderTemplate tpl context withUseTags :: PandocMonad m => TW m a -> TW m a withUseTags action = do diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index ed1f04fdf..e1bc40351 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -20,13 +20,16 @@ import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Default (Default (..)) import Data.List (intercalate, isInfixOf, isPrefixOf, transpose) import qualified Data.Map as Map +import Text.DocLayout (render, literal) import Data.Maybe (fromMaybe) import Data.Text (Text, breakOnAll, pack) import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.ImageSize import Text.Pandoc.Logging -import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText)) +import Text.Pandoc.Options (WrapOption (..), + WriterOptions (writerTableOfContents, writerTemplate, + writerWrapText)) import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, substitute, trimr) import Text.Pandoc.Templates (renderTemplate) @@ -51,16 +54,16 @@ writeZimWiki opts document = evalStateT (pandocToZimWiki opts document) def pandocToZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> ZW m Text pandocToZimWiki opts (Pandoc meta blocks) = do metadata <- metaToContext opts - (fmap trimr . blockListToZimWiki opts) - (fmap trimr . inlineListToZimWiki opts) + (fmap (literal . pack . trimr) . blockListToZimWiki opts) + (fmap (literal . pack . trimr) . inlineListToZimWiki opts) meta - main <- blockListToZimWiki opts blocks + main <- pack <$> blockListToZimWiki opts blocks --let header = "Content-Type: text/x-zim-wiki\nWiki-Format: zim 0.4\n" let context = defField "body" main $ defField "toc" (writerTableOfContents opts) metadata - return $ pack $ + return $ case writerTemplate opts of - Just tpl -> renderTemplate tpl context + Just tpl -> render Nothing $ renderTemplate tpl context Nothing -> main -- | Escape special characters for ZimWiki. diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs index 8d7a2720c..f0cdf8302 100644 --- a/src/Text/Pandoc/XML.hs +++ b/src/Text/Pandoc/XML.hs @@ -56,14 +56,14 @@ escapeNls (x:xs) escapeNls [] = [] -- | Return a text object with a string of formatted XML attributes. -attributeList :: IsString a => [(String, String)] -> Doc a +attributeList :: (HasChars a, IsString a) => [(String, String)] -> Doc a attributeList = hcat . map (\(a, b) -> text (' ' : escapeStringForXML a ++ "=\"" ++ escapeNls (escapeStringForXML b) ++ "\"")) -- | Put the supplied contents between start and end tags of tagType, -- with specified attributes and (if specified) indentation. -inTags:: IsString a +inTags:: (HasChars a, IsString a) => Bool -> String -> [(String, String)] -> Doc a -> Doc a inTags isIndented tagType attribs contents = let openTag = char '<' <> text tagType <> attributeList attribs <> @@ -74,16 +74,19 @@ inTags isIndented tagType attribs contents = else openTag <> contents <> closeTag -- | Return a self-closing tag of tagType with specified attributes -selfClosingTag :: IsString a => String -> [(String, String)] -> Doc a +selfClosingTag :: (HasChars a, IsString a) + => String -> [(String, String)] -> Doc a selfClosingTag tagType attribs = char '<' <> text tagType <> attributeList attribs <> text " />" -- | Put the supplied contents between start and end tags of tagType. -inTagsSimple :: IsString a => String -> Doc a -> Doc a +inTagsSimple :: (HasChars a, IsString a) + => String -> Doc a -> Doc a inTagsSimple tagType = inTags False tagType [] -- | Put the supplied contents in indented block btw start and end tags. -inTagsIndented :: IsString a => String -> Doc a -> Doc a +inTagsIndented :: (HasChars a, IsString a) + => String -> Doc a -> Doc a inTagsIndented tagType = inTags True tagType [] -- | Escape all non-ascii characters using numerical entities. |