scripths 0.5.4.1 → 0.5.4.2

raw patch · 10 files changed

+205/−110 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−4
• README.md +4/−2
• app/Main.hs +3/−1
• scripths.cabal +2/−1
• src/ScriptHs/Compiled.hs +2/−11
• src/ScriptHs/Lex.hs +74/−0
• src/ScriptHs/Parser.hs +19/−22
• src/ScriptHs/Render.hs +56/−67
• test/Test/Render.hs +30/−1
• test/Test/Run.hs +1/−1

@@ -1,9 +1,19 @@ # Revision history for scripths  +## 0.5.4.2 -- 2026-08-13+* fixes heuristic to parse binds.+* declarations separated by a single blank line and/or comment lines merge into one `:{ … :}` block, so mutually recursive definitions with commented section headers load together. A double blank line still splits blocks.+ ## 0.5.3.1 -- 2026-06-28 * Merge consecutive blank lines. +## 0.5.3.0 -- 2026-06-23+* **Line-numbered errors**: every rendered block carries a `{-# LINE #-}`+  pragma with its original source line, so GHC diagnostics point at the real+  line in your script or notebook cell instead of a position inside the+  generated GHCi input.+ ## 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).@@ -11,8 +21,8 @@ * **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)+## 0.4.1.0 -- 2026-05-31+* **Custom-prelude support**: auto print (our hook to route everything but strings to show)   now doesn't assume a prelude. * **Cleaner error rendering** (notebooks): don't leak internals when printing errors. * **UTF-8 output**: captured notebook output is decoded as UTF-8.@@ -33,7 +43,7 @@ * **`scripths --version` / `-v`** prints the scripths version.  ## 0.4.0.1 -- 2026-05-30-* Parse pandoc markdown code fences as haskel code fences.+* Parse pandoc markdown code fences as Haskell code fences.  ## 0.4.0.0 -- 2026-05-29 @@ -101,7 +111,7 @@  ## 0.1.0.1 -- 2026-02-24 -* Fix code new ine behaviour for code fencing.+* Fix code newline behaviour for code fencing.  ## 0.1.0.0 -- YYYY-mm-dd 

@@ -24,11 +24,13 @@ ## CLI Usage  ```-scripths [-o FILE | --output=FILE] [-i | --in-place] [-p DIR | --package DIR]... [--no-local-project] [-h | --help] [-v | --version] <script>+scripths [-o FILE | --output=FILE] [-i | --in-place] [-p DIR | --package DIR]... [--no-local-project] [--code-style=display|remove] [--output-style=quoted|raw] [-h | --help] [-v | --version] <script> ```  When `-o` / `--output` is provided for Markdown files, the result is written to that path. Otherwise it is printed to stdout. With `-i` / `--in-place` the notebook is rewritten in place: any previously rendered output is stripped and replaced, and re-running is idempotent (it does not accumulate blank lines). `-i` is only valid for `.md` / `.markdown` notebooks and cannot be combined with `-o`. +Rendered notebooks can be styled: `--code-style=remove` omits the code fences from the output (results only, e.g. for exporting a report), and `--output-style=raw` emits captured output verbatim instead of as a block quote. The defaults are `display` and `quoted`.+ The file extension determines the mode. `.ghci` / `hs` files are parsed and executed as a standalone GHCi script. `.md` / `.markdown` files are processed as a notebook with captured output. Run `scripths --help` for the full option and directive list, or `scripths --version` to print the version.  ## Version tag@@ -126,7 +128,7 @@ -- cabal: source-repository-package: https://github.com/owner/repo v1.2.3 ``` -The recognised keys are `build-depends`, `default-extensions`, `ghc-options`, `packages` (extra local package directories, relative to the script), and `source-repository-package`. An unrecognised key is reported as a warning.+The recognised keys are `build-depends`, `default-extensions`, `ghc-options`, `packages` (extra local package directories, relative to the script), `source-repository-package`, `extra-lib-dirs`, and `extra-include-dirs`. An unrecognised key is reported as a warning.  `OverloadedStrings` is enabled in every scripths repl by default, so string literals work directly as `Text` / `ByteString`; add any further extensions with `default-extensions`. 

