summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--pandoc.cabal5
-rw-r--r--src/Text/Pandoc/Lua.hs181
-rw-r--r--src/Text/Pandoc/Lua/Compat.hs40
-rw-r--r--src/Text/Pandoc/Lua/PandocModule.hs24
-rw-r--r--src/Text/Pandoc/Lua/SharedInstances.hs82
-rw-r--r--src/Text/Pandoc/Lua/StackInstances.hs407
-rw-r--r--src/Text/Pandoc/Lua/Util.hs102
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs237
-rw-r--r--stack.full.yaml2
-rw-r--r--stack.pkg.yaml2
-rw-r--r--stack.yaml2
-rw-r--r--test/Tests/Lua.hs31
12 files changed, 478 insertions, 637 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index 39a390dd6..988f253cd 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -317,7 +317,7 @@ Library
yaml >= 0.8.8.2 && < 0.9,
scientific >= 0.2 && < 0.4,
vector >= 0.10 && < 0.13,
- hslua >= 0.4 && < 0.6,
+ hslua >= 0.7 && < 0.8,
binary >= 0.5 && < 0.9,
SHA >= 1.6 && < 1.7,
haddock-library >= 1.1 && < 1.5,
@@ -464,7 +464,6 @@ Library
Text.Pandoc.Readers.Org.ParserState,
Text.Pandoc.Readers.Org.Parsing,
Text.Pandoc.Readers.Org.Shared,
- Text.Pandoc.Lua.Compat,
Text.Pandoc.Lua.PandocModule,
Text.Pandoc.Lua.SharedInstances,
Text.Pandoc.Lua.StackInstances,
@@ -545,7 +544,7 @@ Test-Suite test-pandoc
text >= 0.11 && < 1.3,
directory >= 1 && < 1.4,
filepath >= 1.1 && < 1.5,
- hslua >= 0.4 && < 0.6,
+ hslua >= 0.7 && < 0.8,
process >= 1.2.3 && < 1.7,
skylighting >= 0.3.3 && < 0.4,
temporary >= 1.1 && < 1.3,
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
diff --git a/src/Text/Pandoc/Lua/Compat.hs b/src/Text/Pandoc/Lua/Compat.hs
deleted file mode 100644
index 3fc81a15c..000000000
--- a/src/Text/Pandoc/Lua/Compat.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-
-Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-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 CPP #-}
-{- |
- Module : Text.Pandoc.Lua.Compat
- Copyright : Copyright © 2017 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Compatibility helpers for hslua
--}
-module Text.Pandoc.Lua.Compat ( loadstring ) where
-
-import Scripting.Lua (LuaState)
-import qualified Scripting.Lua as Lua
-
--- | Interpret string as lua code and load into the lua environment.
-loadstring :: LuaState -> String -> String -> IO Int
-#if MIN_VERSION_hslua(0,5,0)
-loadstring lua script _ = Lua.loadstring lua script
-#else
-loadstring lua script cn = Lua.loadstring lua script cn
-#endif
diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs
index d46ed3629..c8eaf3da0 100644
--- a/src/Text/Pandoc/Lua/PandocModule.hs
+++ b/src/Text/Pandoc/Lua/PandocModule.hs
@@ -31,31 +31,31 @@ import Control.Monad (unless)
import Data.ByteString.Char8 (unpack)
import Data.Default (Default (..))
import Data.Text (pack)
-import Scripting.Lua (LuaState, call, push, pushhsfunction, rawset)
+import Foreign.Lua (Lua, Status (OK), liftIO, push, pushHaskellFunction)
+import Foreign.Lua.Api (call, loadstring, rawset)
import Text.Pandoc.Class
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Options (ReaderOptions(readerExtensions))
-import Text.Pandoc.Lua.Compat (loadstring)
import Text.Pandoc.Lua.StackInstances ()
import Text.Pandoc.Readers (Reader (..), getReader)
-- | Push the "pandoc" on the lua stack.
-pushPandocModule :: Maybe FilePath -> LuaState -> IO ()
-pushPandocModule datadir lua = do
- script <- pandocModuleScript datadir
- status <- loadstring lua script "pandoc.lua"
- unless (status /= 0) $ call lua 0 1
- push lua "__read"
- pushhsfunction lua read_doc
- rawset lua (-3)
+pushPandocModule :: Maybe FilePath -> Lua ()
+pushPandocModule datadir = do
+ script <- liftIO (pandocModuleScript datadir)
+ status <- loadstring script
+ unless (status /= OK) $ call 0 1
+ push "__read"
+ pushHaskellFunction readDoc
+ rawset (-3)
-- | Get the string representation of the pandoc module
pandocModuleScript :: Maybe FilePath -> IO String
pandocModuleScript datadir = unpack <$>
runIOorExplode (setUserDataDir datadir >> readDataFile "pandoc.lua")
-read_doc :: String -> String -> IO (Either String Pandoc)
-read_doc formatSpec content = do
+readDoc :: String -> String -> Lua (Either String Pandoc)
+readDoc formatSpec content = liftIO $ do
case getReader formatSpec of
Left s -> return $ Left s
Right (reader, es) ->
diff --git a/src/Text/Pandoc/Lua/SharedInstances.hs b/src/Text/Pandoc/Lua/SharedInstances.hs
index a5d4ba1e9..e9e72c219 100644
--- a/src/Text/Pandoc/Lua/SharedInstances.hs
+++ b/src/Text/Pandoc/Lua/SharedInstances.hs
@@ -36,81 +36,9 @@ Shared StackValue instances for pandoc and generic types.
-}
module Text.Pandoc.Lua.SharedInstances () where
-import Scripting.Lua (LTYPE (..), StackValue (..), newtable)
-import Text.Pandoc.Lua.Util (addRawInt, addValue, getRawInt, keyValuePairs)
+import Foreign.Lua (ToLuaStack (push))
-import qualified Data.Map as M
-import qualified Text.Pandoc.UTF8 as UTF8
-
-#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} StackValue [Char] where
-#else
-instance StackValue [Char] where
-#endif
- push lua cs = push lua (UTF8.fromString cs)
- peek lua i = fmap UTF8.toString <$> peek lua i
- valuetype _ = TSTRING
-
-instance (StackValue a, StackValue b) => StackValue (a, b) where
- push lua (a, b) = do
- newtable lua
- addRawInt lua 1 a
- addRawInt lua 2 b
- peek lua idx = do
- a <- getRawInt lua idx 1
- b <- getRawInt lua idx 2
- return $ (,) <$> a <*> b
- valuetype _ = TTABLE
-
-instance (StackValue a, StackValue b, StackValue c) =>
- StackValue (a, b, c)
- where
- push lua (a, b, c) = do
- newtable lua
- addRawInt lua 1 a
- addRawInt lua 2 b
- addRawInt lua 3 c
- peek lua idx = do
- a <- getRawInt lua idx 1
- b <- getRawInt lua idx 2
- c <- getRawInt lua idx 3
- return $ (,,) <$> a <*> b <*> c
- valuetype _ = TTABLE
-
-instance (StackValue a, StackValue b, StackValue c,
- StackValue d, StackValue e) =>
- StackValue (a, b, c, d, e)
- where
- push lua (a, b, c, d, e) = do
- newtable lua
- addRawInt lua 1 a
- addRawInt lua 2 b
- addRawInt lua 3 c
- addRawInt lua 4 d
- addRawInt lua 5 e
- peek lua idx = do
- a <- getRawInt lua idx 1
- b <- getRawInt lua idx 2
- c <- getRawInt lua idx 3
- d <- getRawInt lua idx 4
- e <- getRawInt lua idx 5
- return $ (,,,,) <$> a <*> b <*> c <*> d <*> e
- valuetype _ = TTABLE
-
-instance (Ord a, StackValue a, StackValue b) =>
- StackValue (M.Map a b) where
- push lua m = do
- newtable lua
- mapM_ (uncurry $ addValue lua) $ M.toList m
- peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
- valuetype _ = TTABLE
-
-instance (StackValue a, StackValue b) => StackValue (Either a b) where
- push lua = \case
- Left x -> push lua x
- Right x -> push lua x
- peek lua idx = peek lua idx >>= \case
- Just left -> return . Just $ Left left
- Nothing -> fmap Right <$> peek lua idx
- valuetype (Left x) = valuetype x
- valuetype (Right x) = valuetype x
+instance (ToLuaStack a, ToLuaStack b) => ToLuaStack (Either a b) where
+ push = \case
+ Left x -> push x
+ Right x -> push x
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index d2e3f630a..4eea5bc2f 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -33,243 +33,244 @@ StackValue instances for pandoc types.
module Text.Pandoc.Lua.StackInstances () where
import Control.Applicative ((<|>))
-import Scripting.Lua (LTYPE (..), LuaState, StackValue (..), ltype, newtable,
- objlen)
+import Foreign.Lua (Lua, Type (..), FromLuaStack (peek), ToLuaStack (push),
+ StackIndex, peekEither, throwLuaError)
+import Foreign.Lua.Api (getfield, ltype, newtable, pop, rawlen)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.SharedInstances ()
import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)
import Text.Pandoc.Shared (safeRead)
-instance StackValue Pandoc where
- push lua (Pandoc meta blocks) = do
- newtable lua
- addValue lua "blocks" blocks
- addValue lua "meta" meta
- peek lua idx = do
- blocks <- getTable lua idx "blocks"
- meta <- getTable lua idx "meta"
- return $ Pandoc <$> meta <*> blocks
- valuetype _ = TTABLE
-
-instance StackValue Meta where
- push lua (Meta mmap) = push lua mmap
- peek lua idx = fmap Meta <$> peek lua idx
- valuetype _ = TTABLE
-
-instance StackValue MetaValue where
+instance ToLuaStack Pandoc where
+ push (Pandoc meta blocks) = do
+ newtable
+ addValue "blocks" blocks
+ addValue "meta" meta
+instance FromLuaStack Pandoc where
+ peek idx = do
+ blocks <- getTable idx "blocks"
+ meta <- getTable idx "meta"
+ return $ Pandoc meta blocks
+
+instance ToLuaStack Meta where
+ push (Meta mmap) = push mmap
+instance FromLuaStack Meta where
+ peek idx = Meta <$> peek idx
+
+instance ToLuaStack MetaValue where
push = pushMetaValue
+instance FromLuaStack MetaValue where
peek = peekMetaValue
- valuetype = \case
- MetaBlocks _ -> TTABLE
- MetaBool _ -> TBOOLEAN
- MetaInlines _ -> TTABLE
- MetaList _ -> TTABLE
- MetaMap _ -> TTABLE
- MetaString _ -> TSTRING
-
-instance StackValue Block where
+
+instance ToLuaStack Block where
push = pushBlock
+
+instance FromLuaStack Block where
peek = peekBlock
- valuetype _ = TTABLE
-instance StackValue Inline where
+-- Inline
+instance ToLuaStack Inline where
push = pushInline
+
+instance FromLuaStack Inline where
peek = peekInline
- valuetype _ = TTABLE
-
-instance StackValue Citation where
- push lua (Citation cid prefix suffix mode noteNum hash) =
- pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash
- peek lua idx = do
- id' <- getTable lua idx "citationId"
- prefix <- getTable lua idx "citationPrefix"
- suffix <- getTable lua idx "citationSuffix"
- mode <- getTable lua idx "citationMode"
- num <- getTable lua idx "citationNoteNum"
- hash <- getTable lua idx "citationHash"
- return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash
- valuetype _ = TTABLE
-
-instance StackValue Alignment where
- push lua = push lua . show
- peek lua idx = (>>= safeRead) <$> peek lua idx
- valuetype _ = TSTRING
-
-instance StackValue CitationMode where
- push lua = push lua . show
- peek lua idx = (>>= safeRead) <$> peek lua idx
- valuetype _ = TSTRING
-
-instance StackValue Format where
- push lua (Format f) = push lua f
- peek lua idx = fmap Format <$> peek lua idx
- valuetype _ = TSTRING
-
-instance StackValue ListNumberDelim where
- push lua = push lua . show
- peek lua idx = (>>= safeRead) <$> peek lua idx
- valuetype _ = TSTRING
-
-instance StackValue ListNumberStyle where
- push lua = push lua . show
- peek lua idx = (>>= safeRead) <$> peek lua idx
- valuetype _ = TSTRING
-
-instance StackValue MathType where
- push lua = push lua . show
- peek lua idx = (>>= safeRead) <$> peek lua idx
- valuetype _ = TSTRING
-
-instance StackValue QuoteType where
- push lua = push lua . show
- peek lua idx = (>>= safeRead) <$> peek lua idx
- valuetype _ = TSTRING
+
+-- Citation
+instance ToLuaStack Citation where
+ push (Citation cid prefix suffix mode noteNum hash) =
+ pushViaConstructor "Citation" cid mode prefix suffix noteNum hash
+
+instance FromLuaStack Citation where
+ peek idx = do
+ id' <- getTable idx "citationId"
+ prefix <- getTable idx "citationPrefix"
+ suffix <- getTable idx "citationSuffix"
+ mode <- getTable idx "citationMode"
+ num <- getTable idx "citationNoteNum"
+ hash <- getTable idx "citationHash"
+ 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
+
+safeRead' :: Read a => String -> Lua a
+safeRead' s = case safeRead s of
+ Nothing -> throwLuaError ("Could not read: " ++ s)
+ Just x -> return x
-- | Push an meta value element to the top of the lua stack.
-pushMetaValue :: LuaState -> MetaValue -> IO ()
-pushMetaValue lua = \case
- MetaBlocks blcks -> pushViaConstructor lua "MetaBlocks" blcks
- MetaBool bool -> push lua bool
- MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns
- MetaList metalist -> pushViaConstructor lua "MetaList" metalist
- MetaMap metamap -> pushViaConstructor lua "MetaMap" metamap
- MetaString str -> push lua str
+pushMetaValue :: MetaValue -> Lua ()
+pushMetaValue = \case
+ MetaBlocks blcks -> pushViaConstructor "MetaBlocks" blcks
+ MetaBool bool -> push bool
+ MetaInlines inlns -> pushViaConstructor "MetaInlines" inlns
+ MetaList metalist -> pushViaConstructor "MetaList" metalist
+ MetaMap metamap -> pushViaConstructor "MetaMap" metamap
+ MetaString str -> push str
-- | Interpret the value at the given stack index as meta value.
-peekMetaValue :: LuaState -> Int -> IO (Maybe MetaValue)
-peekMetaValue lua idx = do
+peekMetaValue :: StackIndex -> Lua MetaValue
+peekMetaValue idx = do
-- Get the contents of an AST element.
- let elementContent :: StackValue a => IO (Maybe a)
- elementContent = peek lua idx
- luatype <- ltype lua idx
+ let elementContent :: FromLuaStack a => Lua a
+ elementContent = peek idx
+ luatype <- ltype idx
case luatype of
- TBOOLEAN -> fmap MetaBool <$> peek lua idx
- TSTRING -> fmap MetaString <$> peek lua idx
- TTABLE -> do
- tag <- getTable lua idx "t"
+ TypeBoolean -> MetaBool <$> peek idx
+ TypeString -> MetaString <$> peek idx
+ TypeTable -> do
+ tag <- getfield idx "t" *> peekEither (-1) <* pop 1
case tag of
- Just "MetaBlocks" -> fmap MetaBlocks <$> elementContent
- Just "MetaBool" -> fmap MetaBool <$> elementContent
- Just "MetaMap" -> fmap MetaMap <$> elementContent
- Just "MetaInlines" -> fmap MetaInlines <$> elementContent
- Just "MetaList" -> fmap MetaList <$> elementContent
- Just "MetaString" -> fmap MetaString <$> elementContent
- Nothing -> do
+ Right "MetaBlocks" -> MetaBlocks <$> elementContent
+ Right "MetaBool" -> MetaBool <$> elementContent
+ Right "MetaMap" -> MetaMap <$> elementContent
+ Right "MetaInlines" -> MetaInlines <$> elementContent
+ Right "MetaList" -> MetaList <$> elementContent
+ Right "MetaString" -> MetaString <$> elementContent
+ Right t -> throwLuaError ("Unknown meta tag: " ++ t)
+ Left _ -> do
-- no meta value tag given, try to guess.
- len <- objlen lua idx
+ len <- rawlen idx
if len <= 0
- then fmap MetaMap <$> peek lua idx
- else (fmap MetaInlines <$> peek lua idx)
- <|> (fmap MetaBlocks <$> peek lua idx)
- <|> (fmap MetaList <$> peek lua idx)
- _ -> return Nothing
- _ -> return Nothing
+ then MetaMap <$> peek idx
+ else (MetaInlines <$> peek idx)
+ <|> (MetaBlocks <$> peek idx)
+ <|> (MetaList <$> peek idx)
+ _ -> throwLuaError ("could not get meta value")
-- | Push an block element to the top of the lua stack.
-pushBlock :: LuaState -> Block -> IO ()
-pushBlock lua = \case
- BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks
- BulletList items -> pushViaConstructor lua "BulletList" items
- CodeBlock attr code -> pushViaConstructor lua "CodeBlock" code (LuaAttr attr)
- DefinitionList items -> pushViaConstructor lua "DefinitionList" items
- Div attr blcks -> pushViaConstructor lua "Div" blcks (LuaAttr attr)
- Header lvl attr inlns -> pushViaConstructor lua "Header" lvl inlns (LuaAttr attr)
- HorizontalRule -> pushViaConstructor lua "HorizontalRule"
- LineBlock blcks -> pushViaConstructor lua "LineBlock" blcks
- OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr
- Null -> pushViaConstructor lua "Null"
- Para blcks -> pushViaConstructor lua "Para" blcks
- Plain blcks -> pushViaConstructor lua "Plain" blcks
- RawBlock f cs -> pushViaConstructor lua "RawBlock" f cs
+pushBlock :: Block -> Lua ()
+pushBlock = \case
+ BlockQuote blcks -> pushViaConstructor "BlockQuote" blcks
+ BulletList items -> pushViaConstructor "BulletList" items
+ CodeBlock attr code -> pushViaConstructor "CodeBlock" code (LuaAttr attr)
+ DefinitionList items -> pushViaConstructor "DefinitionList" items
+ Div attr blcks -> pushViaConstructor "Div" blcks (LuaAttr attr)
+ Header lvl attr inlns -> pushViaConstructor "Header" lvl inlns (LuaAttr attr)
+ HorizontalRule -> pushViaConstructor "HorizontalRule"
+ LineBlock blcks -> pushViaConstructor "LineBlock" blcks
+ OrderedList lstAttr list -> pushViaConstructor "OrderedList" list lstAttr
+ Null -> pushViaConstructor "Null"
+ Para blcks -> pushViaConstructor "Para" blcks
+ Plain blcks -> pushViaConstructor "Plain" blcks
+ RawBlock f cs -> pushViaConstructor "RawBlock" f cs
Table capt aligns widths headers rows ->
- pushViaConstructor lua "Table" capt aligns widths headers rows
+ pushViaConstructor "Table" capt aligns widths headers rows
-- | Return the value at the given index as block if possible.
-peekBlock :: LuaState -> Int -> IO (Maybe Block)
-peekBlock lua idx = do
- tag <- getTable lua idx "t"
+peekBlock :: StackIndex -> Lua Block
+peekBlock idx = do
+ tag <- getTable idx "t"
case tag of
- Nothing -> return Nothing
- Just t -> case t of
- "BlockQuote" -> fmap BlockQuote <$> elementContent
- "BulletList" -> fmap BulletList <$> elementContent
- "CodeBlock" -> fmap (withAttr CodeBlock) <$> elementContent
- "DefinitionList" -> fmap DefinitionList <$> elementContent
- "Div" -> fmap (withAttr Div) <$> elementContent
- "Header" -> fmap (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
+ "BlockQuote" -> BlockQuote <$> elementContent
+ "BulletList" -> BulletList <$> elementContent
+ "CodeBlock" -> (withAttr CodeBlock) <$> elementContent
+ "DefinitionList" -> DefinitionList <$> elementContent
+ "Div" -> (withAttr Div) <$> elementContent
+ "Header" -> (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
<$> elementContent
- "HorizontalRule" -> return (Just HorizontalRule)
- "LineBlock" -> fmap LineBlock <$> elementContent
- "OrderedList" -> fmap (uncurry OrderedList) <$> elementContent
- "Null" -> return (Just Null)
- "Para" -> fmap Para <$> elementContent
- "Plain" -> fmap Plain <$> elementContent
- "RawBlock" -> fmap (uncurry RawBlock) <$> elementContent
- "Table" -> fmap (\(capt, aligns, widths, headers, body) ->
+ "HorizontalRule" -> return HorizontalRule
+ "LineBlock" -> LineBlock <$> elementContent
+ "OrderedList" -> (uncurry OrderedList) <$> elementContent
+ "Null" -> return Null
+ "Para" -> Para <$> elementContent
+ "Plain" -> Plain <$> elementContent
+ "RawBlock" -> (uncurry RawBlock) <$> elementContent
+ "Table" -> (\(capt, aligns, widths, headers, body) ->
Table capt aligns widths headers body)
<$> elementContent
- _ -> return Nothing
+ _ -> throwLuaError ("Unknown block type: " ++ tag)
where
-- Get the contents of an AST element.
- elementContent :: StackValue a => IO (Maybe a)
- elementContent = getTable lua idx "c"
+ elementContent :: FromLuaStack a => Lua a
+ elementContent = getTable idx "c"
-- | Push an inline element to the top of the lua stack.
-pushInline :: LuaState -> Inline -> IO ()
-pushInline lua = \case
- Cite citations lst -> pushViaConstructor lua "Cite" lst citations
- Code attr lst -> pushViaConstructor lua "Code" lst (LuaAttr attr)
- Emph inlns -> pushViaConstructor lua "Emph" inlns
- Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit (LuaAttr attr)
- LineBreak -> pushViaConstructor lua "LineBreak"
- Link attr lst (src,tit) -> pushViaConstructor lua "Link" lst src tit (LuaAttr attr)
- Note blcks -> pushViaConstructor lua "Note" blcks
- Math mty str -> pushViaConstructor lua "Math" mty str
- Quoted qt inlns -> pushViaConstructor lua "Quoted" qt inlns
- RawInline f cs -> pushViaConstructor lua "RawInline" f cs
- SmallCaps inlns -> pushViaConstructor lua "SmallCaps" inlns
- SoftBreak -> pushViaConstructor lua "SoftBreak"
- Space -> pushViaConstructor lua "Space"
- Span attr inlns -> pushViaConstructor lua "Span" inlns (LuaAttr attr)
- Str str -> pushViaConstructor lua "Str" str
- Strikeout inlns -> pushViaConstructor lua "Strikeout" inlns
- Strong inlns -> pushViaConstructor lua "Strong" inlns
- Subscript inlns -> pushViaConstructor lua "Subscript" inlns
- Superscript inlns -> pushViaConstructor lua "Superscript" inlns
+pushInline :: Inline -> Lua ()
+pushInline = \case
+ Cite citations lst -> pushViaConstructor "Cite" lst citations
+ Code attr lst -> pushViaConstructor "Code" lst (LuaAttr attr)
+ Emph inlns -> pushViaConstructor "Emph" inlns
+ Image attr alt (src,tit) -> pushViaConstructor "Image" alt src tit (LuaAttr attr)
+ LineBreak -> pushViaConstructor "LineBreak"
+ Link attr lst (src,tit) -> pushViaConstructor "Link" lst src tit (LuaAttr attr)
+ Note blcks -> pushViaConstructor "Note" blcks
+ Math mty str -> pushViaConstructor "Math" mty str
+ Quoted qt inlns -> pushViaConstructor "Quoted" qt inlns
+ RawInline f cs -> pushViaConstructor "RawInline" f cs
+ SmallCaps inlns -> pushViaConstructor "SmallCaps" inlns
+ SoftBreak -> pushViaConstructor "SoftBreak"
+ Space -> pushViaConstructor "Space"
+ Span attr inlns -> pushViaConstructor "Span" inlns (LuaAttr attr)
+ Str str -> pushViaConstructor "Str" str
+ Strikeout inlns -> pushViaConstructor "Strikeout" inlns
+ Strong inlns -> pushViaConstructor "Strong" inlns
+ Subscript inlns -> pushViaConstructor "Subscript" inlns
+ Superscript inlns -> pushViaConstructor "Superscript" inlns
-- | Return the value at the given index as inline if possible.
-peekInline :: LuaState -> Int -> IO (Maybe Inline)
-peekInline lua idx = do
- tag <- getTable lua idx "t"
+peekInline :: StackIndex -> Lua Inline
+peekInline idx = do
+ tag <- getTable idx "t"
case tag of
- Nothing -> return Nothing
- Just t -> case t of
- "Cite" -> fmap (uncurry Cite) <$> elementContent
- "Code" -> fmap (withAttr Code) <$> elementContent
- "Emph" -> fmap Emph <$> elementContent
- "Image" -> fmap (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)
- <$> elementContent
- "Link" -> fmap (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)
- <$> elementContent
- "LineBreak" -> return (Just LineBreak)
- "Note" -> fmap Note <$> elementContent
- "Math" -> fmap (uncurry Math) <$> elementContent
- "Quoted" -> fmap (uncurry Quoted) <$> elementContent
- "RawInline" -> fmap (uncurry RawInline) <$> elementContent
- "SmallCaps" -> fmap SmallCaps <$> elementContent
- "SoftBreak" -> return (Just SoftBreak)
- "Space" -> return (Just Space)
- "Span" -> fmap (withAttr Span) <$> elementContent
- "Str" -> fmap Str <$> elementContent
- "Strikeout" -> fmap Strikeout <$> elementContent
- "Strong" -> fmap Strong <$> elementContent
- "Subscript" -> fmap Subscript <$> elementContent
- "Superscript"-> fmap Superscript <$> elementContent
- _ -> return Nothing
+ "Cite" -> (uncurry Cite) <$> elementContent
+ "Code" -> (withAttr Code) <$> elementContent
+ "Emph" -> Emph <$> elementContent
+ "Image" -> (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)
+ <$> elementContent
+ "Link" -> (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)
+ <$> elementContent
+ "LineBreak" -> return LineBreak
+ "Note" -> Note <$> elementContent
+ "Math" -> (uncurry Math) <$> elementContent
+ "Quoted" -> (uncurry Quoted) <$> elementContent
+ "RawInline" -> (uncurry RawInline) <$> elementContent
+ "SmallCaps" -> SmallCaps <$> elementContent
+ "SoftBreak" -> return SoftBreak
+ "Space" -> return Space
+ "Span" -> (withAttr Span) <$> elementContent
+ "Str" -> Str <$> elementContent
+ "Strikeout" -> Strikeout <$> elementContent
+ "Strong" -> Strong <$> elementContent
+ "Subscript" -> Subscript <$> elementContent
+ "Superscript"-> Superscript <$> elementContent
+ _ -> throwLuaError ("Unknown inline type: " ++ tag)
where
-- Get the contents of an AST element.
- elementContent :: StackValue a => IO (Maybe a)
- elementContent = getTable lua idx "c"
+ elementContent :: FromLuaStack a => Lua a
+ elementContent = getTable idx "c"
withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr f (attributes, x) = f (fromLuaAttr attributes) x
@@ -277,8 +278,8 @@ withAttr f (attributes, x) = f (fromLuaAttr attributes) x
-- | Wrapper for Attr
newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }
-instance StackValue LuaAttr where
- push lua (LuaAttr (id', classes, kv)) =
- pushViaConstructor lua "Attr" id' classes kv
- peek lua idx = fmap LuaAttr <$> peek lua idx
- valuetype _ = TTABLE
+instance ToLuaStack LuaAttr where
+ push (LuaAttr (id', classes, kv)) =
+ pushViaConstructor "Attr" id' classes kv
+instance FromLuaStack LuaAttr where
+ peek idx = LuaAttr <$> peek idx
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 0a704d027..9e72b652c 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -36,103 +36,79 @@ module Text.Pandoc.Lua.Util
, getRawInt
, setRawInt
, addRawInt
- , keyValuePairs
, PushViaCall
, pushViaCall
, pushViaConstructor
) where
-import Scripting.Lua (LuaState, StackValue (..), call, getglobal2, gettable,
- next, pop, pushnil, rawgeti, rawseti, settable)
+import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), NumArgs,
+ StackIndex, getglobal')
+import Foreign.Lua.Api (call, gettable, pop, rawgeti, rawseti, settable)
-- | Adjust the stack index, assuming that @n@ new elements have been pushed on
-- the stack.
-adjustIndexBy :: Int -> Int -> Int
+adjustIndexBy :: StackIndex -> StackIndex -> StackIndex
adjustIndexBy idx n =
if idx < 0
then idx - n
else idx
-- | Get value behind key from table at given index.
-getTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)
-getTable lua idx key = do
- push lua key
- gettable lua (idx `adjustIndexBy` 1)
- peek lua (-1) <* pop lua 1
+getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b
+getTable idx key = do
+ push key
+ gettable (idx `adjustIndexBy` 1)
+ peek (-1) <* pop 1
-- | Set value for key for table at the given index
-setTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
-setTable lua idx key value = do
- push lua key
- push lua value
- settable lua (idx `adjustIndexBy` 2)
+setTable :: (ToLuaStack a, ToLuaStack b) => StackIndex -> a -> b -> Lua ()
+setTable idx key value = do
+ push key
+ push value
+ settable (idx `adjustIndexBy` 2)
-- | Add a key-value pair to the table at the top of the stack
-addValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO ()
-addValue lua = setTable lua (-1)
+addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
+addValue = setTable (-1)
-- | Get value behind key from table at given index.
-getRawInt :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
-getRawInt lua idx key =
- rawgeti lua idx key
- *> peek lua (-1)
- <* pop lua 1
+getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a
+getRawInt idx key =
+ rawgeti idx key
+ *> peek (-1)
+ <* pop 1
-- | Set numeric key/value in table at the given index
-setRawInt :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
-setRawInt lua idx key value = do
- push lua value
- rawseti lua (idx `adjustIndexBy` 1) key
+setRawInt :: ToLuaStack a => StackIndex -> Int -> a -> Lua ()
+setRawInt idx key value = do
+ push value
+ rawseti (idx `adjustIndexBy` 1) key
-- | Set numeric key/value in table at the top of the stack.
-addRawInt :: StackValue a => LuaState -> Int -> a -> IO ()
-addRawInt lua = setRawInt lua (-1)
-
--- | Try reading the table under the given index as a list of key-value pairs.
-keyValuePairs :: (StackValue a, StackValue b)
- => LuaState -> Int -> IO (Maybe [(a, b)])
-keyValuePairs lua idx = do
- pushnil lua
- sequence <$> remainingPairs
- where
- remainingPairs = do
- res <- nextPair
- case res of
- Nothing -> return []
- Just a -> (a:) <$> remainingPairs
- nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
- nextPair = do
- hasNext <- next lua (idx `adjustIndexBy` 1)
- if hasNext
- then do
- val <- peek lua (-1)
- key <- peek lua (-2)
- pop lua 1 -- removes the value, keeps the key
- return $ Just <$> ((,) <$> key <*> val)
- else do
- return Nothing
+addRawInt :: ToLuaStack a => Int -> a -> Lua ()
+addRawInt = setRawInt (-1)
-- | Helper class for pushing a single value to the stack via a lua function.
-- See @pushViaCall@.
class PushViaCall a where
- pushViaCall' :: LuaState -> String -> IO () -> Int -> a
+ pushViaCall' :: String -> Lua () -> NumArgs -> a
-instance PushViaCall (IO ()) where
- pushViaCall' lua fn pushArgs num = do
- getglobal2 lua fn
+instance PushViaCall (Lua ()) where
+ pushViaCall' fn pushArgs num = do
+ getglobal' fn
pushArgs
- call lua num 1
+ call num 1
-instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
- pushViaCall' lua fn pushArgs num x =
- pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
+instance (ToLuaStack a, PushViaCall b) => PushViaCall (a -> b) where
+ pushViaCall' fn pushArgs num x =
+ pushViaCall' fn (pushArgs *> push x) (num + 1)
-- | Push an value to the stack via a lua function. The lua function is called
-- with all arguments that are passed to this function and is expected to return
-- a single value.
-pushViaCall :: PushViaCall a => LuaState -> String -> a
-pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
+pushViaCall :: PushViaCall a => String -> a
+pushViaCall fn = pushViaCall' fn (return ()) 0
-- | Call a pandoc element constructor within lua, passing all given arguments.
-pushViaConstructor :: PushViaCall a => LuaState -> String -> a
-pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
+pushViaConstructor :: PushViaCall a => String -> a
+pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 363bad99b..485394187 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -44,10 +44,9 @@ import qualified Data.Map as M
import Data.Text (Text, pack)
import Data.Typeable
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
-import Scripting.Lua (LuaState, StackValue, callfunc)
-import qualified Scripting.Lua as Lua
+import Foreign.Lua (Lua, ToLuaStack (..), callFunc, runLua)
+import Foreign.Lua.Api
import Text.Pandoc.Error
-import Text.Pandoc.Lua.Compat ( loadstring )
import Text.Pandoc.Lua.Util ( addValue )
import Text.Pandoc.Lua.SharedInstances ()
import Text.Pandoc.Definition
@@ -62,55 +61,40 @@ attrToMap (id',classes,keyvals) = M.fromList
: ("class", unwords classes)
: keyvals
-instance StackValue Format where
- push lua (Format f) = Lua.push lua (map toLower f)
- peek l n = fmap Format `fmap` Lua.peek l n
- valuetype _ = Lua.TSTRING
+instance ToLuaStack Format where
+ push (Format f) = push (map toLower f)
#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} StackValue [Inline] where
+instance {-# OVERLAPS #-} ToLuaStack [Inline] where
#else
-instance StackValue [Inline] where
+instance ToLuaStack [Inline] where
#endif
- push l ils = Lua.push l =<< inlineListToCustom l ils
- peek _ _ = undefined
- valuetype _ = Lua.TSTRING
+ push ils = push =<< inlineListToCustom ils
#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} StackValue [Block] where
+instance {-# OVERLAPS #-} ToLuaStack [Block] where
#else
-instance StackValue [Block] where
+instance ToLuaStack [Block] where
#endif
- push l ils = Lua.push l =<< blockListToCustom l ils
- peek _ _ = undefined
- valuetype _ = Lua.TSTRING
-
-instance StackValue MetaValue where
- push l (MetaMap m) = Lua.push l m
- push l (MetaList xs) = Lua.push l xs
- push l (MetaBool x) = Lua.push l x
- push l (MetaString s) = Lua.push l s
- push l (MetaInlines ils) = Lua.push l ils
- push l (MetaBlocks bs) = Lua.push l bs
- peek _ _ = undefined
- valuetype (MetaMap _) = Lua.TTABLE
- valuetype (MetaList _) = Lua.TTABLE
- valuetype (MetaBool _) = Lua.TBOOLEAN
- valuetype (MetaString _) = Lua.TSTRING
- valuetype (MetaInlines _) = Lua.TSTRING
- valuetype (MetaBlocks _) = Lua.TSTRING
-
-instance StackValue Citation where
- push lua cit = do
- Lua.createtable lua 6 0
- addValue lua "citationId" $ citationId cit
- addValue lua "citationPrefix" $ citationPrefix cit
- addValue lua "citationSuffix" $ citationSuffix cit
- addValue lua "citationMode" $ show (citationMode cit)
- addValue lua "citationNoteNum" $ citationNoteNum cit
- addValue lua "citationHash" $ citationHash cit
- peek = undefined
- valuetype _ = Lua.TTABLE
+ push ils = push =<< blockListToCustom ils
+
+instance ToLuaStack MetaValue where
+ push (MetaMap m) = push m
+ push (MetaList xs) = push xs
+ push (MetaBool x) = push x
+ push (MetaString s) = push s
+ push (MetaInlines ils) = push ils
+ push (MetaBlocks bs) = push bs
+
+instance ToLuaStack Citation where
+ push cit = do
+ createtable 6 0
+ addValue "citationId" $ citationId cit
+ addValue "citationPrefix" $ citationPrefix cit
+ addValue "citationSuffix" $ citationSuffix cit
+ addValue "citationMode" $ show (citationMode cit)
+ addValue "citationNoteNum" $ citationNoteNum cit
+ addValue "citationHash" $ citationHash cit
data PandocLuaException = PandocLuaException String
deriving (Show, Typeable)
@@ -123,23 +107,22 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
luaScript <- UTF8.readFile luaFile
enc <- getForeignEncoding
setForeignEncoding utf8
- lua <- Lua.newstate
- Lua.openlibs lua
- status <- loadstring lua luaScript luaFile
- -- check for error in lua script (later we'll change the return type
- -- to handle this more gracefully):
- when (status /= 0) $
- Lua.tostring lua 1 >>= throw . PandocLuaException . UTF8.toString
- Lua.call lua 0 0
+ (body, context) <- runLua $ do
+ openlibs
+ stat <- loadstring luaScript
+ -- check for error in lua script (later we'll change the return type
+ -- to handle this more gracefully):
+ when (stat /= OK) $
+ tostring 1 >>= throw . PandocLuaException . UTF8.toString
+ call 0 0
-- TODO - call hierarchicalize, so we have that info
- rendered <- docToCustom lua opts doc
- context <- metaToJSON opts
- (blockListToCustom lua)
- (inlineListToCustom lua)
- meta
- Lua.close lua
+ rendered <- docToCustom opts doc
+ context <- metaToJSON opts
+ blockListToCustom
+ inlineListToCustom
+ meta
+ return (rendered, context)
setForeignEncoding enc
- let body = rendered
case writerTemplate opts of
Nothing -> return $ pack body
Just tpl ->
@@ -147,117 +130,115 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
Left e -> throw (PandocTemplateError e)
Right r -> return (pack r)
-docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String
-docToCustom lua opts (Pandoc (Meta metamap) blocks) = do
- body <- blockListToCustom lua blocks
- callfunc lua "Doc" body metamap (writerVariables opts)
+docToCustom :: WriterOptions -> Pandoc -> Lua String
+docToCustom opts (Pandoc (Meta metamap) blocks) = do
+ body <- blockListToCustom blocks
+ callFunc "Doc" body metamap (writerVariables opts)
-- | Convert Pandoc block element to Custom.
-blockToCustom :: LuaState -- ^ Lua state
- -> Block -- ^ Block element
- -> IO String
+blockToCustom :: Block -- ^ Block element
+ -> Lua String
-blockToCustom _ Null = return ""
+blockToCustom Null = return ""
-blockToCustom lua (Plain inlines) = callfunc lua "Plain" inlines
+blockToCustom (Plain inlines) = callFunc "Plain" inlines
-blockToCustom lua (Para [Image attr txt (src,tit)]) =
- callfunc lua "CaptionedImage" src tit txt (attrToMap attr)
+blockToCustom (Para [Image attr txt (src,tit)]) =
+ callFunc "CaptionedImage" src tit txt (attrToMap attr)
-blockToCustom lua (Para inlines) = callfunc lua "Para" inlines
+blockToCustom (Para inlines) = callFunc "Para" inlines
-blockToCustom lua (LineBlock linesList) = callfunc lua "LineBlock" linesList
+blockToCustom (LineBlock linesList) = callFunc "LineBlock" linesList
-blockToCustom lua (RawBlock format str) =
- callfunc lua "RawBlock" format str
+blockToCustom (RawBlock format str) =
+ callFunc "RawBlock" format str
-blockToCustom lua HorizontalRule = callfunc lua "HorizontalRule"
+blockToCustom HorizontalRule = callFunc "HorizontalRule"
-blockToCustom lua (Header level attr inlines) =
- callfunc lua "Header" level inlines (attrToMap attr)
+blockToCustom (Header level attr inlines) =
+ callFunc "Header" level inlines (attrToMap attr)
-blockToCustom lua (CodeBlock attr str) =
- callfunc lua "CodeBlock" str (attrToMap attr)
+blockToCustom (CodeBlock attr str) =
+ callFunc "CodeBlock" str (attrToMap attr)
-blockToCustom lua (BlockQuote blocks) = callfunc lua "BlockQuote" blocks
+blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" blocks
-blockToCustom lua (Table capt aligns widths headers rows') =
- callfunc lua "Table" capt (map show aligns) widths headers rows'
+blockToCustom (Table capt aligns widths headers rows') =
+ callFunc "Table" capt (map show aligns) widths headers rows'
-blockToCustom lua (BulletList items) = callfunc lua "BulletList" items
+blockToCustom (BulletList items) = callFunc "BulletList" items
-blockToCustom lua (OrderedList (num,sty,delim) items) =
- callfunc lua "OrderedList" items num (show sty) (show delim)
+blockToCustom (OrderedList (num,sty,delim) items) =
+ callFunc "OrderedList" items num (show sty) (show delim)
-blockToCustom lua (DefinitionList items) =
- callfunc lua "DefinitionList" items
+blockToCustom (DefinitionList items) =
+ callFunc "DefinitionList" items
-blockToCustom lua (Div attr items) =
- callfunc lua "Div" items (attrToMap attr)
+blockToCustom (Div attr items) =
+ callFunc "Div" items (attrToMap attr)
-- | Convert list of Pandoc block elements to Custom.
-blockListToCustom :: LuaState -- ^ Options
- -> [Block] -- ^ List of block elements
- -> IO String
-blockListToCustom lua xs = do
- blocksep <- callfunc lua "Blocksep"
- bs <- mapM (blockToCustom lua) xs
+blockListToCustom :: [Block] -- ^ List of block elements
+ -> Lua String
+blockListToCustom xs = do
+ blocksep <- callFunc "Blocksep"
+ bs <- mapM blockToCustom xs
return $ mconcat $ intersperse blocksep bs
-- | Convert list of Pandoc inline elements to Custom.
-inlineListToCustom :: LuaState -> [Inline] -> IO String
-inlineListToCustom lua lst = do
- xs <- mapM (inlineToCustom lua) lst
- return $ concat xs
+inlineListToCustom :: [Inline] -> Lua String
+inlineListToCustom lst = do
+ xs <- mapM inlineToCustom lst
+ return $ mconcat xs
-- | Convert Pandoc inline element to Custom.
-inlineToCustom :: LuaState -> Inline -> IO String
+inlineToCustom :: Inline -> Lua String
-inlineToCustom lua (Str str) = callfunc lua "Str" str
+inlineToCustom (Str str) = callFunc "Str" str
-inlineToCustom lua Space = callfunc lua "Space"
+inlineToCustom Space = callFunc "Space"
-inlineToCustom lua SoftBreak = callfunc lua "SoftBreak"
+inlineToCustom SoftBreak = callFunc "SoftBreak"
-inlineToCustom lua (Emph lst) = callfunc lua "Emph" lst
+inlineToCustom (Emph lst) = callFunc "Emph" lst
-inlineToCustom lua (Strong lst) = callfunc lua "Strong" lst
+inlineToCustom (Strong lst) = callFunc "Strong" lst
-inlineToCustom lua (Strikeout lst) = callfunc lua "Strikeout" lst
+inlineToCustom (Strikeout lst) = callFunc "Strikeout" lst
-inlineToCustom lua (Superscript lst) = callfunc lua "Superscript" lst
+inlineToCustom (Superscript lst) = callFunc "Superscript" lst
-inlineToCustom lua (Subscript lst) = callfunc lua "Subscript" lst
+inlineToCustom (Subscript lst) = callFunc "Subscript" lst
-inlineToCustom lua (SmallCaps lst) = callfunc lua "SmallCaps" lst
+inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" lst
-inlineToCustom lua (Quoted SingleQuote lst) = callfunc lua "SingleQuoted" lst
+inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" lst
-inlineToCustom lua (Quoted DoubleQuote lst) = callfunc lua "DoubleQuoted" lst
+inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" lst
-inlineToCustom lua (Cite cs lst) = callfunc lua "Cite" lst cs
+inlineToCustom (Cite cs lst) = callFunc "Cite" lst cs
-inlineToCustom lua (Code attr str) =
- callfunc lua "Code" str (attrToMap attr)
+inlineToCustom (Code attr str) =
+ callFunc "Code" str (attrToMap attr)
-inlineToCustom lua (Math DisplayMath str) =
- callfunc lua "DisplayMath" str
+inlineToCustom (Math DisplayMath str) =
+ callFunc "DisplayMath" str
-inlineToCustom lua (Math InlineMath str) =
- callfunc lua "InlineMath" str
+inlineToCustom (Math InlineMath str) =
+ callFunc "InlineMath" str
-inlineToCustom lua (RawInline format str) =
- callfunc lua "RawInline" format str
+inlineToCustom (RawInline format str) =
+ callFunc "RawInline" format str
-inlineToCustom lua (LineBreak) = callfunc lua "LineBreak"
+inlineToCustom (LineBreak) = callFunc "LineBreak"
-inlineToCustom lua (Link attr txt (src,tit)) =
- callfunc lua "Link" txt src tit (attrToMap attr)
+inlineToCustom (Link attr txt (src,tit)) =
+ callFunc "Link" txt src tit (attrToMap attr)
-inlineToCustom lua (Image attr alt (src,tit)) =
- callfunc lua "Image" alt src tit (attrToMap attr)
+inlineToCustom (Image attr alt (src,tit)) =
+ callFunc "Image" alt src tit (attrToMap attr)
-inlineToCustom lua (Note contents) = callfunc lua "Note" contents
+inlineToCustom (Note contents) = callFunc "Note" contents
-inlineToCustom lua (Span attr items) =
- callfunc lua "Span" items (attrToMap attr)
+inlineToCustom (Span attr items) =
+ callFunc "Span" items (attrToMap attr)
diff --git a/stack.full.yaml b/stack.full.yaml
index e5fff5a4e..c75f5b89f 100644
--- a/stack.full.yaml
+++ b/stack.full.yaml
@@ -20,6 +20,6 @@ packages:
- '../pandoc-types'
- '../texmath'
extra-deps:
-- hslua-0.5.0
+- hslua-0.7.0
- skylighting-0.3.3
resolver: lts-8.12
diff --git a/stack.pkg.yaml b/stack.pkg.yaml
index 721cb64fc..9e03834ee 100644
--- a/stack.pkg.yaml
+++ b/stack.pkg.yaml
@@ -17,7 +17,7 @@ packages:
commit: 2e27f5cb40577c9b3ffe0fc112687084f3d9d877
extra-dep: false
extra-deps:
-- hslua-0.5.0
+- hslua-0.7.0
- skylighting-0.3.3
- cmark-gfm-0.1.1
- QuickCheck-2.10.0.1
diff --git a/stack.yaml b/stack.yaml
index 1f2ff7f42..c3bc1041d 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -7,7 +7,7 @@ flags:
packages:
- '.'
extra-deps:
-- hslua-0.5.0
+- hslua-0.7.0
- skylighting-0.3.3
- cmark-gfm-0.1.1
- QuickCheck-2.10.0.1
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
index ebd39366b..8cbda996a 100644
--- a/test/Tests/Lua.hs
+++ b/test/Tests/Lua.hs
@@ -13,7 +13,7 @@ import Text.Pandoc.Builder ( (<>), bulletList, doc, doubleQuoted, emph
, space, str, strong)
import Text.Pandoc.Lua
-import qualified Scripting.Lua as Lua
+import Foreign.Lua
tests :: [TestTree]
tests = map (localOption (QuickCheckTests 20))
@@ -71,23 +71,20 @@ assertFilterConversion msg filterPath docIn docExpected = do
docRes <- runLuaFilter Nothing ("lua" </> filterPath) [] docIn
assertEqual msg docExpected docRes
-roundtripEqual :: (Eq a, Lua.StackValue a) => a -> IO Bool
+roundtripEqual :: (Eq a, FromLuaStack a, ToLuaStack a) => a -> IO Bool
roundtripEqual x = (x ==) <$> roundtripped
where
- roundtripped :: (Lua.StackValue a) => IO a
- roundtripped = do
- lua <- Lua.newstate
- Lua.openlibs lua
- pushPandocModule Nothing lua
- Lua.setglobal lua "pandoc"
- oldSize <- Lua.gettop lua
- Lua.push lua x
- size <- Lua.gettop lua
+ roundtripped :: (FromLuaStack a, ToLuaStack a) => IO a
+ roundtripped = runLua $ do
+ openlibs
+ pushPandocModule Nothing
+ setglobal "pandoc"
+ oldSize <- gettop
+ push x
+ size <- gettop
when ((size - oldSize) /= 1) $
error ("not exactly one additional element on the stack: " ++ show size)
- res <- Lua.peek lua (-1)
- retval <- case res of
- Nothing -> error "could not read from stack"
- Just y -> return y
- Lua.close lua
- return retval
+ res <- peekEither (-1)
+ case res of
+ Left _ -> error "could not read from stack"
+ Right y -> return y
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-23 14:48:32 +0000