diff --git a/hslua.cabal b/hslua.cabal --- a/hslua.cabal +++ b/hslua.cabal @@ -1,8 +1,7 @@ Name: hslua -Version: 0.3 +Version: 0.3.2 Stability: beta Cabal-version: >= 1.6 -Exposed-modules: Scripting.Lua License: BSD3 Build-type: Simple License-File: COPYRIGHT @@ -17,15 +16,26 @@ The package is standalone: full Lua interpreter version 5.1.4 is distributed in this package as well. Category: Scripting -Build-depends: base==4.* -Hs-source-dirs: src -C-sources: src/lapi.c, src/lauxlib.c, src/lbaselib.c, src/lcode.c, src/ldblib.c, - src/ldebug.c, src/ldo.c, src/ldump.c, src/lfunc.c, src/lgc.c, - src/linit.c, src/liolib.c, src/llex.c, src/lmathlib.c, src/lmem.c, - src/loadlib.c, src/lobject.c, src/lopcodes.c, src/loslib.c, - src/lparser.c, src/lstate.c, src/lstring.c, src/lstrlib.c, - src/ltable.c, src/ltablib.c, src/ltm.c, src/lundump.c, src/lvm.c, - src/lzio.c, - src/ntrljmp.c Extra-source-files: src/*.h -Include-dirs: src + +Library + Build-depends: base==4.* + Exposed-modules: Scripting.Lua, Scripting.Lua.ConfigFile + Hs-source-dirs: src + C-sources: src/lapi.c, src/lauxlib.c, src/lbaselib.c, src/lcode.c, + src/ldblib.c, src/ldebug.c, src/ldo.c, src/ldump.c, src/lfunc.c, + src/lgc.c, src/linit.c, src/liolib.c, src/llex.c, src/lmathlib.c, + src/lmem.c, src/loadlib.c, src/lobject.c, src/lopcodes.c, + src/loslib.c, src/lparser.c, src/lstate.c, src/lstring.c, + src/lstrlib.c, src/ltable.c, src/ltablib.c, src/ltm.c, + src/lundump.c, src/lvm.c, src/lzio.c, src/ntrljmp.c + Include-dirs: src + + if os(linux) + CC-Options: "-DLUA_USE_LINUX" + + if os(darwin) + CC-Options: "-DLUA_USE_MACOSX" + + if os(freebsd) + CC-Options: "-DLUA_USE_POSIX" diff --git a/src/Scripting/Lua.hs b/src/Scripting/Lua.hs --- a/src/Scripting/Lua.hs +++ b/src/Scripting/Lua.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind -fno-warn-unused-binds #-} -- | -- Module : Scripting.Lua -- Copyright : (c) Gracjan Polak 2007 @@ -51,6 +52,7 @@ LuaCFunction, LuaInteger, LuaNumber, + LuaImport(..), -- * Constants and enumerations GCCONTROL(..), @@ -174,8 +176,7 @@ registerhsfunction ) where -import Prelude hiding (error,concat) -import qualified Prelude +import Prelude hiding (concat) import Foreign.C import Foreign.Ptr import Foreign.StablePtr @@ -211,6 +212,7 @@ | TBOOLEAN | TLIGHTUSERDATA | TNUMBER + fromEnum TFUNCTION = 6 | TSTRING | TTABLE | TFUNCTION @@ -219,26 +221,26 @@ deriving (Eq,Show,Ord) instance Enum LTYPE where - fromEnum TNONE = -1 - fromEnum TNIL = 0 - fromEnum TBOOLEAN = 1 - fromEnum TLIGHTUSERDATA = 2 - fromEnum TNUMBER = 3 - fromEnum TSTRING = 4 - fromEnum TTABLE = 5 - fromEnum TFUNCTION = 6 - fromEnum TUSERDATA = 7 - fromEnum TTHREAD = 8 - toEnum (-1) = TNONE - toEnum 0 = TNIL - toEnum 1 = TBOOLEAN - toEnum 2 = TLIGHTUSERDATA - toEnum 3 = TNUMBER - toEnum 4 = TSTRING - toEnum 5 = TTABLE - toEnum 6 = TFUNCTION - toEnum 7 = TUSERDATA - toEnum 8 = TTHREAD + fromEnum TNONE = -1 + fromEnum TNIL = 0 + fromEnum TBOOLEAN = 1 + fromEnum TLIGHTUSERDATA = 2 + fromEnum TNUMBER = 3 + fromEnum TSTRING = 4 + fromEnum TTABLE = 5 + fromEnum TUSERDATA = 7 + fromEnum TTHREAD = 8 + toEnum (-1) = TNONE + toEnum 0 = TNIL + toEnum 1 = TBOOLEAN + toEnum 2 = TLIGHTUSERDATA + toEnum 3 = TNUMBER + toEnum 4 = TSTRING + toEnum 5 = TTABLE + toEnum 6 = TFUNCTION + toEnum 7 = TUSERDATA + toEnum 8 = TTHREAD + toEnum n = error $ "Cannot convert (" ++ show n ++ ") to LTYPE" -- | Enumeration used by @gc@ function. data GCCONTROL = GCSTOP @@ -564,7 +566,7 @@ dump l = do r <- newIORef "" let wr :: LuaWriter - wr l p s d = do + wr _l p s _d = do k <- peekCStringLen (p,fromIntegral s) modifyIORef r (++k) return 0 @@ -642,7 +644,7 @@ loadstring l script cn = do w <- newIORef nullPtr let rd :: LuaReader - rd l d ps = do + rd _l _d ps = do k <- readIORef w if k==nullPtr then do @@ -816,6 +818,7 @@ -- | Lua type id code of the vaule expected. Parameter is unused. valuetype :: a -> LTYPE +maybepeek :: l -> n -> (l -> n -> IO Bool) -> (l -> n -> IO r) -> IO (Maybe r) maybepeek l n test peek = do v <- test l n if v @@ -871,7 +874,7 @@ instance StackValue () where push l _ = pushnil l - peek l n = maybepeek l n isnil (\l n -> return ()) + peek l n = maybepeek l n isnil (\_l _n -> return ()) valuetype _ = TNIL @@ -912,6 +915,9 @@ where (x:xs) = splitdot n splitdot = filter (/=".") . L.groupBy (\a b -> a/='.' && b/='.') dotable x = getfield l (-1) x >> gettop l >>= \n -> remove l (n-1) + + +typenameindex :: LuaState -> Int -> IO String typenameindex l n = ltype l n >>= typename l class LuaImport a where @@ -919,8 +925,8 @@ luaimportargerror :: Int -> String -> a -> LuaCFunction instance (StackValue a) => LuaImport (IO a) where - luaimportargerror n msg x l = argerror l n msg - luaimport' narg x l = x >>= push l >> return 1 + luaimportargerror n msg _x l = argerror l n msg + luaimport' _narg x l = x >>= push l >> return 1 instance (StackValue a,LuaImport b) => LuaImport (a -> b) where luaimportargerror n msg x l = luaimportargerror n msg (x undefined) l diff --git a/src/Scripting/Lua/ConfigFile.hs b/src/Scripting/Lua/ConfigFile.hs new file mode 100644 --- /dev/null +++ b/src/Scripting/Lua/ConfigFile.hs @@ -0,0 +1,397 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +-- | +-- Module : Scripting.Lua.ConfigFile +-- Copyright : (c) Benjamin Geer 2011 +-- +-- License : BSD3-style +-- +-- Maintainer : benjamin.geer@gmail.com +-- Stability : alpha +-- Portability : portable, ffi +-- +-- Reads configuration files written in Lua. See @http:\/\/www.lua.org\/@ +-- for more details. +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 Data.Typeable (Typeable) + +-- | Represents an open configuration file. +data Config = Config Lua.LuaState + +-- | Thrown when an error occurs in reading a configuration file. +data ConfigFileException = ConfigFileException String + deriving (Show, Typeable) +instance Exception ConfigFileException + +-- | Opens a config file and returns an opaque reference to the file. +-- You must close this reference using @close@ when you're done reading +-- the file. +openConfig :: FilePath -> IO Config +openConfig path = do + l <- Lua.newstate + loadResult <- Lua.loadfile l path + callResult <- Lua.call l 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) + +-- | Closes a configuration file. +closeConfig :: Config -> IO () +closeConfig (Config l) = + -- putStrLn "closing Lua" + Lua.close l + +-- | Returns a boolean value from a configuration file. Returns @False@ +-- if the value is not defined in the file. Example: +-- +-- > someVal = true +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 + +-- | Returns a string value from a configuration file. Returns the +-- empty string if the value is not defined in the file. Example: +-- +-- > someVal = "foo" +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 + +-- | Returns an integer value from a configuration file. Example: +-- +-- > someVal = 2 +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 + +-- | Returns a double value from a configuration file. Example: +-- +-- > someVal = 3.1415926 +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 + +-- | Returns a list of strings (i.e. a Lua table in which the keys +-- are integers and the values are strings) from a configuration file. +-- Example: +-- +-- > someVal = { "foo", "bar", "baz" } +getList :: Config -> String -> IO [String] +getList (Config l) name = + getTable l name getListOfStrings + +-- | Returns a list of lists, i.e. a Lua table of tables. In the outer +-- table, the keys are integers and the values are tables, and in the inner +-- tables, the keys are integers and the values are strings. Example: +-- +-- > someVal = { +-- > { "foo one", "foo two", "foo three" }, +-- > { "bar one", "bar two", "bar three" } +-- > } +getNestedLists :: Config -> String -> IO [[String]] +getNestedLists (Config l) name = + getTable l name (\l name -> getOuterList l name getListOfStrings) + +-- | Returns an association list, i.e. a Lua table in which the keys +-- and values are strings. Example: +-- +-- > someVal = { +-- > one = "foo", +-- > two = "bar", +-- > three = "baz" +-- > } +getAssocList :: Config -> String -> IO [(String, String)] +getAssocList (Config l) name = + getTable l name getColumns + +-- | Returns a list of association lists, i.e. a Lua table of tables. +-- In the outer table, the keys are integers and the values are tables, +-- and in the inner tables, the keys and values are strings. Example: +-- +-- > someVal = { +-- > { +-- > foo = "aaa", +-- > bar = "bbb", +-- > baz = "ccc" +-- > }, +-- > { +-- > foo = "ddd", +-- > bar = "eee", +-- > baz = "fff" +-- > } +-- > } +getListOfAssocLists :: Config -> String -> IO [[(String, String)]] +getListOfAssocLists (Config l) name = + getTable l name (\l name -> getOuterList l name getColumns) + +-- | Returns an association list of association lists, i.e. a Lua table +-- of tables. In the outer table, the keys are strings and the values +-- are tables, and in the inner tables, the keys and values are strings. +-- Example: +-- +-- > someVal = { +-- > something = { +-- > foo = "aaa", +-- > bar = "bbb", +-- > baz = "ccc" +-- > }, +-- > somethingElse = { +-- > foo = "ddd", +-- > bar = "eee", +-- > baz = "fff" +-- > } +-- > } +getNestedAssocLists :: Config -> String -> IO [(String, [(String, String)])] +getNestedAssocLists (Config l) name = + getTable l name getRows + +-- Private functions + +{- + +Gets a Lua global and pops it off the Lua stack. + +-} +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) + +{- + +Checks whether a value can be converted to a string. + +-} +canBeString valType = + valType `elem` [Lua.TSTRING, Lua.TNUMBER] + +{- + +Gets a Lua table, performs some action on it and returns the result +as a list. + +-} +getTable :: Lua.LuaState -> + String -> + (Lua.LuaState -> String -> IO [a]) -> + IO [a] +getTable l name f = do + Lua.getglobal l name + valType <- Lua.ltype l (-1) + case valType of + Lua.TTABLE -> do items <- f l name + Lua.pop l 1 + return items + Lua.TNIL -> return [] + _ -> throwIO $ ConfigFileException $ "expected table: " ++ name + + +{- + +Iterates over the elements of a Lua table whose keys are integers, +performs some action on each element, and returns the results as a +list. + +-} +forList :: Lua.LuaState -> + IO a -> + IO [a] +forList l f = do + tableSize <- Lua.objlen l (-1) + forM [1..tableSize] $ \i -> do + Lua.push l i + Lua.gettable l (-2) + f + +{- + +Gets all elements from a Lua table representing a list. Keys are +integers and values are strings. + +-} +getListOfStrings :: Lua.LuaState -> + String -> + IO [String] +getListOfStrings l name = + forList l $ do + valType <- Lua.ltype l (-1) + if canBeString valType then + do + valStr <- Lua.tostring l (-1) + Lua.pop l 1 + return valStr + else throwIO $ ConfigFileException $ + "expected table of strings: " ++ name + +{- + +Gets all elements from a Lua table of tables. In the outer table, +keys are integers and values are tables. The function passed as an +argument knows the structure of the inner tables. + +-} +getOuterList :: Lua.LuaState -> + String -> + (Lua.LuaState -> String -> IO a) -> + IO [a] +getOuterList l name f = + forList l $ do + valType <- Lua.ltype l (-1) + case valType of + Lua.TTABLE -> do innerItems <- f l name + Lua.pop l 1 + return innerItems + _ -> throwIO $ ConfigFileException $ "expected table: " ++ name + +{- + +Gets all elements from a Lua table of tables. In the outer table, +each key is a string, and each value is a table. In the inner tables, +keys and values are strings. + +-} +getRows :: Lua.LuaState -> String -> IO [(String, [(String, String)])] +getRows l name = do + -- putStrLn $ "entering getRows" + -- stackDump l + Lua.pushnil l + getRemainingRows l name + +{- + +Recursively gets the remaining elements from a Lua table of tables. +In the outer table, each key is a string, and each value is a table. +In the inner tables, keys and values are strings. + +-} +getRemainingRows :: Lua.LuaState -> String -> IO [(String, [(String, String)])] +getRemainingRows l name = do + -- putStrLn $ "entering getRemainingRows" + -- stackDump l + hasNext <- Lua.next l (-2) + if hasNext then + do -- putStrLn $ "getRemainingRows: hasNext" + keyType <- Lua.ltype l (-2) + valType <- Lua.ltype l (-1) + case (keyType, valType) of + (Lua.TSTRING, Lua.TTABLE) -> + do keyStr <- Lua.tostring l (-2) + columns <- getColumns l name + Lua.pop l 1 + rest <- getRemainingRows l name + return ((keyStr, columns) : rest) + (_, _) -> throwIO $ ConfigFileException $ + "expected string keys and table values: " ++ name + else return [] + +{- + +Gets all elements from a Lua table and returns them as a list of +key-value pairs, where keys and values are strings. + +-} +getColumns :: Lua.LuaState -> String -> IO [(String, String)] +getColumns l name = do + -- putStrLn $ "entering getColumns" + -- stackDump l + Lua.pushnil l + getRemainingColumns l name + +{- + +Recursively gets the remaining elements from a Lua table and returns +them as a list of key-value pairs, where keys and values are strings. + +-} +getRemainingColumns :: Lua.LuaState -> String -> IO [(String, String)] +getRemainingColumns l name = do + -- putStrLn $ "entering getRemainingColumns" + -- stackDump l + hasNext <- Lua.next l (-2) + if hasNext then + do -- putStrLn $ "getRemainingColumns: hasNext" + -- stackDump l + keyType <- Lua.ltype l (-2) + valType <- Lua.ltype l (-1) + if keyType == Lua.TSTRING && canBeString valType then + do + keyStr <- Lua.tostring l (-2) + valStr <- Lua.tostring l (-1) + Lua.pop l 1 + rest <- getRemainingColumns l name + return ((keyStr, valStr) : rest) + else throwIO $ ConfigFileException $ + "expected string keys and string values: " ++ name + else return [] + +{- + +Dumps the Lua stack for debugging purposes. + +-} +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"