module Main where
import Data.String.Utils
import Text.Parsec
import System.Exit
import qualified Options
import Parsing.Parse
import Parsing.ParseBlock
import Parsing.ParseHtml
import Parsing.ParseInline
import Parsing.State
import Rendering.Render
import Rendering.RenderOptions
printExpectedSuccess :: (ToHtml a) => String -> String -> String -> a -> IO Bool
printExpectedSuccess name input expected parsed = if output == expected
then do
putStrLn $ "PASS: " ++ name
return True
else do
putStrLn $ "FAIL: " ++ name
putStrLn "in:"
putStrLn input
putStrLn "out:"
putStrLn output
putStrLn "expect:"
putStrLn expected
return False
where
output = toHtml defaultRenderOptions parsed
expectSuccess :: (ToHtml a) => String -> (Parser a) -> String -> String -> IO Bool
expectSuccess name p input expected = either
(\err -> do
putStrLn $ "FAIL: " ++ name
putStrLn $ show err
return False)
(printExpectedSuccess name input expected)
$ runParser p initialState name input
testItalics = expectSuccess "italics" inline "*abc*" "abc"
testBold = expectSuccess "bold" inline "**abc**" "abc"
testBoldItalics = expectSuccess "bold italics" inline "***abc***" "abc"
testCode = expectSuccess "code" inline "`abc`" "abc
"
testInlineHtml = expectSuccess "inline html" html
"SQL"
"SQL"
testMultipleAttrs = expectSuccess "html with multiple attrs" html
"SQL"
"SQL"
testFootnoteRef = expectSuccess "footnote reference" inline
"^[x]"
"[0]"
testCaret = expectSuccess "literal '^' does not need escaping" inline "^" "^"
testImage = expectSuccess "inline image" inline
"![an image](/img/0)"
""
testExclamationMark = expectSuccess "literal '!' does not need escaping" inline "!" "!"
testLink = expectSuccess "link" inline
"[Google](https://google.com)"
"Google"
testLinkWithContents = expectSuccess "link with styling inside" inline
"[*Whence* `he` **came**](https://google.com)"
"Whence
he
came"
testLinkImplicit = expectSuccess "link with implicit href" inline
"[https://google.com]"
"https://google.com"
testH1 = expectSuccess "h1" header "# hello" "
This is a paragraph\n\ \of text.
" testEscapeCharacters = expectSuccess "paragraph with escaped special characters" paragraph "These are special: \\~, \\*, \\[, \\], \\^\n" "These are special: ~, *, [, ], ^
" testHashInParagraph = expectSuccess "paragraph containing literal '#'" paragraph "This is a paragraph\n\ \containing '#'\n" "This is a paragraph\n\ \containing '#'
" testOrderedList = expectSuccess "ol" listBlock " - point 1\n\ \ - point 2\n" "The politician said that\n\ \he would fix the economy." testBlockQuotePreFormatted = expectSuccess "blockquote pre-formatted" blockQuote "> \"This is it... this is where I belong...\"\n\ \> I know everyone here... even if I've never met them, never talked to\n\ \> them, may never hear from them again... I know you all...\n" "
\"This is it... this is where I belong...\"\n\ \ I know everyone here... even if I've never met them, never talked to\n\ \them, may never hear from them again... I know you all..." testBlockCode = expectSuccess "block code" blockCode " var x = 0;\n\ \ alert(x);\n" "
var x = 0;\n\
\alert(x);\n\
\
"
testBlockCodeWhitespace = expectSuccess "block code handles starting whitespace correctly" blockCode
" def f(x):\n\
\ return x\n"
"def f(x):\n\
\ return x\n\
\
"
testBlockCodeSpecialChars = expectSuccess "any line beginning with four spaces should be a block of code, regardless of the first non-whitespace character" block
" > print(1)\n\
\ * 1"
"> print(1)\n\
\* 1\n\
\
"
testBlockHtml = expectSuccess "block html" blockHtml
"a | \n\ \b | \n\ \
c | \n\ \d | \n\ \
a | \n\ \b | \n\ \
---|---|
c | \n\ \d | \n\ \
e | \n\ \f | \n\ \
a | \n\ \b | \n\ \
c | \n\ \d | \n\ \
a | \n\ \b | \n\ \
---|---|
c | \n\ \d | \n\ \
e | \n\ \f | \n\ \
This is a single list item\n\ \of footnote.
This is a single list item\n\ \of footnote.
a
b
c
a
b
ab
" expectFailure :: (ToHtml a) => String -> (Parser a) -> String -> String -> IO Bool expectFailure name p input expectedErr = either (\err -> if endswith expectedErr $ show err then do putStrLn $ "PASS: " ++ name return True else do putStrLn $ "FAIL: " ++ name putStrLn "in:" putStrLn input putStrLn "out:" putStrLn $ show err putStrLn "expect:" putStrLn expectedErr return False) (\parsed -> do putStrLn $ "FAIL: " ++ name putStrLn $ "unexpected success:" putStrLn $ toHtml defaultRenderOptions parsed return False) $ runParser p initialState name input testNestedBold = expectFailure "bold tags cannot be nested" inline "****abc****" "cannot have empty or nested bold nodes" testMismatchedBoldItalics = expectFailure "bold opening tag closed with italics tag" inline "**a*" "expecting content in italics node or extra \"*\" to close bold node" testSwappedItalicsBold = expectFailure "italics and bold closing tags swapped" paragraph "*a**b*c**" "unexpected \"c\"\n\ \expecting closing \"**\" (bold)" testNestedLink = expectFailure "links cannot be nested" inline "[[a](https://a.com)](https://b.com)" "unexpected \"[\"\n\ \expecting \"**\" (bold), \"*\" (italics), \"`\" (code), \"^[\" (footnote reference), \"![\" (image) or \"<\" (html tag)\n\ \links cannot be nested" testBadImplicitLink = expectFailure "link href required unless text is valid URI" inline "[notauri]" "unexpected end of input\n\ \expecting \"(\" (link href)\n\ \link href is required unless link text is a valid absolute URI" testUnclosedOpeningTag = expectFailure "unclosed opening tag should fail to parse" html "