module Scripting.LuaUtils
( luaDoString
, luaDoFile
, dumpStack
) where
import CustomPrelude
import qualified Data.Text as T
import Data.Maybe (fromJust)
import qualified Data.Map as M
import Control.Monad.Loops (whileM, whileM_)
import qualified Scripting.Lua as Lua
instance Lua.StackValue Text where
push l x = Lua.push l $ T.unpack x
peek l ix = do
i <- getIdx l ix
x <- Lua.peek l i
return $ Just $ T.pack (fromJust x)
valuetype _ = Lua.TSTRING
instance (Lua.StackValue o) => Lua.StackValue (Maybe o) where
push l (Just x) = pushTagged l "Just" x
push l (Nothing) = pushTagged l "Nothing" ()
peek l ix = do
i <- getIdx l ix
tag <- readTag l i
case tag of
"Just" -> pullTagged l i Just
"Nothing" -> pullTagged l i f
_ -> error "Invalid Value"
where
f :: o -> Maybe o
f = const Nothing
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue o1, Lua.StackValue o2) => Lua.StackValue (Either o1 o2) where
push l (Left x) = pushTagged l "Left" x
push l (Right x) = pushTagged l "Right" x
peek l ix = do
i <- getIdx l ix
tag <- readTag l i
case tag of
"Left" -> pullTagged l i Left
"Right" -> pullTagged l i Right
_ -> error "Invalid Value"
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue a) => Lua.StackValue [a]
where
push l xs = do
let llen = length xs + 1
Lua.createtable l llen 0
forM_ (zip [1..] xs) $ \(ix,val) -> do
Lua.push l val
Lua.rawseti l (2) ix
peek l i = do
ix <- getIdx l i
Lua.pushnil l
arr <- whileM (Lua.next l ix) $ do
xm <- Lua.peek l (1)
Lua.pop l 1
return $ fromJust xm
return $ Just arr
valuetype _ = Lua.TTABLE
instance (Lua.StackValue a, Lua.StackValue b) => Lua.StackValue (a,b)
where
push l (a,b) = do
Lua.createtable l 2 0
Lua.push l a
Lua.rawseti l (2) 1
Lua.push l b
Lua.rawseti l (2) 2
Lua.pushnil l
Lua.rawseti l (2) 3
peek l i = do
ix <- getIdx l i
Lua.pushnil l
Lua.next l ix
Just a <- Lua.peek l (1)
Lua.pop l 1
Lua.next l ix
Just b <- Lua.peek l (1)
Lua.pop l 2
return $ Just (a,b)
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue a, Lua.StackValue b, Lua.StackValue c) => Lua.StackValue (a,b,c)
where
push l (a,b,c) = Lua.push l ((a,b),c)
peek l ix = do
Just ((a,b),c) <- Lua.peek l ix
return $ Just (a,b,c)
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue a, Lua.StackValue b, Lua.StackValue c, Lua.StackValue d) => Lua.StackValue (a,b,c,d)
where
push l (a,b,c,d) = Lua.push l ((a,b),(c,d))
peek l ix = do
Just ((a,b),(c,d)) <- Lua.peek l ix
return $ Just (a,b,c,d)
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue a, Lua.StackValue b, Lua.StackValue c, Lua.StackValue d, Lua.StackValue e) => Lua.StackValue (a,b,c,d,e)
where
push l (a,b,c,d,e) = Lua.push l ((a,(b,c)),(d,e))
peek l ix = do
Just ((a,(b,c)),(d,e)) <- Lua.peek l ix
return $ Just (a,b,c,d,e)
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue a, Lua.StackValue b, Lua.StackValue c, Lua.StackValue d, Lua.StackValue e, Lua.StackValue f) => Lua.StackValue (a,b,c,d,e,f)
where
push l (a,b,c,d,e,f) = Lua.push l (((a,b),(c,d)),(e,f))
peek l ix = do
Just (((a,b),(c,d)),(e,f)) <- Lua.peek l ix
return $ Just (a,b,c,d,e,f)
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue a, Lua.StackValue b, Lua.StackValue c, Lua.StackValue d,Lua.StackValue e, Lua.StackValue f, Lua.StackValue g) => Lua.StackValue (a,b,c,d,e,f,g)
where
push l (a,b,c,d,e,f,g) = Lua.push l (((a,b),(c,d)),((e,f),g))
peek l ix = do
Just (((a,b),(c,d)),((e,f),g)) <- Lua.peek l ix
return $ Just (a,b,c,d,e,f,g)
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue a, Lua.StackValue b, Lua.StackValue c, Lua.StackValue d, Lua.StackValue e, Lua.StackValue f, Lua.StackValue g, Lua.StackValue h) => Lua.StackValue (a,b,c,d,e,f,g,h)
where
push l (a,b,c,d,e,f,g,h) = Lua.push l (((a,b),(c,d)),((e,f),(g,h)))
peek l ix = do
Just (((a,b),(c,d)),((e,f),(g,h))) <- Lua.peek l ix
return $ Just (a,b,c,d,e,f,g,h)
valuetype _ = Lua.TUSERDATA
instance (Lua.StackValue k, Lua.StackValue v, Ord k) => Lua.StackValue (M.Map k v)
where
push l m = do
let llen = M.size m + 1
Lua.createtable l llen 0
M.foldlWithKey f (return ()) m
where
f m' k v = m' >> do
Lua.push l k
Lua.push l v
Lua.rawset l (3)
peek l i = do
ix <- getIdx l i
Lua.pushnil l
m <- whileIterateM (const $ Lua.next l ix) f M.empty
return $ Just m
where
f m = do
k <- Lua.peek l (2)
v <- Lua.peek l (1)
Lua.pop l 1
return $ M.insert (fromJust k) (fromJust v) m
valuetype _ = Lua.TTABLE
pullTagged :: Lua.StackValue o => Lua.LuaState -> Int -> (o -> a) -> IO (Maybe a)
pullTagged l i f = do
Lua.next l i
Just x <- Lua.peek l (1)
Lua.pop l 1
return $ Just $ f x
pushTagged :: (Lua.StackValue o) => Lua.LuaState -> String -> o -> IO ()
pushTagged l s o = do
Lua.createtable l 2 0
Lua.push l s
Lua.rawseti l (2) 1
Lua.push l o
Lua.rawseti l (2) 2
readTag :: Lua.LuaState -> Int -> IO String
readTag l i = do
Lua.pushnil l
Lua.next l i
Just tag <- Lua.peek l (1)
Lua.pop l 1
return tag
getIdx :: Lua.LuaState -> Int -> IO Int
getIdx l i
| i < 0 = do
top <- Lua.gettop l
return $ top + i + 1
| otherwise = return i
luaDoString :: Lua.LuaState -> String -> IO ()
luaDoString l s = do
Lua.loadstring l s ""
Lua.call l 0 0
luaDoFile :: Lua.LuaState -> String -> IO ()
luaDoFile l s = do
Lua.loadfile l s
Lua.call l 0 0
dumpStack :: Lua.LuaState -> IO ()
dumpStack l = do
putStrLn "<stack>"
top <- Lua.gettop l
forM_ (reverse [1..top]) (\x -> pValue l x 2)
putStrLn "</stack>"
return ()
pValue :: Lua.LuaState -> Int -> Int -> IO ()
pValue l i ident = do
ix <- getIdx l i
t <- Lua.ltype l ix
case t of
Lua.TNIL -> do
putIdent ident
putStrLn "<nil/>"
Lua.TBOOLEAN -> do
putIdent ident
Just (x:: Bool) <- Lua.peek l ix
print x
Lua.TNUMBER -> do
putIdent ident
Just (x:: Int) <- Lua.peek l ix
print x
Lua.TSTRING -> do
putIdent ident
Just (x:: String) <- Lua.peek l ix
print x
Lua.TTABLE -> do
putIdent ident
putStrLn "<table>"
Lua.pushnil l
whileM_ (Lua.next l ix) $ pValue l (1) (ident+2) >> Lua.pop l 1
putIdent ident
putStrLn "</table>"
Lua.TFUNCTION -> do
putIdent ident
putStrLn "<function/>"
_ -> do
putIdent ident
putStrLn "<unknown value />"
where
putIdent x
| x <= 0 = return ()
| otherwise = putStr " " >> putIdent (x1)