scripths-0.5.0.0: test/Test/Notebook.hs
module Test.Notebook (notebookTests) where
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
import qualified Data.Text as T
import ScriptHs.Markdown (CodeOutput (..), MimeType (..), Segment (..))
import ScriptHs.Notebook (
addOutputToSegments,
generatedMarkedScript,
isHaskell,
isPython,
markerStatement,
mkIndexedCodeSegments,
mkMarker,
parseBlocks,
processNotebook,
scrubCellOutput,
splitByMarkers,
)
import ScriptHs.Parser (CabalMeta (metaDeps), Line (..))
import ScriptHs.Run (defaultRunOptions)
-- | A fixed nonce for marker tests (the real one is per-run; see 'makeNonce').
tn :: T.Text
tn = "TESTNONCE"
notebookTests :: TestTree
notebookTests =
testGroup
"Notebook"
[ testGroup
"isHaskell"
[ testCase "accepts haskell" $ do
isHaskell "haskell" @?= True
, testCase "accepts hs" $ do
isHaskell "hs" @?= True
, testCase "case-insensitive + trims" $ do
isHaskell " HaSkElL " @?= True
isHaskell "\tHS\n" @?= True
, testCase "rejects other languages" $ do
isHaskell "python" @?= False
isHaskell "" @?= False
isHaskell "hask" @?= False
, testCase "accepts pandoc attribute fences" $ do
isHaskell "{.haskell:hs}" @?= True
isHaskell "{haskell}" @?= True
isHaskell "{.haskell}" @?= True
isHaskell "{.haskell:ghci}" @?= True
, testCase "pandoc python fences are not haskell" $ do
isHaskell "{.python}" @?= False
isHaskell "{python}" @?= False
isHaskell "{.python:py}" @?= False
]
, testGroup
"isPython"
[ testCase "accepts python and py" $ do
isPython "python" @?= True
isPython "py" @?= True
, testCase "accepts pandoc attribute fences" $ do
isPython "{.python:py}" @?= True
isPython "{python}" @?= True
isPython "{.python}" @?= True
, testCase "rejects haskell" $ do
isPython "haskell" @?= False
isPython "{.haskell:hs}" @?= False
]
, testGroup
"mkMarker"
[ testCase "format includes nonce and index" $ do
mkMarker tn 0 @?= "---SCRIPTHS_BLOCK_" <> tn <> "_0_END---"
mkMarker tn 12 @?= "---SCRIPTHS_BLOCK_" <> tn <> "_12_END---"
, testCase "different nonces give different markers (anti-spoofing)" $
assertBool "differ" (mkMarker "aaaa" 0 /= mkMarker "bbbb" 0)
]
, testGroup
"splitByMarkers"
[ testCase "empty marker list => []" $ do
splitByMarkers tn "anything" [] @?= []
, testCase "marker not found => strip remaining as output for that idx" $ do
let out = " hello world \n"
splitByMarkers tn out [0] @?= [(0, "hello world")]
, testCase "single marker splits before it" $ do
let out = T.unlines ["42", mkMarker tn 0, "ignored trailing"]
splitByMarkers tn out [0] @?= [(0, "42")]
, testCase "multiple markers split sequentially" $ do
let out =
T.concat
[ "cell0\n"
, mkMarker tn 0
, "\ncell1\n"
, mkMarker tn 1
, "\ncell2\n"
, mkMarker tn 2
, "\n"
]
splitByMarkers tn out [0, 1, 2]
@?= [ (0, "cell0")
, (1, "cell1")
, (2, "cell2")
]
, testCase "later marker missing => remainder becomes that cell output" $ do
let out =
T.concat
[ "cell0\n"
, mkMarker tn 0
, "\ncell1-no-marker-at-end\n"
]
splitByMarkers tn out [0, 1]
@?= [ (0, "cell0")
, (1, "cell1-no-marker-at-end")
]
, testCase "output spoofing a DIFFERENT nonce's marker is not split on" $ do
-- A cell printing a marker with the wrong nonce can't steal a boundary.
let out = "real" <> mkMarker "OTHER" 0 <> "data\n" <> mkMarker tn 0
splitByMarkers tn out [0] @?= [(0, "real" <> mkMarker "OTHER" 0 <> "data")]
]
, testGroup
"mkIndexedCodeSegments"
[ testCase "filters only haskell/hs code blocks" $ do
let segs =
[ (0, Prose "intro\n")
, (1, CodeBlock "haskell" "print 1\n" Nothing)
, (2, CodeBlock "python" "print('x')\n" Nothing)
, (3, CodeBlock "HS" "print 2\n" Nothing)
, (4, Prose "outro\n")
]
let hsSegs = mkIndexedCodeSegments segs
map fst hsSegs @?= [1, 3]
case map snd hsSegs of
[CodeBlock "haskell" _ _, CodeBlock "HS" _ _] -> pure ()
other -> assertFailure $ "unexpected segments: " ++ show other
]
, testGroup
"addOutputToSegments"
[ testCase "adds outputs to matching code blocks and leaves others alone" $ do
let outputs =
[ (1, "out-1")
, (3, "out-3")
, (999, "unused")
]
let indexedSegs =
[ (0, Prose "intro\n")
, (1, CodeBlock "haskell" "print 1\n" Nothing)
, (2, CodeBlock "python" "print('x')\n" Nothing)
,
( 3
, CodeBlock
"hs"
"print 3\n"
(Just $ CodeOutput MimePlain "old-should-be-replaced")
)
, (4, Prose "outro\n")
]
let result = addOutputToSegments outputs indexedSegs
length result @?= length indexedSegs
head result @?= Prose "intro\n"
result !! 4 @?= Prose "outro\n"
result !! 1
@?= CodeBlock "haskell" "print 1\n" (Just $ CodeOutput MimePlain "out-1")
result !! 3 @?= CodeBlock "hs" "print 3\n" (Just $ CodeOutput MimePlain "out-3")
result !! 2 @?= CodeBlock "python" "print('x')\n" Nothing
]
, testGroup
"generatedMarkedScript"
[ testCase "inserts marker print after each block" $ do
let blocks =
[ (10, [HaskellLine "print 10"])
, (11, [HaskellLine "print 11"])
]
let ls = generatedMarkedScript tn blocks
assertBool "has first line" (HaskellLine "print 10" `elem` ls)
assertBool "has second line" (HaskellLine "print 11" `elem` ls)
let m10 = mkMarker tn 10
m11 = mkMarker tn 11
assertBool
"has marker statement 10"
(HaskellLine (markerStatement m10) `elem` ls)
assertBool
"has marker statement 11"
(HaskellLine (markerStatement m11) `elem` ls)
assertBool
"marker print is prelude-qualified"
(T.isInfixOf ".putStrLn" (markerStatement m10))
assertBool "has Blank separators" (Blank `elem` ls)
]
, testGroup
"parseBlocks"
[ testCase "extracts only haskell blocks and preserves indices" $ do
let segs =
[ (0, Prose "intro\n")
, (1, CodeBlock "python" "print('x')\n" Nothing)
, (2, CodeBlock "haskell" "print 42\n" Nothing)
, (3, CodeBlock "hs" "print 99\n" Nothing)
, (4, Prose "outro\n")
]
let (_meta, indexedBlocks) = parseBlocks segs
map fst indexedBlocks @?= [2, 3]
case indexedBlocks of
[(2, ls2), (3, ls3)] -> do
assertBool "block 2 non-empty lines" (not (null ls2))
assertBool "block 3 non-empty lines" (not (null ls3))
other -> assertFailure $ "unexpected indexedBlocks: " ++ show other
, testCase "no haskell blocks => empty indexedBlocks and empty-ish meta" $ do
let segs =
[ (0, Prose "intro\n")
, (1, CodeBlock "python" "print('x')\n" Nothing)
, (2, Prose "outro\n")
]
let (meta, indexedBlocks) = parseBlocks segs
indexedBlocks @?= []
metaDeps meta @?= []
]
, testGroup
"processNotebook"
[ testCase "no code blocks => returns input unchanged" $ do
let input = T.unlines ["# Title", "", "Just prose.", ""]
out <- processNotebook defaultRunOptions "" input
out @?= input
, testCase "non-haskell code blocks only => returns input unchanged" $ do
let input =
T.unlines
[ "# Title"
, ""
, "```python"
, "print('hello')"
, "```"
, ""
, "more prose"
]
out <- processNotebook defaultRunOptions "" input
out @?= input
]
, testGroup
"scrubCellOutput"
[ testCase "removes a block marker that survived splitting" $ do
let out = "line one\n" <> mkMarker tn 1 <> "\nline two"
scrubbed = scrubCellOutput tn [0, 1, 2] out
assertBool "no marker leaks" (not (T.isInfixOf "SCRIPTHS_BLOCK" scrubbed))
assertBool "keeps the stdout" (T.isInfixOf "line one" scrubbed)
, testCase "scrubs scripths internal identifiers from a cell error" $ do
let scrubbed =
scrubCellOutput tn [0] "No instance for Show .. use of scripthsAutoPrint"
assertBool "no autoprint name" (not (T.isInfixOf "scripthsAutoPrint" scrubbed))
, testCase "strips markers for every listed index" $ do
let out = "a" <> mkMarker tn 0 <> "b" <> mkMarker tn 2 <> "c"
scrubCellOutput tn [0, 1, 2] out @?= "abc"
, testCase "a marker whose index is NOT a real cell is left intact" $ do
let out = "real data: " <> mkMarker tn 5
scrubCellOutput tn [0] out @?= out
]
]