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