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