git.iko.soy/typeable/pandoc
on 76a4e71 help sign in
typeable/pandoc/test/Tests/Lua.hs
242 lines 9.6 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{- |
4 Module : Tests.Lua
5 Copyright : © 2017-2021 Albert Krewinkel
6 License : GNU GPL, version 2 or above
8 Maintainer : Albert Krewinkel <albert@zeitkraut.de>
9 Stability : alpha
10 Portability : portable
12Unit and integration tests for pandoc's Lua subsystem.
13-}
14module Tests.Lua ( runLuaTest, tests ) where
16import Control.Monad (when)
17import System.FilePath ((</>))
18import Test.Tasty (TestTree, localOption)
19import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
20import Test.Tasty.QuickCheck (QuickCheckTests (..), ioProperty, testProperty)
21import Text.Pandoc.Arbitrary ()
22import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
23 doc, doubleQuoted, emph, header, lineBlock,
24 linebreak, math, orderedList, para, plain, rawBlock,
25 singleQuoted, space, str, strong,
26 HasMeta (setMeta))
27import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
28import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
29 Attr, Meta, Pandoc, pandocTypesVersion)
30import Text.Pandoc.Error (PandocError (PandocLuaError))
31import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters)
32import Text.Pandoc.Lua (runLua)
33import Text.Pandoc.Options (def)
34import Text.Pandoc.Shared (pandocVersion)
36import qualified Control.Monad.Catch as Catch
37import qualified Foreign.Lua as Lua
38import qualified Data.Text as T
39import qualified Data.Text.Encoding as TE
41tests :: [TestTree]
42tests = map (localOption (QuickCheckTests 20))
43 [ testProperty "inline elements can be round-tripped through the lua stack" $
44 \x -> ioProperty (roundtripEqual (x::Inline))
46 , testProperty "block elements can be round-tripped through the lua stack" $
47 \x -> ioProperty (roundtripEqual (x::Block))
49 , testProperty "meta blocks can be round-tripped through the lua stack" $
50 \x -> ioProperty (roundtripEqual (x::Meta))
52 , testProperty "documents can be round-tripped through the lua stack" $
53 \x -> ioProperty (roundtripEqual (x::Pandoc))
55 , testCase "macro expansion via filter" $
56 assertFilterConversion "a '{{helloworld}}' string is expanded"
57 "strmacro.lua"
58 (doc . para $ str "{{helloworld}}")
59 (doc . para . emph $ str "Hello, World")
61 , testCase "convert all plains to paras" $
62 assertFilterConversion "plains become para"
63 "plain-to-para.lua"
64 (doc $ bulletList [plain (str "alfa"), plain (str "bravo")])
65 (doc $ bulletList [para (str "alfa"), para (str "bravo")])
67 , testCase "convert display math to inline math" $
68 assertFilterConversion "display math becomes inline math"
69 "math.lua"
70 (doc $ para (displayMath "5+5"))
71 (doc $ para (math "5+5"))
73 , testCase "make hello world document" $
74 assertFilterConversion "Document contains 'Hello, World!'"
75 "hello-world-doc.lua"
76 (doc . para $ str "Hey!" <> linebreak <> str "What's up?")
77 (doc . para $ str "Hello," <> space <> str "World!")
79 , testCase "implicit doc filter" $
80 assertFilterConversion "Document contains 'Hello, World!'"
81 "implicit-doc-filter.lua"
82 (doc . plain $ linebreak)
83 (doc . para $ str "Hello," <> space <> str "World!")
85 , testCase "parse raw markdown blocks" $
86 assertFilterConversion "raw markdown block is converted"
87 "markdown-reader.lua"
88 (doc $ rawBlock "markdown" "*charly* **delta**")
89 (doc . para $ emph "charly" <> space <> strong "delta")
91 , testCase "allow shorthand functions for quote types" $
92 assertFilterConversion "single quoted becomes double quoted string"
93 "single-to-double-quoted.lua"
94 (doc . para . singleQuoted $ str "simple")
95 (doc . para . doubleQuoted $ str "simple")
97 , testCase "Count inlines via metatable catch-all" $
98 assertFilterConversion "filtering with metatable catch-all failed"
99 "metatable-catch-all.lua"
100 (doc . para $ "four words, three spaces")
101 (doc . para $ str "7")
103 , testCase "Count blocks via Block-specific catch-all" $
104 assertFilterConversion "filtering with Block catch-all failed"
105 "block-count.lua"
106 (doc $ para "one" <> para "two")
107 (doc $ para "2")
109 , testCase "Smart constructors" $
110 assertFilterConversion "smart constructors returned a wrong result"
111 "smart-constructors.lua"
112 (doc $ para "")
113 (doc $ mconcat
114 [ bulletList [para "Hello", para "World"]
115 , definitionList [("foo", [para "placeholder"])]
116 , lineBlock ["Moin", "Welt"]
117 , orderedList [plain "one", plain "two"]
118 ])
120 , testCase "Convert header upper case" $
121 assertFilterConversion "converting header to upper case failed"
122 "uppercase-header.lua"
123 (doc $ header 1 "les états-unis" <> para "text")
124 (doc $ header 1 "LES ÉTATS-UNIS" <> para "text")
126 , testCase "Attribute lists are convenient to use" $
127 let kv_before = [("one", "1"), ("two", "2"), ("three", "3")]
128 kv_after = [("one", "eins"), ("three", "3"), ("five", "5")]
129 in assertFilterConversion "Attr doesn't behave as expected"
130 "attr-test.lua"
131 (doc $ divWith ("", [], kv_before) (para "nil"))
132 (doc $ divWith ("", [], kv_after) (para "nil"))
134 , testCase "Filter list of inlines" $
135 assertFilterConversion "List of inlines"
136 "inlines-filter.lua"
137 (doc $ para ("Hello," <> linebreak <> "World! Wassup?"))
138 (doc $ para "Hello, World! Wassup?")
140 , testCase "Filter list of blocks" $
141 assertFilterConversion "List of blocks"
142 "blocks-filter.lua"
143 (doc $ para "one." <> para "two." <> para "three.")
144 (doc $ plain "3")
146 , testCase "Filter Meta" $
147 let setMetaBefore = setMeta "old" ("old" :: T.Text)
148 . setMeta "bool" False
149 setMetaAfter = setMeta "new" ("new" :: T.Text)
150 . setMeta "bool" True
151 in assertFilterConversion "Meta filtering"
152 "meta.lua"
153 (setMetaBefore . doc $ mempty)
154 (setMetaAfter . doc $ mempty)
156 , testCase "Script filename is set" $
157 assertFilterConversion "unexpected script name"
158 "script-name.lua"
159 (doc $ para "ignored")
160 (doc $ para (str $ T.pack $ "lua" </> "script-name.lua"))
162 , testCase "Pandoc version is set" . runLuaTest $ do
163 Lua.getglobal "PANDOC_VERSION"
164 Lua.liftIO .
165 assertEqual "pandoc version is wrong" (TE.encodeUtf8 pandocVersion)
166 =<< Lua.tostring' Lua.stackTop
168 , testCase "Pandoc types version is set" . runLuaTest $ do
169 Lua.getglobal "PANDOC_API_VERSION"
170 Lua.liftIO . assertEqual "pandoc-types version is wrong" pandocTypesVersion
171 =<< Lua.peek Lua.stackTop
173 , testCase "require file" $
174 assertFilterConversion "requiring file failed"
175 "require-file.lua"
176 (doc $ para "ignored")
177 (doc $ para (str . T.pack $ "lua" </> "require-file.lua"))
179 , testCase "Allow singleton inline in constructors" . runLuaTest $ do
180 Lua.liftIO . assertEqual "Not the expected Emph" (Emph [Str "test"])
181 =<< Lua.callFunc "pandoc.Emph" (Str "test")
182 Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
183 =<< Lua.callFunc "pandoc.Para" ("test" :: String)
184 Lua.liftIO . assertEqual "Unexptected element"
185 (BlockQuote [Para [Str "foo"]]) =<< (
186 do
187 Lua.getglobal' "pandoc.BlockQuote"
188 Lua.push (Para [Str "foo"])
189 _ <- Lua.call 1 1
190 Lua.peek Lua.stackTop
191 )
193 , testCase "Elements with Attr have `attr` accessor" . runLuaTest $ do
194 Lua.push (Div ("hi", ["moin"], [])
195 [Para [Str "ignored"]])
196 Lua.getfield Lua.stackTop "attr"
197 Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
198 =<< Lua.peek Lua.stackTop
200 , testCase "module `pandoc.system` is present" . runLuaTest $ do
201 Lua.getglobal' "pandoc.system"
202 ty <- Lua.ltype Lua.stackTop
203 Lua.liftIO $ assertEqual "module should be a table" Lua.TypeTable ty
205 , testCase "informative error messages" . runLuaTest $ do
206 Lua.pushboolean True
207 eitherPandoc <- Catch.try (Lua.peek Lua.stackTop :: Lua.Lua Pandoc)
208 case eitherPandoc of
209 Left (PandocLuaError msg) -> do
210 let expectedMsg = "Could not get Pandoc value: "
211 <> "table expected, got boolean"
212 Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
213 Left e -> error ("Expected a Lua error, but got " <> show e)
214 Right _ -> error "Getting a Pandoc element from a bool should fail."
215 ]
217assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
218assertFilterConversion msg filterPath docIn expectedDoc = do
219 actualDoc <- runIOorExplode $ do
220 setUserDataDir (Just "../data")
221 applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
222 assertEqual msg expectedDoc actualDoc
224roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool
225roundtripEqual x = (x ==) <$> roundtripped
226 where
227 roundtripped :: Lua.Peekable a => IO a
228 roundtripped = runLuaTest $ do
229 oldSize <- Lua.gettop
230 Lua.push x
231 size <- Lua.gettop
232 when (size - oldSize /= 1) $
233 error ("not exactly one additional element on the stack: " ++ show size)
234 Lua.peek (-1)
236runLuaTest :: Lua.Lua a -> IO a
237runLuaTest op = runIOorExplode $ do
238 setUserDataDir (Just "../data")
239 res <- runLua op
240 case res of
241 Left e -> error (show e)
242 Right x -> return x