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.1
+version:            0.5.4.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
@@ -31,7 +31,9 @@
     Kind (..),
     Piece (..),
     toPieces,
+    mergePieces,
     classify,
+    bindStatementBody,
     lineText,
     unRewriteSplice,
 ) where
@@ -160,8 +162,44 @@
     let s = T.stripStart t
      in "$(" `T.isPrefixOf` s || "_ = ();" `T.isPrefixOf` s
 
+{- | 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.
+-}
 isIOBindLead :: Text -> Bool
-isIOBindLead = T.isInfixOf "<-"
+isIOBindLead = isJust . bindStatementBody
+
+{- | 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.
+-}
+bindStatementBody :: Text -> Maybe Text
+bindStatementBody = scan (0 :: Int)
+  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
 
 isDeclaration :: Text -> [Text] -> Bool
 isDeclaration leadText contTexts =
diff --git a/test/Test/Render.hs b/test/Test/Render.hs
--- a/test/Test/Render.hs
+++ b/test/Test/Render.hs
@@ -7,16 +7,20 @@
 import qualified Data.Text as T
 import ScriptHs.Parser (CabalMeta (..), Line (..))
 import ScriptHs.Render (
+    Kind (..),
     LhsBlock (..),
     ModuleParts (..),
+    Piece (..),
     TrailKind (..),
     actionExprs,
+    bindStatementBody,
     renderCabalScriptHeader,
     renderLiterate,
     renderModuleText,
     toGhciScript,
     toGhciScriptTagged,
     toModule,
+    toPieces,
  )
 
 renderTests :: TestTree
@@ -45,6 +49,57 @@
                 assertBool "has blank" (T.isInfixOf "\n\n" result || result == "\n")
             ]
         , testGroup
+            "Monadic-bind classification: only a top-level `<-` binds"
+            [ testCase "plain bind" $
+                kindOf "x <- getLine" @?= Just KIOBind
+            , testCase "pattern bind" $
+                kindOf "Just y <- pure (Just 1)" @?= Just KIOBind
+            , testCase "tuple pattern bind" $
+                kindOf "(a, b) <- pure (1, 2)" @?= Just KIOBind
+            , testCase "bind whose rhs holds a comprehension" $
+                kindOf "ys <- pure [y | y <- [1, 2]]" @?= Just KIOBind
+            , -- The live_test19 regression: a list comprehension's `<-` sits
+              -- inside brackets and binds nothing at the statement level.
+              testCase "comprehension is an action, not a bind" $
+                kindOf "print [(x, sin x) | x <- [0, 0.01 .. 2]]" @?= Just KAction
+            , testCase "comprehension inside a lambda is an action" $
+                kindOf "animate 0 (\\t -> plot [(x, sin x) | x <- xs])"
+                    @?= Just KAction
+            , testCase "one-line do block is an action" $
+                kindOf "mapM_ (\\n -> do { m <- pure n; print m }) [1]"
+                    @?= Just KAction
+            , testCase "arrow inside a string literal is an action" $
+                kindOf "putStrLn \"x <- y\"" @?= Just KAction
+            ]
+        , testGroup
+            "bindStatementBody: the expression a bind runs"
+            [ testCase "drops a plain pattern" $
+                bindStatementBody "x <- getLine" @?= Just "getLine"
+            , testCase "drops a tuple pattern" $
+                bindStatementBody "(a, b) <- pure (1, 2)" @?= Just "pure (1, 2)"
+            , testCase "keeps a comprehension in the bound expression" $
+                bindStatementBody "ys <- pure [y | y <- [1, 2]]"
+                    @?= Just "pure [y | y <- [1, 2]]"
+            , testCase "a non-bind has no body" $
+                bindStatementBody "print [(x, y) | x <- xs]" @?= 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" $
+                mapM_
+                    ( \t ->
+                        assertBool
+                            (T.unpack t)
+                            ((kindOf t == Just KIOBind) == (bindStatementBody t /= Nothing))
+                    )
+                    [ "x <- getLine"
+                    , "Just y <- pure (Just 1)"
+                    , "ys <- pure [y | y <- [1, 2]]"
+                    , "print [(x, sin x) | x <- [0, 1]]"
+                    , "animate 0 (\\t -> plot [(x, y) | x <- xs])"
+                    , "putStrLn \"x <- y\""
+                    ]
+            ]
+        , testGroup
             "Isolation: one block per statement"
             [ testCase "consecutive IO binds each get own block" $ do
                 let result =
@@ -641,6 +696,12 @@
 
 nonEmpty :: Text -> [Text]
 nonEmpty = filter (not . T.null . T.strip) . T.lines
+
+-- | The 'Kind' 'toPieces' assigns a single Haskell line.
+kindOf :: Text -> Maybe Kind
+kindOf src = case toPieces [HaskellLine src] of
+    [PUnit k _] -> Just k
+    _ -> Nothing
 
 assertNotWrapped :: Text -> Assertion
 assertNotWrapped t =
