1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{- |
Module : Text.Pandoc.Lua.Custom
Copyright : © 2021-2024 Albert Krewinkel, John MacFarlane
License : GPL-2.0-or-later
Maintainer : Albert Krewinkel <[email protected]>
Supports custom parsers written in Lua which produce a Pandoc AST.
-}
module Text.Pandoc.Lua.Custom ( loadCustom ) where
import Control.Exception
import Control.Monad ((<=<), (<$!>))
import Control.Monad.IO.Class (MonadIO)
import Data.Maybe (fromMaybe)
import HsLua as Lua hiding (Operation (Div))
import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Marshal.Format (peekExtensionsConfig)
import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions)
import Text.Pandoc.Lua.PandocLua (unPandocLua)
import Text.Pandoc.Lua.Run (runLuaWith)
import Text.Pandoc.Readers (Reader (..))
import Text.Pandoc.Sources (ToSources(..))
import Text.Pandoc.Scripting (CustomComponents (..))
import Text.Pandoc.Writers (Writer (..))
import qualified Text.Pandoc.Lua.Writer.Classic as Classic
import qualified Text.Pandoc.Class as PandocMonad
-- | Convert custom markup to Pandoc.
loadCustom :: (PandocMonad m, MonadIO m)
=> FilePath -> m (CustomComponents m)
loadCustom luaFile = do
luaState <- liftIO newGCManagedState
luaFile' <- fromMaybe luaFile <$>
findFileWithDataFallback "custom" luaFile
either throw pure <=< runLuaWith luaState $ do
let globals = [ PANDOC_SCRIPT_FILE luaFile' ]
setGlobals globals
dofileTrace (Just luaFile') >>= \case
OK -> pure ()
_ -> throwErrorAsException
mextsConf <- rawgetglobal "Extensions" >>= \case
TypeNil -> pure Nothing
TypeFunction -> Just <$!> do
callTrace 0 1
forcePeek $ peekExtensionsConfig top `lastly` pop 1
_ -> Just <$!> do
forcePeek $ peekExtensionsConfig top `lastly` pop 1
mtemplate <- rawgetglobal "Template" >>= \case
TypeNil -> pure Nothing
TypeFunction -> Just <$!> do
callTrace 0 1
forcePeek $ peekText top `lastly` pop 1
_ -> Just <$!> do
forcePeek $ peekText top `lastly` pop 1
mreader <- rawgetglobal "Reader" >>= \case
TypeNil -> do
pop 1
rawgetglobal "ByteStringReader" >>= \case
TypeNil -> pure Nothing
_ -> do
setfield registryindex readerField
pure . Just $ byteStringReader luaState
_ -> do
setfield registryindex readerField
pure . Just $ textReader luaState
mwriter <- rawgetglobal "Writer" >>= \case
TypeNil -> rawgetglobal "ByteStringWriter" >>= \case
TypeNil -> do
-- Neither `Writer` nor `BinaryWriter` are defined. Check for
-- "Doc"; if present, use the file as a classic writer.
docType <- rawgetglobal "Doc"
pop 3 -- remove nils/value of "Writer", "ByteStringWriter", "Doc"
pure $
if docType /= TypeFunction
then Nothing
else Just . TextWriter $ \opts doc -> do
-- See TextWriter below for why the state is updated
st <- PandocMonad.getCommonState
liftIO $ withGCManagedState luaState $
unPandocLua (PandocMonad.putCommonState st) >>
Classic.runCustom @PandocError opts doc
_ -> Just <$!> do
-- Binary writer. Writer function is on top of the stack.
setfield registryindex writerField
pure $ ByteStringWriter $ \opts doc -> do
-- See TextWriter below for why the state is updated
st <- PandocMonad.getCommonState
-- Call writer with document and writer options as arguments.
liftIO $ withGCManagedState luaState $ do
unPandocLua (PandocMonad.putCommonState st)
getfield registryindex writerField
push doc
pushWriterOptions opts
callTrace 2 1
forcePeek @PandocError $ peekLazyByteString top
_ -> Just <$!> do
-- New-type text writer. Writer function is on top of the stack.
setfield registryindex writerField
pure $ TextWriter $ \opts doc -> do
-- The CommonState might have changed since the Lua file was
-- loaded. That's why the state must be updated when the
-- writer is run. (#9229)
st <- PandocMonad.getCommonState
liftIO $ withGCManagedState luaState $ do
unPandocLua (PandocMonad.putCommonState st)
getfield registryindex writerField
push doc
pushWriterOptions opts
callTrace 2 1
forcePeek @PandocError $ peekText top
pure $ CustomComponents
{ customReader = mreader
, customWriter = mwriter
, customTemplate = mtemplate
, customExtensions = mextsConf
}
-- | "Raw", non-metatable lookup of a key in the global table.
--
-- Most classic writers contain code that throws an error if a global
-- is not present. This would break our check for the existence of a
-- "Writer" function. We resort to raw access for that reason, but
-- could also catch the error instead.
--
-- TODO: This function ensures the proper behavior of legacy custom
-- writers. It should be replaced with 'getglobal' in the future.
rawgetglobal :: LuaError e => Name -> LuaE e Lua.Type
rawgetglobal x = do
pushglobaltable
pushName x
rawget (nth 2) <* remove (nth 2) -- remove global table
-- | Name under which the reader function is stored in the registry.
readerField :: Name
readerField = "Pandoc Reader function"
-- | Name under which the writer function is stored in the registry.
writerField :: Name
writerField = "Pandoc Writer function"
-- | Runs a Lua action in a continuable environment and transfers the common
-- state after the Lua action has finished.
inLua :: (PandocMonad m, MonadIO m)
=> GCManagedState -> LuaE PandocError a -> m a
inLua st luaAction = do
let inLua' = liftIO . withGCManagedState @PandocError st
result <- inLua' luaAction
cstate <- inLua' (unPandocLua PandocMonad.getCommonState)
PandocMonad.putCommonState cstate
return result
-- | Returns the ByteStringReader function
byteStringReader :: (PandocMonad m, MonadIO m) => GCManagedState -> Reader m
byteStringReader st = ByteStringReader $ \ropts input -> inLua st $ do
getfield registryindex readerField
push input
push ropts
pcallTrace 2 1 >>= \case
OK -> forcePeek $ peekPandoc top
_ -> throwErrorAsException
-- | Returns the TextReader function
textReader :: (PandocMonad m, MonadIO m) => GCManagedState -> Reader m
textReader st = TextReader $ \ropts srcs -> inLua st $ do
let input = toSources srcs
getfield registryindex readerField
push input
push ropts
pcallTrace 2 1 >>= \case
OK -> forcePeek (peekPandoc top)
_ -> throwErrorAsException
|
