git.iko.soy/typeable/pandoc
on 8a0ffba help sign in
typeable/pandoc/test/Tests/Lua.hs
213 lines 8.4 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 ( 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)
27import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
28import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
29 Attr, Meta, Pandoc, pandocTypesVersion)
30import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters)
31import Text.Pandoc.Lua (runLua)
32import Text.Pandoc.Options (def)
33import Text.Pandoc.Shared (pandocVersion)
35import qualified Foreign.Lua as Lua
36import qualified Data.ByteString.Char8 as BS
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 "Script filename is set" $
132 assertFilterConversion "unexpected script name"
133 "script-name.lua"
134 (doc $ para "ignored")
135 (doc $ para (str $ "lua" </> "script-name.lua"))
137 , testCase "Pandoc version is set" . runLuaTest $ do
138 Lua.getglobal "PANDOC_VERSION"
139 Lua.liftIO .
140 assertEqual "pandoc version is wrong" (BS.pack pandocVersion)
141 =<< Lua.tostring' Lua.stackTop
143 , testCase "Pandoc types version is set" . runLuaTest $ do
144 Lua.getglobal "PANDOC_API_VERSION"
145 Lua.liftIO . assertEqual "pandoc-types version is wrong" pandocTypesVersion
146 =<< Lua.peek Lua.stackTop
148 , testCase "Allow singleton inline in constructors" . runLuaTest $ do
149 Lua.liftIO . assertEqual "Not the exptected Emph" (Emph [Str "test"])
150 =<< Lua.callFunc "pandoc.Emph" (Str "test")
151 Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
152 =<< Lua.callFunc "pandoc.Para" ("test" :: String)
153 Lua.liftIO . assertEqual "Unexptected element"
154 (BlockQuote [Para [Str "foo"]]) =<< (
155 do
156 Lua.getglobal' "pandoc.BlockQuote"
157 Lua.push (Para [Str "foo"])
158 _ <- Lua.call 1 1
159 Lua.peek Lua.stackTop
160 )
162 , testCase "Elements with Attr have `attr` accessor" . runLuaTest $ do
163 Lua.push (Div ("hi", ["moin"], [])
164 [Para [Str "ignored"]])
165 Lua.getfield Lua.stackTop "attr"
166 Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
167 =<< Lua.peek Lua.stackTop
169 , testCase "module `pandoc.system` is present" . runLuaTest $ do
170 Lua.getglobal' "pandoc.system"
171 ty <- Lua.ltype Lua.stackTop
172 Lua.liftIO $ assertEqual "module should be a table" Lua.TypeTable ty
174 , testCase "informative error messages" . runLuaTest $ do
175 Lua.pushboolean True
176 err <- Lua.peekEither Lua.stackTop
177 case (err :: Either String Pandoc) of
178 Left msg -> do
179 let expectedMsg = "Could not get Pandoc value: "
180 <> "table expected, got boolean"
181 Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
182 Right _ -> error "Getting a Pandoc element from a bool should fail."
183 ]
185assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
186assertFilterConversion msg filterPath docIn expectedDoc = do
187 actualDoc <- runIOorExplode $ do
188 setUserDataDir (Just "../data")
189 applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
190 assertEqual msg expectedDoc actualDoc
192roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool
193roundtripEqual x = (x ==) <$> roundtripped
194 where
195 roundtripped :: Lua.Peekable a => IO a
196 roundtripped = runLuaTest $ do
197 oldSize <- Lua.gettop
198 Lua.push x
199 size <- Lua.gettop
200 when (size - oldSize /= 1) $
201 error ("not exactly one additional element on the stack: " ++ show size)
202 res <- Lua.peekEither (-1)
203 case res of
204 Left e -> error (show e)
205 Right y -> return y
207runLuaTest :: Lua.Lua a -> IO a
208runLuaTest op = runIOorExplode $ do
209 setUserDataDir (Just "../data")
210 res <- runLua op
211 case res of
212 Left e -> error (show e)
213 Right x -> return x