git.iko.soy/typeable/pandoc
on 6be8f4e help sign in
typeable/pandoc/test/Tests/Lua.hs
227 lines 9.0 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 "informative error messages" . runLua' $ do
189 Lua.pushboolean True
190 err <- Lua.peekEither Lua.stackTop
191 case (err :: Either String Pandoc) of
192 Left msg -> do
193 let expectedMsg = "Could not get Pandoc value: "
194 <> "table expected, got boolean"
195 Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
196 Right _ -> error "Getting a Pandoc element from a bool should fail."
197 ]
199assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
200assertFilterConversion msg filterPath docIn expectedDoc = do
201 actualDoc <- runIOorExplode $ do
202 setUserDataDir (Just "../data")
203 applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
204 assertEqual msg expectedDoc actualDoc
206roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool
207roundtripEqual x = (x ==) <$> roundtripped
208 where
209 roundtripped :: (Lua.Peekable a, Lua.Pushable a) => IO a
210 roundtripped = runLua' $ do
211 oldSize <- Lua.gettop
212 Lua.push x
213 size <- Lua.gettop
214 when (size - oldSize /= 1) $
215 error ("not exactly one additional element on the stack: " ++ show size)
216 res <- Lua.peekEither (-1)
217 case res of
218 Left e -> error (show e)
219 Right y -> return y
221runLua' :: Lua.Lua a -> IO a
222runLua' op = runIOorExplode $ do
223 setUserDataDir (Just "../data")
224 res <- runLua op
225 case res of
226 Left e -> error (show e)
227 Right x -> return x