@@ -138,7 +138,7 @@         , "  -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)"+        , "  --output-style=quoted|raw      control how evaluated output is rendered (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"@@ -150,6 +150,8 @@         , "  -- cabal: ghc-options: -Wall"         , "  -- cabal: packages: ../sibling-pkg        (extra local package dirs)"         , "  -- cabal: source-repository-package: <git-url> <ref> [subdir]"+        , "  -- cabal: extra-lib-dirs: /opt/lib         (native library search paths)"+        , "  -- cabal: extra-include-dirs: /opt/include (C header search paths)"         , ""         , "Each code block should end in a single bare expression to be auto-printed;"         , "a block ending in a '<-' bind prints nothing — repeat the bound name on a"

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               scripths-version:            0.5.4.1+version:            0.5.4.2 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/@@ -25,6 +25,7 @@     import:           warnings     exposed-modules:  ScriptHs.CLI.Types,                       ScriptHs.Compiled,+                      ScriptHs.Lex,                       ScriptHs.Markdown,                       ScriptHs.Notebook,                       ScriptHs.Parser,

@@ -28,6 +28,8 @@ import ScriptHs.Render (     Kind (..),     Piece (..),+    dedup,+    languagePragma,     linePragma,     lineText,     numberedPieces,@@ -159,14 +161,3 @@         , k `elem` [KComment, KDeclaration, KTHSplice]         ]     declLines = T.lines . unRewriteSplice . T.intercalate "\n" . map lineText--languagePragma :: Text -> Text-languagePragma ext = "{-# LANGUAGE " <> ext <> " #-}"--dedup :: [Text] -> [Text]-dedup = go []-  where-    go _ [] = []-    go seen (x : xs)-        | x `elem` seen = go seen xs-        | otherwise = x : go (x : seen) xs

