hslua 0.3.4 → 0.3.5
raw patch · 2 files changed
+119/−93 lines, 2 filesdep +mtl
Dependencies added: mtl
Files
- hslua.cabal +3/−3
- src/Scripting/Lua/ConfigFile.hs +116/−90
hslua.cabal view
@@ -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 <gracjanpolak@gmail.com> Maintainer: Gracjan Polak <gracjanpolak@gmail.com> 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,
src/Scripting/Lua/ConfigFile.hs view
@@ -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 ++ "] = "