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