@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++{- | Length-preserving lexical masking for single source lines. The+classifiers in "ScriptHs.Render" decide what a line is from tokens at the+statement level; masking literal contents, bracketed text, and trailing+comments first lets each check stay a plain "Data.Text" search.+-}+module ScriptHs.Lex (+    maskLiterals,+    maskNested,+    stripLineComment,+    isSymbolChar,+) where++import Data.Text (Text)+import qualified Data.Text as T++{- | Blank out string and character literals (delimiters included) with+spaces. A single quote counts as a literal only when one closes it right+after the (possibly escaped) character; otherwise it is a prime in an+identifier like @xs'@.+-}+maskLiterals :: Text -> Text+maskLiterals = T.pack . go . T.unpack+  where+    go [] = []+    go ('"' : cs) = ' ' : inString cs+    go ('\'' : '\\' : c : cs)+        | (esc, '\'' : rest) <- break (== '\'') cs =+            blank (3 + length esc + 1) ++ go rest+        | otherwise = '\'' : go ('\\' : c : cs)+    go ('\'' : c : '\'' : cs)+        | c /= '\\' = blank 3 ++ go cs+    go (c : cs) = c : go cs+    inString [] = []+    inString ('\\' : _ : cs) = ' ' : ' ' : inString cs+    inString ('"' : cs) = ' ' : go cs+    inString (_ : cs) = ' ' : inString cs+    blank n = replicate n ' '++{- | 'maskLiterals', then blank out everything inside (and including)+brackets, leaving only statement-level source visible.+-}+maskNested :: Text -> Text+maskNested = T.pack . go (0 :: Int) . T.unpack . maskLiterals+  where+    go _ [] = []+    go d (c : cs)+        | c `elem` ("([{" :: String) = ' ' : go (d + 1) cs+        | c `elem` (")]}" :: String) = ' ' : go (max 0 (d - 1)) cs+        | d > 0 = ' ' : go d cs+        | otherwise = c : go d cs++{- | Drop a trailing @--@ line comment (and anything after it). Honouring+maximal munch, a dash run extended by other symbol characters (@-->@, @--|@)+is an operator, not a comment; a @--@ inside a literal is text.+-}+stripLineComment :: Text -> Text+stripLineComment t = maybe t (\i -> T.take i t) (commentIndex 0 (maskLiterals t))+  where+    commentIndex i s = case T.uncons s of+        Nothing -> Nothing+        Just (c, rest)+            | isSymbolChar c ->+                let run = T.takeWhile isSymbolChar s+                    n = T.length run+                 in if n >= 2 && T.all (== '-') run+                        then Just i+                        else commentIndex (i + n) (T.drop n s)+            | otherwise -> commentIndex (i + 1) rest++-- | Characters that can extend a Haskell operator lexeme (maximal munch).+isSymbolChar :: Char -> Bool+isSymbolChar c = c `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String)

@@ -88,6 +88,22 @@     }     deriving (Show, Eq) +instance Semigroup CabalMeta where+    a <> b =+        CabalMeta+            { metaDeps = metaDeps a <> metaDeps b+            , metaExts = metaExts a <> metaExts b+            , metaGhcOptions = metaGhcOptions a <> metaGhcOptions b+            , metaExtraLibDirs = metaExtraLibDirs a <> metaExtraLibDirs b+            , metaExtraIncludeDirs = metaExtraIncludeDirs a <> metaExtraIncludeDirs b+            , metaPackages = metaPackages a <> metaPackages b+            , metaSourceRepos = metaSourceRepos a <> metaSourceRepos b+            , metaUnknownKeys = metaUnknownKeys a <> metaUnknownKeys b+            }++instance Monoid CabalMeta where+    mempty = CabalMeta [] [] [] [] [] [] [] []+ {- | A git @source-repository-package@ pin, declared with  @@@ -178,18 +194,9 @@     | RawCompile CompileDirective     | RawCode Line +-- | Field-wise concatenation of every directive's contribution. mergeMetas :: [CabalMeta] -> CabalMeta-mergeMetas ms =-    CabalMeta-        { metaDeps = concatMap metaDeps ms-        , metaExts = concatMap metaExts ms-        , metaGhcOptions = concatMap metaGhcOptions ms-        , metaExtraLibDirs = concatMap metaExtraLibDirs ms-        , metaExtraIncludeDirs = concatMap metaExtraIncludeDirs ms-        , metaPackages = concatMap metaPackages ms-        , metaSourceRepos = concatMap metaSourceRepos ms-        , metaUnknownKeys = concatMap metaUnknownKeys ms-        }+mergeMetas = mconcat  parseLine :: Text -> RawLine parseLine line@@ -230,17 +237,7 @@                 other -> emptyCabal{metaUnknownKeys = [other]}         _ -> Nothing   where-    emptyCabal =-        CabalMeta-            { metaDeps = []-            , metaExts = []-            , metaGhcOptions = []-            , metaExtraLibDirs = []-            , metaExtraIncludeDirs = []-            , metaPackages = []-            , metaSourceRepos = []-            , metaUnknownKeys = []-            }+    emptyCabal = mempty :: CabalMeta  {- | Parse a @source-repository-package@ value: whitespace-separated @\<location\> \<ref\> [subdir]@ (not comma-separated like the other directives).

@@ -32,10 +32,15 @@     Piece (..),     toPieces,     mergePieces,-    classify,-    bindStatementBody,     lineText,     unRewriteSplice,++    -- * Shared rendering helpers+    dedup,+    languagePragma,++    -- * Internals exposed for testing+    bindStatementBody, ) where  import Data.Bifunctor (first, second)@@ -44,6 +49,7 @@ import Data.Maybe import Data.Text (Text) import qualified Data.Text as T+import ScriptHs.Lex (isSymbolChar, maskNested, stripLineComment) import ScriptHs.Parser (CabalMeta (..), Line (..), SourceRepoPin (..))  data Block@@ -58,8 +64,9 @@ * A run of @--@ comment lines forms a 'KComment' unit that attaches   forward to the next non-comment unit. * A type signature, value binding, or clause-head-with-guards forms a-  'KDeclaration' unit; consecutive declarations merge into a single-  @:{ … :}@ block.+  'KDeclaration' unit; declarations separated by at most a single blank+  line and\/or comment lines merge into a single @:{ … :}@ block (a+  double blank line splits). * A monadic bind (@<-@ on the lead line) forms a 'KIOBind' unit; each   such unit is its own block. * A Template Haskell splice (@$(…)@ or the rewritten @_ = (); …@ form)@@ -81,6 +88,7 @@ toGhciScriptTagged tag =     T.unlines . concatMap (renderBlockTagged tag) . numberedBlocks +-- | The statement-level classification of a logical unit of lines. data Kind     = KComment     | KDeclaration@@ -89,6 +97,7 @@     | KTHSplice     deriving (Show, Eq) +-- | One element of a parsed line stream: a classified unit or a bare line. data Piece     = PBlank     | PGhciCommand Text@@ -97,6 +106,7 @@     | PUnit Kind [Line]     deriving (Show) +-- | Group lines into logical units (lead + continuations) and classify each. toPieces :: [Line] -> [Piece] toPieces [] = [] toPieces (Blank : rest) = PBlank : toPieces rest@@ -150,6 +160,7 @@ isBlankLine Blank = True isBlankLine _ = False +-- | The 'Kind' of a unit, from its lead line and continuation lines. classify :: Text -> [Text] -> Kind classify leadText contTexts     | isTHSplice leadText = KTHSplice@@ -164,7 +175,7 @@  {- | A statement binds monadically when @<-@ separates a pattern from an expression at the STATEMENT level. Defined through 'bindStatementBody' so the-classifier and the extractor can never disagree about which arrow binds.+classifier and the body extraction can never disagree about which arrow binds. -} isIOBindLead :: Text -> Bool isIOBindLead = isJust . bindStatementBody@@ -172,34 +183,23 @@ {- | The expression a monadic bind runs, with its pattern dropped: the text after the statement-level @<-@, or 'Nothing' when the line binds nothing. An arrow nested inside brackets belongs to a list comprehension or an inline-@do@, and one inside a literal is text; neither binds a name a caller can use.+@do@, one inside a literal or comment is text, and one extended by symbol+characters (@<->@) is an operator; none binds a name. -} bindStatementBody :: Text -> Maybe Text-bindStatementBody = scan (0 :: Int)+bindStatementBody t = body <$> findArrow 0   where-    scan depth t = case T.uncons t of-        Nothing -> Nothing-        Just ('"', rest) -> scan depth (skipString rest)-        Just ('\'', rest) -> scan depth (skipChar rest)-        Just ('<', rest)-            | depth == 0-            , Just body <- T.stripPrefix "-" rest ->-                Just (T.strip body)-        Just (c, rest)-            | c `elem` ("([{" :: String) -> scan (depth + 1) rest-            | c `elem` (")]}" :: String) -> scan (depth - 1) rest-            | otherwise -> scan depth rest-    skipString t = case T.uncons t of-        Nothing -> t-        Just ('\\', rest) -> skipString (T.drop 1 rest)-        Just ('"', rest) -> rest-        Just (_, rest) -> skipString rest-    -- A quote opens a character literal only when one closes it right after-    -- the character; otherwise it is a prime in an identifier like @xs'@.-    skipChar t = case T.uncons t of-        Just ('\\', rest) -> T.drop 1 (T.dropWhile (/= '\'') rest)-        Just (_, rest) | "'" `T.isPrefixOf` rest -> T.drop 1 rest-        _ -> t+    stripped = stripLineComment t+    masked = maskNested stripped+    body i = T.strip (T.drop (i + 2) stripped)+    findArrow i = case T.breakOn "<-" (T.drop i masked) of+        (_, "") -> Nothing+        (pre, _) ->+            let j = i + T.length pre+             in if standaloneArrow j then Just j else findArrow (j + 2)+    standaloneArrow j = not (symbolAt (j - 1)) && not (symbolAt (j + 2))+    symbolAt k =+        k >= 0 && k < T.length masked && isSymbolChar (T.index masked k)  isDeclaration :: Text -> [Text] -> Bool isDeclaration leadText contTexts =@@ -295,51 +295,40 @@                , "infixr"                ] -{- | A standalone @=@ at bracket depth 0 outside string literals — the-discriminator between a value binding and an expression whose string content-happens to contain @\" = \"@ (a labelled print) or a record update's field-assignment.+{- | A standalone @=@ at bracket depth 0 outside literals and comments — the+discriminator between a value binding and an expression whose nested text+happens to contain an @=@ (a labelled print, a record update's field+assignment, a trailing comment). -} hasTopLevelEquals :: Text -> Bool-hasTopLevelEquals = go (0 :: Int) . T.unpack+hasTopLevelEquals t =+    " = " `T.isInfixOf` masked || " =" `T.isSuffixOf` T.stripEnd masked   where-    go 0 (' ' : '=' : rest)-        | null rest || head rest == ' ' = True-    go d ('\\' : _ : cs) = go d cs-    go d ('"' : cs) = go d (dropString cs)-    go d (c : cs)-        | c `elem` ("([{" :: String) = go (d + 1) cs-        | c `elem` (")]}" :: String) = go (max 0 (d - 1)) cs-        | otherwise = go d cs-    go _ [] = False-    dropString ('\\' : _ : cs) = dropString cs-    dropString ('"' : cs) = cs-    dropString (_ : cs) = dropString cs-    dropString [] = []+    masked = maskNested (stripLineComment t)  isCommentText :: Text -> Bool isCommentText t = "--" `T.isPrefixOf` T.stripStart t  {- | Normalize a piece stream: attach each comment unit forward onto the-following non-comment unit, and merge runs of adjacent declarations into a-single unit. Shared by 'toGhciScript' (block wrapping) and 'toModule'-(bucketing) so both see identical grouping.+following non-comment unit, and merge declarations separated by at most a+single blank line and\/or comment lines into a single unit. Shared by+'toGhciScript' (block wrapping) and 'toModule' (bucketing) so both see+identical grouping. Defined through 'mergeNumberedPieces' so the two can+never diverge. -} mergePieces :: [Piece] -> [Piece]-mergePieces (PUnit KComment l1 : PUnit k l2 : rest)-    | k /= KComment = mergePieces (PUnit k (l1 ++ l2) : rest)-mergePieces (PUnit KDeclaration l1 : rest)-    | Just (l2, rest') <- declContinuation rest =-        mergePieces (PUnit KDeclaration (l1 ++ l2) : rest')-mergePieces (p : rest) = p : mergePieces rest-mergePieces [] = []+mergePieces = map snd . mergeNumberedPieces . zip [0 ..] -declContinuation :: [Piece] -> Maybe ([Line], [Piece])+{- | The declaration unit continuing the current one across at most a single+blank line and\/or comment runs; the gap lines are kept in the merged unit so+line counts (and any LINE pragma) stay true.+-}+declContinuation :: [(Int, Piece)] -> Maybe ([Line], [(Int, Piece)]) declContinuation = go False   where-    go _ (PUnit KDeclaration l : r) = Just (l, r)-    go False (PBlank : r) = first (Blank :) <$> go True r-    go _ (PUnit KComment lc : r) = first (lc ++) <$> go False r+    go _ ((_, PUnit KDeclaration l) : r) = Just (l, r)+    go False ((_, PBlank) : r) = first (Blank :) <$> go True r+    go _ ((_, PUnit KComment lc) : r) = first (lc ++) <$> go False r     go _ _ = Nothing  piecesToBlocks :: [Piece] -> [Block]@@ -368,16 +357,15 @@     pieceLen (PUnit _ ls) = length ls     pieceLen _ = 1 -{- | 'mergePieces' carrying each piece's first source line; a merge keeps the-earliest line so a tagged block points at where the unit began.+{- | The one merge implementation, carrying each piece's first source line; a+merge keeps the earliest line so a tagged block points at where the unit began. -} mergeNumberedPieces :: [(Int, Piece)] -> [(Int, Piece)] mergeNumberedPieces ((i, PUnit KComment l1) : (_, PUnit k l2) : rest)     | k /= KComment = mergeNumberedPieces ((i, PUnit k (l1 ++ l2)) : rest) mergeNumberedPieces ((i, PUnit KDeclaration l1) : rest)-    | Just (l2, rest') <- declContinuation (map snd rest) =-        mergeNumberedPieces-            ((i, PUnit KDeclaration (l1 ++ l2)) : drop (length rest - length rest') rest)+    | Just (l2, rest') <- declContinuation rest =+        mergeNumberedPieces ((i, PUnit KDeclaration (l1 ++ l2)) : rest') mergeNumberedPieces (p : rest) = p : mergeNumberedPieces rest mergeNumberedPieces [] = [] @@ -415,6 +403,7 @@ linePragma :: Int -> Text -> Text linePragma n tag = "{-# LINE " <> T.pack (show n) <> " \"" <> tag <> "\" #-}" +-- | A line's raw text (empty for 'Blank'). lineText :: Line -> Text lineText Blank = "" lineText (GhciCommand t) = t

@@ -70,6 +70,14 @@                     @?= Just KAction             , testCase "arrow inside a string literal is an action" $                 kindOf "putStrLn \"x <- y\"" @?= Just KAction+            , testCase "arrow behind an escaped quote is still in the string" $+                kindOf "putStrLn \"he said \\\"x <- y\\\"\"" @?= Just KAction+            , testCase "arrow inside a trailing comment is not a bind" $+                kindOf "putStrLn \"done\" -- then: x <- readLn" @?= Just KAction+            , testCase "an operator containing <- is not a bind" $+                kindOf "v1 <-> v2" @?= Just KAction+            , testCase "defining an operator containing <- is not a bind" $+                kindOf "(<->) = undefined" @?= Just KAction             ]         , testGroup             "bindStatementBody: the expression a bind runs"@@ -82,6 +90,10 @@                     @?= Just "pure [y | y <- [1, 2]]"             , testCase "a non-bind has no body" $                 bindStatementBody "print [(x, y) | x <- xs]" @?= Nothing+            , testCase "drops a trailing comment from the body" $+                bindStatementBody "x <- readLn -- setup" @?= Just "readLn"+            , testCase "an operator containing <- has no body" $+                bindStatementBody "v1 <-> v2" @?= Nothing             , -- The classifier and the extractor must never disagree: a line               -- classified KIOBind is exactly one with a statement body.               testCase "agrees with the classifier" $@@ -367,6 +379,23 @@                             , HaskellLine "  \"value\""                             ]                 length (splitBlocks result) @?= 1+            , testCase "bracket in a char literal does not hide a guard's binding" $ do+                let result =+                        toGhciScript+                            [ HaskellLine "describe c"+                            , HaskellLine "  | c == '(' = \"open\""+                            , Blank+                            , HaskellLine "isParen c = describe c /= \"\""+                            ]+                length (splitBlocks result) @?= 1+            , testCase "'=' inside a trailing comment is not a binding" $ do+                let result =+                        toGhciScript+                            [ HaskellLine "y = 2"+                            , Blank+                            , HaskellLine "print y -- expected = 2"+                            ]+                length (splitBlocks result) @?= 2             ]         , testGroup             "Mixed block splitting"@@ -662,7 +691,7 @@             assertBool "indents print 1" (T.isInfixOf "    print 1" txt)         , testCase "cabal-script header includes base + Wno-unused-imports" $ do             let hdr =-                    renderCabalScriptHeader (CabalMeta ["dataframe", "text"] [] [] [] [] [] [] [])+                    renderCabalScriptHeader (mempty{metaDeps = ["dataframe", "text"]})             assertBool "opens block" (T.isInfixOf "{- cabal:" hdr)             assertBool                 "base + deps"

@@ -17,7 +17,7 @@  )  emptyMeta :: CabalMeta-emptyMeta = CabalMeta [] [] [] [] [] [] [] []+emptyMeta = mempty  runTests :: TestTree runTests =