138 lines
4.5 KiB
Haskell
138 lines
4.5 KiB
Haskell
{-
|
||
Copyright © 2012-2017 John MacFarlane <jgm@berkeley.edu>
|
||
2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
||
|
||
This program is free software; you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation; either version 2 of the License, or
|
||
(at your option) any later version.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with this program; if not, write to the Free Software
|
||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||
-}
|
||
{-# LANGUAGE FlexibleInstances #-}
|
||
{- |
|
||
Module : Text.Pandoc.Lua.Util
|
||
Copyright : © 2012–2016 John MacFarlane,
|
||
© 2017 Albert Krewinkel
|
||
License : GNU GPL, version 2 or above
|
||
|
||
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
||
Stability : alpha
|
||
|
||
Lua utility functions.
|
||
-}
|
||
module Text.Pandoc.Lua.Util
|
||
( adjustIndexBy
|
||
, getTable
|
||
, setTable
|
||
, addValue
|
||
, getRawInt
|
||
, setRawInt
|
||
, addRawInt
|
||
, keyValuePairs
|
||
, PushViaCall
|
||
, pushViaCall
|
||
, pushViaConstructor
|
||
) where
|
||
|
||
import Scripting.Lua (LuaState, StackValue (..), call, getglobal2, gettable,
|
||
next, pop, pushnil, rawgeti, rawseti, settable)
|
||
|
||
-- | Adjust the stack index, assuming that @n@ new elements have been pushed on
|
||
-- the stack.
|
||
adjustIndexBy :: Int -> Int -> Int
|
||
adjustIndexBy idx n =
|
||
if idx < 0
|
||
then idx - n
|
||
else idx
|
||
|
||
-- | Get value behind key from table at given index.
|
||
getTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)
|
||
getTable lua idx key = do
|
||
push lua key
|
||
gettable lua (idx `adjustIndexBy` 1)
|
||
peek lua (-1) <* pop lua 1
|
||
|
||
-- | Set value for key for table at the given index
|
||
setTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
|
||
setTable lua idx key value = do
|
||
push lua key
|
||
push lua value
|
||
settable lua (idx `adjustIndexBy` 2)
|
||
|
||
-- | Add a key-value pair to the table at the top of the stack
|
||
addValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO ()
|
||
addValue lua = setTable lua (-1)
|
||
|
||
-- | Get value behind key from table at given index.
|
||
getRawInt :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
|
||
getRawInt lua idx key =
|
||
rawgeti lua idx key
|
||
*> peek lua (-1)
|
||
<* pop lua 1
|
||
|
||
-- | Set numeric key/value in table at the given index
|
||
setRawInt :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
|
||
setRawInt lua idx key value = do
|
||
push lua value
|
||
rawseti lua (idx `adjustIndexBy` 1) key
|
||
|
||
-- | Set numeric key/value in table at the top of the stack.
|
||
addRawInt :: StackValue a => LuaState -> Int -> a -> IO ()
|
||
addRawInt lua = setRawInt lua (-1)
|
||
|
||
-- | Try reading the table under the given index as a list of key-value pairs.
|
||
keyValuePairs :: (StackValue a, StackValue b)
|
||
=> LuaState -> Int -> IO (Maybe [(a, b)])
|
||
keyValuePairs lua idx = do
|
||
pushnil lua
|
||
sequence <$> remainingPairs
|
||
where
|
||
remainingPairs = do
|
||
res <- nextPair
|
||
case res of
|
||
Nothing -> return []
|
||
Just a -> (a:) <$> remainingPairs
|
||
nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
|
||
nextPair = do
|
||
hasNext <- next lua (idx `adjustIndexBy` 1)
|
||
if hasNext
|
||
then do
|
||
val <- peek lua (-1)
|
||
key <- peek lua (-2)
|
||
pop lua 1 -- removes the value, keeps the key
|
||
return $ Just <$> ((,) <$> key <*> val)
|
||
else do
|
||
return Nothing
|
||
|
||
-- | Helper class for pushing a single value to the stack via a lua function.
|
||
-- See @pushViaCall@.
|
||
class PushViaCall a where
|
||
pushViaCall' :: LuaState -> String -> IO () -> Int -> a
|
||
|
||
instance PushViaCall (IO ()) where
|
||
pushViaCall' lua fn pushArgs num = do
|
||
getglobal2 lua fn
|
||
pushArgs
|
||
call lua num 1
|
||
|
||
instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
|
||
pushViaCall' lua fn pushArgs num x =
|
||
pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
|
||
|
||
-- | Push an value to the stack via a lua function. The lua function is called
|
||
-- with all arguments that are passed to this function and is expected to return
|
||
-- a single value.
|
||
pushViaCall :: PushViaCall a => LuaState -> String -> a
|
||
pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
|
||
|
||
-- | Call a pandoc element constructor within lua, passing all given arguments.
|
||
pushViaConstructor :: PushViaCall a => LuaState -> String -> a
|
||
pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
|