packages feed

hslua 0.3 → 0.3.2

raw patch · 3 files changed

+453/−40 lines, 3 files

Files

hslua.cabal view
@@ -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"
src/Scripting/Lua.hs view
@@ -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
+ src/Scripting/Lua/ConfigFile.hs view
@@ -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"