diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,9 @@ # Revision history for scripths +## 0.5.3.1 -- 2026-06-28 +* Merge consecutive blank lines. + ## 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). diff --git a/scripths.cabal b/scripths.cabal --- a/scripths.cabal +++ b/scripths.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: scripths -version: 0.5.3.0 +version: 0.5.3.1 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/ diff --git a/src/ScriptHs/Render.hs b/src/ScriptHs/Render.hs --- a/src/ScriptHs/Render.hs +++ b/src/ScriptHs/Render.hs @@ -36,7 +36,7 @@ unRewriteSplice, ) where -import Data.Bifunctor (second) +import Data.Bifunctor (first, second) import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Data.List (intercalate) import Data.Maybe @@ -257,8 +257,27 @@ , "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. +-} hasTopLevelEquals :: Text -> Bool -hasTopLevelEquals t = " = " `T.isInfixOf` t || T.isSuffixOf " =" t +hasTopLevelEquals = go (0 :: Int) . T.unpack + 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 [] = [] isCommentText :: Text -> Bool isCommentText t = "--" `T.isPrefixOf` T.stripStart t @@ -271,11 +290,20 @@ mergePieces :: [Piece] -> [Piece] mergePieces (PUnit KComment l1 : PUnit k l2 : rest) | k /= KComment = mergePieces (PUnit k (l1 ++ l2) : rest) -mergePieces (PUnit KDeclaration l1 : PUnit KDeclaration l2 : rest) = - mergePieces (PUnit KDeclaration (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 [] = [] +declContinuation :: [Piece] -> Maybe ([Line], [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 _ _ = Nothing + piecesToBlocks :: [Piece] -> [Block] piecesToBlocks = map pieceToBlock . mergePieces @@ -308,8 +336,10 @@ 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) : (_, PUnit KDeclaration l2) : rest) = - mergeNumberedPieces ((i, PUnit KDeclaration (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) mergeNumberedPieces (p : rest) = p : mergeNumberedPieces rest mergeNumberedPieces [] = [] diff --git a/test/Test/Render.hs b/test/Test/Render.hs --- a/test/Test/Render.hs +++ b/test/Test/Render.hs @@ -200,8 +200,120 @@ , HaskellLine "y = 2" ] length (splitBlocks result) @?= 2 + , testCase "type sig + single blank + binding stay in one block" $ do + let result = + toGhciScript + [ HaskellLine "f :: Int -> Int" + , Blank + , HaskellLine "f x = x + 1" + ] + length (splitBlocks result) @?= 1 + , testCase "two value bindings + single blank stay in one block" $ do + let result = + toGhciScript + [ HaskellLine "x = 1" + , Blank + , HaskellLine "y = 2" + ] + length (splitBlocks result) @?= 1 + , testCase "data decl + single blank + instance stay in one block" $ do + let result = + toGhciScript + [ HaskellLine "data User = User { name :: String }" + , Blank + , HaskellLine "instance Show User where" + , HaskellLine " show u = name u" + ] + length (splitBlocks result) @?= 1 + , testCase "decl + blank + comment + decl stay in one block" $ do + -- Mutually recursive decls separated by a commented paragraph + -- must share a block or the forward reference fails in GHCi. + let result = + toGhciScript + [ HaskellLine "parseFactor = parens parseExpr" + , Blank + , HaskellLine "-- Level 1: Addition" + , HaskellLine "parseExpr = chainl1 parseFactor op" + ] + length (splitBlocks result) @?= 1 + , testCase "decl + comment + decl (no blank) stay in one block" $ do + let result = + toGhciScript + [ HaskellLine "f = g + 1" + , HaskellLine "-- helper" + , HaskellLine "g = 2" + ] + length (splitBlocks result) @?= 1 + , testCase "blank/comment interleave between decls stays merged" $ do + let result = + toGhciScript + [ HaskellLine "numberParser = lexeme digits" + , Blank + , HaskellLine "-- 2. Expression Parsing" + , Blank + , HaskellLine "-- Level 3: Factors" + , HaskellLine "parseFactor = numberParser" + ] + length (splitBlocks result) @?= 1 + , testCase "double blank before a comment + decl still breaks" $ do + let result = + toGhciScript + [ HaskellLine "x = 1" + , Blank + , Blank + , HaskellLine "-- fresh section" + , HaskellLine "y = 2" + ] + length (splitBlocks result) @?= 2 + , testCase "merged gap lines are preserved inside the block" $ do + -- The blank and comment lines stay in the merged block so a + -- LINE pragma keeps every diagnostic on its original line. + let result = + toGhciScript + [ HaskellLine "f :: Int" + , Blank + , HaskellLine "-- note" + , HaskellLine "f = 2" + ] + splitBlocks result @?= [["f :: Int", "", "-- note", "f = 2"]] ] , testGroup + "Equals inside literals is not a binding" + [ testCase "print with ' = ' inside a string stays an action" $ do + -- Measured live: labelled prints classified as declarations + -- merge into one block and GHCi juxtaposes them into garbage. + let result = + toGhciScript + [ HaskellLine + "print $ \"2 + 3 * 4 = \" ++ show (evalExpr \"2 + 3 * 4\")" + , HaskellLine + "print $ \"(2 + 3) * 4 = \" ++ show (evalExpr \"(2 + 3) * 4\")" + ] + length (splitBlocks result) @?= 2 + , testCase "record update ' = ' inside braces stays an action" $ do + let result = + toGhciScript + [ HaskellLine "print cfg { retries = 3 }" + , HaskellLine "print cfg { retries = 4 }" + ] + length (splitBlocks result) @?= 2 + , testCase "a real binding whose RHS is a string still merges" $ do + let result = + toGhciScript + [ HaskellLine "label = \"x = y\"" + , Blank + , HaskellLine "caption = label ++ \"!\"" + ] + length (splitBlocks result) @?= 1 + , testCase "trailing '=' at depth 0 is still a binding head" $ do + let result = + toGhciScript + [ HaskellLine "longDef =" + , HaskellLine " \"value\"" + ] + length (splitBlocks result) @?= 1 + ] + , testGroup "Mixed block splitting" [ testCase "pure definitions stay grouped" $ do let result = @@ -300,14 +412,17 @@ , HaskellLine "do" , HaskellLine " let testPrimes = primesUpTo 10" ] + -- The three commented declaration sections merge into ONE + -- block (they may be mutually recursive); the trailing do + -- action stays its own block. let blocks = splitBlocks result assertBool - ( "expected 4 blocks (one per logical section), got " + ( "expected 2 blocks (merged decls + do action), got " ++ show (length blocks) ++ ": " ++ show blocks ) - (length blocks == 4) + (length blocks == 2) ] , testGroup "Comments" @@ -385,6 +500,20 @@ ] length (splitBlocks result) @?= 1 linePragmasIn result @?= ["{-# LINE 5 \"cell\" #-}"] + , testCase "decls merged across a blank + comment gap keep one true pragma" $ do + let result = + toGhciScriptTagged + "cell" + [ (5, HaskellLine "f = g + 1") + , (6, Blank) + , (7, HaskellLine "-- helper") + , (8, HaskellLine "g = 2") + ] + length (splitBlocks result) @?= 1 + linePragmasIn result @?= ["{-# LINE 5 \"cell\" #-}"] + -- Gap lines preserved: g's diagnostic must still map to line 8. + splitBlocks result + @?= [["{-# LINE 5 \"cell\" #-}", "f = g + 1", "", "-- helper", "g = 2"]] , testCase "comment attaching forward uses the comment's line number" $ do let result = toGhciScriptTagged