9e74826ba9
The new HsLua version takes a somewhat different approach to marshalling and unmarshalling, relying less on typeclasses and more on specialized types. This allows for better performance and improved error messages. Furthermore, new abstractions allow to document the code and exposed functions.
253 lines
9.6 KiB
Haskell
253 lines
9.6 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{- |
|
|
Module : Tests.Lua
|
|
Copyright : © 2017-2021 Albert Krewinkel
|
|
License : GNU GPL, version 2 or above
|
|
|
|
Maintainer : Albert Krewinkel <albert@zeitkraut.de>
|
|
Stability : alpha
|
|
Portability : portable
|
|
|
|
Unit and integration tests for pandoc's Lua subsystem.
|
|
-}
|
|
module Tests.Lua ( runLuaTest, tests ) where
|
|
|
|
import Control.Monad (when)
|
|
import HsLua as Lua hiding (Operation (Div), error)
|
|
import System.FilePath ((</>))
|
|
import Test.Tasty (TestTree, localOption)
|
|
import Test.Tasty.HUnit (Assertion, HasCallStack, assertEqual, testCase)
|
|
import Test.Tasty.QuickCheck (QuickCheckTests (..), ioProperty, testProperty)
|
|
import Text.Pandoc.Arbitrary ()
|
|
import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
|
|
doc, doubleQuoted, emph, header, lineBlock,
|
|
linebreak, math, orderedList, para, plain, rawBlock,
|
|
singleQuoted, space, str, strong,
|
|
HasMeta (setMeta))
|
|
import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
|
|
import Text.Pandoc.Definition (Attr, Block (BlockQuote, Div, Para), Pandoc,
|
|
Inline (Emph, Str), Meta, pandocTypesVersion)
|
|
import Text.Pandoc.Error (PandocError (PandocLuaError))
|
|
import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters)
|
|
import Text.Pandoc.Lua (runLua)
|
|
import Text.Pandoc.Options (def)
|
|
import Text.Pandoc.Shared (pandocVersion)
|
|
|
|
import qualified Control.Monad.Catch as Catch
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
|
|
tests :: [TestTree]
|
|
tests = map (localOption (QuickCheckTests 20))
|
|
[ testProperty "inline elements can be round-tripped through the lua stack" $
|
|
ioProperty . roundtripEqual @Inline
|
|
|
|
, testProperty "block elements can be round-tripped through the lua stack" $
|
|
ioProperty . roundtripEqual @Block
|
|
|
|
, testProperty "meta blocks can be round-tripped through the lua stack" $
|
|
ioProperty . roundtripEqual @Meta
|
|
|
|
, testProperty "documents can be round-tripped through the lua stack" $
|
|
ioProperty . roundtripEqual @Pandoc
|
|
|
|
, testCase "macro expansion via filter" $
|
|
assertFilterConversion "a '{{helloworld}}' string is expanded"
|
|
"strmacro.lua"
|
|
(doc . para $ str "{{helloworld}}")
|
|
(doc . para . emph $ str "Hello, World")
|
|
|
|
, testCase "convert all plains to paras" $
|
|
assertFilterConversion "plains become para"
|
|
"plain-to-para.lua"
|
|
(doc $ bulletList [plain (str "alfa"), plain (str "bravo")])
|
|
(doc $ bulletList [para (str "alfa"), para (str "bravo")])
|
|
|
|
, testCase "convert display math to inline math" $
|
|
assertFilterConversion "display math becomes inline math"
|
|
"math.lua"
|
|
(doc $ para (displayMath "5+5"))
|
|
(doc $ para (math "5+5"))
|
|
|
|
, testCase "make hello world document" $
|
|
assertFilterConversion "Document contains 'Hello, World!'"
|
|
"hello-world-doc.lua"
|
|
(doc . para $ str "Hey!" <> linebreak <> str "What's up?")
|
|
(doc . para $ str "Hello," <> space <> str "World!")
|
|
|
|
, testCase "implicit doc filter" $
|
|
assertFilterConversion "Document contains 'Hello, World!'"
|
|
"implicit-doc-filter.lua"
|
|
(doc . plain $ linebreak)
|
|
(doc . para $ str "Hello," <> space <> str "World!")
|
|
|
|
, testCase "parse raw markdown blocks" $
|
|
assertFilterConversion "raw markdown block is converted"
|
|
"markdown-reader.lua"
|
|
(doc $ rawBlock "markdown" "*charly* **delta**")
|
|
(doc . para $ emph "charly" <> space <> strong "delta")
|
|
|
|
, testCase "allow shorthand functions for quote types" $
|
|
assertFilterConversion "single quoted becomes double quoted string"
|
|
"single-to-double-quoted.lua"
|
|
(doc . para . singleQuoted $ str "simple")
|
|
(doc . para . doubleQuoted $ str "simple")
|
|
|
|
, testCase "Count inlines via metatable catch-all" $
|
|
assertFilterConversion "filtering with metatable catch-all failed"
|
|
"metatable-catch-all.lua"
|
|
(doc . para $ "four words, three spaces")
|
|
(doc . para $ str "7")
|
|
|
|
, testCase "Count blocks via Block-specific catch-all" $
|
|
assertFilterConversion "filtering with Block catch-all failed"
|
|
"block-count.lua"
|
|
(doc $ para "one" <> para "two")
|
|
(doc $ para "2")
|
|
|
|
, testCase "Smart constructors" $
|
|
assertFilterConversion "smart constructors returned a wrong result"
|
|
"smart-constructors.lua"
|
|
(doc $ para "")
|
|
(doc $ mconcat
|
|
[ bulletList [para "Hello", para "World"]
|
|
, definitionList [("foo", [para "placeholder"])]
|
|
, lineBlock ["Moin", "Welt"]
|
|
, orderedList [plain "one", plain "two"]
|
|
])
|
|
|
|
, testCase "Convert header upper case" $
|
|
assertFilterConversion "converting header to upper case failed"
|
|
"uppercase-header.lua"
|
|
(doc $ header 1 "les états-unis" <> para "text")
|
|
(doc $ header 1 "LES ÉTATS-UNIS" <> para "text")
|
|
|
|
, testCase "Attribute lists are convenient to use" $
|
|
let kv_before = [("one", "1"), ("two", "2"), ("three", "3")]
|
|
kv_after = [("one", "eins"), ("three", "3"), ("five", "5")]
|
|
in assertFilterConversion "Attr doesn't behave as expected"
|
|
"attr-test.lua"
|
|
(doc $ divWith ("", [], kv_before) (para "nil"))
|
|
(doc $ divWith ("", [], kv_after) (para "nil"))
|
|
|
|
, testCase "Filter list of inlines" $
|
|
assertFilterConversion "List of inlines"
|
|
"inlines-filter.lua"
|
|
(doc $ para ("Hello," <> linebreak <> "World! Wassup?"))
|
|
(doc $ para "Hello, World! Wassup?")
|
|
|
|
, testCase "Filter list of blocks" $
|
|
assertFilterConversion "List of blocks"
|
|
"blocks-filter.lua"
|
|
(doc $ para "one." <> para "two." <> para "three.")
|
|
(doc $ plain "3")
|
|
|
|
, testCase "Filter Meta" $
|
|
let setMetaBefore = setMeta "old" ("old" :: T.Text)
|
|
. setMeta "bool" False
|
|
setMetaAfter = setMeta "new" ("new" :: T.Text)
|
|
. setMeta "bool" True
|
|
in assertFilterConversion "Meta filtering"
|
|
"meta.lua"
|
|
(setMetaBefore . doc $ mempty)
|
|
(setMetaAfter . doc $ mempty)
|
|
|
|
, testCase "Script filename is set" $
|
|
assertFilterConversion "unexpected script name"
|
|
"script-name.lua"
|
|
(doc $ para "ignored")
|
|
(doc $ para (str $ T.pack $ "lua" </> "script-name.lua"))
|
|
|
|
, testCase "Pandoc version is set" . runLuaTest $ do
|
|
Lua.getglobal "PANDOC_VERSION"
|
|
Lua.liftIO .
|
|
assertEqual "pandoc version is wrong" (TE.encodeUtf8 pandocVersion)
|
|
=<< Lua.tostring' Lua.top
|
|
|
|
, testCase "Pandoc types version is set" . runLuaTest $ do
|
|
Lua.getglobal "PANDOC_API_VERSION"
|
|
Lua.liftIO . assertEqual "pandoc-types version is wrong" pandocTypesVersion
|
|
=<< Lua.peek Lua.top
|
|
|
|
, testCase "require file" $
|
|
assertFilterConversion "requiring file failed"
|
|
"require-file.lua"
|
|
(doc $ para "ignored")
|
|
(doc $ para (str . T.pack $ "lua" </> "require-file.lua"))
|
|
|
|
, testCase "Allow singleton inline in constructors" . runLuaTest $ do
|
|
Lua.liftIO . assertEqual "Not the expected Emph"
|
|
(Emph [Str "test"]) =<< do
|
|
Lua.OK <- Lua.dostring "return pandoc.Emph"
|
|
Lua.push @Inline (Str "test")
|
|
Lua.call 1 1
|
|
Lua.peek @Inline top
|
|
Lua.liftIO . assertEqual "Unexpected element"
|
|
(Para [Str "test"]) =<< do
|
|
Lua.getglobal' "pandoc.Para"
|
|
Lua.pushString "test"
|
|
Lua.call 1 1
|
|
Lua.peek @Block top
|
|
Lua.liftIO . assertEqual "Unexptected element"
|
|
(BlockQuote [Para [Str "foo"]]) =<< (
|
|
do
|
|
Lua.getglobal' "pandoc.BlockQuote"
|
|
Lua.push (Para [Str "foo"])
|
|
_ <- Lua.call 1 1
|
|
Lua.peek @Block Lua.top
|
|
)
|
|
|
|
, testCase "Elements with Attr have `attr` accessor" . runLuaTest $ do
|
|
Lua.push (Div ("hi", ["moin"], [])
|
|
[Para [Str "ignored"]])
|
|
Lua.getfield Lua.top "attr"
|
|
Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
|
|
=<< Lua.peek Lua.top
|
|
|
|
, testCase "module `pandoc.system` is present" . runLuaTest $ do
|
|
Lua.getglobal' "pandoc.system"
|
|
ty <- Lua.ltype Lua.top
|
|
Lua.liftIO $ assertEqual "module should be a table" Lua.TypeTable ty
|
|
|
|
, testCase "informative error messages" . runLuaTest $ do
|
|
Lua.pushboolean True
|
|
-- Lua.newtable
|
|
eitherPandoc <- Catch.try (peek @Pandoc Lua.top)
|
|
case eitherPandoc of
|
|
Left (PandocLuaError msg) -> do
|
|
let expectedMsg = "table expected, got boolean\n"
|
|
<> "\twhile retrieving Pandoc value"
|
|
Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
|
|
Left e -> error ("Expected a Lua error, but got " <> show e)
|
|
Right _ -> error "Getting a Pandoc element from a bool should fail."
|
|
]
|
|
|
|
assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
|
|
assertFilterConversion msg filterPath docIn expectedDoc = do
|
|
actualDoc <- runIOorExplode $ do
|
|
setUserDataDir (Just "../data")
|
|
applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
|
|
assertEqual msg expectedDoc actualDoc
|
|
|
|
roundtripEqual :: forall a. (Eq a, Lua.Pushable a, Lua.Peekable a)
|
|
=> a -> IO Bool
|
|
roundtripEqual x = (x ==) <$> roundtripped
|
|
where
|
|
roundtripped :: IO a
|
|
roundtripped = runLuaTest $ do
|
|
oldSize <- Lua.gettop
|
|
Lua.push x
|
|
size <- Lua.gettop
|
|
when (size - oldSize /= 1) $
|
|
error ("not exactly one additional element on the stack: " ++ show size)
|
|
Lua.peek Lua.top
|
|
|
|
runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a
|
|
runLuaTest op = runIOorExplode $ do
|
|
setUserDataDir (Just "../data")
|
|
res <- runLua op
|
|
case res of
|
|
Left e -> error (show e)
|
|
Right x -> return x
|