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