scripths-0.4.0.0: test/Test/Markdown.hs
module Test.Markdown (markdownTests) where
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (
assertBool,
assertFailure,
testCase,
(@?=),
)
import Data.Text (Text)
import qualified Data.Text as T
import ScriptHs.Markdown (
CodeOutput (..),
MimeType (..),
Segment (CodeBlock, Prose),
parseMarkdown,
reassemble,
)
markdownTests :: TestTree
markdownTests =
testGroup
"Markdown"
[ testGroup
"parseMarkdown"
[ testCase "prose only" $ do
let segs = parseMarkdown "Hello world\nSecond line\n"
length segs @?= 1
case segs of
[Prose _] -> pure ()
other -> assertFailure $ "expected [Prose], got: " ++ show other
, testCase "single code block" $ do
let input =
T.unlines
[ "```haskell"
, "print 42"
, "```"
]
let segs = parseMarkdown input
length segs @?= 1
case segs of
[CodeBlock lang code Nothing] -> do
lang @?= "haskell"
assertBool "has print 42" (T.isInfixOf "print 42" code)
other -> assertFailure $ "expected [CodeBlock], got: " ++ show other
, testCase "four backticks is not a code fence" $ do
let input =
T.unlines
[ "````haskell"
, "print 42"
, "````"
]
let segs = parseMarkdown input
case segs of
[Prose _] -> pure ()
other -> assertFailure $ "expected [Prose], got: " ++ show other
, testCase "exactly three backticks with a tag is a fence" $ do
let segs = parseMarkdown (T.unlines ["```haskell", "print 42", "```"])
case segs of
[CodeBlock "haskell" _ _] -> pure ()
other -> assertFailure $ "expected [CodeBlock haskell], got: " ++ show other
, testCase "prose then code" $ do
let input =
T.unlines
[ "# Title"
, ""
, "Some text."
, ""
, "```haskell"
, "print 42"
, "```"
]
let segs = parseMarkdown input
length segs @?= 2
case segs of
[Prose _, CodeBlock "haskell" _ _] -> pure ()
other -> assertFailure $ "expected [Prose, CodeBlock], got: " ++ show other
, testCase "code then prose" $ do
let input =
T.unlines
[ "```haskell"
, "print 42"
, "```"
, ""
, "Some text after."
]
let segs = parseMarkdown input
length segs @?= 2
case segs of
[CodeBlock{}, Prose _] -> pure ()
other -> assertFailure $ "expected [CodeBlock, Prose], got: " ++ show other
, testCase "latex mimetype" $ do
let input =
T.unlines
[ "```haskell"
, "print 42"
, "```"
, ""
, "> <!-- sabela:mime text/latex -->"
, "> 2"
, ""
, "Some text after."
]
let segs = parseMarkdown input
length segs @?= 2
case segs of
[CodeBlock _ _ (Just (CodeOutput m _)), Prose _] -> assertBool "mime is latex" (m == MimeLatex)
other -> assertFailure $ "expected [CodeBlock, Prose], got: " ++ show other
, testCase "svg mimetype" $ do
let input =
T.unlines
[ "```haskell"
, "print 42"
, "```"
, ""
, "> <!-- sabela:mime image/svg+xml -->"
, "> <svg></svg>"
, ""
, "Some text after."
]
let segs = parseMarkdown input
length segs @?= 2
case segs of
[CodeBlock _ _ (Just (CodeOutput m _)), Prose _] -> assertBool "mime is svg" (m == MimeSvg)
other -> assertFailure $ "expected [CodeBlock, Prose], got: " ++ show other
, testCase "multiple code blocks" $ do
let input =
T.unlines
[ "# Title"
, ""
, "```haskell"
, "print 1"
, "```"
, ""
, "> <!-- scripths:mime text/plain -->"
, "> 1"
, ""
, "Middle text."
, ""
, "```haskell"
, "print 2"
, "```"
, ""
, "> <!-- scripths:mime text/plain -->"
, "> 2"
]
let segs = parseMarkdown input
let codeBlocks = [c | c@(CodeBlock{}) <- segs]
let outputBlocks = [o | (CodeBlock _ _ o@(Just _)) <- segs]
length codeBlocks @?= 2
length outputBlocks @?= 2
assertBool
"all mimeType plain"
(all (== MimePlain) [m | (Just (CodeOutput m _)) <- outputBlocks])
, testCase "non-haskell code block preserved" $ do
let input =
T.unlines
[ "```python"
, "print('hello')"
, "```"
]
let segs = parseMarkdown input
case segs of
[CodeBlock "python" code Nothing] ->
assertBool "has python code" (T.isInfixOf "print('hello')" code)
other -> assertFailure $ "expected [CodeBlock python], got: " ++ show other
, testCase "empty code block" $ do
let input =
T.unlines
[ "```haskell"
, "```"
]
let segs = parseMarkdown input
case segs of
[CodeBlock "haskell" code _] ->
assertBool "empty or whitespace" (T.null (T.strip code))
other -> assertFailure $ "expected [CodeBlock], got: " ++ show other
, testCase "multi-line code block" $ do
let input =
T.unlines
[ "```haskell"
, "import Data.Text"
, ""
, "x <- getLine"
, "print x"
, "```"
]
let segs = parseMarkdown input
case segs of
[CodeBlock "haskell" code _] -> do
assertBool "has import" (T.isInfixOf "import Data.Text" code)
assertBool "has x <- getLine" (T.isInfixOf "x <- getLine" code)
assertBool "has print x" (T.isInfixOf "print x" code)
other -> assertFailure $ "expected [CodeBlock], got: " ++ show other
]
, testGroup
"reassemble"
[ testCase "prose without output" $ do
let result = reassemble [Prose "Hello\n"]
result @?= "Hello\n"
, testCase "code block without output" $ do
let result = reassemble [CodeBlock "haskell" "print 42\n" Nothing]
assertBool "has fence" (T.isInfixOf "```haskell" result)
assertBool "has code" (T.isInfixOf "print 42" result)
assertBool "no blockquote" (not $ T.isInfixOf "> " result)
, testCase "code block with output" $ do
let result =
reassemble [CodeBlock "haskell" "print 42\n" (Just $ CodeOutput MimePlain "42")]
assertBool "has fence" (T.isInfixOf "```haskell" result)
assertBool "has code" (T.isInfixOf "print 42" result)
assertBool "has blockquote" (T.isInfixOf "> 42" result)
, testCase "code block with multi-line output" $ do
let result =
reassemble [CodeBlock "hs" "print [1,2]\n" (Just $ CodeOutput MimePlain "1\n2")]
assertBool "has > 1" (T.isInfixOf "> 1" result)
assertBool "has > 2" (T.isInfixOf "> 2" result)
, testCase "full document roundtrip" $ do
let segs =
[ Prose "# Title\n\n"
, CodeBlock "haskell" "print 42\n" (Just $ CodeOutput MimePlain "42")
, Prose "\nSome text.\n"
, CodeBlock "haskell" "print 99\n" (Just $ CodeOutput MimePlain "99")
]
let result = reassemble segs
assertBool "has title" (T.isInfixOf "# Title" result)
assertBool "has first output" (T.isInfixOf "> 42" result)
assertBool "has middle text" (T.isInfixOf "Some text." result)
assertBool "has second output" (T.isInfixOf "> 99" result)
let titleIdx = indexOf "# Title" result
code1Idx = indexOf "print 42" result
middleIdx = indexOf "Some text." result
code2Idx = indexOf "print 99" result
assertBool "title before code1" (titleIdx < code1Idx)
assertBool "code1 before middle" (code1Idx < middleIdx)
assertBool "middle before code2" (middleIdx < code2Idx)
]
, testGroup
"blockquote"
[ testCase "single line" $ do
let result = reassemble [CodeBlock "hs" "x\n" (Just $ CodeOutput MimePlain "hello")]
assertBool "blockquoted" (T.isInfixOf "> hello" result)
, testCase "empty lines in output get bare >" $ do
let result = reassemble [CodeBlock "hs" "x\n" (Just $ CodeOutput MimePlain "a\n\nb")]
assertBool "has bare >" (T.isInfixOf "\n> \n" result)
, testCase "renders the scripths:mime marker (not the legacy sabela)" $ do
let result = reassemble [CodeBlock "hs" "x\n" (Just $ CodeOutput MimePlain "y")]
assertBool "uses scripths:mime" (T.isInfixOf "scripths:mime" result)
assertBool "no sabela:mime" (not (T.isInfixOf "sabela:mime" result))
]
, testGroup
"idempotency (no extra blank lines on re-run)"
[ testCase "round-trip is a fixed point" $ do
let once = roundTrip docWithOutput
twice = roundTrip once
twice @?= once
, testCase "newline count does not grow across re-runs" $ do
let once = roundTrip docWithOutput
twice = roundTrip once
nlCount twice @?= nlCount once
, testCase "prose->code seam is exactly one blank line" $ do
let r = roundTrip "a\n\n```haskell\nx\n```\n"
assertBool "one blank before fence" (T.isInfixOf "a\n\n```haskell" r)
assertBool "not two blanks" (not (T.isInfixOf "a\n\n\n```" r))
, testCase "multiple authored blanks around a fence collapse to one" $ do
let r = roundTrip "a\n\n\n\n```haskell\nx\n```\n"
assertBool "collapsed to one blank" (T.isInfixOf "a\n\n```haskell" r)
assertBool "no triple newline" (not (T.isInfixOf "a\n\n\n" r))
, testCase "doc starting with a code block has no leading blank line" $ do
let r = roundTrip "```haskell\nx\n```\n"
assertBool "no leading newline" (not (T.isPrefixOf "\n" r))
, testCase "trailing blank lines collapse to a single newline" $ do
let r = roundTrip "# Title\n\n```haskell\nx\n```\n"
assertBool "ends with single newline" (T.isSuffixOf "```\n" r)
assertBool "not a trailing blank line" (not (T.isSuffixOf "```\n\n" r))
, testCase "prose-only document is untouched" $ do
roundTrip "# Title\n\nJust prose.\n" @?= "# Title\n\nJust prose.\n"
, testCase "legacy sabela:mime output is recognised and re-rendered as scripths" $ do
let legacy =
T.unlines
[ "```haskell"
, "1 + 1"
, "```"
, ""
, "> <!-- sabela:mime text/plain -->"
, "> 2"
]
r = roundTrip legacy
assertBool "output preserved" (T.isInfixOf "> 2" r)
assertBool "upgraded to scripths:mime" (T.isInfixOf "scripths:mime" r)
assertBool "old output not duplicated" (not (T.isInfixOf "sabela:mime" r))
-- and the upgraded form is itself stable
roundTrip r @?= r
]
]
roundTrip :: Text -> Text
roundTrip = reassemble . parseMarkdown
nlCount :: Text -> Int
nlCount = T.length . T.filter (== '\n')
-- A notebook that already carries rendered output, as an in-place re-run sees it.
docWithOutput :: Text
docWithOutput =
T.unlines
[ "# Title"
, ""
, "Intro prose."
, ""
, "```haskell"
, "1 + 1"
, "```"
, ""
, "> <!-- scripths:mime text/plain -->"
, "> 2"
, ""
, "More prose."
, ""
, "```haskell"
, "2 + 2"
, "```"
, ""
, "> <!-- scripths:mime text/plain -->"
, "> 4"
]
indexOf :: Text -> Text -> Int
indexOf needle haystack =
let (before, _) = T.breakOn needle haystack
in T.length before