@@ -0,0 +1,226 @@
1+{-
2+Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+{-# LANGUAGE FlexibleContexts #-}
19+{-# LANGUAGE LambdaCase #-}
20+{-# LANGUAGE OverloadedStrings #-}
21+{-# LANGUAGE ScopedTypeVariables #-}
22+{-# OPTIONS_GHC -fno-warn-orphans #-}
23+{- |
24+ Module : Text.Pandoc.Lua
25+ Copyright : Copyright © 2017 Albert Krewinkel
26+ License : GNU GPL, version 2 or above
27+
28+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
29+ Stability : alpha
30+
31+Pandoc lua utils.
32+-}
33+module Text.Pandoc.Lua ( runLuaFilter ) where
34+
35+import Control.Monad ( (>=>), when )
36+import Control.Monad.Trans ( MonadIO(..) )
37+import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
38+import Data.HashMap.Lazy ( HashMap )
39+import Data.Text ( Text, pack, unpack )
40+import Data.Text.Encoding ( decodeUtf8 )
41+import Scripting.Lua ( LuaState, StackValue(..) )
42+import Scripting.Lua.Aeson ()
43+import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
44+import Text.Pandoc.Lua.PandocModule
45+import Text.Pandoc.Walk
46+
47+import qualified Data.HashMap.Lazy as HashMap
48+import qualified Scripting.Lua as Lua
49+import qualified Scripting.Lua as LuaAeson
50+
51+runLuaFilter :: (MonadIO m)
52+ => FilePath -> [String] -> Pandoc -> m Pandoc
53+runLuaFilter filterPath args pd = liftIO $ do
54+ lua <- LuaAeson.newstate
55+ Lua.openlibs lua
56+ Lua.newtable lua
57+ Lua.setglobal lua "PANDOC_FILTER_FUNCTIONS" -- hack, store functions here
58+ pushPandocModule lua
59+ Lua.setglobal lua "pandoc"
60+ status <- Lua.loadfile lua filterPath
61+ if (status /= 0)
62+ then do
63+ luaErrMsg <- unpack . decodeUtf8 <$> Lua.tostring lua 1
64+ error luaErrMsg
65+ else do
66+ Lua.call lua 0 1
67+ Just luaFilters <- Lua.peek lua (-1)
68+ Lua.push lua (map pack args)
69+ Lua.setglobal lua "PandocParameters"
70+ doc <- runAll luaFilters >=> luaFilter lua "filter_doc" $ pd
71+ Lua.close lua
72+ return doc
73+
74+runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
75+runAll [] = return
76+runAll (x:xs) = walkMWithLuaFilter x >=> runAll xs
77+
78+luaFilter :: Lua.LuaState -> String -> Pandoc -> IO Pandoc
79+luaFilter lua luaFn x = do
80+ fnExists <- isLuaFunction lua luaFn
81+ if fnExists
82+ then walkM (Lua.callfunc lua luaFn :: Pandoc -> IO Pandoc) x
83+ else return x
84+
85+walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc
86+walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap docFnMap) =
87+ walkM (execInlineLuaFilter lua inlineFnMap) >=>
88+ walkM (execBlockLuaFilter lua blockFnMap) >=>
89+ walkM (execDocLuaFilter lua docFnMap)
90+
91+type InlineFunctionMap = HashMap Text (LuaFilterFunction Inline)
92+type BlockFunctionMap = HashMap Text (LuaFilterFunction Block)
93+type DocFunctionMap = HashMap Text (LuaFilterFunction Pandoc)
94+data LuaFilter =
95+ LuaFilter LuaState InlineFunctionMap BlockFunctionMap DocFunctionMap
96+
97+newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int }
98+
99+execDocLuaFilter :: LuaState
100+ -> HashMap Text (LuaFilterFunction Pandoc)
101+ -> Pandoc -> IO Pandoc
102+execDocLuaFilter lua fnMap x = do
103+ let docFnName = "Doc"
104+ case HashMap.lookup docFnName fnMap of
105+ Nothing -> return x
106+ Just fn -> runLuaFilterFunction lua fn x
107+
108+execBlockLuaFilter :: LuaState
109+ -> HashMap Text (LuaFilterFunction Block)
110+ -> Block -> IO Block
111+execBlockLuaFilter lua fnMap x = do
112+ let filterOrId constr = case HashMap.lookup constr fnMap of
113+ Nothing -> return x
114+ Just fn -> runLuaFilterFunction lua fn x
115+ case x of
116+ Plain _ -> filterOrId "Plain"
117+ Para _ -> filterOrId "Para"
118+ LineBlock _ -> filterOrId "LineBlock"
119+ CodeBlock _ _ -> filterOrId "CodeBlock"
120+ RawBlock _ _ -> filterOrId "RawBlock"
121+ BlockQuote _ -> filterOrId "BlockQuote"
122+ OrderedList _ _ -> filterOrId "OrderedList"
123+ BulletList _ -> filterOrId "BulletList"
124+ DefinitionList _ -> filterOrId "DefinitionList"
125+ Header _ _ _ -> filterOrId "Header"
126+ HorizontalRule -> filterOrId "HorizontalRule"
127+ Table _ _ _ _ _ -> filterOrId "Table"
128+ Div _ _ -> filterOrId "Div"
129+ Null -> filterOrId "Null"
130+
131+execInlineLuaFilter :: LuaState
132+ -> HashMap Text (LuaFilterFunction Inline)
133+ -> Inline -> IO Inline
134+execInlineLuaFilter lua fnMap x = do
135+ let filterOrId constr = case HashMap.lookup constr fnMap of
136+ Nothing -> return x
137+ Just fn -> runLuaFilterFunction lua fn x
138+ case x of
139+ Cite _ _ -> filterOrId "Cite"
140+ Code _ _ -> filterOrId "Code"
141+ Emph _ -> filterOrId "Emph"
142+ Image _ _ _ -> filterOrId "Image"
143+ LineBreak -> filterOrId "LineBreak"
144+ Link _ _ _ -> filterOrId "Link"
145+ Math _ _ -> filterOrId "Math"
146+ Note _ -> filterOrId "Note"
147+ Quoted _ _ -> filterOrId "Quoted"
148+ RawInline _ _ -> filterOrId "RawInline"
149+ SmallCaps _ -> filterOrId "SmallCaps"
150+ SoftBreak -> filterOrId "SoftBreak"
151+ Space -> filterOrId "Space"
152+ Span _ _ -> filterOrId "Span"
153+ Str _ -> filterOrId "Str"
154+ Strikeout _ -> filterOrId "Strikeout"
155+ Strong _ -> filterOrId "Strong"
156+ Subscript _ -> filterOrId "Subscript"
157+ Superscript _ -> filterOrId "Superscript"
158+
159+instance StackValue LuaFilter where
160+ valuetype _ = Lua.TTABLE
161+ push = undefined
162+ peek lua i = do
163+ -- TODO: find a more efficient way of doing this in a typesafe manner.
164+ inlineFnMap <- Lua.peek lua i
165+ blockFnMap <- Lua.peek lua i
166+ docFnMap <- Lua.peek lua i
167+ return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap <*> docFnMap
168+
169+runLuaFilterFunction :: (StackValue a)
170+ => LuaState -> LuaFilterFunction a -> a -> IO a
171+runLuaFilterFunction lua lf inline = do
172+ pushFilterFunction lua lf
173+ Lua.push lua inline
174+ Lua.call lua 1 1
175+ Just res <- Lua.peek lua (-1)
176+ Lua.pop lua 1
177+ return res
178+
179+-- FIXME: use registry
180+pushFilterFunction :: Lua.LuaState -> LuaFilterFunction a -> IO ()
181+pushFilterFunction lua lf = do
182+ Lua.getglobal lua "PANDOC_FILTER_FUNCTIONS"
183+ Lua.rawgeti lua (-1) (functionIndex lf)
184+ Lua.remove lua (-2) -- remove global from stack
185+
186+instance StackValue (LuaFilterFunction a) where
187+ valuetype _ = Lua.TFUNCTION
188+ push lua v = pushFilterFunction lua v
189+ peek lua i = do
190+ isFn <- Lua.isfunction lua i
191+ when (not isFn) (error $ "Not a function at index " ++ (show i))
192+ Lua.pushvalue lua i
193+ Lua.getglobal lua "PANDOC_FILTER_FUNCTIONS"
194+ len <- Lua.objlen lua (-1)
195+ Lua.insert lua (-2)
196+ Lua.rawseti lua (-2) (len + 1)
197+ Lua.pop lua 1
198+ return . Just $ LuaFilterFunction (len + 1)
199+
200+
201+isLuaFunction :: Lua.LuaState -> String -> IO Bool
202+isLuaFunction lua fnName = do
203+ Lua.getglobal lua fnName
204+ res <- Lua.isfunction lua (-1)
205+ Lua.pop lua (-1)
206+ return res
207+
208+maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
209+maybeFromJson mv = fromJSON <$> mv >>= \case
210+ Success x -> Just x
211+ _ -> Nothing
212+
213+instance StackValue Pandoc where
214+ push lua = Lua.push lua . toJSON
215+ peek lua i = maybeFromJson <$> peek lua i
216+ valuetype _ = Lua.TTABLE
217+
218+instance StackValue Block where
219+ push lua = Lua.push lua . toJSON
220+ peek lua i = maybeFromJson <$> peek lua i
221+ valuetype _ = Lua.TTABLE
222+
223+instance StackValue Inline where
224+ push lua = Lua.push lua . toJSON
225+ peek lua i = maybeFromJson <$> peek lua i
226+ valuetype _ = Lua.TTABLE