Use hslua v1.0.0

1 files changed, 33 insertions, 55 deletions

diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index c12884a10..46e11da24 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
 {-
 Copyright © 2012-2018 John MacFarlane <jgm@berkeley.edu>
             2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@@ -18,6 +17,8 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {- |
    Module      : Text.Pandoc.Lua.Util
    Copyright   : © 2012–2018 John MacFarlane,
@@ -35,39 +36,35 @@ module Text.Pandoc.Lua.Util
   , addField
   , addFunction
   , addValue
-  , typeCheck
-  , popValue
-  , PushViaCall
-  , pushViaCall
   , pushViaConstructor
   , loadScriptFromDataDir
-  , dostring'
+  , defineHowTo
+  , throwTopMessageAsError'
   ) where
 
 import Prelude
-import Control.Monad (when)
-import Control.Monad.Catch (finally)
-import Data.ByteString.Char8 (unpack)
-import Foreign.Lua (FromLuaStack, Lua, NumArgs, StackIndex, Status,
-                    ToLuaStack, ToHaskellFunction)
+import Control.Monad (unless, when)
+import Foreign.Lua ( Lua, NumArgs, Peekable, Pushable, StackIndex
+                   , ToHaskellFunction )
 import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
 
 import qualified Foreign.Lua as Lua
+import qualified Text.Pandoc.UTF8 as UTF8
 
 -- | Get value behind key from table at given index.
-rawField :: FromLuaStack a => StackIndex -> String -> Lua a
+rawField :: Peekable a => StackIndex -> String -> Lua a
 rawField idx key = do
   absidx <- Lua.absindex idx
   Lua.push key
   Lua.rawget absidx
-  popValue
+  Lua.popValue
 
 -- | Add a value to the table at the top of the stack at a string-index.
-addField :: ToLuaStack a => String -> a -> Lua ()
+addField :: Pushable a => String -> a -> Lua ()
 addField = addValue
 
 -- | Add a key-value pair to the table at the top of the stack.
-addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
+addValue :: (Pushable a, Pushable b) => a -> b -> Lua ()
 addValue key value = do
   Lua.push key
   Lua.push value
@@ -78,26 +75,8 @@ addFunction :: ToHaskellFunction a => String -> a -> Lua ()
 addFunction name fn = do
   Lua.push name
   Lua.pushHaskellFunction fn
-  Lua.wrapHaskellFunction
   Lua.rawset (-3)
 
-typeCheck :: StackIndex -> Lua.Type -> Lua ()
-typeCheck idx expected = do
-  actual <- Lua.ltype idx
-  when (actual /= expected) $ do
-    expName <- Lua.typename expected
-    actName <- Lua.typename actual
-    Lua.throwLuaError $ "expected " ++ expName ++ " but got " ++ actName ++ "."
-
--- | Get, then pop the value at the top of the stack.
-popValue :: FromLuaStack a => Lua a
-popValue = do
-  resOrError <- Lua.peekEither (-1)
-  Lua.pop 1
-  case resOrError of
-    Left err -> Lua.throwLuaError err
-    Right x -> return x
-
 -- | Helper class for pushing a single value to the stack via a lua function.
 -- See @pushViaCall@.
 class PushViaCall a where
@@ -110,7 +89,7 @@ instance PushViaCall (Lua ()) where
     pushArgs
     Lua.call num 1
 
-instance (ToLuaStack a, PushViaCall b) => PushViaCall (a -> b) where
+instance (Pushable a, PushViaCall b) => PushViaCall (a -> b) where
   pushViaCall' fn pushArgs num x =
     pushViaCall' fn (pushArgs *> Lua.push x) (num + 1)
 
@@ -127,26 +106,11 @@ pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)
 -- | Load a file from pandoc's data directory.
 loadScriptFromDataDir :: Maybe FilePath -> FilePath -> Lua ()
 loadScriptFromDataDir datadir scriptFile = do
-  script <- fmap unpack . Lua.liftIO . runIOorExplode $
+  script <- Lua.liftIO . runIOorExplode $
             setUserDataDir datadir >> readDataFile scriptFile
-  status <- dostring' script
-  when (status /= Lua.OK) .
-    Lua.throwTopMessageAsError' $ \msg ->
-      "Couldn't load '" ++ scriptFile ++ "'.\n" ++ msg
-
--- | Load a string and immediately perform a full garbage collection. This is
--- important to keep the program from hanging: If the program containes a call
--- to @require@, then a new loader function is created which then becomes
--- garbage. If that function is collected at an inopportune time, i.e. when the
--- Lua API is called via a function that doesn't allow calling back into Haskell
--- (getraw, setraw, …), then the function's finalizer, and the full program,
--- will hang.
-dostring' :: String -> Lua Status
-dostring' script = do
-  loadRes <- Lua.loadstring script
-  if loadRes == Lua.OK
-    then Lua.pcall 0 1 Nothing <* Lua.gc Lua.GCCOLLECT 0
-    else return loadRes
+  status <- Lua.dostring script
+  when (status /= Lua.OK) $
+    throwTopMessageAsError' (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
 
 -- | Get the tag of a value. This is an optimized and specialized version of
 -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index
@@ -155,7 +119,21 @@ dostring' script = do
 getTag :: StackIndex -> Lua String
 getTag idx = do
   -- push metatable or just the table
-  Lua.getmetatable idx >>= \hasMT -> when (not hasMT) (Lua.pushvalue idx)
+  Lua.getmetatable idx >>= \hasMT -> unless hasMT (Lua.pushvalue idx)
   Lua.push "tag"
   Lua.rawget (Lua.nthFromTop 2)
-  Lua.peek Lua.stackTop `finally` Lua.pop 2
+  Lua.tostring Lua.stackTop <* Lua.pop 2 >>= \case
+    Nothing -> Lua.throwException "untagged value"
+    Just x -> return (UTF8.toString x)
+
+-- | Modify the message at the top of the stack before throwing it as an
+-- Exception.
+throwTopMessageAsError' :: (String -> String) -> Lua a
+throwTopMessageAsError' modifier = do
+  msg <- Lua.tostring' Lua.stackTop
+  Lua.pop 2 -- remove error and error string pushed by tostring'
+  Lua.throwException (modifier (UTF8.toString msg))
+
+
+defineHowTo :: String -> Lua a -> Lua a
+defineHowTo ctx = Lua.withExceptionMessage (("Could not " <> ctx <> ": ") <>)