@@ -16,12 +16,8 @@ You should have received a copy of the GNU General Public License
1616along with this program; if not, write to the Free Software
1717Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
1818-}
19−{-# LANGUAGE CPP #-}
2019{-# LANGUAGE FlexibleInstances #-}
2120{-# LANGUAGE LambdaCase #-}
22−#if !MIN_VERSION_base(4,8,0)
23−{-# LANGUAGE OverlappingInstances #-}
24−#endif
2521{-# OPTIONS_GHC -fno-warn-orphans #-}
2622{- |
2723 Module : Text.Pandoc.Lua.StackInstances
@@ -38,15 +34,10 @@ module Text.Pandoc.Lua.StackInstances () where
3834
3935import Control.Applicative ( (<|>) )
4036import Scripting.Lua
41− ( LTYPE(..), LuaState, StackValue(..)
42− , call, getglobal2, ltype, newtable, next, objlen, pop, pushnil
43− )
37+ ( LTYPE(..), LuaState, StackValue(..), getglobal2, ltype, newtable, objlen )
4438import Text.Pandoc.Definition
45−import Text.Pandoc.Lua.Util
46− ( adjustIndexBy, addValue, getTable, addRawInt, getRawInt )
47−
48−import qualified Data.Map as M
49−import qualified Text.Pandoc.UTF8 as UTF8
39+import Text.Pandoc.Lua.SharedInstances ()
40+import Text.Pandoc.Lua.Util ( addValue, getTable, pushViaConstructor )
5041
5142instance StackValue Pandoc where
5243 push lua (Pandoc meta blocks) = do
@@ -261,119 +252,6 @@ instance StackValue QuoteType where
261252 _ -> return Nothing
262253 valuetype _ = TTABLE
263254
264−#if MIN_VERSION_base(4,8,0)
265−instance {-# OVERLAPS #-} StackValue [Char] where
266−#else
267−instance StackValue [Char] where
268−#endif
269− push lua cs = push lua (UTF8.fromString cs)
270− peek lua i = fmap UTF8.toString <$> peek lua i
271− valuetype _ = TSTRING
272−
273−instance (StackValue a, StackValue b) => StackValue (a, b) where
274− push lua (a, b) = do
275− newtable lua
276− addRawInt lua 1 a
277− addRawInt lua 2 b
278− peek lua idx = do
279− a <- getRawInt lua idx 1
280− b <- getRawInt lua idx 2
281− return $ (,) <$> a <*> b
282− valuetype _ = TTABLE
283−
284−instance (StackValue a, StackValue b, StackValue c) =>
285− StackValue (a, b, c)
286− where
287− push lua (a, b, c) = do
288− newtable lua
289− addRawInt lua 1 a
290− addRawInt lua 2 b
291− addRawInt lua 3 c
292− peek lua idx = do
293− a <- getRawInt lua idx 1
294− b <- getRawInt lua idx 2
295− c <- getRawInt lua idx 3
296− return $ (,,) <$> a <*> b <*> c
297− valuetype _ = TTABLE
298−
299−instance (StackValue a, StackValue b, StackValue c,
300− StackValue d, StackValue e) =>
301− StackValue (a, b, c, d, e)
302− where
303− push lua (a, b, c, d, e) = do
304− newtable lua
305− addRawInt lua 1 a
306− addRawInt lua 2 b
307− addRawInt lua 3 c
308− addRawInt lua 4 d
309− addRawInt lua 5 e
310− peek lua idx = do
311− a <- getRawInt lua idx 1
312− b <- getRawInt lua idx 2
313− c <- getRawInt lua idx 3
314− d <- getRawInt lua idx 4
315− e <- getRawInt lua idx 5
316− return $ (,,,,) <$> a <*> b <*> c <*> d <*> e
317− valuetype _ = TTABLE
318−
319−instance (Ord a, StackValue a, StackValue b) =>
320− StackValue (M.Map a b) where
321− push lua m = do
322− newtable lua
323− mapM_ (uncurry $ addValue lua) $ M.toList m
324− peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
325− valuetype _ = TTABLE
326−
327−-- | Try reading the value under the given index as a list of key-value pairs.
328−keyValuePairs :: (StackValue a, StackValue b)
329− => LuaState -> Int -> IO (Maybe [(a, b)])
330−keyValuePairs lua idx = do
331− pushnil lua
332− sequence <$> remainingPairs
333− where
334− remainingPairs = do
335− res <- nextPair
336− case res of
337− Nothing -> return []
338− Just a -> (a:) <$> remainingPairs
339− nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
340− nextPair = do
341− hasNext <- next lua (idx `adjustIndexBy` 1)
342− if hasNext
343− then do
344− val <- peek lua (-1)
345− key <- peek lua (-2)
346− pop lua 1 -- removes the value, keeps the key
347− return $ Just <$> ((,) <$> key <*> val)
348− else do
349− return Nothing
350−
351−
352−-- | Helper class for pushing a single value to the stack via a lua function.
353−-- See @pushViaCall@.
354−class PushViaCall a where
355− pushViaCall' :: LuaState -> String -> IO () -> Int -> a
356−
357−instance PushViaCall (IO ()) where
358− pushViaCall' lua fn pushArgs num = do
359− getglobal2 lua fn
360− pushArgs
361− call lua num 1
362−
363−instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
364− pushViaCall' lua fn pushArgs num x =
365− pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
366−
367−-- | Push an value to the stack via a lua function. The lua function is called
368−-- with all arguments that are passed to this function and is expected to return
369−-- a single value.
370−pushViaCall :: PushViaCall a => LuaState -> String -> a
371−pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
372−
373−-- | Call a pandoc element constructor within lua, passing all given arguments.
374−pushViaConstructor :: PushViaCall a => LuaState -> String -> a
375−pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
376−
377255-- | Return the value at the given index as inline if possible.
378256peekInline :: LuaState -> Int -> IO (Maybe Inline)
379257peekInline lua idx = do