scripths 0.3.0.0 → 0.3.0.1
raw patch · 6 files changed
+314/−2 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- scripths.cabal +1/−1
- src/ScriptHs/Parser.hs +12/−0
- src/ScriptHs/Render.hs +53/−1
- test/Test/Parser.hs +50/−0
- test/Test/Render.hs +194/−0
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for scripths +## 0.3.0.1 -- 2026-03-14++* improve block parsing+ ## 0.2.0.2 -- 2026-03-14 * Stop adding extra white space to code cells.
scripths.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: scripths-version: 0.3.0.0+version: 0.3.0.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/
src/ScriptHs/Parser.hs view
@@ -139,7 +139,19 @@ | Just cmd <- parseGhciCommand line = GhciCommand cmd | Just pragma <- parsePragma line = Pragma pragma | Just imp <- parseImport line = Import imp+ | Just stripped <- stripTopLevelLet line = HaskellLine stripped | otherwise = HaskellLine (rewriteSplice line)++{- | Strip @let@ from top-level bindings.+ GHCi's @:{...}@ blocks don't support @let@ at the top level.+ Preserves @let ... in ...@ expressions and indented @let@ (inside do/where).+-}+stripTopLevelLet :: Text -> Maybe Text+stripTopLevelLet line = do+ rest <- T.stripPrefix "let " line+ if " in " `T.isInfixOf` rest+ then Nothing+ else Just rest isBlankLine :: Text -> Bool isBlankLine = T.null . T.strip
src/ScriptHs/Render.hs view
@@ -74,10 +74,62 @@ isIndented _ = False splitIOBinds :: Block -> [Block]-splitIOBinds (MultiLine ls) = map classifyBlock (splitOn isIOLine ls)+splitIOBinds (MultiLine ls) =+ concatMap (splitDefIO . classifyBlock) (splitOn isIOLine ls) where isIOLine l = isIOorTH (lineText l) splitIOBinds b = [b]++{- | Split a block that mixes definitions and IO actions.+ Only splits when there's a clear boundary: a non-indented line+ without @=@ or @::@ following a line that has @=@ or @::@, or vice versa.+ Indented lines always attach to the preceding line's group.+-}+splitDefIO :: Block -> [Block]+splitDefIO (MultiLine ls)+ | hasMix ls = map classifyBlock (groupByKind ls)+ | otherwise = [MultiLine ls]+splitDefIO b = [b]++-- | Check if a block has both definitions and IO actions at the top level.+hasMix :: [Line] -> Bool+hasMix ls =+ let topLevel = filter (not . isIndented) ls+ defs = filter (isDef . lineText) topLevel+ actions = filter (not . isDef . lineText) topLevel+ in not (null defs) && not (null actions)++groupByKind :: [Line] -> [[Line]]+groupByKind [] = []+groupByKind (l : ls) =+ let kind = lineKindOf l+ -- Collect lines of the same kind, plus any indented continuations+ (same, rest) = spanSameKind kind ls+ in (l : same) : groupByKind rest++spanSameKind :: Bool -> [Line] -> ([Line], [Line])+spanSameKind _ [] = ([], [])+spanSameKind kind (l : ls)+ | isIndented l =+ -- Indented lines attach to the current group+ let (more, rest) = spanSameKind kind ls+ in (l : more, rest)+ | lineKindOf l == kind =+ let (more, rest) = spanSameKind kind ls+ in (l : more, rest)+ | otherwise = ([], l : ls)++-- | True if the line looks like a definition (has @=@ or @::@).+lineKindOf :: Line -> Bool+lineKindOf l = isDef (lineText l)++isDef :: Text -> Bool+isDef t =+ hasTopLevelEquals t || " :: " `T.isInfixOf` t++hasTopLevelEquals :: Text -> Bool+hasTopLevelEquals t =+ " = " `T.isInfixOf` t || T.isSuffixOf " =" t splitOn :: (a -> Bool) -> [a] -> [[a]] splitOn _ [] = []
test/Test/Parser.hs view
@@ -152,6 +152,56 @@ [HaskellLine _] -> pure () other -> assertFailure $ "expected HaskellLine, got: " ++ show other ]+ , testGroup+ "Let stripping (don't break)"+ [ testCase "bare binding unchanged" $ do+ let sf = parseScript "x = 5\n"+ case scriptLines sf of+ [HaskellLine t] -> t @?= "x = 5"+ other -> assertFailure $ "expected HaskellLine, got: " ++ show other+ , testCase "let-in expression preserved" $ do+ let sf = parseScript "let x = 1 in x + 1\n"+ case scriptLines sf of+ [HaskellLine t] -> assertBool "has let-in" ("let " `T.isPrefixOf` t && " in " `T.isInfixOf` t)+ other -> assertFailure $ "expected HaskellLine, got: " ++ show other+ , testCase "indented let preserved (inside do/where)" $ do+ let sf = parseScript " let x = 5\n"+ case scriptLines sf of+ [HaskellLine t] -> assertBool "still has let" ("let" `T.isInfixOf` t)+ other -> assertFailure $ "expected HaskellLine, got: " ++ show other+ ]+ , testGroup+ "Let stripping (new behavior)"+ [ testCase "top-level let stripped" $ do+ let sf = parseScript "let x = 5\n"+ case scriptLines sf of+ [HaskellLine t] -> t @?= "x = 5"+ other -> assertFailure $ "expected HaskellLine \"x = 5\", got: " ++ show other+ , testCase "top-level let with complex binding stripped" $ do+ let sf = parseScript "let foo = bar 1 2\n"+ case scriptLines sf of+ [HaskellLine t] -> t @?= "foo = bar 1 2"+ other -> assertFailure $ "expected HaskellLine, got: " ++ show other+ , testCase "multiple let lines each stripped" $ do+ let input = T.unlines ["let x = 1", "let y = 2"]+ let sf = parseScript input+ let code = filter notBlank (scriptLines sf)+ case code of+ [HaskellLine a, HaskellLine b] -> do+ a @?= "x = 1"+ b @?= "y = 2"+ other -> assertFailure $ "expected two stripped lets, got: " ++ show other+ , testCase "let-in NOT stripped" $ do+ let sf = parseScript "let x = 1 in x + 1\n"+ case scriptLines sf of+ [HaskellLine t] -> assertBool "preserved" ("let " `T.isPrefixOf` t)+ other -> assertFailure $ "expected HaskellLine, got: " ++ show other+ , testCase "indented let NOT stripped" $ do+ let sf = parseScript " let x = 5\n"+ case scriptLines sf of+ [HaskellLine t] -> assertBool "still has let" ("let " `T.isInfixOf` t)+ other -> assertFailure $ "expected HaskellLine with let, got: " ++ show other+ ] ] notBlank :: Line -> Bool
test/Test/Render.hs view
@@ -120,6 +120,200 @@ assertBool "has :{" (T.isInfixOf ":{" result) assertBool "has print" (T.isInfixOf "print iris" result) ]+ , testGroup+ "Continuation across blanks (don't break)"+ [ testCase "blank between independent IO statements still separates" $ do+ let result =+ toGhciScript+ [ HaskellLine "putStrLn \"a\""+ , Blank+ , HaskellLine "putStrLn \"b\""+ ]+ let blocks = splitBlocks result+ assertBool+ ("expected 2 blocks, got " ++ show (length blocks))+ (length blocks == 2)+ , testCase "blank between imports still separates" $ do+ let result =+ toGhciScript+ [ Import "import Data.Text"+ , Blank+ , Import "import Data.Map"+ ]+ -- Both imports should appear+ assertBool "has Text" (T.isInfixOf "Data.Text" result)+ assertBool "has Map" (T.isInfixOf "Data.Map" result)+ ]+ , testGroup+ "Continuation across blanks (new behavior)"+ [ testCase "blank before where stays in same block" $ do+ let result =+ toGhciScript+ [ HaskellLine "foo x = bar x"+ , Blank+ , HaskellLine " where"+ , HaskellLine " bar = id"+ ]+ let blocks = splitBlocks result+ assertBool+ ( "expected 1 block for where clause, got "+ ++ show (length blocks)+ ++ ": "+ ++ show blocks+ )+ (length blocks == 1)+ , testCase "blank before guards stays in same block" $ do+ let result =+ toGhciScript+ [ HaskellLine "f n"+ , Blank+ , HaskellLine " | n > 0 = 1"+ , HaskellLine " | otherwise = 0"+ ]+ let blocks = splitBlocks result+ assertBool+ ( "expected 1 block for guards, got "+ ++ show (length blocks)+ ++ ": "+ ++ show blocks+ )+ (length blocks == 1)+ , testCase "blank before deriving stays in same block" $ do+ let result =+ toGhciScript+ [ HaskellLine "data Color = Red | Green | Blue"+ , Blank+ , HaskellLine " deriving (Show, Eq)"+ ]+ let blocks = splitBlocks result+ assertBool+ ( "expected 1 block for deriving, got "+ ++ show (length blocks)+ ++ ": "+ ++ show blocks+ )+ (length blocks == 1)+ , testCase "double blank still breaks (intentional separation)" $ do+ let result =+ toGhciScript+ [ HaskellLine "x = 1"+ , Blank+ , Blank+ , HaskellLine "y = 2"+ ]+ let blocks = splitBlocks result+ assertBool+ ("expected 2 blocks for double blank, got " ++ show (length blocks))+ (length blocks == 2)+ ]+ , testGroup+ "Mixed block splitting (don't break)"+ [ testCase "pure definitions stay grouped" $ do+ let result =+ toGhciScript+ [ HaskellLine "f x = x + 1"+ , HaskellLine "g y = y * 2"+ ]+ let blocks = splitBlocks result+ assertBool+ ("expected 1 block for definitions, got " ++ show (length blocks))+ (length blocks == 1)+ , testCase "indented continuation stays grouped" $ do+ let result =+ toGhciScript+ [ HaskellLine "f x ="+ , HaskellLine " x + 1"+ ]+ let blocks = splitBlocks result+ length blocks @?= 1+ ]+ , testGroup+ "Mixed block splitting (new behavior)"+ [ testCase "definition then IO splits into two blocks" $ do+ let result =+ toGhciScript+ [ HaskellLine "x = 5"+ , HaskellLine "print x"+ ]+ let blocks = splitBlocks result+ assertBool+ ( "expected 2 blocks for def+IO, got "+ ++ show (length blocks)+ ++ ": "+ ++ show blocks+ )+ (length blocks == 2)+ , testCase "IO then definition splits" $ do+ let result =+ toGhciScript+ [ HaskellLine "putStrLn \"hi\""+ , HaskellLine "x = 5"+ ]+ let blocks = splitBlocks result+ assertBool+ ( "expected 2 blocks for IO+def, got "+ ++ show (length blocks)+ ++ ": "+ ++ show blocks+ )+ (length blocks == 2)+ , testCase "three mixed items produce three blocks" $ do+ let result =+ toGhciScript+ [ HaskellLine "x = 1"+ , HaskellLine "print x"+ , HaskellLine "y = 2"+ ]+ let blocks = splitBlocks result+ assertBool+ ("expected 3 blocks, got " ++ show (length blocks) ++ ": " ++ show blocks)+ (length blocks == 3)+ , testCase "type sig + definition stays together" $ do+ let result =+ toGhciScript+ [ HaskellLine "f :: Int -> Int"+ , HaskellLine "f x = x + 1"+ ]+ let blocks = splitBlocks result+ assertBool+ ("expected 1 block for sig+def, got " ++ show (length blocks))+ (length blocks == 1)+ ]+ , testGroup+ "Bracket counting (don't break)"+ [ testCase "complete expression in parens" $ do+ let result = toGhciScript [HaskellLine "f x = (x + 1)"]+ let blocks = splitBlocks result+ length blocks @?= 1+ , testCase "balanced multiline already grouped by indentation" $ do+ let result =+ toGhciScript+ [ HaskellLine "f x ="+ , HaskellLine " (x + 1)"+ ]+ let blocks = splitBlocks result+ length blocks @?= 1+ ]+ , testGroup+ "Bracket counting (new behavior)"+ [ testCase "unclosed bracket extends block" $ do+ let result =+ toGhciScript+ [ HaskellLine "xs = ["+ , HaskellLine " 1,"+ , HaskellLine " 2,"+ , HaskellLine " 3"+ , HaskellLine " ]"+ ]+ let blocks = splitBlocks result+ assertBool+ ( "expected 1 block for list literal, got "+ ++ show (length blocks)+ ++ ": "+ ++ show blocks+ )+ (length blocks == 1)+ ] ] splitBlocks :: Text -> [[Text]]