scripths 0.1.0.2 → 0.2.0.0

raw patch · 6 files changed

+121/−31 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• scripths.cabal +1/−1
• src/ScriptHs/Markdown.hs +56/−11
• src/ScriptHs/Notebook.hs +8/−2
• test/Test/Markdown.hs +39/−13
• test/Test/Notebook.hs +11/−4

@@ -1,5 +1,11 @@ # Revision history for scripths +## 0.2.0.0 -- 2026-03-01++* Add mime type to output.++* Make blocks out of single lines of code as well.+ ## 0.1.0.2 -- 2026-02-28  * Make blocks out of single lines of code as well.

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               scripths-version:            0.1.0.2+version:            0.2.0.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/

@@ -2,14 +2,28 @@     Segment (..),     parseMarkdown,     reassemble,+    MimeType (..),+    CodeOutput (..), ) where  import Data.Text (Text) import qualified Data.Text as T +data MimeType+    = MimeHtml+    | MimeMarkdown+    | MimeSvg+    | MimeLatex+    | MimeJson+    | MimeImage Text -- image type+    | MimePlain+    deriving (Show, Eq)++data CodeOutput = CodeOutput MimeType Text deriving (Show, Eq)+ data Segment     = Prose Text-    | CodeBlock Text Text (Maybe Text)+    | CodeBlock Text Text (Maybe CodeOutput) -- Language, Code, Output     deriving (Show, Eq)  parseMarkdown :: Text -> [Segment]@@ -25,11 +39,24 @@         let             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 (T.isPrefixOf "> <!-- sabela:mime" 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')             segments =                 [Prose prose | not (T.null prose)]-                    ++ [CodeBlock lang (T.unlines codeLines) Nothing]+                    ++ [CodeBlock lang (T.unlines codeLines) output]          in-            segments ++ parseMarkdown' [] rest'+            segments ++ parseMarkdown' [] rest''  fence :: Text fence = "```"@@ -49,16 +76,34 @@ renderSegment :: Segment -> Text renderSegment (Prose t) = t renderSegment (CodeBlock lang code Nothing) = fenceCodeSegment lang code-renderSegment (CodeBlock lang code (Just output)) =-    if T.null (T.strip output)-        then fenceCodeSegment lang code-        else fenceCodeSegment lang code <> blockQuote output+renderSegment (CodeBlock lang code (Just output)) = fenceCodeSegment lang code <> blockQuote output -blockQuote :: Text -> Text-blockQuote t =+blockQuote :: CodeOutput -> Text+blockQuote (CodeOutput mimeType t) =     let-        ls = T.lines t+        ls = ["<!-- sabela:mime " <> 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+        quoted = T.unlines $ map (\l -> if T.null l then "> " else "> " <> l) trimmed      in         quoted <> "\n"++mimeIndicator :: MimeType -> Text+mimeIndicator m = case m of+    MimeHtml -> "text/html"+    MimeMarkdown -> "text/markdown"+    MimeSvg -> "image/svg+xml"+    MimeLatex -> "text/latex"+    MimeJson -> "application/json"+    MimeImage t -> t <> ";base64"+    MimePlain -> "text/plain"++mimeFromTag :: Text -> MimeType+mimeFromTag t+    | T.isInfixOf "text/html" t = MimeHtml+    | T.isInfixOf "text/markdown" t = MimeMarkdown+    | T.isInfixOf "image/svg+html" t = MimeSvg+    | T.isInfixOf "text/latex" t = MimeLatex+    | T.isInfixOf "application/json" t = MimeJson+    | T.isInfixOf "base64" t =+        MimeImage (T.takeWhile (/= ';') (T.drop (T.length "<!-- sabela:mime ") t))+    | otherwise = MimePlain

@@ -5,7 +5,13 @@ import qualified Data.Text as T import qualified Data.Text.IO as TIO -import ScriptHs.Markdown (Segment (..), parseMarkdown, reassemble)+import ScriptHs.Markdown (+    CodeOutput (..),+    MimeType (..),+    Segment (..),+    parseMarkdown,+    reassemble,+ ) import ScriptHs.Parser (     CabalMeta (..),     Line (..),@@ -47,7 +53,7 @@ addOutputToSegments outputs = map addOutput   where     addOutput :: (Int, Segment) -> Segment-    addOutput (i, CodeBlock lang code _) = CodeBlock lang code (lookup i outputs)+    addOutput (i, CodeBlock lang code _) = CodeBlock lang code (fmap (CodeOutput MimePlain) (lookup i outputs))     addOutput (_, seg) = seg  mkIndexedCodeSegments :: IndexedSegments -> IndexedSegments

@@ -11,6 +11,8 @@ import Data.Text (Text) import qualified Data.Text as T import ScriptHs.Markdown (+    CodeOutput (..),+    MimeType (..),     Segment (CodeBlock, Prose),     parseMarkdown,     reassemble,@@ -72,6 +74,23 @@                 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 "multiple code blocks" $ do                 let input =                         T.unlines@@ -81,15 +100,26 @@                             , "print 1"                             , "```"                             , ""+                            , "> <!-- sabela:mime text/plain -->"+                            , "> 1"+                            , ""                             , "Middle text."                             , ""                             , "```haskell"                             , "print 2"                             , "```"+                            , ""+                            , "> <!-- sabela: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@@ -142,26 +172,22 @@                 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 "42")]+                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 "1\n2")]+                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 "empty output is omitted" $ do-                let result = reassemble [CodeBlock "haskell" "import X\n" (Just "")]-                assertBool "no blockquote" (not $ T.isInfixOf "> " result)-            , testCase "whitespace-only output is omitted" $ do-                let result = reassemble [CodeBlock "haskell" "import X\n" (Just "  \n  \n")]-                assertBool "no blockquote" (not $ T.isInfixOf "> " result)             , testCase "full document roundtrip" $ do                 let segs =                         [ Prose "# Title\n\n"-                        , CodeBlock "haskell" "print 42\n" (Just "42")+                        , CodeBlock "haskell" "print 42\n" (Just $ CodeOutput MimePlain "42")                         , Prose "\nSome text.\n"-                        , CodeBlock "haskell" "print 99\n" (Just "99")+                        , CodeBlock "haskell" "print 99\n" (Just $ CodeOutput MimePlain "99")                         ]                 let result = reassemble segs @@ -181,11 +207,11 @@         , testGroup             "blockquote"             [ testCase "single line" $ do-                let result = reassemble [CodeBlock "hs" "x\n" (Just "hello")]+                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 "a\n\nb")]-                assertBool "has bare >" (T.isInfixOf "\n>\n" result)+                let result = reassemble [CodeBlock "hs" "x\n" (Just $ CodeOutput MimePlain "a\n\nb")]+                assertBool "has bare >" (T.isInfixOf "\n> \n" result)             ]         ] 

@@ -5,7 +5,7 @@  import qualified Data.Text as T -import ScriptHs.Markdown (Segment (..))+import ScriptHs.Markdown (CodeOutput (..), MimeType (..), Segment (..)) import ScriptHs.Notebook (     addOutputToSegments,     generatedMarkedScript,@@ -110,7 +110,13 @@                         [ (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 "old-should-be-replaced"))+                        ,+                            ( 3+                            , CodeBlock+                                "hs"+                                "print 3\n"+                                (Just $ CodeOutput MimePlain "old-should-be-replaced")+                            )                         , (4, Prose "outro\n")                         ] @@ -121,8 +127,9 @@                 head result @?= Prose "intro\n"                 result !! 4 @?= Prose "outro\n" -                result !! 1 @?= CodeBlock "haskell" "print 1\n" (Just "out-1")-                result !! 3 @?= CodeBlock "hs" "print 3\n" (Just "out-3")+                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             ]