1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Tests.Lua ( tests ) where
import Prelude
import Control.Monad (when)
import Data.Version (Version (versionBranch))
import System.FilePath ((</>))
import Test.Tasty (TestTree, localOption)
import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
import Test.Tasty.QuickCheck (QuickCheckTests (..), ioProperty, testProperty)
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder (bulletList, divWith, doc, doubleQuoted, emph,
header, linebreak, para, plain, rawBlock,
singleQuoted, space, str, strong)
import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
Attr, Meta, Pandoc, pandocTypesVersion)
import Text.Pandoc.Lua (runLuaFilter, runPandocLua)
import Text.Pandoc.Options (def)
import Text.Pandoc.Shared (pandocVersion)
import qualified Foreign.Lua as Lua
tests :: [TestTree]
tests = map (localOption (QuickCheckTests 20))
[ testProperty "inline elements can be round-tripped through the lua stack" $
\x -> ioProperty (roundtripEqual (x::Inline))
, testProperty "block elements can be round-tripped through the lua stack" $
\x -> ioProperty (roundtripEqual (x::Block))
, testProperty "meta blocks can be round-tripped through the lua stack" $
\x -> ioProperty (roundtripEqual (x::Meta))
, testProperty "documents can be round-tripped through the lua stack" $
\x -> ioProperty (roundtripEqual (x::Pandoc))
, testCase "macro expansion via filter" $
assertFilterConversion "a '{{helloworld}}' string is expanded"
"strmacro.lua"
(doc . para $ str "{{helloworld}}")
(doc . para . emph $ str "Hello, World")
, testCase "convert all plains to paras" $
assertFilterConversion "plains become para"
"plain-to-para.lua"
(doc $ bulletList [plain (str "alfa"), plain (str "bravo")])
(doc $ bulletList [para (str "alfa"), para (str "bravo")])
, testCase "make hello world document" $
assertFilterConversion "Document contains 'Hello, World!'"
"hello-world-doc.lua"
(doc . para $ str "Hey!" <> linebreak <> str "What's up?")
(doc . para $ str "Hello," <> space <> str "World!")
, testCase "implicit doc filter" $
assertFilterConversion "Document contains 'Hello, World!'"
"implicit-doc-filter.lua"
(doc . plain $ linebreak)
(doc . para $ str "Hello," <> space <> str "World!")
, testCase "parse raw markdown blocks" $
assertFilterConversion "raw markdown block is converted"
"markdown-reader.lua"
(doc $ rawBlock "markdown" "*charly* **delta**")
(doc . para $ emph "charly" <> space <> strong "delta")
, testCase "allow shorthand functions for quote types" $
assertFilterConversion "single quoted becomes double quoted string"
"single-to-double-quoted.lua"
(doc . para . singleQuoted $ str "simple")
(doc . para . doubleQuoted $ str "simple")
, testCase "Count inlines via metatable catch-all" $
assertFilterConversion "filtering with metatable catch-all failed"
"metatable-catch-all.lua"
(doc . para $ "four words, three spaces")
(doc . para $ str "7")
, testCase "Count blocks via Block-specific catch-all" $
assertFilterConversion "filtering with Block catch-all failed"
"block-count.lua"
(doc $ para "one" <> para "two")
(doc $ para "2")
, testCase "Convert header upper case" $
assertFilterConversion "converting header to upper case failed"
"uppercase-header.lua"
(doc $ header 1 "les états-unis" <> para "text")
(doc $ header 1 "LES ÉTATS-UNIS" <> para "text")
, testCase "Attribute lists are convenient to use" $
let kv_before = [("one", "1"), ("two", "2"), ("three", "3")]
kv_after = [("one", "eins"), ("three", "3"), ("five", "5")]
in assertFilterConversion "Attr doesn't behave as expected"
"attr-test.lua"
(doc $ divWith ("", [], kv_before) (para "nil"))
(doc $ divWith ("", [], kv_after) (para "nil"))
, testCase "Test module pandoc.utils" $
assertFilterConversion "pandoc.utils doesn't work as expected."
"test-pandoc-utils.lua"
(doc $ para "doesn't matter")
(doc $ mconcat [ plain (str "hierarchicalize: OK")
, plain (str "normalize_date: OK")
, plain (str "pipe: OK")
, plain (str "failing pipe: OK")
, plain (str "read: OK")
, plain (str "failing read: OK")
, plain (str "sha1: OK")
, plain (str "stringify: OK")
, plain (str "to_roman_numeral: OK")
])
, testCase "Script filename is set" $
assertFilterConversion "unexpected script name"
"script-name.lua"
(doc $ para "ignored")
(doc $ para (str $ "lua" </> "script-name.lua"))
, testCase "Pandoc version is set" . runPandocLua' $ do
Lua.getglobal' "table.concat"
Lua.getglobal "PANDOC_VERSION"
Lua.push ("." :: String) -- seperator
Lua.call 2 1
Lua.liftIO . assertEqual "pandoc version is wrong" pandocVersion
=<< Lua.peek Lua.stackTop
, testCase "Pandoc types version is set" . runPandocLua' $ do
let versionNums = versionBranch pandocTypesVersion
Lua.getglobal "PANDOC_API_VERSION"
Lua.liftIO . assertEqual "pandoc-types version is wrong" versionNums
=<< Lua.peek Lua.stackTop
, testCase "Allow singleton inline in constructors" . runPandocLua' $ do
Lua.liftIO . assertEqual "Not the exptected Emph" (Emph [Str "test"])
=<< Lua.callFunc "pandoc.Emph" (Str "test")
Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
=<< Lua.callFunc "pandoc.Para" ("test" :: String)
Lua.liftIO . assertEqual "Unexptected element"
(BlockQuote [Para [Str "foo"]]) =<< (
do
Lua.getglobal' "pandoc.BlockQuote"
Lua.push (Para [Str "foo"])
_ <- Lua.call 1 1
Lua.peek Lua.stackTop
)
, testCase "Elements with Attr have `attr` accessor" . runPandocLua' $ do
Lua.push (Div ("hi", ["moin"], [])
[Para [Str "ignored"]])
Lua.getfield Lua.stackTop "attr"
Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
=<< Lua.peek Lua.stackTop
, testCase "informative error messages" . runPandocLua' $ do
Lua.pushboolean True
err <- Lua.peekEither Lua.stackTop :: Lua.Lua (Either String Pandoc)
case err of
Left msg -> do
let expectedMsg = "Could not get Pandoc value: "
++ "expected table but got boolean."
Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
Right _ -> error "Getting a Pandoc element from a bool should fail."
]
assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
assertFilterConversion msg filterPath docIn docExpected = do
docEither <- runIOorExplode $ do
setUserDataDir (Just "../data")
runLuaFilter def ("lua" </> filterPath) [] docIn
case docEither of
Left _ -> fail "lua filter failed"
Right docRes -> assertEqual msg docExpected docRes
roundtripEqual :: (Eq a, Lua.FromLuaStack a, Lua.ToLuaStack a) => a -> IO Bool
roundtripEqual x = (x ==) <$> roundtripped
where
roundtripped :: (Lua.FromLuaStack a, Lua.ToLuaStack a) => IO a
roundtripped = runPandocLua' $ do
oldSize <- Lua.gettop
Lua.push x
size <- Lua.gettop
when (size - oldSize /= 1) $
error ("not exactly one additional element on the stack: " ++ show size)
res <- Lua.peekEither (-1)
case res of
Left e -> error (show e)
Right y -> return y
runPandocLua' :: Lua.Lua a -> IO a
runPandocLua' op = runIOorExplode $ do
setUserDataDir (Just "../data")
res <- runPandocLua op
case res of
Left e -> error (show e)
Right x -> return x
|
