1{-| 2Module : Text.Jira.Parser.InlineTests 3Copyright : © 2019–2021 Albert Krewinkel 4License : MIT 5 6Maintainer : Albert Krewinkel <tarleb@zeitkraut.de> 7Stability : alpha 8Portability : portable 9 10Tests for the jira wiki inline markup parsers. 11-} 12module Text.Jira.Parser.InlineTests (tests) where 13 14import Data.Either (isLeft) 15import Data.Text () 16import Text.Jira.Markup 17import Text.Jira.Parser.Core 18import Text.Jira.Parser.Inline 19import Text.Parsec (many1) 20 21import Test.Tasty (TestTree, testGroup) 22import Test.Tasty.HUnit (testCase, (@?=), (@?)) 23 24tests :: TestTree 25tests = testGroup "Inline" 26 [ testGroup "components" 27 [ testGroup "str" 28 [ testCase "simple word" $ 29 parseJira str "word" @?= Right (Str "word") 30 31 , testCase "non-special symbols" $ 32 parseJira str ",.#%" @?= Right (Str ",.#%") 33 34 , testCase "umlauts" $ 35 parseJira str "äéíöüßðå" @?= Right (Str "äéíöüßðå") 36 37 , testCase "mix of alphanums and non-special chars" $ 38 parseJira str "20.09" @?= Right (Str "20.09") 39 40 , testCase "space fails" $ 41 isLeft (parseJira str " ") @? 42 "str should only be parsed into Space" 43 ] 44 45 , testGroup "specialChar" 46 [ testCase "plain special char" $ 47 parseJira specialChar "!" @?= Right (SpecialChar '!') 48 49 , testCase "escaped symbol" $ 50 parseJira specialChar "\\{" @?= Right (SpecialChar '{') 51 ] 52 53 , testGroup "dash" 54 [ testCase "en dash" $ 55 parseJira dash "--" @?= Right (Str "–") 56 57 , testCase "em dash" $ 58 parseJira dash "---" @?= Right (Str "—") 59 ] 60 61 , testGroup "emoji" 62 [ testCase "smiling face" $ 63 parseJira emoji ":D" @?= Right (Emoji IconSmiling) 64 65 , testCase "winking face" $ 66 parseJira emoji ";)" @?= Right (Emoji IconWinking) 67 68 , testCase "checkmark" $ 69 parseJira emoji "(/)" @?= Right (Emoji IconCheckmark) 70 71 , testCase "red x" $ 72 parseJira emoji "(x)" @?= Right (Emoji IconX) 73 74 , testCase "thumbs up" $ 75 parseJira emoji "(y)" @?= Right (Emoji IconThumbsUp) 76 77 , testCase "green star" $ 78 parseJira emoji "(*g)" @?= Right (Emoji IconStarGreen) 79 80 , testCase "may not be followed by a letter" $ 81 isLeft (parseJira emoji "(x)nope") @? "no letters after emojis" 82 ] 83 84 , testGroup "whitespace" 85 [ testCase "space" $ 86 parseJira whitespace " " @?= Right Space 87 88 , testCase "tab" $ 89 isLeft (parseJira whitespace "\t") @? 90 "TAB is not considered whitespace" 91 92 , testCase "nonbreaking space fails" $ 93 isLeft (parseJira whitespace "\160") @? 94 "NBSP is not considered whitespace" 95 96 , testCase "zero width space fails" $ 97 isLeft (parseJira whitespace "\8203") @? 98 "ZWSP is not considered whitespace" 99 100 , testCase "newline fails" $ 101 isLeft (parseJira whitespace "\n") @? 102 "newline is not considered whitespace" 103 ] 104 105 , testGroup "entity" 106 [ testCase "named entity" $ 107 parseJira entity "©" @?= Right (Entity "copy") 108 109 , testCase "numerical entity" $ 110 parseJira entity "A" @?= Right (Entity "#65") 111 112 , testCase "invalid entity" $ 113 parseJira entity "&haskell;" @?= Right (Entity "haskell") 114 115 , testCase "space" $ 116 isLeft (parseJira entity "&a b;") @? 117 "entities may not contain spaces" 118 119 , testCase "symbol" $ 120 isLeft (parseJira entity "&a-b;") @? 121 "entities may not contain symbols" 122 123 , testCase "number without hash" $ 124 isLeft (parseJira entity "&65;") @? 125 "numerical entities must start with &#" 126 127 , testCase "no name" $ 128 isLeft (parseJira entity "&;") @? 129 "entities must not be empty" 130 ] 131 132 , testGroup "styled" 133 134 [ testCase "deleted" $ 135 parseJira styled "-far-fetched-" @?= 136 Right (Styled Strikeout [Str "far", SpecialChar '-', Str "fetched"]) 137 138 , testCase "symbol before closing char" $ 139 parseJira styled "-backwards<-" @?= 140 Right (Styled Strikeout [Str "backwards<"]) 141 142 , testGroup "emphasis" 143 [ testCase "single word" $ 144 parseJira styled "_single_" @?= Right (Styled Emphasis [Str "single"]) 145 146 , testCase "multi word" $ 147 parseJira styled "_multiple words_" @?= 148 Right (Styled Emphasis [Str "multiple", Space, Str "words"]) 149 150 , testCase "forced markup" $ 151 parseJira styled "{_}forced{_}" @?= 152 Right (Styled Emphasis [Str "forced"]) 153 154 , testCase "symbol before opening underscore" $ 155 parseJira (str *> styled) "#_bar_" @?= 156 Right (Styled Emphasis [Str "bar"]) 157 158 , testCase "neither symbol nor space before opening underscore" $ 159 isLeft (parseJira (str *> styled) "foo_bar_") @? "space after opening char" 160 161 , testCase "disallow space after opening underscore" $ 162 isLeft (parseJira styled "_ nope_") @? "space after underscore" 163 164 , testCase "require word boundary after closing underscore" $ 165 isLeft (parseJira styled "_nope_nope") @? "no boundary after closing" 166 167 , testCase "disallow newline in markup" $ 168 isLeft (parseJira styled "_eol\nnext line_") @? "newline in markup" 169 170 , testCase "zero with space as word boundary" $ 171 parseJira ((,) <$> styled <*> str) "_yup_\8203next" @?= 172 Right (Styled Emphasis [Str "yup"], Str "\8203next") 173 ] 174 175 , testCase "inserted" $ 176 parseJira styled "+multiple words+" @?= 177 Right (Styled Insert [Str "multiple", Space, Str "words"]) 178 179 , testCase "strong" $ 180 parseJira styled "*single*" @?= Right (Styled Strong [Str "single"]) 181 182 , testCase "subscript" $ 183 parseJira styled "~multiple words~" @?= 184 Right (Styled Subscript [Str "multiple", Space, Str "words"]) 185 186 , testCase "superscript" $ 187 parseJira styled "^multiple words^" @?= 188 Right (Styled Superscript [Str "multiple", Space, Str "words"]) 189 ] 190 191 , testCase "monospaced" $ 192 parseJira monospaced "{{multiple words}}" @?= 193 Right (Monospaced [Str "multiple", Space, Str "words"]) 194 195 , testGroup "linebreak" 196 [ testCase "linebreak before text" $ 197 parseJira linebreak "\na" @?= 198 Right Linebreak 199 200 , testCase "double-backslash linebreak" $ 201 parseJira linebreak "\\\\" @?= 202 Right Linebreak 203 204 , testCase "linebreak at eof fails" $ 205 isLeft (parseJira linebreak "\n") @? "newline before eof" 206 207 , testCase "linebreak before blank line fails" $ 208 isLeft (parseJira linebreak "\n\n") @? "newline before blank line" 209 210 , testCase "linebreak before list fails" $ 211 isLeft (parseJira linebreak "\n\n") @? "newline before list" 212 213 , testCase "linebreak before header fails" $ 214 isLeft (parseJira linebreak "\nh1.foo\n") @? "newline before header" 215 216 , testCase "three backslashes do not cause a linebreak" $ 217 isLeft (parseJira linebreak "\\\\\\") @? "three backslashes" 218 ] 219 220 , testCase "anchor" $ 221 parseJira anchor "{anchor:testing}" @?= 222 Right (Anchor "testing") 223 224 , testGroup "autolink" 225 [ testCase "hypertext link" $ 226 parseJira autolink "https://example.org/foo" @?= 227 Right (AutoLink (URL "https://example.org/foo")) 228 229 , testCase "link followed by text" $ 230 parseJira autolink "ftp://example.com/passwd has passwords" @?= 231 Right (AutoLink (URL "ftp://example.com/passwd")) 232 233 , testCase "email" $ 234 parseJira autolink "mailto:nobody@test.invalid" @?= 235 Right (AutoLink (URL "mailto:nobody@test.invalid")) 236 237 , testCase "braces cannot be in bare links" $ 238 parseJira autolink "https://example.edu/{*}" @?= 239 Right (AutoLink (URL "https://example.edu/")) 240 241 , testCase "file URIs are not autolinks" $ 242 isLeft (parseJira autolink "file:///etc/fstab") @? "" 243 ] 244 245 , testGroup "citation" 246 [ testCase "name" $ 247 parseJira citation "??John Doe??" @?= 248 Right (Citation [Str "John", Space, Str "Doe"]) 249 250 , testCase "with markup" $ 251 parseJira citation "??Jane *Example* Doe??" @?= 252 Right (Citation [ Str "Jane", Space, Styled Strong [Str "Example"] 253 , Space, Str "Doe"]) 254 ] 255 256 , testGroup "link" 257 [ testCase "unaliased link" $ 258 parseJira link "[https://example.org]" @?= 259 Right (Link External [] (URL "https://example.org")) 260 261 , testCase "aliased link" $ 262 parseJira link "[Example|https://example.org]" @?= 263 Right (Link External [Str "Example"] (URL "https://example.org")) 264 265 , testCase "alias with emphasis" $ 266 parseJira link "[_important_ example|https://example.org]" @?= 267 Right (Link External 268 [Styled Emphasis [Str "important"], Space, Str "example"] 269 (URL "https://example.org")) 270 271 , testCase "alias with URL" $ 272 parseJira link "[https://example.org website|https://example.org]" @?= 273 Right (Link External 274 [ Str "https", SpecialChar ':', Str "//example.org" 275 , Space, Str "website"] 276 (URL "https://example.org")) 277 278 , testCase "link to anchor" $ 279 parseJira link "[see here|#there]" @?= 280 Right (Link External [Str "see", Space, Str "here"] (URL "#there")) 281 282 , testCase "mail address" $ 283 parseJira link "[send mail|mailto:me@nope.invalid]" @?= 284 Right (Link Email [Str "send", Space, Str "mail"] 285 (URL "me@nope.invalid")) 286 287 , testGroup "attachment link" 288 [ testCase "simple attachment" $ 289 parseJira link "[testing^test.xml]" @?= 290 Right (Link Attachment [Str "testing"] (URL "test.xml")) 291 292 , testCase "attachment without description" $ 293 parseJira link "[^results.txt]" @?= 294 Right (Link Attachment [] (URL "results.txt")) 295 296 , testCase "filename with space and unicode" $ 297 parseJira link "[^Straßenbahn Berlin.jpg]" @?= 298 Right (Link Attachment [] (URL "Straßenbahn Berlin.jpg")) 299 ] 300 301 , testGroup "smart links" 302 [ testCase "smart link" $ 303 parseJira link "[hslua|https://github.com/hslua/hslua|smart-link]" @?= 304 Right (Link SmartLink [Str "hslua"] 305 (URL "https://github.com/hslua/hslua")) 306 307 , testCase "smart card" $ 308 parseJira link 309 "[repo|https://github.com/tarleb/jira-wiki-markup|smart-card]" @?= 310 Right (Link SmartCard [Str "repo"] 311 (URL "https://github.com/tarleb/jira-wiki-markup")) 312 ] 313 314 , testCase "user link" $ 315 parseJira link "[testing|~account-id:something]" @?= 316 Right (Link User [Str "testing"] (URL "account-id:something")) 317 318 , testCase "user without description" $ 319 parseJira link "[~username]" @?= 320 Right (Link User [] (URL "username")) 321 ] 322 323 , testGroup "image" 324 [ testCase "local file" $ 325 parseJira image "!image.jpg!" @?= 326 Right (Image [] (URL "image.jpg")) 327 328 , testCase "no newlines" $ 329 isLeft (parseJira image "!hello\nworld.png!") @? 330 "no newlines in image names" 331 332 , testCase "thumbnail" $ 333 parseJira image "!image.png|thumbnail!" @?= 334 Right (Image [Parameter "thumbnail" ""] (URL "image.png")) 335 336 , testCase "parameters" $ 337 parseJira image "!image.gif|align=right, vspace=4!" @?= 338 let params = [ Parameter "align" "right" 339 , Parameter "vspace" "4" 340 ] 341 in Right (Image params (URL "image.gif")) 342 343 , testCase "quoted parameter" $ 344 parseJira image "!foo.jpg|alt=\"some foo!\"!" @?= 345 let params = [ Parameter "alt" "some foo!"] 346 in Right (Image params (URL "foo.jpg")) 347 ] 348 349 , testGroup "color" 350 [ testCase "colored word" $ 351 parseJira colorInline "{color:red}red{color}" @?= 352 Right (ColorInline (ColorName "red") [Str "red"]) 353 354 , testCase "hex color" $ 355 parseJira colorInline "{color:#526487}blueish{color}" @?= 356 Right (ColorInline (ColorName "#526487") [Str "blueish"]) 357 358 , testCase "hex color without hash" $ 359 parseJira colorInline "{color:526Ab7}blueish{color}" @?= 360 Right (ColorInline (ColorName "#526Ab7") [Str "blueish"]) 361 ] 362 ] 363 364 , testGroup "inline parser" 365 [ testCase "simple sentence" $ 366 parseJira (normalizeInlines <$> many1 inline) "Hello, World!" @?= 367 Right [Str "Hello,", Space, Str "World", SpecialChar '!'] 368 369 , testCase "with entity" $ 370 parseJira (many1 inline) "shopping at P&C" @?= 371 Right [ Str "shopping", Space, Str "at", Space 372 , Str "P", Entity "amp", Str "C" 373 ] 374 375 , testCase "autolink followed by pipe" $ 376 parseJira (many1 inline) "https://jira.example/file.txt|" @?= 377 Right [AutoLink (URL "https://jira.example/file.txt"), SpecialChar '|'] 378 379 , testCase "autolink followed by pipe" $ 380 parseJira (many1 inline) "https://jira.example/file.txt|" @?= 381 Right [AutoLink (URL "https://jira.example/file.txt"), SpecialChar '|'] 382 383 , testCase "backslash-escaped char" $ 384 parseJira (normalizeInlines <$> many1 inline) "opening brace: \\{" @?= 385 Right [ Str "opening", Space, Str "brace", SpecialChar ':', Space 386 , SpecialChar '{'] 387 388 , testCase "icon after word" $ 389 parseJira (many1 inline) "checkmark(/)" @?= 390 Right [Str "checkmark", Emoji IconCheckmark] 391 392 , testCase "smiley after word" $ 393 parseJira (normalizeInlines <$> many1 inline) "smiley:)" @?= 394 Right [Str "smiley", Emoji IconSlightlySmiling] 395 396 , testCase "escaped smiley after word" $ 397 parseJira (normalizeInlines <$> many1 inline) "closing paren\\:)" @?= 398 Right [Str "closing", Space, Str "paren", SpecialChar ':', Str ")"] 399 400 , testCase "smiley between words" $ 401 parseJira (normalizeInlines <$> many1 inline) "verdict: :D funny" @?= 402 Right [ Str "verdict", SpecialChar ':', Space 403 , Emoji IconSmiling, Space, Str "funny"] 404 405 , testCase "smiley within word" $ 406 parseJira (normalizeInlines <$> many1 inline) "C:DE" @?= 407 Right [ Str "C", SpecialChar ':', Str "DE" ] 408 409 , testCase "dash with spaces" $ 410 parseJira (many1 inline) "one -- two" @?= 411 Right [Str "one", Space, Str "–", Space, Str "two"] 412 413 , testCase "forced markup" $ 414 parseJira (many1 inline) "H{~}2{~}O" @?= 415 Right [Str "H", Styled Subscript [Str "2"], Str "O"] 416 417 , testCase "color in sentence" $ 418 parseJira (many1 inline) "This is {color:red}red{color}." @?= 419 Right [ Str "This", Space, Str "is", Space 420 , ColorInline (ColorName "red") [Str "red"] 421 , Str "." 422 ] 423 424 , testCase "hypen between numbers" $ 425 -- the hypens used to be treated as deletion markers. 426 parseJira (many1 inline) "-15 02-3" @?= 427 Right [ SpecialChar '-', Str "15" , Space, Str "02" 428 , SpecialChar '-', Str "3" 429 ] 430 431 , testCase "ascii arrows" $ 432 -- the hypens used to be treated as deletion markers. 433 parseJira (many1 inline) "-> step ->" @?= 434 Right [ SpecialChar '-', Str ">" , Space, Str "step", Space 435 , SpecialChar '-', Str ">" 436 ] 437 438 , testCase "long ascii arrow" $ 439 parseJira (many1 inline) "click --> done" @?= 440 Right [ Str "click", Space, SpecialChar '-', SpecialChar '-' 441 , Str ">", Space, Str "done"] 442 443 ] 444 ] 445