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