summaryrefslogtreecommitdiff
path: root/test/Tests/Lua.hs
diff options
context:
space:
mode:
Diffstat (limited to 'test/Tests/Lua.hs')
-rw-r--r--test/Tests/Lua.hs196
1 files changed, 196 insertions, 0 deletions
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
new file mode 100644
index 000000000..4599e544d
--- /dev/null
+++ b/test/Tests/Lua.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.Lua ( tests ) where
+
+import Control.Monad (when)
+import Data.Version (Version (versionBranch))
+import System.FilePath ((</>))
+import Test.Tasty (TestTree, localOption)
+import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
+import Test.Tasty.QuickCheck (QuickCheckTests (..), ioProperty, testProperty)
+import Text.Pandoc.Arbitrary ()
+import Text.Pandoc.Builder (bulletList, divWith, doc, doubleQuoted, emph,
+ header, linebreak, para, plain, rawBlock,
+ singleQuoted, space, str, strong, (<>))
+import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
+import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
+ Attr, Meta, Pandoc, pandocTypesVersion)
+import Text.Pandoc.Lua (runLuaFilter, runPandocLua)
+import Text.Pandoc.Options (def)
+import Text.Pandoc.Shared (pandocVersion)
+
+import qualified Foreign.Lua as Lua
+
+tests :: [TestTree]
+tests = map (localOption (QuickCheckTests 20))
+ [ testProperty "inline elements can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::Inline))
+
+ , testProperty "block elements can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::Block))
+
+ , testProperty "meta blocks can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::Meta))
+
+ , testProperty "documents can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::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 "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 "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 "Test module pandoc.utils" $
+ assertFilterConversion "pandoc.utils doesn't work as expected."
+ "test-pandoc-utils.lua"
+ (doc $ para "doesn't matter")
+ (doc $ mconcat [ plain (str "hierarchicalize: OK")
+ , plain (str "normalize_date: OK")
+ , plain (str "pipe: OK")
+ , plain (str "failing pipe: OK")
+ , plain (str "read: OK")
+ , plain (str "failing read: OK")
+ , plain (str "sha1: OK")
+ , plain (str "stringify: OK")
+ , plain (str "to_roman_numeral: OK")
+ ])
+
+ , testCase "Script filename is set" $
+ assertFilterConversion "unexpected script name"
+ "script-name.lua"
+ (doc $ para "ignored")
+ (doc $ para (str $ "lua" </> "script-name.lua"))
+
+ , testCase "Pandoc version is set" . runPandocLua' $ do
+ Lua.getglobal' "table.concat"
+ Lua.getglobal "PANDOC_VERSION"
+ Lua.push ("." :: String) -- seperator
+ Lua.call 2 1
+ Lua.liftIO . assertEqual "pandoc version is wrong" pandocVersion
+ =<< Lua.peek Lua.stackTop
+
+ , testCase "Pandoc types version is set" . runPandocLua' $ do
+ let versionNums = versionBranch pandocTypesVersion
+ Lua.getglobal "PANDOC_API_VERSION"
+ Lua.liftIO . assertEqual "pandoc-types version is wrong" versionNums
+ =<< Lua.peek Lua.stackTop
+
+ , testCase "Allow singleton inline in constructors" . runPandocLua' $ do
+ Lua.liftIO . assertEqual "Not the exptected Emph" (Emph [Str "test"])
+ =<< Lua.callFunc "pandoc.Emph" (Str "test")
+ Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
+ =<< Lua.callFunc "pandoc.Para" ("test" :: String)
+ 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 Lua.stackTop
+ )
+
+ , testCase "Elements with Attr have `attr` accessor" . runPandocLua' $ do
+ Lua.push (Div ("hi", ["moin"], [])
+ [Para [Str "ignored"]])
+ Lua.getfield Lua.stackTop "attr"
+ Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
+ =<< Lua.peek Lua.stackTop
+
+ , testCase "informative error messages" . runPandocLua' $ do
+ Lua.pushboolean True
+ err <- Lua.peekEither Lua.stackTop :: Lua.Lua (Either String Pandoc)
+ case err of
+ Left msg -> do
+ let expectedMsg = "Could not get Pandoc value: "
+ ++ "expected table but got boolean."
+ Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
+ Right _ -> error "Getting a Pandoc element from a bool should fail."
+ ]
+
+assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
+assertFilterConversion msg filterPath docIn docExpected = do
+ docEither <- runIOorExplode $ do
+ setUserDataDir (Just "../data")
+ runLuaFilter def ("lua" </> filterPath) [] docIn
+ case docEither of
+ Left _ -> fail "lua filter failed"
+ Right docRes -> assertEqual msg docExpected docRes
+
+roundtripEqual :: (Eq a, Lua.FromLuaStack a, Lua.ToLuaStack a) => a -> IO Bool
+roundtripEqual x = (x ==) <$> roundtripped
+ where
+ roundtripped :: (Lua.FromLuaStack a, Lua.ToLuaStack a) => IO a
+ roundtripped = runPandocLua' $ 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)
+ res <- Lua.peekEither (-1)
+ case res of
+ Left e -> error (show e)
+ Right y -> return y
+
+runPandocLua' :: Lua.Lua a -> IO a
+runPandocLua' op = runIOorExplode $ do
+ setUserDataDir (Just "../data")
+ res <- runPandocLua op
+ case res of
+ Left e -> error (show e)
+ Right x -> return x