git.iko.soy/typeable/pandoc
on 2afca42 help sign in
typeable/pandoc/test/Tests/Lua.hs
157 lines 6.3 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, Inline, Meta, Pandoc, pandocTypesVersion)
16import Text.Pandoc.Lua (runLuaFilter, runPandocLua)
17import Text.Pandoc.Shared (pandocVersion)
19import qualified Foreign.Lua as Lua
21tests :: [TestTree]
22tests = map (localOption (QuickCheckTests 20))
23 [ testProperty "inline elements can be round-tripped through the lua stack" $
24 \x -> ioProperty (roundtripEqual (x::Inline))
26 , testProperty "block elements can be round-tripped through the lua stack" $
27 \x -> ioProperty (roundtripEqual (x::Block))
29 , testProperty "meta blocks can be round-tripped through the lua stack" $
30 \x -> ioProperty (roundtripEqual (x::Meta))
32 , testProperty "documents can be round-tripped through the lua stack" $
33 \x -> ioProperty (roundtripEqual (x::Pandoc))
35 , testCase "macro expansion via filter" $
36 assertFilterConversion "a '{{helloworld}}' string is expanded"
37 "strmacro.lua"
38 (doc . para $ str "{{helloworld}}")
39 (doc . para . emph $ str "Hello, World")
41 , testCase "convert all plains to paras" $
42 assertFilterConversion "plains become para"
43 "plain-to-para.lua"
44 (doc $ bulletList [plain (str "alfa"), plain (str "bravo")])
45 (doc $ bulletList [para (str "alfa"), para (str "bravo")])
47 , testCase "make hello world document" $
48 assertFilterConversion "Document contains 'Hello, World!'"
49 "hello-world-doc.lua"
50 (doc . para $ str "Hey!" <> linebreak <> str "What's up?")
51 (doc . para $ str "Hello," <> space <> str "World!")
53 , testCase "implicit doc filter" $
54 assertFilterConversion "Document contains 'Hello, World!'"
55 "implicit-doc-filter.lua"
56 (doc . plain $ linebreak)
57 (doc . para $ str "Hello," <> space <> str "World!")
59 , testCase "parse raw markdown blocks" $
60 assertFilterConversion "raw markdown block is converted"
61 "markdown-reader.lua"
62 (doc $ rawBlock "markdown" "*charly* **delta**")
63 (doc . para $ emph "charly" <> space <> strong "delta")
65 , testCase "allow shorthand functions for quote types" $
66 assertFilterConversion "single quoted becomes double quoted string"
67 "single-to-double-quoted.lua"
68 (doc . para . singleQuoted $ str "simple")
69 (doc . para . doubleQuoted $ str "simple")
71 , testCase "Count inlines via metatable catch-all" $
72 assertFilterConversion "filtering with metatable catch-all failed"
73 "metatable-catch-all.lua"
74 (doc . para $ "four words, three spaces")
75 (doc . para $ str "7")
77 , testCase "Count blocks via Block-specific catch-all" $
78 assertFilterConversion "filtering with Block catch-all failed"
79 "block-count.lua"
80 (doc $ para "one" <> para "two")
81 (doc $ para "2")
83 , testCase "Convert header upper case" $
84 assertFilterConversion "converting header to upper case failed"
85 "uppercase-header.lua"
86 (doc $ header 1 "les états-unis" <> para "text")
87 (doc $ header 1 "LES ÉTATS-UNIS" <> para "text")
89 , testCase "Attribute lists are convenient to use" $
90 let kv_before = [("one", "1"), ("two", "2"), ("three", "3")]
91 kv_after = [("one", "eins"), ("three", "3"), ("five", "5")]
92 in assertFilterConversion "Attr doesn't behave as expected"
93 "attr-test.lua"
94 (doc $ divWith ("", [], kv_before) (para "nil"))
95 (doc $ divWith ("", [], kv_after) (para "nil"))
97 , testCase "Test module pandoc.utils" $
98 assertFilterConversion "pandoc.utils doesn't work as expected."
99 "test-pandoc-utils.lua"
100 (doc $ para "doesn't matter")
101 (doc $ mconcat [ plain (str "hierarchicalize: OK")
102 , plain (str "normalize_date: OK")
103 , plain (str "pipe: OK")
104 , plain (str "failing pipe: OK")
105 , plain (str "read: OK")
106 , plain (str "failing read: OK")
107 , plain (str "sha1: OK")
108 , plain (str "stringify: OK")
109 , plain (str "to_roman_numeral: OK")
110 ])
112 , testCase "Pandoc version is set" . runPandocLua' $ do
113 Lua.getglobal' "table.concat"
114 Lua.getglobal "PANDOC_VERSION"
115 Lua.push ("." :: String) -- seperator
116 Lua.call 2 1
117 Lua.liftIO . assertEqual "pandoc version is wrong" pandocVersion
118 =<< Lua.peek Lua.stackTop
120 , testCase "Pandoc types version is set" . runPandocLua' $ do
121 let versionNums = versionBranch pandocTypesVersion
122 Lua.getglobal "PANDOC_API_VERSION"
123 Lua.liftIO . assertEqual "pandoc-types version is wrong" versionNums
124 =<< Lua.peek Lua.stackTop
125 ]
127assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
128assertFilterConversion msg filterPath docIn docExpected = do
129 docEither <- runIOorExplode $ do
130 setUserDataDir (Just "../data")
131 runLuaFilter ("lua" </> filterPath) [] docIn
132 case docEither of
133 Left _ -> fail "lua filter failed"
134 Right docRes -> assertEqual msg docExpected docRes
136roundtripEqual :: (Eq a, Lua.FromLuaStack a, Lua.ToLuaStack a) => a -> IO Bool
137roundtripEqual x = (x ==) <$> roundtripped
138 where
139 roundtripped :: (Lua.FromLuaStack a, Lua.ToLuaStack a) => IO a
140 roundtripped = runPandocLua' $ do
141 oldSize <- Lua.gettop
142 Lua.push x
143 size <- Lua.gettop
144 when (size - oldSize /= 1) $
145 error ("not exactly one additional element on the stack: " ++ show size)
146 res <- Lua.peekEither (-1)
147 case res of
148 Left e -> error (show e)
149 Right y -> return y
151runPandocLua' :: Lua.Lua a -> IO a
152runPandocLua' op = runIOorExplode $ do
153 setUserDataDir (Just "../data")
154 res <- runPandocLua op
155 case res of
156 Left e -> error (show e)
157 Right x -> return x