From f738c451d7092e5fa5562d68bf3dcc4b1274e156 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Fri, 4 Feb 2022 23:56:02 +0100
Subject: [PATCH] Lua: move custom writer code into Lua hierarchy.
---
pandoc.cabal | 1 +
src/Text/Pandoc/Lua/Writer/Classic.hs | 247 ++++++++++++++++++++++++
src/Text/Pandoc/Writers/Custom.hs | 258 ++------------------------
3 files changed, 266 insertions(+), 240 deletions(-)
create mode 100644 src/Text/Pandoc/Lua/Writer/Classic.hs
diff --git a/pandoc.cabal b/pandoc.cabal
index 43fb4648a..376c9a41c 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -728,6 +728,7 @@ library
Text.Pandoc.Lua.Orphans,
Text.Pandoc.Lua.Packages,
Text.Pandoc.Lua.PandocLua,
+ Text.Pandoc.Lua.Writer.Classic,
Text.Pandoc.XML.Light,
Text.Pandoc.XML.Light.Types,
Text.Pandoc.XML.Light.Proc,
diff --git a/src/Text/Pandoc/Lua/Writer/Classic.hs b/src/Text/Pandoc/Lua/Writer/Classic.hs
new file mode 100644
index 000000000..6b021911c
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Writer/Classic.hs
@@ -0,0 +1,247 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{- |
+ Module : Text.Pandoc.Lua.Writer.Classic
+ Copyright : Copyright (C) 2012-2022 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Conversion of Pandoc documents using a \"classic\" custom Lua writer.
+-}
+module Text.Pandoc.Lua.Writer.Classic
+ ( runCustom
+ ) where
+import Control.Applicative (optional)
+import Control.Arrow ((***))
+import Data.List (intersperse)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Data.Text (Text, pack)
+import HsLua as Lua hiding (Operation (Div))
+import HsLua.Aeson (peekViaJSON)
+import Text.DocLayout (literal, render)
+import Text.DocTemplates (Context)
+import Text.Pandoc.Definition
+import Text.Pandoc.Lua.Marshal.Attr (pushAttributeList)
+import Text.Pandoc.Lua.Orphans ()
+import Text.Pandoc.Options
+import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Writers.Shared
+
+-- | List of key-value pairs that is pushed to Lua as AttributeList
+-- userdata.
+newtype AttributeList = AttributeList [(Text, Text)]
+instance Pushable AttributeList where
+ push (AttributeList kvs) = pushAttributeList kvs
+
+attrToMap :: Attr -> AttributeList
+attrToMap (id',classes,keyvals) = AttributeList
+ $ ("id", id')
+ : ("class", T.unwords classes)
+ : keyvals
+
+newtype Stringify a = Stringify a
+
+instance Pushable (Stringify Format) where
+ push (Stringify (Format f)) = Lua.push (T.toLower f)
+
+instance Pushable (Stringify [Inline]) where
+ push (Stringify ils) = Lua.push =<< inlineListToCustom ils
+
+instance Pushable (Stringify [Block]) where
+ push (Stringify blks) = Lua.push =<< blockListToCustom blks
+
+instance Pushable (Stringify MetaValue) where
+ push (Stringify (MetaMap m)) = Lua.push (fmap Stringify m)
+ push (Stringify (MetaList xs)) = Lua.push (map Stringify xs)
+ push (Stringify (MetaBool x)) = Lua.push x
+ push (Stringify (MetaString s)) = Lua.push s
+ push (Stringify (MetaInlines ils)) = Lua.push (Stringify ils)
+ push (Stringify (MetaBlocks bs)) = Lua.push (Stringify bs)
+
+instance Pushable (Stringify Citation) where
+ push (Stringify cit) = flip pushAsTable cit
+ [ ("citationId", push . citationId)
+ , ("citationPrefix", push . Stringify . citationPrefix)
+ , ("citationSuffix", push . Stringify . citationSuffix)
+ , ("citationMode", push . citationMode)
+ , ("citationNoteNum", push . citationNoteNum)
+ , ("citationHash", push . citationHash)
+ ]
+
+-- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the
+-- associated value.
+newtype KeyValue a b = KeyValue (a, b)
+
+instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
+ push (KeyValue (k, v)) = do
+ Lua.newtable
+ Lua.push k
+ Lua.push v
+ Lua.rawset (Lua.nth 3)
+
+-- | Convert Pandoc to custom markup usind a classic Lua writer.
+runCustom :: LuaError e
+ => WriterOptions
+ -> Pandoc
+ -> LuaE e Text
+runCustom opts doc@(Pandoc meta _) = do
+ (body, context) <- docToCustom opts doc
+ -- convert metavalues to a template context (variables)
+ metaContext <- metaToContext opts
+ (fmap (literal . pack) . blockListToCustom)
+ (fmap (literal . pack) . inlineListToCustom)
+ meta
+ -- merge contexts from metadata and variables
+ let renderContext = context <> metaContext
+ return $ case writerTemplate opts of
+ Nothing -> body
+ Just tpl -> render Nothing $
+ renderTemplate tpl $ setField "body" body renderContext
+
+-- | Converts a Pandoc value to custom markup using a classic Lua writer.
+docToCustom :: forall e. LuaError e
+ => WriterOptions -> Pandoc -> LuaE e (Text, Context Text)
+docToCustom opts (Pandoc (Meta metamap) blocks) = do
+ body <- blockListToCustom blocks
+ -- invoke doesn't work with multiple return values, so we have to call
+ -- `Doc` manually.
+ Lua.getglobal "Doc" -- function
+ push body -- argument 1
+ push (fmap Stringify metamap) -- argument 2
+ push (writerVariables opts) -- argument 3
+ call 3 2
+ rendered <- peek (nth 2) -- first return value
+ context <- forcePeek . optional $ peekViaJSON top -- snd return value
+ return (rendered, fromMaybe mempty context)
+
+
+-- | Convert Pandoc block element to Custom.
+blockToCustom :: forall e. LuaError e
+ => Block -- ^ Block element
+ -> LuaE e String
+
+blockToCustom Null = return ""
+
+blockToCustom (Plain inlines) = invoke "Plain" (Stringify inlines)
+
+blockToCustom (Para [Image attr txt (src,tit)]) =
+ invoke "CaptionedImage" src tit (Stringify txt) (attrToMap attr)
+
+blockToCustom (Para inlines) = invoke "Para" (Stringify inlines)
+
+blockToCustom (LineBlock linesList) =
+ invoke "LineBlock" (map (Stringify) linesList)
+
+blockToCustom (RawBlock format str) =
+ invoke "RawBlock" (Stringify format) str
+
+blockToCustom HorizontalRule = invoke "HorizontalRule"
+
+blockToCustom (Header level attr inlines) =
+ invoke "Header" level (Stringify inlines) (attrToMap attr)
+
+blockToCustom (CodeBlock attr str) =
+ invoke "CodeBlock" str (attrToMap attr)
+
+blockToCustom (BlockQuote blocks) =
+ invoke "BlockQuote" (Stringify blocks)
+
+blockToCustom (Table _ blkCapt specs thead tbody tfoot) =
+ let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
+ aligns' = map show aligns
+ capt' = Stringify capt
+ headers' = map (Stringify) headers
+ rows' = map (map (Stringify)) rows
+ in invoke "Table" capt' aligns' widths headers' rows'
+
+blockToCustom (BulletList items) =
+ invoke "BulletList" (map (Stringify) items)
+
+blockToCustom (OrderedList (num,sty,delim) items) =
+ invoke "OrderedList" (map (Stringify) items) num (show sty) (show delim)
+
+blockToCustom (DefinitionList items) =
+ invoke "DefinitionList"
+ (map (KeyValue . (Stringify *** map (Stringify))) items)
+
+blockToCustom (Div attr items) =
+ invoke "Div" (Stringify items) (attrToMap attr)
+
+-- | Convert list of Pandoc block elements to Custom.
+blockListToCustom :: forall e. LuaError e
+ => [Block] -- ^ List of block elements
+ -> LuaE e String
+blockListToCustom xs = do
+ blocksep <- invoke "Blocksep"
+ bs <- mapM blockToCustom xs
+ return $ mconcat $ intersperse blocksep bs
+
+-- | Convert list of Pandoc inline elements to Custom.
+inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String
+inlineListToCustom lst = do
+ xs <- mapM (inlineToCustom @e) lst
+ return $ mconcat xs
+
+-- | Convert Pandoc inline element to Custom.
+inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String
+
+inlineToCustom (Str str) = invoke "Str" str
+
+inlineToCustom Space = invoke "Space"
+
+inlineToCustom SoftBreak = invoke "SoftBreak"
+
+inlineToCustom (Emph lst) = invoke "Emph" (Stringify lst)
+
+inlineToCustom (Underline lst) = invoke "Underline" (Stringify lst)
+
+inlineToCustom (Strong lst) = invoke "Strong" (Stringify lst)
+
+inlineToCustom (Strikeout lst) = invoke "Strikeout" (Stringify lst)
+
+inlineToCustom (Superscript lst) = invoke "Superscript" (Stringify lst)
+
+inlineToCustom (Subscript lst) = invoke "Subscript" (Stringify lst)
+
+inlineToCustom (SmallCaps lst) = invoke "SmallCaps" (Stringify lst)
+
+inlineToCustom (Quoted SingleQuote lst) =
+ invoke "SingleQuoted" (Stringify lst)
+
+inlineToCustom (Quoted DoubleQuote lst) =
+ invoke "DoubleQuoted" (Stringify lst)
+
+inlineToCustom (Cite cs lst) =
+ invoke "Cite" (Stringify lst) (map (Stringify) cs)
+
+inlineToCustom (Code attr str) =
+ invoke "Code" str (attrToMap attr)
+
+inlineToCustom (Math DisplayMath str) =
+ invoke "DisplayMath" str
+
+inlineToCustom (Math InlineMath str) =
+ invoke "InlineMath" str
+
+inlineToCustom (RawInline format str) =
+ invoke "RawInline" (Stringify format) str
+
+inlineToCustom LineBreak = invoke "LineBreak"
+
+inlineToCustom (Link attr txt (src,tit)) =
+ invoke "Link" (Stringify txt) src tit (attrToMap attr)
+
+inlineToCustom (Image attr alt (src,tit)) =
+ invoke "Image" (Stringify alt) src tit (attrToMap attr)
+
+inlineToCustom (Note contents) = invoke "Note" (Stringify contents)
+
+inlineToCustom (Span attr items) =
+ invoke "Span" (Stringify items) (attrToMap attr)
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 52ae33c35..e2b8bddf6 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -1,258 +1,36 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
{- |
Module : Text.Pandoc.Writers.Custom
- Copyright : Copyright (C) 2012-2022 John MacFarlane
+ Copyright : 2012-2022 John MacFarlane,
License : GNU GPL, version 2 or above
-
Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
Conversion of 'Pandoc' documents to custom markup using
a Lua writer.
-}
module Text.Pandoc.Writers.Custom ( writeCustom ) where
-import Control.Applicative (optional)
-import Control.Arrow ((***))
import Control.Exception
-import Control.Monad (when)
-import Data.List (intersperse)
-import Data.Maybe (fromMaybe)
-import qualified Data.Text as T
-import Data.Text (Text, pack)
-import HsLua as Lua hiding (Operation (Div))
-import HsLua.Aeson (peekViaJSON)
-import Text.DocLayout (render, literal)
-import Text.DocTemplates (Context)
+import Control.Monad ((<=<))
+import Data.Text (Text)
+import HsLua
import Control.Monad.IO.Class (MonadIO)
-import Text.Pandoc.Definition
-import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
-import Text.Pandoc.Lua.Marshal.Attr (pushAttributeList)
-import Text.Pandoc.Options
import Text.Pandoc.Class (PandocMonad)
-import Text.Pandoc.Templates (renderTemplate)
-import Text.Pandoc.Writers.Shared
+import Text.Pandoc.Definition (Pandoc (..))
+import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
+import Text.Pandoc.Options (WriterOptions)
--- | List of key-value pairs that is pushed to Lua as AttributeList
--- userdata.
-newtype AttributeList = AttributeList [(Text, Text)]
-instance Pushable AttributeList where
- push (AttributeList kvs) = pushAttributeList kvs
-
-attrToMap :: Attr -> AttributeList
-attrToMap (id',classes,keyvals) = AttributeList
- $ ("id", id')
- : ("class", T.unwords classes)
- : keyvals
-
-newtype Stringify a = Stringify a
-
-instance Pushable (Stringify Format) where
- push (Stringify (Format f)) = Lua.push (T.toLower f)
-
-instance Pushable (Stringify [Inline]) where
- push (Stringify ils) = Lua.push =<< inlineListToCustom ils
-
-instance Pushable (Stringify [Block]) where
- push (Stringify blks) = Lua.push =<< blockListToCustom blks
-
-instance Pushable (Stringify MetaValue) where
- push (Stringify (MetaMap m)) = Lua.push (fmap Stringify m)
- push (Stringify (MetaList xs)) = Lua.push (map Stringify xs)
- push (Stringify (MetaBool x)) = Lua.push x
- push (Stringify (MetaString s)) = Lua.push s
- push (Stringify (MetaInlines ils)) = Lua.push (Stringify ils)
- push (Stringify (MetaBlocks bs)) = Lua.push (Stringify bs)
-
-instance Pushable (Stringify Citation) where
- push (Stringify cit) = flip pushAsTable cit
- [ ("citationId", push . citationId)
- , ("citationPrefix", push . Stringify . citationPrefix)
- , ("citationSuffix", push . Stringify . citationSuffix)
- , ("citationMode", push . citationMode)
- , ("citationNoteNum", push . citationNoteNum)
- , ("citationHash", push . citationHash)
- ]
-
--- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the
--- associated value.
-newtype KeyValue a b = KeyValue (a, b)
-
-instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
- push (KeyValue (k, v)) = do
- Lua.newtable
- Lua.push k
- Lua.push v
- Lua.rawset (Lua.nth 3)
+import qualified Text.Pandoc.Lua.Writer.Classic as Classic
-- | Convert Pandoc to custom markup.
writeCustom :: (PandocMonad m, MonadIO m)
=> FilePath -> WriterOptions -> Pandoc -> m Text
-writeCustom luaFile opts doc@(Pandoc meta _) = do
- let globals = [ PANDOC_DOCUMENT doc
- , PANDOC_SCRIPT_FILE luaFile
- , PANDOC_WRITER_OPTIONS opts
- ]
- res <- runLua $ do
- setGlobals globals
- stat <- dofileTrace luaFile
- -- check for error in lua script (later we'll change the return type
- -- to handle this more gracefully):
- when (stat /= Lua.OK)
- Lua.throwErrorAsException
- (rendered, context) <- docToCustom opts doc
- metaContext <- metaToContext opts
- (fmap (literal . pack) . blockListToCustom)
- (fmap (literal . pack) . inlineListToCustom)
- meta
- return (pack rendered, context <> metaContext)
- case res of
- Left msg -> throw msg
- Right (body, context) -> return $
- case writerTemplate opts of
- Nothing -> body
- Just tpl -> render Nothing $
- renderTemplate tpl $ setField "body" body context
-
-docToCustom :: forall e. LuaError e
- => WriterOptions -> Pandoc -> LuaE e (String, Context Text)
-docToCustom opts (Pandoc (Meta metamap) blocks) = do
- body <- blockListToCustom blocks
- -- invoke doesn't work with multiple return values, so we have to call
- -- `Doc` manually.
- Lua.getglobal "Doc" -- function
- push body -- argument 1
- push (fmap Stringify metamap) -- argument 2
- push (writerVariables opts) -- argument 3
- call 3 2
- rendered <- peek (nth 2) -- first return value
- context <- forcePeek . optional $ peekViaJSON top -- snd return value
- return (rendered, fromMaybe mempty context)
-
--- | Convert Pandoc block element to Custom.
-blockToCustom :: forall e. LuaError e
- => Block -- ^ Block element
- -> LuaE e String
-
-blockToCustom Null = return ""
-
-blockToCustom (Plain inlines) = invoke "Plain" (Stringify inlines)
-
-blockToCustom (Para [Image attr txt (src,tit)]) =
- invoke "CaptionedImage" src tit (Stringify txt) (attrToMap attr)
-
-blockToCustom (Para inlines) = invoke "Para" (Stringify inlines)
-
-blockToCustom (LineBlock linesList) =
- invoke "LineBlock" (map (Stringify) linesList)
-
-blockToCustom (RawBlock format str) =
- invoke "RawBlock" (Stringify format) str
-
-blockToCustom HorizontalRule = invoke "HorizontalRule"
-
-blockToCustom (Header level attr inlines) =
- invoke "Header" level (Stringify inlines) (attrToMap attr)
-
-blockToCustom (CodeBlock attr str) =
- invoke "CodeBlock" str (attrToMap attr)
-
-blockToCustom (BlockQuote blocks) =
- invoke "BlockQuote" (Stringify blocks)
-
-blockToCustom (Table _ blkCapt specs thead tbody tfoot) =
- let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
- aligns' = map show aligns
- capt' = Stringify capt
- headers' = map (Stringify) headers
- rows' = map (map (Stringify)) rows
- in invoke "Table" capt' aligns' widths headers' rows'
-
-blockToCustom (BulletList items) =
- invoke "BulletList" (map (Stringify) items)
-
-blockToCustom (OrderedList (num,sty,delim) items) =
- invoke "OrderedList" (map (Stringify) items) num (show sty) (show delim)
-
-blockToCustom (DefinitionList items) =
- invoke "DefinitionList"
- (map (KeyValue . (Stringify *** map (Stringify))) items)
-
-blockToCustom (Div attr items) =
- invoke "Div" (Stringify items) (attrToMap attr)
-
--- | Convert list of Pandoc block elements to Custom.
-blockListToCustom :: forall e. LuaError e
- => [Block] -- ^ List of block elements
- -> LuaE e String
-blockListToCustom xs = do
- blocksep <- invoke "Blocksep"
- bs <- mapM blockToCustom xs
- return $ mconcat $ intersperse blocksep bs
-
--- | Convert list of Pandoc inline elements to Custom.
-inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String
-inlineListToCustom lst = do
- xs <- mapM (inlineToCustom @e) lst
- return $ mconcat xs
-
--- | Convert Pandoc inline element to Custom.
-inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String
-
-inlineToCustom (Str str) = invoke "Str" str
-
-inlineToCustom Space = invoke "Space"
-
-inlineToCustom SoftBreak = invoke "SoftBreak"
-
-inlineToCustom (Emph lst) = invoke "Emph" (Stringify lst)
-
-inlineToCustom (Underline lst) = invoke "Underline" (Stringify lst)
-
-inlineToCustom (Strong lst) = invoke "Strong" (Stringify lst)
-
-inlineToCustom (Strikeout lst) = invoke "Strikeout" (Stringify lst)
-
-inlineToCustom (Superscript lst) = invoke "Superscript" (Stringify lst)
-
-inlineToCustom (Subscript lst) = invoke "Subscript" (Stringify lst)
-
-inlineToCustom (SmallCaps lst) = invoke "SmallCaps" (Stringify lst)
-
-inlineToCustom (Quoted SingleQuote lst) =
- invoke "SingleQuoted" (Stringify lst)
-
-inlineToCustom (Quoted DoubleQuote lst) =
- invoke "DoubleQuoted" (Stringify lst)
-
-inlineToCustom (Cite cs lst) =
- invoke "Cite" (Stringify lst) (map (Stringify) cs)
-
-inlineToCustom (Code attr str) =
- invoke "Code" str (attrToMap attr)
-
-inlineToCustom (Math DisplayMath str) =
- invoke "DisplayMath" str
-
-inlineToCustom (Math InlineMath str) =
- invoke "InlineMath" str
-
-inlineToCustom (RawInline format str) =
- invoke "RawInline" (Stringify format) str
-
-inlineToCustom LineBreak = invoke "LineBreak"
-
-inlineToCustom (Link attr txt (src,tit)) =
- invoke "Link" (Stringify txt) src tit (attrToMap attr)
-
-inlineToCustom (Image attr alt (src,tit)) =
- invoke "Image" (Stringify alt) src tit (attrToMap attr)
-
-inlineToCustom (Note contents) = invoke "Note" (Stringify contents)
-
-inlineToCustom (Span attr items) =
- invoke "Span" (Stringify items) (attrToMap attr)
+writeCustom luaFile opts doc = either throw pure <=< runLua $ do
+ setGlobals [ PANDOC_DOCUMENT doc
+ , PANDOC_SCRIPT_FILE luaFile
+ , PANDOC_WRITER_OPTIONS opts
+ ]
+ dofileTrace luaFile >>= \case
+ OK -> pure ()
+ _ -> throwErrorAsException
+ Classic.runCustom opts doc