git.iko.soy/typeable/pandoc
on 545da61 help sign in
typeable/pandoc/test/Tests/Lua.hs
232 lines 9.2 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3{- |
4 Module : Tests.Lua
5 Copyright : © 2017-2019 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 ( tests ) where
16import Prelude
17import Control.Monad (when)
18import Data.Version (Version (versionBranch))
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)
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
38tests :: [TestTree]
39tests = map (localOption (QuickCheckTests 20))
40 [ testProperty "inline elements can be round-tripped through the lua stack" $
41 \x -> ioProperty (roundtripEqual (x::Inline))
43 , testProperty "block elements can be round-tripped through the lua stack" $
44 \x -> ioProperty (roundtripEqual (x::Block))
46 , testProperty "meta blocks can be round-tripped through the lua stack" $
47 \x -> ioProperty (roundtripEqual (x::Meta))
49 , testProperty "documents can be round-tripped through the lua stack" $
50 \x -> ioProperty (roundtripEqual (x::Pandoc))
52 , testCase "macro expansion via filter" $
53 assertFilterConversion "a '{{helloworld}}' string is expanded"
54 "strmacro.lua"
55 (doc . para $ str "{{helloworld}}")
56 (doc . para . emph $ str "Hello, World")
58 , testCase "convert all plains to paras" $
59 assertFilterConversion "plains become para"
60 "plain-to-para.lua"
61 (doc $ bulletList [plain (str "alfa"), plain (str "bravo")])
62 (doc $ bulletList [para (str "alfa"), para (str "bravo")])
64 , testCase "convert display math to inline math" $
65 assertFilterConversion "display math becomes inline math"
66 "math.lua"
67 (doc $ para (displayMath "5+5"))
68 (doc $ para (math "5+5"))
70 , testCase "make hello world document" $
71 assertFilterConversion "Document contains 'Hello, World!'"
72 "hello-world-doc.lua"
73 (doc . para $ str "Hey!" <> linebreak <> str "What's up?")
74 (doc . para $ str "Hello," <> space <> str "World!")
76 , testCase "implicit doc filter" $
77 assertFilterConversion "Document contains 'Hello, World!'"
78 "implicit-doc-filter.lua"
79 (doc . plain $ linebreak)
80 (doc . para $ str "Hello," <> space <> str "World!")
82 , testCase "parse raw markdown blocks" $
83 assertFilterConversion "raw markdown block is converted"
84 "markdown-reader.lua"
85 (doc $ rawBlock "markdown" "*charly* **delta**")
86 (doc . para $ emph "charly" <> space <> strong "delta")
88 , testCase "allow shorthand functions for quote types" $
89 assertFilterConversion "single quoted becomes double quoted string"
90 "single-to-double-quoted.lua"
91 (doc . para . singleQuoted $ str "simple")
92 (doc . para . doubleQuoted $ str "simple")
94 , testCase "Count inlines via metatable catch-all" $
95 assertFilterConversion "filtering with metatable catch-all failed"
96 "metatable-catch-all.lua"
97 (doc . para $ "four words, three spaces")
98 (doc . para $ str "7")
100 , testCase "Count blocks via Block-specific catch-all" $
101 assertFilterConversion "filtering with Block catch-all failed"
102 "block-count.lua"
103 (doc $ para "one" <> para "two")
104 (doc $ para "2")
106 , testCase "Smart constructors" $
107 assertFilterConversion "smart constructors returned a wrong result"
108 "smart-constructors.lua"
109 (doc $ para "")
110 (doc $ mconcat
111 [ bulletList [para "Hello", para "World"]
112 , definitionList [("foo", [para "placeholder"])]
113 , lineBlock ["Moin", "Welt"]
114 , orderedList [plain "one", plain "two"]
115 ])
117 , testCase "Convert header upper case" $
118 assertFilterConversion "converting header to upper case failed"
119 "uppercase-header.lua"
120 (doc $ header 1 "les états-unis" <> para "text")
121 (doc $ header 1 "LES ÉTATS-UNIS" <> para "text")
123 , testCase "Attribute lists are convenient to use" $
124 let kv_before = [("one", "1"), ("two", "2"), ("three", "3")]
125 kv_after = [("one", "eins"), ("three", "3"), ("five", "5")]
126 in assertFilterConversion "Attr doesn't behave as expected"
127 "attr-test.lua"
128 (doc $ divWith ("", [], kv_before) (para "nil"))
129 (doc $ divWith ("", [], kv_after) (para "nil"))
131 , testCase "Test module pandoc.utils" $
132 assertFilterConversion "pandoc.utils doesn't work as expected."
133 "test-pandoc-utils.lua"
134 (doc $ para "doesn't matter")
135 (doc $ mconcat [ plain (str "blocks_to_inlines: OK")
136 , plain (str "hierarchicalize: OK")
137 , plain (str "normalize_date: OK")
138 , plain (str "pipe: OK")
139 , plain (str "failing pipe: OK")
140 , plain (str "read: OK")
141 , plain (str "failing read: OK")
142 , plain (str "sha1: OK")
143 , plain (str "stringify: OK")
144 , plain (str "to_roman_numeral: OK")
145 ])
147 , testCase "Script filename is set" $
148 assertFilterConversion "unexpected script name"
149 "script-name.lua"
150 (doc $ para "ignored")
151 (doc $ para (str $ "lua" </> "script-name.lua"))
153 , testCase "Pandoc version is set" . runLua' $ do
154 Lua.getglobal' "table.concat"
155 Lua.getglobal "PANDOC_VERSION"
156 Lua.push ("." :: String) -- separator
157 Lua.call 2 1
158 Lua.liftIO . assertEqual "pandoc version is wrong" pandocVersion
159 =<< Lua.peek Lua.stackTop
161 , testCase "Pandoc types version is set" . runLua' $ do
162 let versionNums = versionBranch pandocTypesVersion
163 Lua.getglobal "PANDOC_API_VERSION"
164 Lua.liftIO . assertEqual "pandoc-types version is wrong" versionNums
165 =<< Lua.peek Lua.stackTop
167 , testCase "Allow singleton inline in constructors" . runLua' $ do
168 Lua.liftIO . assertEqual "Not the exptected Emph" (Emph [Str "test"])
169 =<< Lua.callFunc "pandoc.Emph" (Str "test")
170 Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
171 =<< Lua.callFunc "pandoc.Para" ("test" :: String)
172 Lua.liftIO . assertEqual "Unexptected element"
173 (BlockQuote [Para [Str "foo"]]) =<< (
174 do
175 Lua.getglobal' "pandoc.BlockQuote"
176 Lua.push (Para [Str "foo"])
177 _ <- Lua.call 1 1
178 Lua.peek Lua.stackTop
179 )
181 , testCase "Elements with Attr have `attr` accessor" . runLua' $ do
182 Lua.push (Div ("hi", ["moin"], [])
183 [Para [Str "ignored"]])
184 Lua.getfield Lua.stackTop "attr"
185 Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
186 =<< Lua.peek Lua.stackTop
188 , testCase "module `pandoc.system` is present" . runLua' $ do
189 Lua.getglobal' "pandoc.system"
190 ty <- Lua.ltype Lua.stackTop
191 Lua.liftIO $ assertEqual "module should be a table" Lua.TypeTable ty
193 , testCase "informative error messages" . runLua' $ do
194 Lua.pushboolean True
195 err <- Lua.peekEither Lua.stackTop
196 case (err :: Either String Pandoc) of
197 Left msg -> do
198 let expectedMsg = "Could not get Pandoc value: "
199 <> "table expected, got boolean"
200 Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
201 Right _ -> error "Getting a Pandoc element from a bool should fail."
202 ]
204assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
205assertFilterConversion msg filterPath docIn expectedDoc = do
206 actualDoc <- runIOorExplode $ do
207 setUserDataDir (Just "../data")
208 applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
209 assertEqual msg expectedDoc actualDoc
211roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool
212roundtripEqual x = (x ==) <$> roundtripped
213 where
214 roundtripped :: (Lua.Peekable a, Lua.Pushable a) => IO a
215 roundtripped = runLua' $ do
216 oldSize <- Lua.gettop
217 Lua.push x
218 size <- Lua.gettop
219 when (size - oldSize /= 1) $
220 error ("not exactly one additional element on the stack: " ++ show size)
221 res <- Lua.peekEither (-1)
222 case res of
223 Left e -> error (show e)
224 Right y -> return y
226runLua' :: Lua.Lua a -> IO a
227runLua' op = runIOorExplode $ do
228 setUserDataDir (Just "../data")
229 res <- runLua op
230 case res of
231 Left e -> error (show e)
232 Right x -> return x