1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE OverloadedStrings #-} 3module Tests.Writers.RST (tests) where 4 5import Prelude 6import Control.Monad.Identity 7import Test.Tasty 8import Test.Tasty.HUnit 9import Tests.Helpers 10import Text.Pandoc 11import Text.Pandoc.Arbitrary () 12import Text.Pandoc.Builder 13import Text.Pandoc.Writers.RST 14import qualified Data.Text as T 15 16infix 4 =: 17(=:) :: (ToString a, ToPandoc a) 18 => String -> (a, String) -> TestTree 19(=:) = test (purely (writeRST def . toPandoc)) 20 21testTemplate :: (ToString a, ToString c, ToPandoc a) => 22 String -> String -> (a, c) -> TestTree 23testTemplate t = case runIdentity (compileTemplate [] (T.pack t)) of 24 Left e -> error $ "Could not compile RST template: " ++ e 25 Right templ -> test (purely (writeRST def{ writerTemplate = Just templ }) . toPandoc) 26 27bodyTemplate :: Template T.Text 28bodyTemplate = case runIdentity (compileTemplate [] "$body$\n") of 29 Left e -> error $ 30 "Could not compile RST bodyTemplate" ++ e 31 Right templ -> templ 32 33tests :: [TestTree] 34tests = [ testGroup "rubrics" 35 [ "in list item" =: 36 bulletList [header 2 (text "foo")] =?> 37 "- .. rubric:: foo" 38 , "in definition list item" =: 39 definitionList [(text "foo", [header 2 (text "bar"), 40 para $ text "baz"])] =?> 41 unlines 42 [ "foo" 43 , " .. rubric:: bar" 44 , "" 45 , " baz"] 46 , "in block quote" =: 47 blockQuote (header 1 (text "bar")) =?> 48 " .. rubric:: bar" 49 , "with id" =: 50 blockQuote (headerWith ("foo",[],[]) 1 (text "bar")) =?> 51 unlines 52 [ " .. rubric:: bar" 53 , " :name: foo"] 54 , "with id class" =: 55 blockQuote (headerWith ("foo",["baz"],[]) 1 (text "bar")) =?> 56 unlines 57 [ " .. rubric:: bar" 58 , " :name: foo" 59 , " :class: baz"] 60 ] 61 , testGroup "ligatures" -- handling specific sequences of blocks 62 [ "a list is closed by a comment before a quote" =: -- issue 4248 63 bulletList [plain "bulleted"] <> blockQuote (plain "quoted") =?> 64 unlines 65 [ "- bulleted" 66 , "" 67 , ".." 68 , "" 69 , " quoted"] 70 ] 71 , testGroup "flatten" 72 [ testCase "emerges nested styles as expected" $ 73 flatten (Emph [Str "1", Strong [Str "2"], Str "3"]) @?= 74 [Emph [Str "1"], Strong [Str "2"], Emph [Str "3"]] 75 , testCase "could introduce trailing spaces" $ 76 flatten (Emph [Str "f", Space, Strong [Str "2"]]) @?= 77 [Emph [Str "f", Space], Strong [Str "2"]] 78 -- the test above is the reason why we call 79 -- stripLeadingTrailingSpace through transformNested after 80 -- flatten 81 , testCase "preserves empty parents" $ 82 flatten (Image ("",[],[]) [] ("loc","title")) @?= 83 [Image ("",[],[]) [] ("loc","title")] 84 ] 85 , testGroup "inlines" 86 [ "are removed when empty" =: -- #4434 87 plain (strong (str "")) =?> "" 88 , "do not cause the introduction of extra spaces when removed" =: 89 plain (strong (str "") <> emph (str "text")) =?> "*text*" 90 , "spaces are stripped at beginning and end" =: 91 -- pandoc issue 4327 "The text within inline markup may not 92 -- begin or end with whitespace" 93 -- http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html#inline-markup 94 strong (space <> str "text" <> space <> space) =?> "**text**" 95 , "single space stripped" =: 96 strong space =?> "" 97 , "give priority to strong style over emphasis" =: 98 strong (emph (strong (str "s"))) =?> "**s**" 99 , "links are not elided by outer style" =: 100 strong (emph (link "loc" "" (str "text"))) =?> 101 "`text <loc>`__" 102 , "RST inlines cannot start nor end with spaces" =: 103 emph (str "f" <> space <> strong (str "d") <> space <> str "l") =?> 104 "*f*\\ **d**\\ *l*" 105 , "keeps quotes" =: 106 strong (str "f" <> doubleQuoted (str "d") <> str "l") =?> 107 "**f“d”l**" 108 , "backslash inserted between str and code" =: 109 str "/api?query=" <> code "foo" =?> 110 "/api?query=\\ ``foo``" 111 ] 112 , testGroup "headings" 113 [ "normal heading" =: 114 header 1 (text "foo") =?> 115 unlines 116 [ "foo" 117 , "==="] 118 -- note: heading normalization is only done in standalone mode 119 , test (purely (writeRST def{ writerTemplate = Just bodyTemplate }) 120 . toPandoc) 121 "heading levels" $ 122 header 1 (text "Header 1") <> 123 header 3 (text "Header 2") <> 124 header 2 (text "Header 2") <> 125 header 1 (text "Header 1") <> 126 header 4 (text "Header 2") <> 127 header 5 (text "Header 3") <> 128 header 3 (text "Header 2") =?> 129 unlines 130 [ "Header 1" 131 , "========" 132 , "" 133 , "Header 2" 134 , "--------" 135 , "" 136 , "Header 2" 137 , "--------" 138 , "" 139 , "Header 1" 140 , "========" 141 , "" 142 , "Header 2" 143 , "--------" 144 , "" 145 , "Header 3" 146 , "~~~~~~~~" 147 , "" 148 , "Header 2" 149 , "--------"] 150 , test (purely (writeRST def{ writerTemplate = Just bodyTemplate }) . toPandoc) 151 "minimal heading levels" $ 152 header 2 (text "Header 1") <> 153 header 3 (text "Header 2") <> 154 header 2 (text "Header 1") <> 155 header 4 (text "Header 2") <> 156 header 5 (text "Header 3") <> 157 header 3 (text "Header 2") =?> 158 unlines 159 [ "Header 1" 160 , "========" 161 , "" 162 , "Header 2" 163 , "--------" 164 , "" 165 , "Header 1" 166 , "========" 167 , "" 168 , "Header 2" 169 , "--------" 170 , "" 171 , "Header 3" 172 , "~~~~~~~~" 173 , "" 174 , "Header 2" 175 , "--------"] 176 ] 177 , testTemplate "$subtitle$\n" "subtitle" $ 178 setMeta "subtitle" ("subtitle" :: Inlines) (doc $ plain "") =?> 179 ("subtitle" :: String) 180 ] 181