diff options
Diffstat (limited to 'src/Text/Pandoc/Lua')
-rw-r--r-- | src/Text/Pandoc/Lua/Filter.hs | 27 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Init.hs | 13 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/MediaBag.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 28 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/Utils.hs | 24 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Packages.hs | 32 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/StackInstances.hs | 194 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Util.hs | 88 |
8 files changed, 175 insertions, 233 deletions
diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 6cbb10c6b..9b5f5f40a 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -45,23 +45,22 @@ import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf, showConstr, toConstr, tyconUQname) import Data.Foldable (foldrM) import Data.Map (Map) -import Foreign.Lua (Lua, FromLuaStack, ToLuaStack) +import Foreign.Lua (Lua, Peekable, Pushable) import Text.Pandoc.Definition import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (typeCheck) import Text.Pandoc.Walk (walkM, Walkable) import qualified Data.Map.Strict as Map import qualified Foreign.Lua as Lua --- | Filter function stored at the given index in the registry -newtype LuaFilterFunction = LuaFilterFunction Int +-- | Filter function stored in the registry +newtype LuaFilterFunction = LuaFilterFunction Lua.Reference -- | Collection of filter functions (at most one function per element -- constructor) newtype LuaFilter = LuaFilter (Map String LuaFilterFunction) -instance FromLuaStack LuaFilter where +instance Peekable LuaFilter where peek idx = do let constrs = metaFilterName : pandocFilterNames @@ -87,10 +86,10 @@ registerFilterFunction = do -- | Retrieve filter function from registry and push it to the top of the stack. pushFilterFunction :: LuaFilterFunction -> Lua () pushFilterFunction (LuaFilterFunction fnRef) = - Lua.rawgeti Lua.registryindex fnRef + Lua.getref Lua.registryindex fnRef -elementOrList :: FromLuaStack a => a -> Lua [a] +elementOrList :: Peekable a => a -> Lua [a] elementOrList x = do let topOfStack = Lua.stackTop elementUnchanged <- Lua.isnil topOfStack @@ -100,12 +99,10 @@ elementOrList x = do mbres <- Lua.peekEither topOfStack case mbres of Right res -> [res] <$ Lua.pop 1 - Left _ -> do - typeCheck Lua.stackTop Lua.TypeTable - Lua.toList topOfStack `finally` Lua.pop 1 + Left _ -> Lua.peekList topOfStack `finally` Lua.pop 1 -- | Try running a filter for the given element -tryFilter :: (Data a, FromLuaStack a, ToLuaStack a) +tryFilter :: (Data a, Peekable a, Pushable a) => LuaFilter -> a -> Lua [a] tryFilter (LuaFilter fnMap) x = let filterFnName = showConstr (toConstr x) @@ -119,10 +116,10 @@ tryFilter (LuaFilter fnMap) x = -- 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 :: ToLuaStack a => LuaFilterFunction -> a -> Lua () +runFilterFunction :: Pushable a => LuaFilterFunction -> a -> Lua () runFilterFunction lf x = do let errorPrefix = "Error while running filter function:\n" - (`Lua.modifyLuaError` (errorPrefix <>)) $ do + Lua.withExceptionMessage (errorPrefix <>) $ do pushFilterFunction lf Lua.push x Lua.call 1 1 @@ -178,7 +175,7 @@ metaFilterName = "Meta" pandocFilterNames :: [String] pandocFilterNames = ["Pandoc", "Doc"] -singleElement :: FromLuaStack a => a -> Lua a +singleElement :: Peekable a => a -> Lua a singleElement x = do elementUnchanged <- Lua.isnil (-1) if elementUnchanged @@ -189,6 +186,6 @@ singleElement x = do Right res -> res <$ Lua.pop 1 Left err -> do Lua.pop 1 - Lua.throwLuaError $ + Lua.throwException $ "Error while trying to get a filter's return " ++ "value from lua stack.\n" ++ err diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index 15f90664e..35611d481 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} {- Copyright © 2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -16,6 +15,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} +{-# LANGUAGE NoImplicitPrelude #-} {- | Module : Text.Pandoc.Lua Copyright : Copyright © 2017-2018 Albert Krewinkel @@ -40,7 +40,7 @@ import Control.Monad.Trans (MonadIO (..)) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.IORef (newIORef, readIORef) import Data.Version (Version (versionBranch)) -import Foreign.Lua (Lua, LuaException (..)) +import Foreign.Lua (Lua) import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) import Paths_pandoc (version) import Text.Pandoc.Class (PandocIO, getCommonState, getUserDataDir, getMediaBag, @@ -54,17 +54,22 @@ import qualified Foreign.Lua as Lua import qualified Foreign.Lua.Module.Text as Lua import qualified Text.Pandoc.Definition as Pandoc +-- | Lua error message +newtype LuaException = LuaException String deriving (Show) + -- | Run the lua interpreter, using pandoc's default way of environment -- initialization. runPandocLua :: Lua a -> PandocIO (Either LuaException a) runPandocLua luaOp = do luaPkgParams <- luaPackageParams enc <- liftIO $ getForeignEncoding <* setForeignEncoding utf8 - res <- liftIO $ Lua.runLuaEither (initLuaState luaPkgParams *> luaOp) + res <- liftIO $ Lua.runEither (initLuaState luaPkgParams *> luaOp) liftIO $ setForeignEncoding enc newMediaBag <- liftIO (readIORef (luaPkgMediaBag luaPkgParams)) setMediaBag newMediaBag - return res + return $ case res of + Left (Lua.Exception msg) -> Left (LuaException msg) + Right x -> Right x -- | Generate parameters required to setup pandoc's lua environment. luaPackageParams :: PandocIO LuaPackageParams diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index f48fe56c5..150c06cc8 100644 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -87,7 +87,7 @@ mediaDirectoryFn mbRef = do zipWithM_ addEntry [1..] dirContents return 1 where - addEntry :: Int -> (FilePath, MimeType, Int) -> Lua () + addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> Lua () addEntry idx (fp, mimeType, contentLength) = do Lua.newtable Lua.push "path" *> Lua.push fp *> Lua.rawset (-3) diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index ca337941f..769b04b9e 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} {- Copyright © 2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -17,6 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} {- | Module : Text.Pandoc.Lua.Module.Pandoc Copyright : Copyright © 2017-2018 Albert Krewinkel @@ -36,13 +36,12 @@ import Control.Monad (when) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Data.Text (pack) -import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, Optional, liftIO) +import Foreign.Lua (Lua, NumResults, Optional, Peekable, Pushable) import System.Exit (ExitCode (..)) import Text.Pandoc.Class (runIO) import Text.Pandoc.Definition (Block, Inline) import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (addFunction, loadScriptFromDataDir) import Text.Pandoc.Walk (Walkable) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) @@ -57,14 +56,14 @@ import qualified Text.Pandoc.Lua.Util as LuaUtil -- loaded. pushModule :: Maybe FilePath -> Lua NumResults pushModule datadir = do - loadScriptFromDataDir datadir "pandoc.lua" - addFunction "read" readDoc - addFunction "pipe" pipeFn - addFunction "walk_block" walkBlock - addFunction "walk_inline" walkInline + LuaUtil.loadScriptFromDataDir datadir "pandoc.lua" + LuaUtil.addFunction "read" readDoc + LuaUtil.addFunction "pipe" pipeFn + LuaUtil.addFunction "walk_block" walkBlock + LuaUtil.addFunction "walk_inline" walkInline return 1 -walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a) +walkElement :: (Pushable a, Walkable [Inline] a, Walkable [Block] a) => a -> LuaFilter -> Lua a walkElement x f = walkInlines f x >>= walkBlocks f @@ -82,7 +81,8 @@ readDoc content formatSpecOrNil = do Right (reader, es) -> case reader of TextReader r -> do - res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content) + res <- Lua.liftIO . runIO $ + r def{ readerExtensions = es } (pack content) case res of Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc Left s -> Lua.raiseError (show s) -- error while reading @@ -94,7 +94,7 @@ pipeFn :: String -> BL.ByteString -> Lua NumResults pipeFn command args input = do - (ec, output) <- liftIO $ pipeProcess Nothing command args input + (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input case ec of ExitSuccess -> 1 <$ Lua.push output ExitFailure n -> Lua.raiseError (PipeError command n output) @@ -105,14 +105,14 @@ data PipeError = PipeError , pipeErrorOutput :: BL.ByteString } -instance FromLuaStack PipeError where +instance Peekable PipeError where peek idx = PipeError <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1) <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1) <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1) -instance ToLuaStack PipeError where +instance Pushable PipeError where push pipeErr = do Lua.newtable LuaUtil.addField "command" (pipeErrorCommand pipeErr) @@ -124,7 +124,7 @@ instance ToLuaStack PipeError where pushPipeErrorMetaTable :: Lua () pushPipeErrorMetaTable = do v <- Lua.newmetatable "pandoc pipe error" - when v $ addFunction "__tostring" pipeErrorMessage + when v $ LuaUtil.addFunction "__tostring" pipeErrorMessage pipeErrorMessage :: PipeError -> Lua BL.ByteString pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 7016c7ebd..030d6af95 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} {- Copyright © 2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -16,6 +15,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} +{-# LANGUAGE NoImplicitPrelude #-} {- | Module : Text.Pandoc.Lua.Module.Utils Copyright : Copyright © 2017-2018 Albert Krewinkel @@ -33,11 +33,11 @@ module Text.Pandoc.Lua.Module.Utils import Prelude import Control.Applicative ((<|>)) import Data.Default (def) -import Foreign.Lua (FromLuaStack, Lua, LuaInteger, NumResults) +import Foreign.Lua (Peekable, Lua, NumResults) import Text.Pandoc.Class (runIO, setUserDataDir) import Text.Pandoc.Definition (Pandoc, Meta, MetaValue, Block, Inline) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (addFunction, popValue) +import Text.Pandoc.Lua.Util (addFunction) import qualified Data.Digest.Pure.SHA as SHA import qualified Data.ByteString.Lazy as BSL @@ -89,7 +89,7 @@ runJSONFilter mbDatadir doc filterFile optArgs = do Just x -> return x Nothing -> do Lua.getglobal "FORMAT" - (:[]) <$> popValue + (:[]) <$> Lua.popValue filterRes <- Lua.liftIO . runIO $ do setUserDataDir mbDatadir JSONFilter.apply def args filterFile doc @@ -121,18 +121,18 @@ data AstElement | MetaValueElement MetaValue deriving (Show) -instance FromLuaStack AstElement where +instance Peekable AstElement where peek idx = do - res <- Lua.tryLua $ (PandocElement <$> Lua.peek idx) - <|> (InlineElement <$> Lua.peek idx) - <|> (BlockElement <$> Lua.peek idx) - <|> (MetaElement <$> Lua.peek idx) - <|> (MetaValueElement <$> Lua.peek idx) + res <- Lua.try $ (PandocElement <$> Lua.peek idx) + <|> (InlineElement <$> Lua.peek idx) + <|> (BlockElement <$> Lua.peek idx) + <|> (MetaElement <$> Lua.peek idx) + <|> (MetaValueElement <$> Lua.peek idx) case res of Right x -> return x - Left _ -> Lua.throwLuaError + Left _ -> Lua.throwException "Expected an AST element, but could not parse value as such." -- | Convert a number < 4000 to uppercase roman numeral. -toRomanNumeral :: LuaInteger -> Lua String +toRomanNumeral :: Lua.Integer -> Lua String toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index 59637826e..5cf11f5c5 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} {- Copyright © 2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -16,8 +15,9 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} {- | Module : Text.Pandoc.Lua.Packages Copyright : Copyright © 2017-2018 Albert Krewinkel @@ -35,12 +35,11 @@ module Text.Pandoc.Lua.Packages import Prelude import Control.Monad (forM_) -import Data.ByteString.Char8 (unpack) +import Data.ByteString (ByteString) import Data.IORef (IORef) import Foreign.Lua (Lua, NumResults, liftIO) import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir) import Text.Pandoc.MediaBag (MediaBag) -import Text.Pandoc.Lua.Util (dostring') import qualified Foreign.Lua as Lua import Text.Pandoc.Lua.Module.Pandoc as Pandoc @@ -57,14 +56,10 @@ data LuaPackageParams = LuaPackageParams -- | Insert pandoc's package loader as the first loader, making it the default. installPandocPackageSearcher :: LuaPackageParams -> Lua () installPandocPackageSearcher luaPkgParams = do - luaVersion <- Lua.getglobal "_VERSION" *> Lua.peek (-1) - if luaVersion == "Lua 5.1" - then Lua.getglobal' "package.loaders" - else Lua.getglobal' "package.searchers" + Lua.getglobal' "package.searchers" shiftArray Lua.pushHaskellFunction (pandocPackageSearcher luaPkgParams) - Lua.wrapHaskellFunction - Lua.rawseti (-2) 1 + Lua.rawseti (Lua.nthFromTop 2) 1 Lua.pop 1 -- remove 'package.searchers' from stack where shiftArray = forM_ [4, 3, 2, 1] $ \i -> do @@ -86,7 +81,6 @@ pandocPackageSearcher luaPkgParams pkgName = where pushWrappedHsFun f = do Lua.pushHaskellFunction f - Lua.wrapHaskellFunction return 1 searchPureLuaLoader = do let filename = pkgName ++ ".lua" @@ -97,21 +91,19 @@ pandocPackageSearcher luaPkgParams pkgName = Lua.push ("no file '" ++ filename ++ "' in pandoc's datadir") return 1 -loadStringAsPackage :: String -> String -> Lua NumResults +loadStringAsPackage :: String -> ByteString -> Lua NumResults loadStringAsPackage pkgName script = do - status <- dostring' script + status <- Lua.dostring script if status == Lua.OK then return (1 :: NumResults) else do - msg <- Lua.peek (-1) <* Lua.pop 1 - Lua.push ("Error while loading ``" ++ pkgName ++ "`.\n" ++ msg) - Lua.lerror - return (2 :: NumResults) + msg <- Lua.popValue + Lua.raiseError ("Error while loading `" <> pkgName <> "`.\n" <> msg) --- | Get the string representation of the pandoc module -dataDirScript :: Maybe FilePath -> FilePath -> IO (Maybe String) +-- | Get the ByteString representation of the pandoc module. +dataDirScript :: Maybe FilePath -> FilePath -> IO (Maybe ByteString) dataDirScript datadir moduleFile = do res <- runIO $ setUserDataDir datadir >> readDataFile moduleFile return $ case res of Left _ -> Nothing - Right s -> Just (unpack s) + Right s -> Just s diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 9c3b40f12..220dfccfa 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/src/Text/Pandoc/Lua/StackInstances.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} {- Copyright © 2012-2018 John MacFarlane <jgm@berkeley.edu> 2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -19,6 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- | @@ -37,67 +37,59 @@ module Text.Pandoc.Lua.StackInstances () where import Prelude import Control.Applicative ((<|>)) import Control.Monad (when) -import Control.Monad.Catch (finally) import Data.Data (showConstr, toConstr) -import Data.Foldable (forM_) -import Foreign.Lua (FromLuaStack (peek), Lua, LuaInteger, LuaNumber, StackIndex, - ToLuaStack (push), Type (..), throwLuaError, tryLua) +import Foreign.Lua (Lua, Peekable, Pushable, StackIndex) import Text.Pandoc.Definition import Text.Pandoc.Extensions (Extensions) -import Text.Pandoc.Lua.Util (pushViaConstructor, typeCheck) +import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor) import Text.Pandoc.Options (ReaderOptions (..), TrackChanges) -import Text.Pandoc.Shared (Element (Blk, Sec), safeRead) +import Text.Pandoc.Shared (Element (Blk, Sec)) -import qualified Foreign.Lua as Lua import qualified Data.Set as Set +import qualified Foreign.Lua as Lua import qualified Text.Pandoc.Lua.Util as LuaUtil -defineHowTo :: String -> Lua a -> Lua a -defineHowTo ctx op = op `Lua.modifyLuaError` (("Could not " ++ ctx ++ ": ") ++) - -instance ToLuaStack Pandoc where +instance Pushable Pandoc where push (Pandoc meta blocks) = pushViaConstructor "Pandoc" blocks meta -instance FromLuaStack Pandoc where +instance Peekable Pandoc where peek idx = defineHowTo "get Pandoc value" $ do - typeCheck idx Lua.TypeTable blocks <- LuaUtil.rawField idx "blocks" - meta <- Lua.getfield idx "meta" *> (Lua.peek Lua.stackTop `finally` Lua.pop 1) + meta <- LuaUtil.rawField idx "meta" return $ Pandoc meta blocks -instance ToLuaStack Meta where +instance Pushable Meta where push (Meta mmap) = pushViaConstructor "Meta" mmap -instance FromLuaStack Meta where - peek idx = defineHowTo "get Meta value" $ do - typeCheck idx Lua.TypeTable - Meta <$> peek idx +instance Peekable Meta where + peek idx = defineHowTo "get Meta value" $ + Meta <$> Lua.peek idx -instance ToLuaStack MetaValue where +instance Pushable MetaValue where push = pushMetaValue -instance FromLuaStack MetaValue where +instance Peekable MetaValue where peek = peekMetaValue -instance ToLuaStack Block where +instance Pushable Block where push = pushBlock -instance FromLuaStack Block where +instance Peekable Block where peek = peekBlock -- Inline -instance ToLuaStack Inline where +instance Pushable Inline where push = pushInline -instance FromLuaStack Inline where +instance Peekable Inline where peek = peekInline -- Citation -instance ToLuaStack Citation where +instance Pushable Citation where push (Citation cid prefix suffix mode noteNum hash) = pushViaConstructor "Citation" cid mode prefix suffix noteNum hash -instance FromLuaStack Citation where +instance Peekable Citation where peek idx = do id' <- LuaUtil.rawField idx "id" prefix <- LuaUtil.rawField idx "prefix" @@ -107,78 +99,63 @@ instance FromLuaStack Citation where hash <- LuaUtil.rawField idx "hash" return $ Citation id' prefix suffix mode num hash -instance ToLuaStack Alignment where - push = push . show -instance FromLuaStack Alignment where - peek idx = safeRead' =<< peek idx - -instance ToLuaStack CitationMode where - push = push . show -instance FromLuaStack CitationMode where - peek idx = safeRead' =<< peek idx - -instance ToLuaStack Format where - push (Format f) = push f -instance FromLuaStack Format where - peek idx = Format <$> peek idx - -instance ToLuaStack ListNumberDelim where - push = push . show -instance FromLuaStack ListNumberDelim where - peek idx = safeRead' =<< peek idx - -instance ToLuaStack ListNumberStyle where - push = push . show -instance FromLuaStack ListNumberStyle where - peek idx = safeRead' =<< peek idx - -instance ToLuaStack MathType where - push = push . show -instance FromLuaStack MathType where - peek idx = safeRead' =<< peek idx - -instance ToLuaStack QuoteType where - push = push . show -instance FromLuaStack QuoteType where - peek idx = safeRead' =<< peek idx - -instance ToLuaStack Double where - push = push . (realToFrac :: Double -> LuaNumber) -instance FromLuaStack Double where - peek = fmap (realToFrac :: LuaNumber -> Double) . peek - -instance ToLuaStack Int where - push = push . (fromIntegral :: Int -> LuaInteger) -instance FromLuaStack Int where - peek = fmap (fromIntegral :: LuaInteger-> Int) . peek - -safeRead' :: Read a => String -> Lua a -safeRead' s = case safeRead s of - Nothing -> throwLuaError ("Could not read: " ++ s) - Just x -> return x +instance Pushable Alignment where + push = Lua.push . show +instance Peekable Alignment where + peek = Lua.peekRead + +instance Pushable CitationMode where + push = Lua.push . show +instance Peekable CitationMode where + peek = Lua.peekRead + +instance Pushable Format where + push (Format f) = Lua.push f +instance Peekable Format where + peek idx = Format <$> Lua.peek idx + +instance Pushable ListNumberDelim where + push = Lua.push . show +instance Peekable ListNumberDelim where + peek = Lua.peekRead + +instance Pushable ListNumberStyle where + push = Lua.push . show +instance Peekable ListNumberStyle where + peek = Lua.peekRead + +instance Pushable MathType where + push = Lua.push . show +instance Peekable MathType where + peek = Lua.peekRead + +instance Pushable QuoteType where + push = Lua.push . show +instance Peekable QuoteType where + peek = Lua.peekRead -- | Push an meta value element to the top of the lua stack. pushMetaValue :: MetaValue -> Lua () pushMetaValue = \case MetaBlocks blcks -> pushViaConstructor "MetaBlocks" blcks - MetaBool bool -> push bool + MetaBool bool -> Lua.push bool MetaInlines inlns -> pushViaConstructor "MetaInlines" inlns MetaList metalist -> pushViaConstructor "MetaList" metalist MetaMap metamap -> pushViaConstructor "MetaMap" metamap - MetaString str -> push str + MetaString str -> Lua.push str -- | Interpret the value at the given stack index as meta value. peekMetaValue :: StackIndex -> Lua MetaValue peekMetaValue idx = defineHowTo "get MetaValue" $ do -- Get the contents of an AST element. - let elementContent :: FromLuaStack a => Lua a - elementContent = peek idx + let elementContent :: Peekable a => Lua a + elementContent = Lua.peek idx luatype <- Lua.ltype idx case luatype of - TypeBoolean -> MetaBool <$> peek idx - TypeString -> MetaString <$> peek idx - TypeTable -> do - tag <- tryLua $ LuaUtil.getTag idx + Lua.TypeBoolean -> MetaBool <$> Lua.peek idx + Lua.TypeString -> MetaString <$> Lua.peek idx + Lua.TypeTable -> do + tag <- Lua.try $ LuaUtil.getTag idx case tag of Right "MetaBlocks" -> MetaBlocks <$> elementContent Right "MetaBool" -> MetaBool <$> elementContent @@ -186,16 +163,16 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do Right "MetaInlines" -> MetaInlines <$> elementContent Right "MetaList" -> MetaList <$> elementContent Right "MetaString" -> MetaString <$> elementContent - Right t -> throwLuaError ("Unknown meta tag: " ++ t) + Right t -> Lua.throwException ("Unknown meta tag: " <> t) Left _ -> do -- no meta value tag given, try to guess. len <- Lua.rawlen idx if len <= 0 - then MetaMap <$> peek idx - else (MetaInlines <$> peek idx) - <|> (MetaBlocks <$> peek idx) - <|> (MetaList <$> peek idx) - _ -> throwLuaError "could not get meta value" + then MetaMap <$> Lua.peek idx + else (MetaInlines <$> Lua.peek idx) + <|> (MetaBlocks <$> Lua.peek idx) + <|> (MetaList <$> Lua.peek idx) + _ -> Lua.throwException "could not get meta value" -- | Push an block element to the top of the lua stack. pushBlock :: Block -> Lua () @@ -219,7 +196,6 @@ pushBlock = \case -- | Return the value at the given index as block if possible. peekBlock :: StackIndex -> Lua Block peekBlock idx = defineHowTo "get Block value" $ do - typeCheck idx Lua.TypeTable tag <- LuaUtil.getTag idx case tag of "BlockQuote" -> BlockQuote <$> elementContent @@ -239,10 +215,10 @@ peekBlock idx = defineHowTo "get Block value" $ do "Table" -> (\(capt, aligns, widths, headers, body) -> Table capt aligns widths headers body) <$> elementContent - _ -> throwLuaError ("Unknown block type: " ++ tag) + _ -> Lua.throwException ("Unknown block type: " <> tag) where -- Get the contents of an AST element. - elementContent :: FromLuaStack a => Lua a + elementContent :: Peekable a => Lua a elementContent = LuaUtil.rawField idx "c" -- | Push an inline element to the top of the lua stack. @@ -271,7 +247,6 @@ pushInline = \case -- | Return the value at the given index as inline if possible. peekInline :: StackIndex -> Lua Inline peekInline idx = defineHowTo "get Inline value" $ do - typeCheck idx Lua.TypeTable tag <- LuaUtil.getTag idx case tag of "Cite" -> uncurry Cite <$> elementContent @@ -295,10 +270,10 @@ peekInline idx = defineHowTo "get Inline value" $ do "Strong" -> Strong <$> elementContent "Subscript" -> Subscript <$> elementContent "Superscript"-> Superscript <$> elementContent - _ -> throwLuaError ("Unknown inline type: " ++ tag) + _ -> Lua.throwException ("Unknown inline type: " <> tag) where -- Get the contents of an AST element. - elementContent :: FromLuaStack a => Lua a + elementContent :: Peekable a => Lua a elementContent = LuaUtil.rawField idx "c" withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b @@ -307,18 +282,18 @@ withAttr f (attributes, x) = f (fromLuaAttr attributes) x -- | Wrapper for Attr newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr } -instance ToLuaStack LuaAttr where +instance Pushable LuaAttr where push (LuaAttr (id', classes, kv)) = pushViaConstructor "Attr" id' classes kv -instance FromLuaStack LuaAttr where - peek idx = defineHowTo "get Attr value" (LuaAttr <$> peek idx) +instance Peekable LuaAttr where + peek idx = defineHowTo "get Attr value" (LuaAttr <$> Lua.peek idx) -- -- Hierarchical elements -- -instance ToLuaStack Element where - push (Blk blk) = push blk +instance Pushable Element where + push (Blk blk) = Lua.push blk push (Sec lvl num attr label contents) = do Lua.newtable LuaUtil.addField "level" lvl @@ -342,18 +317,13 @@ instance ToLuaStack Element where -- -- Reader Options -- -instance ToLuaStack Extensions where - push exts = push (show exts) +instance Pushable Extensions where + push exts = Lua.push (show exts) -instance ToLuaStack TrackChanges where - push = push . showConstr . toConstr - -instance ToLuaStack a => ToLuaStack (Set.Set a) where - push set = do - Lua.newtable - forM_ set (`LuaUtil.addValue` True) +instance Pushable TrackChanges where + push = Lua.push . showConstr . toConstr -instance ToLuaStack ReaderOptions where +instance Pushable ReaderOptions where push ro = do let ReaderOptions (extensions :: Extensions) 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 <> ": ") <>) |