[API Change] Extract Lua code into new package pandoc-lua-engine

The flag 'lua53` must now be used with that package if pandoc is to be
compiled against Lua 5.3.

3 files changed, 328 insertions, 0 deletions

diff --git a/pandoc-lua-engine/test/Tests/Lua.hs b/pandoc-lua-engine/test/Tests/Lua.hs
new file mode 100644
index 000000000..6f544ccd4
--- /dev/null
+++ b/pandoc-lua-engine/test/Tests/Lua.hs
@@ -0,0 +1,246 @@
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{- |
+   Module      : Tests.Lua
+   Copyright   : © 2017-2022 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 HsLua as Lua hiding (Operation (Div), error)
+import System.FilePath ((</>))
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit ((@=?), Assertion, HasCallStack, assertEqual, testCase)
+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), pandocTypesVersion)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
+import Text.Pandoc.Lua (Global (..), applyFilter, runLua, setGlobals)
+import Text.Pandoc.Options (def)
+import Text.Pandoc.Shared (pandocVersionText)
+
+import qualified Control.Monad.Catch as Catch
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+
+tests :: [TestTree]
+tests =
+  [ 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 pandocVersionText)
+        =<< 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 @Attr 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
+
+  , testGroup "global modules"
+    [ testCase "module 'lpeg' is loaded into a global" . runLuaTest $ do
+        s <- Lua.dostring "assert(type(lpeg)=='table')"
+        Lua.liftIO $ Lua.OK @=? s
+
+    , testCase "module 're' is loaded into a global" . runLuaTest $ do
+        s <- Lua.dostring "assert(type(re)=='table')"
+        Lua.liftIO $ Lua.OK @=? s
+
+    , testCase "module 'lpeg' is available via `require`" . runLuaTest $ do
+        s <- Lua.dostring
+              "package.path = ''; package.cpath = ''; require 'lpeg'"
+        Lua.liftIO $ Lua.OK @=? s
+
+    , testCase "module 're' is available via `require`" . runLuaTest $ do
+        s <- Lua.dostring
+               "package.path = ''; package.cpath = ''; require 're'"
+        Lua.liftIO $ Lua.OK @=? s
+    ]
+
+  , 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 = "Pandoc expected, got boolean\n"
+                <> "\twhile retrieving Pandoc"
+          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")
+    applyFilter def ["HTML"] ("lua" </> filterPath) docIn
+  assertEqual msg expectedDoc actualDoc
+
+runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a
+runLuaTest op = runIOorExplode $ do
+  res <- runLua $ do
+    setGlobals [ PANDOC_WRITER_OPTIONS def ]
+    op
+  case res of
+    Left e -> error (show e)
+    Right x -> return x
diff --git a/pandoc-lua-engine/test/Tests/Lua/Module.hs b/pandoc-lua-engine/test/Tests/Lua/Module.hs
new file mode 100644
index 000000000..fd3fc8998
--- /dev/null
+++ b/pandoc-lua-engine/test/Tests/Lua/Module.hs
@@ -0,0 +1,41 @@
+{- |
+Module      : Tests.Lua.Module
+Copyright   : © 2019-2022 Albert Krewinkel
+License     : GNU GPL, version 2 or above
+
+Maintainer  : Albert Krewinkel <albert@zeitkraut.de>
+Stability   : alpha
+Portability : portable
+
+Lua module tests
+-}
+module Tests.Lua.Module (tests) where
+
+import System.FilePath ((</>))
+import Test.Tasty (TestName, TestTree)
+import Test.Tasty.Lua (testLuaFile)
+
+import Tests.Lua (runLuaTest)
+
+tests :: [TestTree]
+tests =
+  [ testPandocLua "pandoc"
+                  ("lua" </> "module" </> "pandoc.lua")
+  , testPandocLua "pandoc.List"
+                  ("lua" </> "module" </> "pandoc-list.lua")
+  , testPandocLua "pandoc.mediabag"
+                  ("lua" </> "module" </> "pandoc-mediabag.lua")
+  , testPandocLua "pandoc.path"
+                  ("lua" </> "module" </> "pandoc-path.lua")
+  , testPandocLua "pandoc.template"
+                  ("lua" </> "module" </> "pandoc-template.lua")
+  , testPandocLua "pandoc.types"
+                  ("lua" </> "module" </> "pandoc-types.lua")
+  , testPandocLua "pandoc.utils"
+                  ("lua" </> "module" </> "pandoc-utils.lua")
+  , testPandocLua "globals"
+                  ("lua" </> "module" </> "globals.lua")
+  ]
+
+testPandocLua :: TestName -> FilePath -> TestTree
+testPandocLua = testLuaFile runLuaTest
diff --git a/pandoc-lua-engine/test/Tests/Lua/Writer.hs b/pandoc-lua-engine/test/Tests/Lua/Writer.hs
new file mode 100644
index 000000000..4086b9768
--- /dev/null
+++ b/pandoc-lua-engine/test/Tests/Lua/Writer.hs
@@ -0,0 +1,41 @@
+{- |
+Module      : Tests.Lua.Writer
+Copyright   : © 2019-2022 Albert Krewinkel
+License     : GNU GPL, version 2 or above
+
+Maintainer  : Albert Krewinkel <albert@zeitkraut.de>
+Stability   : alpha
+Portability : portable
+
+Tests for custom Lua writers.
+-}
+module Tests.Lua.Writer (tests) where
+
+import Data.Default (Default (def))
+import Text.Pandoc.Class (runIOorExplode, readFileStrict)
+import Text.Pandoc.Lua (writeCustom)
+import Text.Pandoc.Readers (readNative)
+import Test.Tasty (TestTree)
+import Test.Tasty.Golden (goldenVsString)
+
+import qualified Data.ByteString.Lazy as BL
+import qualified Text.Pandoc.UTF8 as UTF8
+
+tests :: [TestTree]
+tests =
+  [ goldenVsString "default testsuite"
+    "writer.custom"
+    (runIOorExplode $ do
+        source <- UTF8.toText <$> readFileStrict "testsuite.native"
+        doc <- readNative def source
+        txt <- writeCustom "sample.lua" def doc
+        pure $ BL.fromStrict (UTF8.fromText txt))
+
+  , goldenVsString "tables testsuite"
+    "tables.custom"
+    (runIOorExplode $ do
+        source <- UTF8.toText <$> readFileStrict "tables.native"
+        doc <- readNative def source
+        txt <- writeCustom "sample.lua" def doc
+        pure $ BL.fromStrict (UTF8.fromText txt))
+  ]