git.iko.soy/typeable/pandoc
on b010113 help sign in
typeable/pandoc/test/Tests/Lua.hs
190 lines 7.8 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 "Pandoc version is set" . runPandocLua' $ do
115 Lua.getglobal' "table.concat"
116 Lua.getglobal "PANDOC_VERSION"
117 Lua.push ("." :: String) -- seperator
118 Lua.call 2 1
119 Lua.liftIO . assertEqual "pandoc version is wrong" pandocVersion
120 =<< Lua.peek Lua.stackTop
122 , testCase "Pandoc types version is set" . runPandocLua' $ do
123 let versionNums = versionBranch pandocTypesVersion
124 Lua.getglobal "PANDOC_API_VERSION"
125 Lua.liftIO . assertEqual "pandoc-types version is wrong" versionNums
126 =<< Lua.peek Lua.stackTop
128 , testCase "Allow singleton inline in constructors" . runPandocLua' $ do
129 Lua.liftIO . assertEqual "Not the exptected Emph" (Emph [Str "test"])
130 =<< Lua.callFunc "pandoc.Emph" (Str "test")
131 Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
132 =<< Lua.callFunc "pandoc.Para" ("test" :: String)
133 Lua.liftIO . assertEqual "Unexptected element"
134 (BlockQuote [Para [Str "foo"]]) =<< (
135 do
136 Lua.getglobal' "pandoc.BlockQuote"
137 Lua.push (Para [Str "foo"])
138 _ <- Lua.call 1 1
139 Lua.peek Lua.stackTop
140 )
142 , testCase "Elements with Attr have `attr` accessor" . runPandocLua' $ do
143 Lua.push (Div ("hi", ["moin"], [])
144 [Para [Str "ignored"]])
145 Lua.getfield Lua.stackTop "attr"
146 Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
147 =<< Lua.peek Lua.stackTop
149 , testCase "informative error messages" . runPandocLua' $ do
150 Lua.pushboolean True
151 err <- Lua.peekEither Lua.stackTop :: Lua.Lua (Either String Pandoc)
152 case err of
153 Left msg -> do
154 let expectedMsg = "Could not get Pandoc value: "
155 ++ "expected table but got boolean."
156 Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
157 Right _ -> error "Getting a Pandoc element from a bool should fail."
158 ]
160assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
161assertFilterConversion msg filterPath docIn docExpected = do
162 docEither <- runIOorExplode $ do
163 setUserDataDir (Just "../data")
164 runLuaFilter def ("lua" </> filterPath) [] docIn
165 case docEither of
166 Left _ -> fail "lua filter failed"
167 Right docRes -> assertEqual msg docExpected docRes
169roundtripEqual :: (Eq a, Lua.FromLuaStack a, Lua.ToLuaStack a) => a -> IO Bool
170roundtripEqual x = (x ==) <$> roundtripped
171 where
172 roundtripped :: (Lua.FromLuaStack a, Lua.ToLuaStack a) => IO a
173 roundtripped = runPandocLua' $ do
174 oldSize <- Lua.gettop
175 Lua.push x
176 size <- Lua.gettop
177 when (size - oldSize /= 1) $
178 error ("not exactly one additional element on the stack: " ++ show size)
179 res <- Lua.peekEither (-1)
180 case res of
181 Left e -> error (show e)
182 Right y -> return y
184runPandocLua' :: Lua.Lua a -> IO a
185runPandocLua' op = runIOorExplode $ do
186 setUserDataDir (Just "../data")
187 res <- runPandocLua op
188 case res of
189 Left e -> error (show e)
190 Right x -> return x