git.iko.soy/typeable/pandoc
on eceb8ea help sign in
typeable/pandoc/test/Tests/Lua.hs
238 lines 9.4 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 "Allow singleton inline in constructors" . runLuaTest $ do
176 Lua.liftIO . assertEqual "Not the exptected Emph" (Emph [Str "test"])
177 =<< Lua.callFunc "pandoc.Emph" (Str "test")
178 Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
179 =<< Lua.callFunc "pandoc.Para" ("test" :: String)
180 Lua.liftIO . assertEqual "Unexptected element"
181 (BlockQuote [Para [Str "foo"]]) =<< (
182 do
183 Lua.getglobal' "pandoc.BlockQuote"
184 Lua.push (Para [Str "foo"])
185 _ <- Lua.call 1 1
186 Lua.peek Lua.stackTop
187 )
189 , testCase "Elements with Attr have `attr` accessor" . runLuaTest $ do
190 Lua.push (Div ("hi", ["moin"], [])
191 [Para [Str "ignored"]])
192 Lua.getfield Lua.stackTop "attr"
193 Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
194 =<< Lua.peek Lua.stackTop
196 , testCase "module `pandoc.system` is present" . runLuaTest $ do
197 Lua.getglobal' "pandoc.system"
198 ty <- Lua.ltype Lua.stackTop
199 Lua.liftIO $ assertEqual "module should be a table" Lua.TypeTable ty
201 , testCase "informative error messages" . runLuaTest $ do
202 Lua.pushboolean True
203 eitherPandoc <- Catch.try (Lua.peek Lua.stackTop :: Lua.Lua Pandoc)
204 case eitherPandoc of
205 Left (PandocLuaError msg) -> do
206 let expectedMsg = "Could not get Pandoc value: "
207 <> "table expected, got boolean"
208 Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
209 Left e -> error ("Expected a Lua error, but got " <> show e)
210 Right _ -> error "Getting a Pandoc element from a bool should fail."
211 ]
213assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
214assertFilterConversion msg filterPath docIn expectedDoc = do
215 actualDoc <- runIOorExplode $ do
216 setUserDataDir (Just "../data")
217 applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
218 assertEqual msg expectedDoc actualDoc
220roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool
221roundtripEqual x = (x ==) <$> roundtripped
222 where
223 roundtripped :: Lua.Peekable a => IO a
224 roundtripped = runLuaTest $ do
225 oldSize <- Lua.gettop
226 Lua.push x
227 size <- Lua.gettop
228 when (size - oldSize /= 1) $
229 error ("not exactly one additional element on the stack: " ++ show size)
230 Lua.peek (-1)
232runLuaTest :: Lua.Lua a -> IO a
233runLuaTest op = runIOorExplode $ do
234 setUserDataDir (Just "../data")
235 res <- runLua op
236 case res of
237 Left e -> error (show e)
238 Right x -> return x