diff --git a/hslua.cabal b/hslua.cabal --- a/hslua.cabal +++ b/hslua.cabal @@ -1,11 +1,11 @@ Name: hslua -Version: 0.3.4 +Version: 0.3.5 Stability: beta Cabal-version: >= 1.6 License: BSD3 Build-type: Simple License-File: COPYRIGHT -Copyright: 2007-2010, Gracjan Polak +Copyright: 2007-2012, Gracjan Polak Author: Gracjan Polak Maintainer: Gracjan Polak Synopsis: A Lua language interpreter embedding in Haskell @@ -19,7 +19,7 @@ Extra-source-files: src/*.h Library - Build-depends: base==4.* + Build-depends: base==4.*, mtl >= 2.1 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, diff --git a/src/Scripting/Lua/ConfigFile.hs b/src/Scripting/Lua/ConfigFile.hs --- a/src/Scripting/Lua/ConfigFile.hs +++ b/src/Scripting/Lua/ConfigFile.hs @@ -2,7 +2,7 @@ -- | -- Module : Scripting.Lua.ConfigFile --- Copyright : (c) Benjamin Geer 2011 +-- Copyright : (c) Benjamin Geer 2011, 2013 -- -- License : BSD3-style -- @@ -33,6 +33,7 @@ import System.IO (FilePath) import Control.Exception (Exception, throwIO) import Control.Monad (forM, forM_) +import Control.Monad.Reader import Data.Typeable (Typeable) -- | Represents an open configuration file. @@ -43,6 +44,10 @@ deriving (Show, Typeable) instance Exception ConfigFileException +-- The ReaderT monad transformer stores the Lua environment so we +-- don't have to pass it around so much. +type LuaIO a = ReaderT Lua.LuaState IO a + -- | 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. @@ -120,7 +125,7 @@ -- > someVal = { "foo", "bar", "baz" } getList :: Config -> String -> IO [String] getList (Config l) name = - getTable l name getListOfStrings + runReaderT (getTable name getListOfStrings) l -- | 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 @@ -132,7 +137,7 @@ -- > } getNestedLists :: Config -> String -> IO [[String]] getNestedLists (Config l) name = - getTable l name (\l name -> getOuterList l name getListOfStrings) + runReaderT (getTable name (getOuterList getListOfStrings)) l -- | Returns an association list, i.e. a Lua table in which the keys -- and values are strings. Example: @@ -144,7 +149,7 @@ -- > } getAssocList :: Config -> String -> IO [(String, String)] getAssocList (Config l) name = - getTable l name getColumns + runReaderT (getTable name getColumns) l -- | 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, @@ -164,7 +169,7 @@ -- > } getListOfAssocLists :: Config -> String -> IO [[(String, String)]] getListOfAssocLists (Config l) name = - getTable l name (\l name -> getOuterList l name getColumns) + runReaderT (getTable name (getOuterList getColumns)) l -- | 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 @@ -185,7 +190,7 @@ -- > } getNestedAssocLists :: Config -> String -> IO [(String, [(String, String)])] getNestedAssocLists (Config l) name = - getTable l name getRows + runReaderT (getTable name getRows) l -- Private functions @@ -215,19 +220,19 @@ 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) +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 l name - Lua.pop l 1 + Lua.TTABLE -> do items <- f name + pop l 1 return items Lua.TNIL -> return [] - _ -> throwIO $ ConfigFileException $ "expected table: " ++ name + _ -> liftIO $ throwIO $ ConfigFileException $ "expected table: " ++ name {- @@ -237,14 +242,14 @@ list. -} -forList :: Lua.LuaState -> - IO a -> - IO [a] -forList l f = do - tableSize <- Lua.objlen l (-1) +forList :: LuaIO a -> + LuaIO [a] +forList f = do + l <- ask + tableSize <- objlen l (-1) forM [1..tableSize] $ \i -> do - Lua.push l i - Lua.gettable l (-2) + push l i + gettable l (-2) f {- @@ -253,18 +258,18 @@ integers and values are strings. -} -getListOfStrings :: Lua.LuaState -> - String -> - IO [String] -getListOfStrings l name = - forList l $ do - valType <- Lua.ltype l (-1) +getListOfStrings :: String -> + LuaIO [String] +getListOfStrings name = do + l <- ask + forList $ do + valType <- ltype l (-1) if canBeString valType then do - valStr <- Lua.tostring l (-1) - Lua.pop l 1 + valStr <- tostring l (-1) + pop l 1 return valStr - else throwIO $ ConfigFileException $ + else liftIO $ throwIO $ ConfigFileException $ "expected table of strings: " ++ name {- @@ -274,18 +279,18 @@ argument knows the structure of the inner tables. -} -getOuterList :: Lua.LuaState -> +getOuterList :: (String -> LuaIO a) -> String -> - (Lua.LuaState -> String -> IO a) -> - IO [a] -getOuterList l name f = - forList l $ do - valType <- Lua.ltype l (-1) + LuaIO [a] +getOuterList f name = do + l <- ask + forList $ do + valType <- ltype l (-1) case valType of - Lua.TTABLE -> do innerItems <- f l name - Lua.pop l 1 + Lua.TTABLE -> do innerItems <- f name + pop l 1 return innerItems - _ -> throwIO $ ConfigFileException $ "expected table: " ++ name + _ -> liftIO $ throwIO $ ConfigFileException $ "expected table: " ++ name {- @@ -294,12 +299,13 @@ 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 +getRows :: String -> LuaIO [(String, [(String, String)])] +getRows name = do + l <- ask + -- liftIO $ putStrLn $ "entering getRows" + -- liftIO $ stackDump l + pushnil l + getRemainingRows name {- @@ -308,24 +314,26 @@ 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) +getRemainingRows :: String -> LuaIO [(String, [(String, String)])] +getRemainingRows name = do + l <- ask + -- liftIO $ putStrLn $ "entering getRemainingRows" + -- liftIO $ stackDump l + hasNext <- 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 + do + -- liftIO $ putStrLn $ "getRemainingRows: hasNext" + 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 [] {- @@ -334,12 +342,13 @@ 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 +getColumns :: String -> LuaIO [(String, String)] +getColumns name = do + l <- ask + -- liftIO $ putStrLn $ "entering getColumns" + -- liftIO $ stackDump l + pushnil l + getRemainingColumns name {- @@ -347,27 +356,44 @@ 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 +getRemainingColumns :: String -> LuaIO [(String, String)] +getRemainingColumns name = do + l <- ask + -- liftIO $ putStrLn $ "entering getRemainingColumns" + -- liftIO $ stackDump l + hasNext <- next l (-2) + if hasNext then do + -- liftIO $ putStrLn $ "getRemainingColumns: hasNext" + -- liftIO $ stackDump l + 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 [] + +{- +These are liftIO wrappers for the Lua functions we use, to reduce +clutter in the monadic code above. + +-} +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 + {- Dumps the Lua stack for debugging purposes. @@ -375,7 +401,7 @@ -} stackDump l = do stackSize <- Lua.gettop l - -- putStrLn $ "Stack dump:" + putStrLn "Stack dump:" forM_ (reverse [1..stackSize]) $ \i -> do let relativeIndex = stackSize - i + 1 putStr $ "Index[" ++ show i ++ " / -" ++ show relativeIndex ++ "] = "