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