module Scripting.Lua.ConfigFile
(
Config,
openConfig,
closeConfig,
getBool,
getString,
getInt,
getDouble,
getList,
getNestedLists,
getAssocList,
getListOfAssocLists,
getNestedAssocLists,
ConfigFileException
) where
import qualified Scripting.Lua as Lua
import System.IO (FilePath)
import Control.Exception (Exception, throwIO)
import Control.Monad (forM, forM_)
import Control.Monad.Reader
import Data.Typeable (Typeable)
data Config = Config Lua.LuaState
data ConfigFileException = ConfigFileException String
deriving (Show, Typeable)
instance Exception ConfigFileException
type LuaIO a = ReaderT Lua.LuaState IO a
openConfig :: FilePath -> IO Config
openConfig path = do
l <- Lua.newstate
loadResult <- Lua.loadfile l path
callResult <- Lua.pcall l 0 0 0
if loadResult /= 0 || callResult /= 0 then
do
errMsg <- Lua.tostring l (1)
throwIO $ ConfigFileException $ "cannot run config file: " ++ errMsg
else return (Config l)
closeConfig :: Config -> IO ()
closeConfig (Config l) =
Lua.close l
getBool :: Config -> String -> IO Bool
getBool (Config l) name = do
(val, valType) <- getGlobalVal l name
case (val, valType) of
(Just v, Lua.TBOOLEAN) -> return v
(Nothing, Lua.TNIL) -> return False
(_, _) -> throwIO $ ConfigFileException $
"expected boolean value: " ++ name
getString :: Config -> String -> IO String
getString (Config l) name = do
(val, valType) <- getGlobalVal l name
case (val, valType) of
(Just v, Lua.TSTRING) -> return v
(Nothing, Lua.TNIL) -> return ""
(_, _) -> throwIO $ ConfigFileException $
"expected string value: " ++ name
getInt :: Config -> String -> IO (Maybe Int)
getInt (Config l) name = do
(val, valType) <- getGlobalVal l name
case (val, valType) of
(Just v, Lua.TNUMBER) -> return (Just v)
(Nothing, Lua.TNIL) -> return Nothing
(_, _) -> throwIO $ ConfigFileException $
"expected numeric value: " ++ name
getDouble :: Config -> String -> IO (Maybe Double)
getDouble (Config l) name = do
(val, valType) <- getGlobalVal l name
case (val, valType) of
(Just v, Lua.TNUMBER) -> return (Just v)
(Nothing, Lua.TNIL) -> return Nothing
(_, _) -> throwIO $ ConfigFileException $
"expected numeric value: " ++ name
getList :: Config -> String -> IO [String]
getList (Config l) name =
runReaderT (getTable name getListOfStrings) l
getNestedLists :: Config -> String -> IO [[String]]
getNestedLists (Config l) name =
runReaderT (getTable name (getOuterList getListOfStrings)) l
getAssocList :: Config -> String -> IO [(String, String)]
getAssocList (Config l) name =
runReaderT (getTable name getColumns) l
getListOfAssocLists :: Config -> String -> IO [[(String, String)]]
getListOfAssocLists (Config l) name =
runReaderT (getTable name (getOuterList getColumns)) l
getNestedAssocLists :: Config -> String -> IO [(String, [(String, String)])]
getNestedAssocLists (Config l) name =
runReaderT (getTable name getRows) l
getGlobalVal l name = do
Lua.getglobal l name
val <- Lua.peek l (1)
valType <- Lua.ltype l (1)
Lua.pop l 1
return (val, valType)
canBeString valType =
valType `elem` [Lua.TSTRING, Lua.TNUMBER]
getTable :: String ->
(String -> LuaIO [a]) ->
LuaIO [a]
getTable name f = do
l <- ask
getglobal l name
valType <- ltype l (1)
case valType of
Lua.TTABLE -> do items <- f name
pop l 1
return items
Lua.TNIL -> return []
_ -> liftIO $ throwIO $ ConfigFileException $ "expected table: " ++ name
forList :: LuaIO a ->
LuaIO [a]
forList f = do
l <- ask
tableSize <- objlen l (1)
forM [1..tableSize] $ \i -> do
push l i
gettable l (2)
f
getListOfStrings :: String ->
LuaIO [String]
getListOfStrings name = do
l <- ask
forList $ do
valType <- ltype l (1)
if canBeString valType then
do
valStr <- tostring l (1)
pop l 1
return valStr
else liftIO $ throwIO $ ConfigFileException $
"expected table of strings: " ++ name
getOuterList :: (String -> LuaIO a) ->
String ->
LuaIO [a]
getOuterList f name = do
l <- ask
forList $ do
valType <- ltype l (1)
case valType of
Lua.TTABLE -> do innerItems <- f name
pop l 1
return innerItems
_ -> liftIO $ throwIO $ ConfigFileException $ "expected table: " ++ name
getRows :: String -> LuaIO [(String, [(String, String)])]
getRows name = do
l <- ask
pushnil l
getRemainingRows name
getRemainingRows :: String -> LuaIO [(String, [(String, String)])]
getRemainingRows name = do
l <- ask
hasNext <- next l (2)
if hasNext then
do
keyType <- ltype l (2)
valType <- ltype l (1)
case (keyType, valType) of
(Lua.TSTRING, Lua.TTABLE) ->
do keyStr <- tostring l (2)
columns <- getColumns name
pop l 1
rest <- getRemainingRows name
return ((keyStr, columns) : rest)
(_, _) -> liftIO $ throwIO $ ConfigFileException $
"expected string keys and table values: " ++ name
else return []
getColumns :: String -> LuaIO [(String, String)]
getColumns name = do
l <- ask
pushnil l
getRemainingColumns name
getRemainingColumns :: String -> LuaIO [(String, String)]
getRemainingColumns name = do
l <- ask
hasNext <- next l (2)
if hasNext then do
keyType <- ltype l (2)
valType <- ltype l (1)
if keyType == Lua.TSTRING && canBeString valType then
do
keyStr <- tostring l (2)
valStr <- tostring l (1)
pop l 1
rest <- getRemainingColumns name
return ((keyStr, valStr) : rest)
else liftIO $ throwIO $ ConfigFileException $
"expected string keys and string values: " ++ name
else return []
getglobal l name = liftIO $ Lua.getglobal l name
ltype l n = liftIO $ Lua.ltype l n
pop l n = liftIO $ Lua.pop l n
objlen l n = liftIO $ Lua.objlen l n
push l n = liftIO $ Lua.push l n
gettable l n = liftIO $ Lua.gettable l n
tostring l n = liftIO $ Lua.tostring l n
pushnil l = liftIO $ Lua.pushnil l
next l n = liftIO $ Lua.next l n
stackDump l = do
stackSize <- Lua.gettop l
putStrLn "Stack dump:"
forM_ (reverse [1..stackSize]) $ \i -> do
let relativeIndex = stackSize i + 1
putStr $ "Index[" ++ show i ++ " / -" ++ show relativeIndex ++ "] = "
itemType <- Lua.ltype l i
case itemType of
Lua.TNONE -> putStr "TNONE"
Lua.TNIL -> putStr "TNIL"
Lua.TBOOLEAN -> do boolVal <- Lua.toboolean l i
putStr $ "TBOOLEAN " ++ show boolVal
Lua.TLIGHTUSERDATA -> putStr "TLIGHTUSERDATA"
Lua.TNUMBER -> do iVal <- Lua.tointeger l i
putStr $ "TNUMBER " ++ show iVal
Lua.TSTRING -> do sVal <- Lua.tostring l i
putStr $ "TSTRING " ++ sVal
Lua.TTABLE -> putStr "TTABLE"
Lua.TFUNCTION -> putStr "TFUNCTION"
Lua.TTHREAD -> putStr "TTHREAD"
putStr "\n"
putStr "\n"