From 56fe5b559e9dbda97840a45c9f3a0713e2913bb5 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 24 Sep 2018 20:11:00 +0200 Subject: Use hslua v1.0.0 --- src/Text/Pandoc/Lua/Util.hs | 88 +++++++++++++++++---------------------------- 1 file changed, 33 insertions(+), 55 deletions(-) (limited to 'src/Text/Pandoc/Lua/Util.hs') 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 2017-2018 Albert Krewinkel @@ -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 <> ": ") <>) -- cgit v1.2.3