Use hslua >= 0.7, update Lua code

1 files changed, 90 insertions, 91 deletions

diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index 22b68d5e0..c5770a18b 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -41,14 +41,16 @@ import Data.Data (toConstr, showConstr, dataTypeOf, dataTypeConstrs, Data)
 import Data.Map (Map)
 import Data.Maybe (isJust)
 import Data.Typeable (Typeable)
-import Scripting.Lua (LuaState, StackValue (..))
+import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), runLua,
+                    peekEither, getglobal', throwLuaError)
+import Foreign.Lua.Types.Lua (runLuaWith, liftLua1)
+import Foreign.Lua.Api
 import Text.Pandoc.Definition
 import Text.Pandoc.Lua.PandocModule (pushPandocModule)
 import Text.Pandoc.Lua.StackInstances ()
 import Text.Pandoc.Walk
 
 import qualified Data.Map as Map
-import qualified Scripting.Lua as Lua
 
 newtype LuaException = LuaException String
   deriving (Show, Typeable)
@@ -57,123 +59,120 @@ instance Exception LuaException
 
 runLuaFilter :: (MonadIO m)
              => Maybe FilePath -> FilePath -> [String] -> Pandoc -> m Pandoc
-runLuaFilter datadir filterPath args pd = liftIO $ do
-  lua <- Lua.newstate
-  Lua.openlibs lua
+runLuaFilter datadir filterPath args pd = liftIO . runLua $ do
+  openlibs
   -- store module in global "pandoc"
-  pushPandocModule datadir lua
-  Lua.setglobal lua "pandoc"
-  top <- Lua.gettop lua
-  status <- Lua.loadfile lua filterPath
-  if status /= 0
+  pushPandocModule datadir
+  setglobal "pandoc"
+  top <- gettop
+  stat<- dofile filterPath
+  if stat /= OK
     then do
-      Just luaErrMsg <- Lua.peek lua 1
-      throwIO (LuaException luaErrMsg)
+      luaErrMsg <- peek (-1) <* pop 1
+      throwLuaError luaErrMsg
     else do
-      Lua.call lua 0 Lua.multret
-      newtop <- Lua.gettop lua
+      newtop <- gettop
       -- Use the implicitly defined global filter if nothing was returned
-      when (newtop - top < 1) $ pushGlobalFilter lua
-      Just luaFilters <- Lua.peek lua (-1)
-      Lua.push lua args
-      Lua.setglobal lua "PandocParameters"
-      doc <- runAll luaFilters pd
-      Lua.close lua
-      return doc
-
-pushGlobalFilter :: LuaState -> IO ()
-pushGlobalFilter lua =
-  Lua.newtable lua
-  *> Lua.getglobal2 lua "pandoc.global_filter"
-  *> Lua.call lua 0 1
-  *> Lua.rawseti lua (-2) 1
-
-runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
+      when (newtop - top < 1) $ pushGlobalFilter
+      luaFilters <- peek (-1)
+      push args
+      setglobal "PandocParameters"
+      runAll luaFilters pd
+
+pushGlobalFilter :: Lua ()
+pushGlobalFilter = do
+  newtable
+  getglobal' "pandoc.global_filter"
+  call 0 1
+  rawseti (-2) 1
+
+runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
 runAll = foldr ((>=>) . walkMWithLuaFilter) return
 
-walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc
-walkMWithLuaFilter (LuaFilter lua fnMap) =
-  (if hasOneOf (constructorsFor (dataTypeOf (Str [])))
-      then walkM (tryFilter lua fnMap :: Inline -> IO Inline)
-      else return)
-  >=>
-  (if hasOneOf (constructorsFor (dataTypeOf (Para [])))
-      then walkM (tryFilter lua fnMap :: Block -> IO Block)
-      else return)
-  >=>
-  (case Map.lookup "Meta" fnMap of
-        Just fn -> walkM (\(Pandoc meta blocks) -> do
-                             meta' <- runFilterFunction lua fn meta
-                             return $ Pandoc meta' blocks)
-        Nothing -> return)
-  >=>
-  (case Map.lookup "Pandoc" fnMap `mplus` Map.lookup "Doc" fnMap of
-        Just fn -> (runFilterFunction lua fn) :: Pandoc -> IO Pandoc
-        Nothing -> return)
-  where hasOneOf = any (\k -> isJust (Map.lookup k fnMap))
-        constructorsFor x = map show (dataTypeConstrs x)
+walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
+walkMWithLuaFilter (LuaFilter fnMap) = liftLua1 walkLua
+  where
+    walkLua :: LuaState -> Pandoc -> IO Pandoc
+    walkLua l =
+          (if hasOneOf (constructorsFor (dataTypeOf (Str [])))
+           then walkM (runLuaWith l . (tryFilter fnMap :: Inline -> Lua Inline))
+           else return)
+          >=>
+          (if hasOneOf (constructorsFor (dataTypeOf (Para [])))
+           then walkM ((runLuaWith l . (tryFilter fnMap :: Block -> Lua Block)))
+           else return)
+          >=>
+          (case Map.lookup "Meta" fnMap of
+             Just fn -> walkM ((\(Pandoc meta blocks) -> runLuaWith l $ do
+                                     meta' <- runFilterFunction fn meta
+                                     return $ Pandoc meta' blocks))
+             Nothing -> return)
+          >=>
+          (case Map.lookup "Pandoc" fnMap `mplus` Map.lookup "Doc" fnMap of
+             Just fn -> runLuaWith l . (runFilterFunction fn :: Pandoc -> Lua Pandoc)
+             Nothing -> return)
+    hasOneOf = any (\k -> isJust (Map.lookup k fnMap))
+    constructorsFor x = map show (dataTypeConstrs x)
 
 type FunctionMap = Map String LuaFilterFunction
-data LuaFilter = LuaFilter LuaState FunctionMap
+data LuaFilter = LuaFilter FunctionMap
 
 newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
 
-tryFilter :: (Data a, StackValue a) => LuaState -> FunctionMap -> a -> IO a
-tryFilter lua fnMap x =
+-- | Try running a filter for the given element
+tryFilter :: (Data a, FromLuaStack a, ToLuaStack a) => FunctionMap -> a -> Lua a
+tryFilter fnMap x =
   let filterFnName = showConstr (toConstr x) in
   case Map.lookup filterFnName fnMap of
     Nothing -> return x
-    Just fn -> runFilterFunction lua fn x
+    Just fn -> runFilterFunction fn x
 
-instance StackValue LuaFilter where
-  valuetype _ = Lua.TTABLE
-  push = undefined
-  peek lua idx = fmap (LuaFilter lua) <$> Lua.peek lua idx
+instance FromLuaStack LuaFilter where
+  peek idx = LuaFilter <$> peek idx
 
 -- | Push a value to the stack via a lua filter function. The filter function is
 -- called with given element as argument and is expected to return an element.
 -- Alternatively, the function can return nothing or nil, in which case the
 -- element is left unchanged.
-runFilterFunction :: StackValue a => LuaState -> LuaFilterFunction -> a -> IO a
-runFilterFunction lua lf x = do
-  pushFilterFunction lua lf
-  Lua.push lua x
-  z <- Lua.pcall lua 1 1 0
-  if (z /= 0)
+runFilterFunction :: (FromLuaStack a, ToLuaStack a)
+                  => LuaFilterFunction -> a -> Lua a
+runFilterFunction lf x = do
+  pushFilterFunction lf
+  push x
+  z <- pcall 1 1 Nothing
+  if z /= OK
     then do
-      msg <- Lua.peek lua (-1)
+      msg <- peek (-1)
       let prefix = "Error while running filter function: "
-      throwIO . LuaException $
-        case msg of
-          Nothing   -> prefix ++ "could not read error message"
-          Just msg' -> prefix ++ msg'
+      throwLuaError $ prefix ++ msg
     else do
-      resType <- Lua.ltype lua (-1)
+      resType <- ltype (-1)
       case resType of
-        Lua.TNIL -> Lua.pop lua 1 *> return x
-        _        -> do
-          mbres <- Lua.peek lua (-1)
+        TypeNil -> pop 1 *> return x
+        _       -> do
+          mbres <- peekEither (-1)
           case mbres of
-            Nothing -> throwIO $ LuaException
-                       ("Error while trying to get a filter's return "
-                        ++ "value from lua stack.")
-            Just res -> res <$ Lua.pop lua 1
+            Left err -> throwLuaError
+                        ("Error while trying to get a filter's return "
+                         ++ "value from lua stack.\n" ++ err)
+            Right res -> res <$ pop 1
 
 -- | Push the filter function to the top of the stack.
-pushFilterFunction :: Lua.LuaState -> LuaFilterFunction -> IO ()
-pushFilterFunction lua lf =
+pushFilterFunction :: LuaFilterFunction -> Lua ()
+pushFilterFunction lf =
   -- The function is stored in a lua registry table, retrieve it from there.
-  Lua.rawgeti lua Lua.registryindex (functionIndex lf)
-
-registerFilterFunction :: LuaState -> Int -> IO LuaFilterFunction
-registerFilterFunction lua idx = do
-  isFn <- Lua.isfunction lua idx
-  unless isFn . throwIO . LuaException $ "Not a function at index " ++ show idx
-  Lua.pushvalue lua idx
-  refIdx <- Lua.ref lua Lua.registryindex
+  rawgeti registryindex (functionIndex lf)
+
+registerFilterFunction :: StackIndex -> Lua LuaFilterFunction
+registerFilterFunction idx = do
+  isFn <- isfunction idx
+  unless isFn . throwLuaError $ "Not a function at index " ++ show idx
+  pushvalue idx
+  refIdx <- ref registryindex
   return $ LuaFilterFunction refIdx
 
-instance StackValue LuaFilterFunction where
-  valuetype _ = Lua.TFUNCTION
+instance ToLuaStack LuaFilterFunction where
   push = pushFilterFunction
-  peek = fmap (fmap Just) . registerFilterFunction
+
+instance FromLuaStack LuaFilterFunction where
+  peek = registerFilterFunction