git.iko.soy/typeable/pandoc
on e02cfcd help sign in
typeable/pandoc/src/Text/Pandoc/Lua.hs
236 lines 8.8 kB history raw
1{-
2Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
4This program is free software; you can redistribute it and/or modify
5it under the terms of the GNU General Public License as published by
6the Free Software Foundation; either version 2 of the License, or
7(at your option) any later version.
9This program is distributed in the hope that it will be useful,
10but WITHOUT ANY WARRANTY; without even the implied warranty of
11MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12GNU General Public License for more details.
14You should have received a copy of the GNU General Public License
15along with this program; if not, write to the Free Software
16Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17-}
18{-# LANGUAGE FlexibleContexts #-}
19{-# LANGUAGE FlexibleInstances #-}
20{-# LANGUAGE MultiParamTypeClasses #-}
21{- |
22 Module : Text.Pandoc.Lua
23 Copyright : Copyright © 2017 Albert Krewinkel
24 License : GNU GPL, version 2 or above
26 Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
27 Stability : alpha
29Pandoc lua utils.
30-}
31module Text.Pandoc.Lua ( runLuaFilter, pushPandocModule ) where
33import Control.Monad ( (>=>), when )
34import Control.Monad.Trans ( MonadIO(..) )
35import Data.Map ( Map )
36import Scripting.Lua ( LuaState, StackValue(..) )
37import Text.Pandoc.Definition
38import Text.Pandoc.Lua.PandocModule ( pushPandocModule )
39import Text.Pandoc.Lua.StackInstances ()
40import Text.Pandoc.Walk
42import qualified Data.Map as Map
43import qualified Scripting.Lua as Lua
45runLuaFilter :: (MonadIO m)
46 => FilePath -> [String] -> Pandoc -> m Pandoc
47runLuaFilter filterPath args pd = liftIO $ do
48 lua <- Lua.newstate
49 Lua.openlibs lua
50 -- create table in registry to store filter functions
51 Lua.push lua "PANDOC_FILTER_FUNCTIONS"
52 Lua.newtable lua
53 Lua.rawset lua Lua.registryindex
54 -- store module in global "pandoc"
55 pushPandocModule lua
56 Lua.setglobal lua "pandoc"
57 top <- Lua.gettop lua
58 status <- Lua.loadfile lua filterPath
59 if (status /= 0)
60 then do
61 Just luaErrMsg <- Lua.peek lua 1
62 error luaErrMsg
63 else do
64 Lua.call lua 0 Lua.multret
65 newtop <- Lua.gettop lua
66 -- Use the implicitly defined global filter if nothing was returned
67 when (newtop - top < 1) $ pushGlobalFilter lua
68 Just luaFilters <- Lua.peek lua (-1)
69 Lua.push lua args
70 Lua.setglobal lua "PandocParameters"
71 doc <- runAll luaFilters pd
72 Lua.close lua
73 return doc
75pushGlobalFilter :: LuaState -> IO ()
76pushGlobalFilter lua =
77 Lua.newtable lua
78 *> Lua.getglobal2 lua "pandoc.global_filter"
79 *> Lua.call lua 0 1
80 *> Lua.rawseti lua (-2) 1
82runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
83runAll [] = return
84runAll (x:xs) = walkMWithLuaFilter x >=> runAll xs
86walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc
87walkMWithLuaFilter (LuaFilter lua fnMap) =
88 walkM (execInlineLuaFilter lua fnMap) >=>
89 walkM (execBlockLuaFilter lua fnMap) >=>
90 walkM (execMetaLuaFilter lua fnMap) >=>
91 walkM (execDocLuaFilter lua fnMap)
93type FunctionMap = Map String LuaFilterFunction
94data LuaFilter = LuaFilter LuaState FunctionMap
96newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
98execDocLuaFilter :: LuaState
99 -> FunctionMap
100 -> Pandoc -> IO Pandoc
101execDocLuaFilter lua fnMap x = do
102 let docFnName = "Doc"
103 case Map.lookup docFnName fnMap of
104 Nothing -> return x
105 Just fn -> runLuaFilterFunction lua fn x
107execMetaLuaFilter :: LuaState
108 -> FunctionMap
109 -> Pandoc -> IO Pandoc
110execMetaLuaFilter lua fnMap pd@(Pandoc meta blks) = do
111 let metaFnName = "Meta"
112 case Map.lookup metaFnName fnMap of
113 Nothing -> return pd
114 Just fn -> do
115 meta' <- runLuaFilterFunction lua fn meta
116 return $ Pandoc meta' blks
118execBlockLuaFilter :: LuaState
119 -> FunctionMap
120 -> Block -> IO Block
121execBlockLuaFilter lua fnMap x = do
122 let tryFilter :: String -> IO Block
123 tryFilter filterFnName =
124 case Map.lookup filterFnName fnMap of
125 Nothing -> return x
126 Just fn -> runLuaFilterFunction lua fn x
127 case x of
128 BlockQuote _ -> tryFilter "BlockQuote"
129 BulletList _ -> tryFilter "BulletList"
130 CodeBlock _ _ -> tryFilter "CodeBlock"
131 DefinitionList _ -> tryFilter "DefinitionList"
132 Div _ _ -> tryFilter "Div"
133 Header _ _ _ -> tryFilter "Header"
134 HorizontalRule -> tryFilter "HorizontalRule"
135 LineBlock _ -> tryFilter "LineBlock"
136 Null -> tryFilter "Null"
137 Para _ -> tryFilter "Para"
138 Plain _ -> tryFilter "Plain"
139 RawBlock _ _ -> tryFilter "RawBlock"
140 OrderedList _ _ -> tryFilter "OrderedList"
141 Table _ _ _ _ _ -> tryFilter "Table"
143execInlineLuaFilter :: LuaState
144 -> FunctionMap
145 -> Inline -> IO Inline
146execInlineLuaFilter lua fnMap x = do
147 let tryFilter :: String -> IO Inline
148 tryFilter filterFnName =
149 case Map.lookup filterFnName fnMap of
150 Nothing -> return x
151 Just fn -> runLuaFilterFunction lua fn x
152 let tryFilterAlternatives :: [String] -> IO Inline
153 tryFilterAlternatives [] = return x
154 tryFilterAlternatives (fnName : alternatives) =
155 case Map.lookup fnName fnMap of
156 Nothing -> tryFilterAlternatives alternatives
157 Just fn -> runLuaFilterFunction lua fn x
158 case x of
159 Cite _ _ -> tryFilter "Cite"
160 Code _ _ -> tryFilter "Code"
161 Emph _ -> tryFilter "Emph"
162 Image _ _ _ -> tryFilter "Image"
163 LineBreak -> tryFilter "LineBreak"
164 Link _ _ _ -> tryFilter "Link"
165 Math DisplayMath _ -> tryFilterAlternatives ["DisplayMath", "Math"]
166 Math InlineMath _ -> tryFilterAlternatives ["InlineMath", "Math"]
167 Note _ -> tryFilter "Note"
168 Quoted DoubleQuote _ -> tryFilterAlternatives ["DoubleQuoted", "Quoted"]
169 Quoted SingleQuote _ -> tryFilterAlternatives ["SingleQuoted", "Quoted"]
170 RawInline _ _ -> tryFilter "RawInline"
171 SmallCaps _ -> tryFilter "SmallCaps"
172 SoftBreak -> tryFilter "SoftBreak"
173 Space -> tryFilter "Space"
174 Span _ _ -> tryFilter "Span"
175 Str _ -> tryFilter "Str"
176 Strikeout _ -> tryFilter "Strikeout"
177 Strong _ -> tryFilter "Strong"
178 Subscript _ -> tryFilter "Subscript"
179 Superscript _ -> tryFilter "Superscript"
181instance StackValue LuaFilter where
182 valuetype _ = Lua.TTABLE
183 push = undefined
184 peek lua idx = fmap (LuaFilter lua) <$> Lua.peek lua idx
186-- | Helper class for pushing a single value to the stack via a lua function.
187-- See @pushViaCall@.
188class PushViaFilterFunction a where
189 pushViaFilterFunction' :: LuaState -> LuaFilterFunction -> IO () -> Int -> a
191instance StackValue a => PushViaFilterFunction (IO a) where
192 pushViaFilterFunction' lua lf pushArgs num = do
193 pushFilterFunction lua lf
194 pushArgs
195 Lua.call lua num 1
196 mbres <- Lua.peek lua (-1)
197 case mbres of
198 Nothing -> error $ "Error while trying to get a filter's return "
199 ++ "value from lua stack."
200 Just res -> res <$ Lua.pop lua 1
202instance (StackValue a, PushViaFilterFunction b) =>
203 PushViaFilterFunction (a -> b) where
204 pushViaFilterFunction' lua lf pushArgs num x =
205 pushViaFilterFunction' lua lf (pushArgs *> push lua x) (num + 1)
207-- | Push an value to the stack via a lua filter function. The function is
208-- called with all arguments that are passed to this function and is expected to
209-- return a single value.
210runLuaFilterFunction :: PushViaFilterFunction a
211 => LuaState -> LuaFilterFunction -> a
212runLuaFilterFunction lua lf = pushViaFilterFunction' lua lf (return ()) 0
214-- | Push the filter function to the top of the stack.
215pushFilterFunction :: Lua.LuaState -> LuaFilterFunction -> IO ()
216pushFilterFunction lua lf = do
217 -- The function is stored in a lua registry table, retrieve it from there.
218 push lua ("PANDOC_FILTER_FUNCTIONS"::String)
219 Lua.rawget lua Lua.registryindex
220 Lua.rawgeti lua (-1) (functionIndex lf)
221 Lua.remove lua (-2) -- remove registry table from stack
223instance StackValue LuaFilterFunction where
224 valuetype _ = Lua.TFUNCTION
225 push lua v = pushFilterFunction lua v
226 peek lua i = do
227 isFn <- Lua.isfunction lua i
228 when (not isFn) (error $ "Not a function at index " ++ (show i))
229 Lua.pushvalue lua i
230 push lua ("PANDOC_FILTER_FUNCTIONS"::String)
231 Lua.rawget lua Lua.registryindex
232 len <- Lua.objlen lua (-1)
233 Lua.insert lua (-2)
234 Lua.rawseti lua (-2) (len + 1)
235 Lua.pop lua 1
236 return . Just $ LuaFilterFunction (len + 1)