Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Use hslua >= 0.7, update Lua code

Browse source
This commit is contained in:
Albert Krewinkel 2017-08-13 12:37:10 +02:00
parent 418bda8128
commit 2dc3dbd68b
12 changed files with 462 additions and 621 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
pandoc.cabal
View file

@ -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,

175
src/Text/Pandoc/Lua.hs
View file

@ -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
when (newtop - top < 1) $ pushGlobalFilter
luaFilters <- peek (-1)
push args
setglobal "PandocParameters"
runAll luaFilters pd
pushGlobalFilter :: LuaState -> IO ()
pushGlobalFilter lua =
Lua.newtable lua
*> Lua.getglobal2 lua "pandoc.global_filter"
*> Lua.call lua 0 1
*> Lua.rawseti lua (-2) 1
pushGlobalFilter :: Lua ()
pushGlobalFilter = do
newtable
getglobal' "pandoc.global_filter"
call 0 1
rawseti (-2) 1
runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
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)
rawgeti 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
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

40
src/Text/Pandoc/Lua/Compat.hs
View file

@ -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

24
src/Text/Pandoc/Lua/PandocModule.hs
View file

@ -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) ->

82
src/Text/Pandoc/Lua/SharedInstances.hs
View file

@ -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

385
src/Text/Pandoc/Lua/StackInstances.hs
View file

@ -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 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 StackValue Meta where
push lua (Meta mmap) = push lua mmap
peek lua idx = fmap Meta <$> peek lua idx
valuetype _ = TTABLE
instance ToLuaStack Meta where
push (Meta mmap) = push mmap
instance FromLuaStack Meta where
peek idx = Meta <$> peek idx
instance StackValue MetaValue where
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
-- Citation
instance ToLuaStack Citation where
push (Citation cid prefix suffix mode noteNum hash) =
pushViaConstructor "Citation" cid mode prefix suffix noteNum hash
instance StackValue Alignment where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
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 StackValue CitationMode where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance ToLuaStack Alignment where
push = push . show
instance FromLuaStack Alignment where
peek idx = safeRead' =<< peek idx
instance StackValue Format where
push lua (Format f) = push lua f
peek lua idx = fmap Format <$> peek lua idx
valuetype _ = TSTRING
instance ToLuaStack CitationMode where
push = push . show
instance FromLuaStack CitationMode where
peek idx = safeRead' =<< peek idx
instance StackValue ListNumberDelim where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance ToLuaStack Format where
push (Format f) = push f
instance FromLuaStack Format where
peek idx = Format <$> peek idx
instance StackValue ListNumberStyle where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance ToLuaStack ListNumberDelim where
push = push . show
instance FromLuaStack ListNumberDelim where
peek idx = safeRead' =<< peek idx
instance StackValue MathType where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance ToLuaStack ListNumberStyle where
push = push . show
instance FromLuaStack ListNumberStyle where
peek idx = safeRead' =<< peek idx
instance StackValue QuoteType where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
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

102
src/Text/Pandoc/Lua/Util.hs
View file

@ -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)

233
src/Text/Pandoc/Writers/Custom.hs
View file

@ -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
push ils = push =<< blockListToCustom ils
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 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 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
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)

2
stack.full.yaml
View file

@ -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

2
stack.pkg.yaml
View file

@ -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

2
stack.yaml
View file

@ -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

31
test/Tests/Lua.hs
View file

@ -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