scripths 0.5.1.0 → 0.5.2.0

raw patch · 9 files changed

+392/−123 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• app/Main.hs +15/−47
• scripths.cabal +4/−3
• src/ScriptHs/CLI/Types.hs +72/−0
• src/ScriptHs/Markdown.hs +118/−33
• src/ScriptHs/Notebook.hs +24/−11
• test/Test/Integration.hs +7/−1
• test/Test/Markdown.hs +100/−23
• test/Test/Notebook.hs +45/−5

@@ -1,6 +1,13 @@ # Revision history for scripths  +## 0.5.2.0 -- 2026-06-16+* **Styling with `RenderOptions`.** You can now have the output quoted vs unquoted+  and the code shown or not (code not shown is if you want to export the results only).+  Thanks to @tchoutri+* **Blank-line fix**: whitespace-only prose between two code fences no longer+  becomes a spurious empty prose segment.+ ## 0.4.1.0 -- 2056-05-31 * **Custom-prelude support**: auto print (our hook to rout evething but strings to shw)   now doesn't assume a prelude.

@@ -1,7 +1,6 @@ module Main where  import Control.Monad (unless, when)-import Data.List (isPrefixOf) import Data.Maybe (isJust) import qualified Data.Text as T import qualified Data.Text.IO as TIO@@ -16,6 +15,8 @@ import System.FilePath (takeExtension) import System.IO (hPutStrLn, stderr) +import ScriptHs.CLI.Types+import ScriptHs.Markdown import ScriptHs.Notebook (runNotebook) import ScriptHs.Parser (parseScript) import ScriptHs.Run (RunOptions (..), defaultRunOptions, runScript)@@ -26,20 +27,6 @@     tagVersion,  ) --- | Parsed command-line options.-data Args = Args-    { argScript :: Maybe FilePath-    , argOutput :: Maybe FilePath-    , argPackages :: [FilePath]-    , argNoLocalProject :: Bool-    , argInPlace :: Bool-    , argHelp :: Bool-    , argVersion :: Bool-    }--emptyArgs :: Args-emptyArgs = Args Nothing Nothing [] False False False False- main :: IO () main = do     raw <- getArgs@@ -61,7 +48,12 @@                                 { roPackages = pkgs                                 , roEnclosingProject = not (argNoLocalProject a)                                 }-                    dispatch opts path outPath+                    let renderOpts =+                            RenderOptions+                                { renderCodeStyle = argCodeStyle a+                                , renderOutputStyle = argOutputStyle a+                                }+                    dispatch renderOpts opts path outPath  {- | Resolve the output destination, honouring @--in-place@: write back over the notebook itself. In-place is only meaningful for notebooks (the @.ghci@\/@.hs@@@ -80,43 +72,17 @@ isNotebook :: FilePath -> Bool isNotebook path = takeExtension path `elem` [".md", ".markdown"] -dispatch :: RunOptions -> FilePath -> Maybe FilePath -> IO ()-dispatch opts path outputPath =+dispatch ::+    RenderOptions -> RunOptions -> FilePath -> Maybe FilePath -> IO ()+dispatch renderOpts opts path outputPath =     case takeExtension path of-        ".md" -> runNotebook opts path outputPath-        ".markdown" -> runNotebook opts path outputPath+        ".md" -> runNotebook renderOpts opts path outputPath+        ".markdown" -> runNotebook renderOpts opts path outputPath         _ -> do             contents <- TIO.readFile path             let sf = parseScript contents             runScript opts path sf -{- | Parse args: @[-o FILE | --output=FILE] [-i | --in-place] [--package DIR |--p DIR | --package=DIR]... [--no-local-project] [-h | --help] <script>@. The-script is the sole non-flag argument.--}-parseArgs :: [String] -> Either String Args-parseArgs = go emptyArgs-  where-    go a [] = Right a-    go a ("-o" : f : rest) = go a{argOutput = Just f} rest-    go _ ["-o"] = Left "-o requires a filename"-    go a (tok : rest)-        | tok == "-p" || tok == "--package" = case rest of-            (d : rest') -> go a{argPackages = argPackages a ++ [d]} rest'-            [] -> Left (tok ++ " requires a directory")-        | Just f <- stripFlag "--output=" tok = go a{argOutput = Just f} rest-        | Just d <- stripFlag "--package=" tok =-            go a{argPackages = argPackages a ++ [d]} rest-        | tok == "--no-local-project" = go a{argNoLocalProject = True} rest-        | tok == "-i" || tok == "--in-place" = go a{argInPlace = True} rest-        | tok == "-h" || tok == "--help" = go a{argHelp = True} rest-        | tok == "-v" || tok == "--version" = go a{argVersion = True} rest-        | "-" `isPrefixOf` tok = Left ("unknown flag: " ++ tok)-        | otherwise = case argScript a of-            Nothing -> go a{argScript = Just tok} rest-            Just _ -> Left ("unexpected extra argument: " ++ tok)-    stripFlag p s = if p `isPrefixOf` s then Just (drop (length p) s) else Nothing- -- | Resolve a @--package@ dir to absolute, requiring a package root (a @.cabal@). resolvePackageDir :: FilePath -> IO FilePath resolvePackageDir dir = do@@ -171,6 +137,8 @@         , "  --no-local-project        do not auto-include the enclosing cabal project"         , "  -h, --help                show this help"         , "  -v, --version             show the scripths version"+        , "  --code-style=display|remove    control how code fences should appear after processing (default: display)"+        , "  --output-style=quoted|raw      control how evaluted code is outputed (default: quoted)"         , ""         , "Files may carry a first-line version tag recording the scripths that wrote"         , "them ('-- scripths: X' in scripts, '<!-- scripths: X -->' in notebooks); a"

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               scripths-version:            0.5.1.0+version:            0.5.2.0 synopsis:           GHCi scripts for standalone execution and Markdown documentation. description:        GHCi scripts for standalone execution (with dependency resolution) and Markdown documentation (produces inline output). homepage:           https://www.datahaskell.org/@@ -23,11 +23,12 @@  library     import:           warnings-    exposed-modules:  ScriptHs.Parser,+    exposed-modules:  ScriptHs.CLI.Types,                       ScriptHs.Compiled,-                      ScriptHs.Render,                       ScriptHs.Markdown,                       ScriptHs.Notebook,+                      ScriptHs.Parser,+                      ScriptHs.Render,                       ScriptHs.Repl,                       ScriptHs.Run,                       ScriptHs.Version

@@ -0,0 +1,72 @@+module ScriptHs.CLI.Types (+    Args (..),+    emptyArgs,+    parseArgs,+) where++import Data.List (isPrefixOf)+import ScriptHs.Markdown++-- | Parsed command-line options.+data Args = Args+    { argScript :: Maybe FilePath+    , argOutput :: Maybe FilePath+    , argPackages :: [FilePath]+    , argNoLocalProject :: Bool+    , argInPlace :: Bool+    , argHelp :: Bool+    , argVersion :: Bool+    , argCodeStyle :: CodeStyle+    , argOutputStyle :: OutputStyle+    }++emptyArgs :: Args+emptyArgs =+    Args+        { argScript = Nothing+        , argOutput = Nothing+        , argPackages = []+        , argNoLocalProject = False+        , argInPlace = False+        , argHelp = False+        , argVersion = False+        , argCodeStyle = DisplayCode+        , argOutputStyle = OutputQuoted+        }++{- | Parse args: @[-o FILE | --output=FILE] [-i | --in-place] [--package DIR |+-p DIR | --package=DIR]... [--no-local-project] [-h | --help] <script>@. The+script is the sole non-flag argument.+-}+parseArgs :: [String] -> Either String Args+parseArgs = go emptyArgs+  where+    go a [] = Right a+    go a ("-o" : f : rest) = go a{argOutput = Just f} rest+    go _ ["-o"] = Left "-o requires a filename"+    go a (tok : rest)+        | tok == "-p" || tok == "--package" = case rest of+            (d : rest') -> go a{argPackages = argPackages a ++ [d]} rest'+            [] -> Left (tok ++ " requires a directory")+        | Just f <- stripFlag "--output=" tok = go a{argOutput = Just f} rest+        | Just d <- stripFlag "--package=" tok =+            go a{argPackages = argPackages a ++ [d]} rest+        | tok == "--no-local-project" = go a{argNoLocalProject = True} rest+        | tok == "-i" || tok == "--in-place" = go a{argInPlace = True} rest+        | tok == "-h" || tok == "--help" = go a{argHelp = True} rest+        | tok == "-v" || tok == "--version" = go a{argVersion = True} rest+        | tok == "--code-style" = case rest of+            (d : rest') -> case parseCodeStyle d of+                Just codeStyle -> go a{argCodeStyle = codeStyle} rest'+                Nothing -> Left ("Could not parse code style: " ++ tok)+            [] -> Left (tok ++ " requires a code style")+        | tok == "--output-style" = case rest of+            (d : rest') -> case parseOutputStyle d of+                Just codeStyle -> go a{argOutputStyle = codeStyle} rest'+                Nothing -> Left ("Could not parse output style: " ++ tok)+            [] -> Left (tok ++ " requires a output style")+        | "-" `isPrefixOf` tok = Left ("unknown flag: " ++ tok)+        | otherwise = case argScript a of+            Nothing -> go a{argScript = Just tok} rest+            Just _ -> Left ("unexpected extra argument: " ++ tok)+    stripFlag p s = if p `isPrefixOf` s then Just (drop (length p) s) else Nothing

@@ -2,13 +2,63 @@     Segment (..),     parseMarkdown,     reassemble,+    reassembleWith,     MimeType (..),     CodeOutput (..),+    CodeStyle (..),+    parseCodeStyle,+    defaultCodeStyle,+    OutputStyle (..),+    parseOutputStyle,+    defaultOutputStyle,+    RenderOptions (..),+    defaultRenderOptions, ) where  import Data.Text (Text) import qualified Data.Text as T +{- |  Directs how the original code fences are styled+  in the processed output.+-}+data CodeStyle+    = DisplayCode+    | RemoveCode+    deriving (Eq, Ord, Show)++parseCodeStyle :: String -> Maybe CodeStyle+parseCodeStyle "display" = Just DisplayCode+parseCodeStyle "remove" = Just RemoveCode+parseCodeStyle _ = Nothing++defaultCodeStyle :: CodeStyle+defaultCodeStyle = DisplayCode++data OutputStyle+    = OutputQuoted+    | OutputRaw+    deriving (Eq, Ord, Show)++parseOutputStyle :: String -> Maybe OutputStyle+parseOutputStyle "quoted" = Just OutputQuoted+parseOutputStyle "raw" = Just OutputRaw+parseOutputStyle _ = Nothing++defaultOutputStyle :: OutputStyle+defaultOutputStyle = OutputQuoted++{- | Render-time presentation choices; kept out of the parsed 'CodeOutput'+content model. Consumed only by 'reassembleWith'.+-}+data RenderOptions = RenderOptions+    { renderCodeStyle :: CodeStyle+    , renderOutputStyle :: OutputStyle+    }+    deriving (Eq, Show)++defaultRenderOptions :: RenderOptions+defaultRenderOptions = RenderOptions defaultCodeStyle defaultOutputStyle+ data MimeType     = MimeHtml     | MimeMarkdown@@ -30,7 +80,7 @@ parseMarkdown = parseMarkdown' [] . T.lines  parseMarkdown' :: [Text] -> [Text] -> [Segment]-parseMarkdown' acc [] = [Prose prose | not (T.null prose)]+parseMarkdown' acc [] = [Prose prose | not (isBlank prose)]   where     prose = T.unlines acc parseMarkdown' acc (line : rest) = case fenceLang line of@@ -40,24 +90,24 @@             prose = T.unlines acc             (codeLines, rest') = fmap (drop 1) (break ((== fence) . T.strip) rest)             (output, rest'') = case dropWhile ((== "") . T.strip) rest' of-                (x : xs) ->-                    if not (isMimeMarkerLine x)-                        then (Nothing, rest')-                        else-                            let-                                (cOutput, afterOutput) = span (T.isPrefixOf "> ") xs-                                mType = mimeFromTag x-                             in-                                ( Just (CodeOutput mType (T.unlines (map (T.drop (T.length "> ")) cOutput)))-                                , afterOutput-                                )-                [] -> (Nothing, rest')+                (x : xs)+                    | isMimeMarkerLine x ->+                        let (body, afterOutput) = extractOutput x xs+                         in (Just (CodeOutput (mimeFromTag x) body), afterOutput)+                _ -> (Nothing, rest')             segments =-                [Prose prose | not (T.null prose)]+                [Prose prose | not (isBlank prose)]                     ++ [CodeBlock lang (T.unlines codeLines) output]          in             segments ++ parseMarkdown' [] rest'' +{- | A prose run that is empty or only whitespace carries no cell content;+the blank line(s) between two code fences parse to such a run and must not+become a spurious prose segment.+-}+isBlank :: Text -> Bool+isBlank = T.null . T.strip+ fence :: Text fence = "```" @@ -77,22 +127,52 @@ mimeMarker :: Text mimeMarker = "<!-- scripths:mime " --- | Does this line open a rendered-output block (either marker spelling)?+{- | Does this line open a rendered-output block? Matches either marker+spelling, quoted (@> @) or raw.+-} isMimeMarkerLine :: Text -> Bool isMimeMarkerLine x =-    T.isPrefixOf "> <!-- scripths:mime" x || T.isPrefixOf "> <!-- sabela:mime" x+    T.isPrefixOf "<!-- scripths:mime" bare || T.isPrefixOf "<!-- sabela:mime" bare+  where+    bare = if T.isPrefixOf "> " x then T.drop 2 x else x +{- | Closing marker that terminates a raw output block so it re-parses; quoted+blocks self-delimit via their @> @ prefix and need no terminator.+-}+endMarker :: Text+endMarker = "<!-- /scripths:mime -->"++isEndMarkerLine :: Text -> Bool+isEndMarkerLine l = T.strip l == endMarker++{- | Collect an output block's body and the lines after it: a quoted block+runs while lines keep the @> @ prefix; a raw block runs to 'endMarker'.+-}+extractOutput :: Text -> [Text] -> (Text, [Text])+extractOutput marker xs+    | T.isPrefixOf "> " marker =+        let (body, after) = span (T.isPrefixOf "> ") xs+         in (T.unlines (map (T.drop (T.length "> ")) body), after)+    | otherwise =+        let (body, after) = break isEndMarkerLine xs+         in (T.unlines body, drop 1 after)+ fenceCodeSegment :: Text -> Text -> Text fenceCodeSegment lang output     | T.null (T.strip output) = ""     | otherwise = T.unlines ["", fence <> lang, T.stripEnd output, fence, ""] -{- | Render segments back to markdown idempotently: the blank-line run at each-seam between segments collapses to one blank line and the document's leading/-trailing blanks are trimmed, so re-running (e.g. @--in-place@) adds no new lines.--}+-- | 'reassembleWith' under 'defaultRenderOptions'; the back-compatible default. reassemble :: [Segment] -> Text-reassemble = finalize . foldr (joinSeam . renderSegment) ""+reassemble = reassembleWith defaultRenderOptions++{- | Render segments back to markdown idempotently (a @--in-place@ re-run is a+fixed point): seam blank runs collapse to one and leading/trailing blanks are+trimmed. Output re-parses under every style — 'OutputRaw' is bounded by a+closing 'endMarker', and 'RemoveCode' leaves no fence so a re-run is a no-op.+-}+reassembleWith :: RenderOptions -> [Segment] -> Text+reassembleWith opts = finalize . foldr (joinSeam . renderSegment opts) ""   where     joinSeam "" acc = acc     joinSeam piece "" = piece@@ -106,19 +186,24 @@         let stripped = T.dropWhileEnd (== '\n') (T.dropWhile (== '\n') t)          in if T.null stripped then "" else stripped <> "\n" -renderSegment :: Segment -> Text-renderSegment (Prose t) = t-renderSegment (CodeBlock lang code Nothing) = fenceCodeSegment lang code-renderSegment (CodeBlock lang code (Just output)) = fenceCodeSegment lang code <> blockQuote output+renderSegment :: RenderOptions -> Segment -> Text+renderSegment _ (Prose t) = t+renderSegment _ (CodeBlock lang code Nothing) = fenceCodeSegment lang code+renderSegment opts (CodeBlock lang code (Just output)) =+    let codeFence = case renderCodeStyle opts of+            DisplayCode -> fenceCodeSegment lang code+            RemoveCode -> mempty+     in codeFence <> blockQuote (renderOutputStyle opts) output -blockQuote :: CodeOutput -> Text-blockQuote (CodeOutput mimeType t) =-    let-        ls = (mimeMarker <> mimeIndicator mimeType <> " -->") : T.lines t-        trimmed = reverse $ dropWhile T.null $ reverse ls-        quoted = T.unlines $ map (\l -> if T.null l then "> " else "> " <> l) trimmed-     in-        quoted <> "\n"+blockQuote :: OutputStyle -> CodeOutput -> Text+blockQuote outputStyle (CodeOutput mimeType t) =+    case outputStyle of+        OutputQuoted -> T.unlines (map quote (marker : body)) <> "\n"+        OutputRaw -> T.unlines (marker : body ++ [endMarker]) <> "\n"+  where+    marker = mimeMarker <> mimeIndicator mimeType <> " -->"+    body = reverse $ dropWhile T.null $ reverse (T.lines t)+    quote l = if T.null l then "> " else "> " <> l  mimeIndicator :: MimeType -> Text mimeIndicator m = case m of

@@ -14,9 +14,10 @@ import ScriptHs.Markdown (     CodeOutput (..),     MimeType (..),+    RenderOptions,     Segment (..),     parseMarkdown,-    reassemble,+    reassembleWith,  ) import ScriptHs.Parser (     CabalMeta (..),@@ -37,10 +38,11 @@ clean; output written to a file (@-o@ or @--in-place@) is stamped with the current scripths version tag at the top. -}-runNotebook :: RunOptions -> FilePath -> Maybe FilePath -> IO ()-runNotebook opts path outputPath = do+runNotebook ::+    RenderOptions -> RunOptions -> FilePath -> Maybe FilePath -> IO ()+runNotebook renderOpts opts path outputPath = do     contents <- stripBom <$> TIO.readFile path-    outputMd <- processNotebook opts path contents+    outputMd <- processNotebook renderOpts opts path contents     case outputPath of         Nothing -> TIO.putStr outputMd         Just output -> TIO.writeFile output (stampVersion NotebookTag outputMd)@@ -49,22 +51,31 @@ stripBom :: Text -> Text stripBom t = fromMaybe t (T.stripPrefix "\65279" t) -processNotebook :: RunOptions -> FilePath -> Text -> IO Text-processNotebook opts notebookPath contents = do+processNotebook ::+    RenderOptions -> RunOptions -> FilePath -> Text -> IO Text+processNotebook renderOpts opts notebookPath contents = do     let indexedSegments = zip [0 ..] (parseMarkdown contents)         (metas, indexedCodeBlocks) = parseBlocks indexedSegments     if null indexedCodeBlocks         then pure contents-        else executeCodeCells opts notebookPath metas indexedSegments indexedCodeBlocks+        else+            executeCodeCells+                renderOpts+                opts+                notebookPath+                metas+                indexedSegments+                indexedCodeBlocks  executeCodeCells ::+    RenderOptions ->     RunOptions ->     FilePath ->     CabalMeta ->     IndexedSegments ->     IndexedBlocks ->     IO Text-executeCodeCells opts notebookPath meta allSegments codeBlocks = do+executeCodeCells renderOpts opts notebookPath meta allSegments codeBlocks = do     let ghciScript0 = generatedMarkedScript "" codeBlocks     nonce <- makeNonce ghciScript0     let ghciScript = generatedMarkedScript nonce codeBlocks@@ -77,7 +88,7 @@                 (fmap (scrubCellOutput nonce indices))                 (splitByMarkers nonce rawOutput indices)         blocksWithOutput = addOutputToSegments outputs allSegments-    pure $ reassemble blocksWithOutput+    pure $ reassembleWith renderOpts blocksWithOutput  {- | A per-run hex nonce woven into every cell-end marker so a cell's own output cannot spoof a marker and misattribute another cell's output. Mixes the process@@ -104,11 +115,13 @@   where     stripMarkers t = foldr (\i acc -> T.replace (mkMarker nonce i) "" acc) t indices -addOutputToSegments :: [(Int, Text)] -> IndexedSegments -> [Segment]+addOutputToSegments ::+    [(Int, Text)] -> IndexedSegments -> [Segment] addOutputToSegments outputs = map addOutput   where     addOutput :: (Int, Segment) -> Segment-    addOutput (i, CodeBlock lang code _) = CodeBlock lang code (fmap (CodeOutput MimePlain) (lookup i outputs))+    addOutput (i, CodeBlock lang code _) =+        CodeBlock lang code (fmap (CodeOutput MimePlain) (lookup i outputs))     addOutput (_, seg) = seg  mkIndexedCodeSegments :: IndexedSegments -> IndexedSegments

@@ -5,6 +5,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, testCase) +import ScriptHs.Markdown import ScriptHs.Notebook (processNotebook) import ScriptHs.Run (defaultRunOptions) @@ -34,7 +35,12 @@                                 , "\"rendered-ok\" :: String"                                 , "```"                                 ]-                    out <- processNotebook defaultRunOptions "/tmp/scripths-integration.md" nb+                    out <-+                        processNotebook+                            defaultRenderOptions+                            defaultRunOptions+                            "/tmp/scripths-integration.md"+                            nb                     assertBool "renders the cell value" ("rendered-ok" `T.isInfixOf` out)                     assertBool                         "no ScripthsInternal leak"

@@ -10,13 +10,7 @@  import Data.Text (Text) import qualified Data.Text as T-import ScriptHs.Markdown (-    CodeOutput (..),-    MimeType (..),-    Segment (CodeBlock, Prose),-    parseMarkdown,-    reassemble,- )+import ScriptHs.Markdown  markdownTests :: TestTree markdownTests =@@ -44,6 +38,28 @@                         lang @?= "haskell"                         assertBool "has print 42" (T.isInfixOf "print 42" code)                     other -> assertFailure $ "expected [CodeBlock], got: " ++ show other+            , testCase "adjacent code blocks emit no spurious prose between them" $ do+                let input =+                        T.unlines+                            [ "```haskell"+                            , "A"+                            , "```"+                            , ""+                            , "```haskell"+                            , "B"+                            , "```"+                            ]+                let segs = parseMarkdown input+                case segs of+                    [CodeBlock{}, CodeBlock{}] -> pure ()+                    other ->+                        assertFailure $+                            "expected [CodeBlock, CodeBlock], got: " ++ show other+            , testCase "whitespace-only trailing lines are not a prose segment" $ do+                let segs = parseMarkdown (T.unlines ["```haskell", "A", "```", "", "  "])+                case segs of+                    [CodeBlock{}] -> pure ()+                    other -> assertFailure $ "expected [CodeBlock], got: " ++ show other             , testCase "four backticks is not a code fence" $ do                 let input =                         T.unlines@@ -196,7 +212,13 @@             ]         , testGroup             "reassemble"-            [ testCase "prose without output" $ do+            [ testCase "reassemble == reassembleWith defaultRenderOptions" $ do+                let segs =+                        [ CodeBlock "hs" "x\n" (Just $ CodeOutput MimePlain "hi")+                        , Prose "p\n"+                        ]+                reassemble segs @?= reassembleWith defaultRenderOptions segs+            , testCase "prose without output" $ do                 let result = reassemble [Prose "Hello\n"]                 result @?= "Hello\n"             , testCase "code block without output" $ do@@ -206,21 +228,37 @@                 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")]+                        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")]+                        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")+                        , CodeBlock+                            "haskell"+                            "print 42\n"+                            (Just $ CodeOutput MimePlain "42")                         , Prose "\nSome text.\n"-                        , CodeBlock "haskell" "print 99\n" (Just $ CodeOutput MimePlain "99")+                        , CodeBlock+                            "haskell"+                            "print 99\n"+                            (Just $ CodeOutput MimePlain "99")                         ]                 let result = reassemble segs @@ -238,17 +276,44 @@                 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))+            "Output style"+            [ testGroup+                "raw"+                [ testCase "raw output drops the blockquote prefix" $ do+                    let result =+                            reassembleWith+                                (RenderOptions defaultCodeStyle OutputRaw)+                                [CodeBlock "hs" "x\n" (Just $ CodeOutput MimePlain "hello")]+                    assertBool "has raw output" (T.isInfixOf "hello" result)+                    assertBool "not quoted" (not (T.isInfixOf "> hello" result))+                , testCase "remove-code + raw drops both the fence and the prefix" $ do+                    let result =+                            reassembleWith+                                (RenderOptions RemoveCode OutputRaw)+                                [CodeBlock "hs" "x = 1\n" (Just $ CodeOutput MimePlain "hello")]+                    assertBool "has raw output" (T.isInfixOf "hello" result)+                    assertBool "no code fence" (not (T.isInfixOf "```" result))+                    assertBool "no blockquote prefix" (not (T.isInfixOf "> " result))+                ]+            , 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)"@@ -256,6 +321,18 @@                 let once = roundTrip docWithOutput                     twice = roundTrip once                 twice @?= once+            , testCase "raw output re-parses as output and is a fixed point" $ do+                let raw = reassembleWith (RenderOptions DisplayCode OutputRaw)+                    segs =+                        [CodeBlock "haskell" "x = 1\n" (Just $ CodeOutput MimePlain "a\n\nb")]+                    once = raw segs+                case parseMarkdown once of+                    [CodeBlock _ _ (Just (CodeOutput MimePlain body))] ->+                        assertBool "output recovered, not orphaned as prose" $+                            T.isInfixOf "a" body && T.isInfixOf "b" body+                    other ->+                        assertFailure $ "expected one CodeBlock with output, got: " ++ show other+                raw (parseMarkdown once) @?= once             , testCase "newline count does not grow across re-runs" $ do                 let once = roundTrip docWithOutput                     twice = roundTrip once

@@ -5,7 +5,15 @@  import qualified Data.Text as T -import ScriptHs.Markdown (CodeOutput (..), MimeType (..), Segment (..))+import ScriptHs.Markdown (+    CodeOutput (..),+    CodeStyle (..),+    MimeType (..),+    RenderOptions (..),+    Segment (..),+    defaultOutputStyle,+    defaultRenderOptions,+ ) import ScriptHs.Notebook (     addOutputToSegments,     generatedMarkedScript,@@ -164,8 +172,15 @@                 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")+                    @?= 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             ]@@ -231,7 +246,8 @@             "processNotebook"             [ testCase "no code blocks => returns input unchanged" $ do                 let input = T.unlines ["# Title", "", "Just prose.", ""]-                out <- processNotebook defaultRunOptions "" input+                out <-+                    processNotebook defaultRenderOptions defaultRunOptions "" input                 out @?= input             , testCase "non-haskell code blocks only => returns input unchanged" $ do                 let input =@@ -244,7 +260,8 @@                             , ""                             , "more prose"                             ]-                out <- processNotebook defaultRunOptions "" input+                out <-+                    processNotebook defaultRenderOptions defaultRunOptions "" input                 out @?= input             ]         , testGroup@@ -264,5 +281,28 @@             , 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+            ]+        , testGroup+            "Code style"+            [ testCase "Removed code in final output" $ do+                let input =+                        T.unlines+                            [ "# Title"+                            , "```haskell"+                            , "1 + 1"+                            , "```"+                            ]+                result <-+                    processNotebook+                        (RenderOptions RemoveCode defaultOutputStyle)+                        defaultRunOptions+                        ""+                        input+                result+                    @?= T.unlines+                        [ "# Title"+                        , "> <!-- scripths:mime text/plain -->"+                        , "> 2"+                        ]             ]         ]