nano-rope (empty) → 0.1.0.0

raw patch · 14 files changed

+6416/−0 lines, 14 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, core-text, deepseq, directory, nano-rope, primitive, quickcheck-classes-base, tasty, tasty-bench, tasty-quickcheck, text, text-rope, yi-rope

Files

• CHANGELOG.md +28/−0
• LICENSE +20/−0
• README.md +126/−0
• bench/Chart.hs +510/−0
• bench/Lsp.hs +342/−0
• bench/Main.hs +514/−0
• bench/Memory.hs +42/−0
• bench/Rand.hs +12/−0
• cbits/scan.c +510/−0
• nano-rope.cabal +175/−0
• src/Data/Text/NanoRope.hs +396/−0
• src/Data/Text/NanoRope/Internal.hs +2576/−0
• src/Data/Text/NanoRope/Measured.hs +128/−0
• test/Main.hs +1037/−0

@@ -0,0 +1,28 @@+# Changelog
+
+## 0.1.0.0 — unreleased
+
+Initial release.
+
+- Persistent B-tree rope with UTF-8 chunks up to 512 bytes and structural
+  sharing between versions.
+- Indexing and conversion in bytes, code points, UTF-16 code units, and lines,
+  plus zero-based line-and-column positions.
+- Insert, delete, and replace operations, with a single-descent fast path for
+  small edits and a bounded buffer for consecutive keystrokes.
+- Cached metrics for constant-time length queries, including pending input.
+- Line lookup, slicing, chunk folds, and zero-copy chunk views.
+- Shared range descent for `slice` and `sliceText`, avoiding tree rebuilding
+  above the lowest node containing the range.
+- Combined line-start and position lookup with `metricsAtLineAndPosition`,
+  for column conversion and detection of clamped or rounded positions.
+- Unlifted tree nodes to avoid evaluation checks during traversal. Requires
+  GHC 9.4 or later.
+- Buffered UTF-8 output through `hPutUtf8` and `writeFileUtf8`.
+- Runtime-selected SSE2 and AVX2 chunk scans on supported x86-64 systems,
+  with portable C elsewhere and an optional Haskell-only build.
+- Direct CPU feature detection without compiler-runtime symbols, supporting
+  GHCi and Template Haskell linking on Windows.
+- Custom monoidal measures and prefix searches in `Data.Text.NanoRope.Measured`.
+- Representation, scan primitives, and invariant checks in
+  `Data.Text.NanoRope.Internal`, without API stability guarantees.

@@ -0,0 +1,20 @@+Copyright (c) 2026 goolord
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,126 @@+# nano-rope
+
+A persistent UTF-8 rope for Haskell. Index and edit by bytes, Unicode code
+points, UTF-16 units, or lines in logarithmic time. Versions share unchanged
+text for undo and snapshots.
+
+Uses a B-tree of chunks up to 512 bytes, buffered consecutive insertions,
+zero-copy chunk reads, and optional custom monoidal summaries.
+
+## Quick start
+
+Requires GHC 9.4+. Add `nano-rope` and `text` to your Cabal `build-depends`.
+
+```haskell
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Text.NanoRope (Rope, Unit (..), Position (..))
+import qualified Data.Text.NanoRope as Rope
+
+document :: Rope
+document = Rope.fromText "let x = \"😀\"\nlet y = x\n"
+
+edited = Rope.replace Lines 1 2 "let z = x\n" document
+-- document remains valid
+
+line = Rope.getLine 1 edited                          -- "let z = x"
+size = Rope.length Utf16 document                     -- 23
+byte = Rope.convert Utf16 Bytes 11 document           -- 13
+pos  = Rope.offsetToPosition Bytes Utf16 17 document   -- Position 1 2
+```
+
+## Coordinates
+
+| Unit | Meaning |
+| --- | --- |
+| `Bytes` | UTF-8 bytes |
+| `Chars` | Unicode code points, not graphemes or display columns |
+| `Utf16` | UTF-16 code units; LSP's default position encoding |
+| `Lines` | Line starts; `length Lines` counts `\n` characters |
+
+- Offsets are zero-based and clamped. Offsets inside a code point round down.
+- Ranges are half-open; both endpoints refer to the original rope. If `j <= i`,
+  slicing is empty, deletion does nothing, and replacement inserts at `i`.
+- `Position` is a zero-based line and column, with the column unit supplied
+  separately. Columns clamp before `\n` or `\r\n`; lines past the document
+  clamp to its end. Negative lines and columns clamp to zero. Only `\n` starts
+  a new line.
+- `getLine` strips the terminator and returns empty text for invalid indices.
+  `lineCount` includes the final, possibly empty line. `lines` omits that empty
+  trailing line and returns `[]` for an empty rope.
+
+For multiple coordinates, reuse `metricsAtPosition`, or
+`metricsAtLineAndPosition` for both line-start and position metrics. Subtract
+their `bytes`, `chars`, or `utf16Units` fields to get columns.
+
+## Reading and writing
+
+- `chunkAt` returns a zero-copy view of the remaining chunk at an offset.
+- `foldlChunks'` / `foldrChunks` traverse chunks; `toChunks` / `toLazyText`
+  share their buffers. `toText` copies unless the rope fits in one chunk.
+- `hPutUtf8` / `writeFileUtf8` stream UTF-8, preserving bytes and line endings
+  regardless of handle encoding or newline translation.
+
+## Custom measures
+
+`Data.Text.NanoRope.Measured` provides `Rope m` with cached monoidal summaries.
+Implement `Measure.measureChunk`, then use `measure` to read the summary or
+`splitWhere` to search by it. Measures must obey:
+
+```haskell
+measureChunk (a <> b) == measureChunk a <> measureChunk b
+measureChunk mempty   == mempty
+```
+
+Search predicates must stay true once true for a growing prefix. Pairs and
+triples of measures are supported. `measured` / `unmeasured` in the plain
+module rebuild annotations while sharing text buffers.
+
+## Performance
+
+For `n` document bytes and `k` inserted or returned bytes:
+
+| Operation | Cost |
+| --- | --- |
+| `null`, `length`, `metrics`, `lineCount`; settled `measure` | `O(1)` |
+| Tree edits, slices, lookups, coordinate conversions, searches | `O(log n)` |
+| `insert`, `replace`, `getLine`, `sliceText` | `O(log n + k)` |
+| Construction, flattening, chunk traversal, UTF-8 output | `O(n)` |
+
+Bounds assume constant-time measure combination and search predicates, and
+linear-time chunk measurement. Consecutive insertions can use a bounded
+buffer; tree reads flush it, while `length` and `metrics` do not.
+
+Scans use SSE2/AVX2 on supported x86-64 systems, portable C elsewhere, and
+Haskell for short scans. Build with `-f -simd` for Haskell-only scans.
+
+### Benchmarks
+
+GHC 9.14.1, about 4 MB / 100,000 lines of generated source. A fresh rope retains
+4.55 MB for 4.03 MB of text; after 10,000 random inserts, 4.60 MB. Retaining
+older versions uses additional memory. Construction and flattening usually
+copy the text.
+
+![Timings, allocation, and live heap: nano-rope, text-rope, yi-rope, core-text](bench/results.svg)
+
+[Raw results](bench/results.csv) · [Benchmark source](bench/Main.hs) ·
+[Language-server workloads](bench/Lsp.hs) (edits, completion, tokens, positions).
+Results vary with hardware, compiler, and document shape.
+
+## Development
+
+```sh
+cabal test
+cabal test -f -simd
+cabal haddock
+cabal bench
+```
+
+Regenerate the comparison chart and CSV:
+
+```sh
+cabal bench -f compare-text-rope -f compare-yi-rope -f compare-core-text --benchmark-options="--chart bench/results.svg"
+```
+
+Add `--redraw` inside `--benchmark-options` to reuse CSV timings and allocations;
+live heap is measured again.

@@ -0,0 +1,510 @@+-- | Render benchmark timings, allocation, and retained heap as an SVG chart.
+-- Timings and allocation come from tasty-bench's CSV output.
+module Chart
+  ( Chart (..)
+  , Group (..)
+  , Row (..)
+  , Sample (..)
+  , Footprint (..)
+  , readSamples
+  , render
+  , showBytes
+  , commas
+  ) where
+
+import Data.List (find, intercalate, nub, unfoldr)
+import Numeric (showFFloat)
+
+-- | One benchmark: a workload run on a library.
+data Sample = Sample
+  { sampleWorkload :: String
+  , sampleLibrary :: String
+  , sampleSeconds :: Double
+  , sampleAllocated :: Maybe Double
+  -- ^ Bytes allocated per run, when the RTS keeps statistics.
+  }
+
+-- | Retained heap for a document in a given state.
+data Footprint = Footprint
+  { footprintState :: String
+  , footprintLibrary :: String
+  , footprintBytes :: Double
+  }
+
+-- | One chart row with a label and (state, workload) pairs. State labels
+-- are hidden when the row has only one run.
+data Row = Row String [(String, String)]
+
+data Group = Group String [Row]
+
+data Chart = Chart
+  { chartTitle :: String
+  , chartSubtitle :: String
+  , chartNotes :: [String]
+  , chartLibraries :: [String]
+  -- ^ All known libraries, with the subject first. Order keeps colours and
+  -- shapes consistent even when only some libraries run.
+  , chartGroups :: [Group]
+  -- ^ Workload groups. Ungrouped results appear in an additional section.
+  , chartSamples :: [Sample]
+  , chartSkipped :: [(String, String)]
+  -- ^ Workload/library pairs omitted because of run time.
+  , chartTextHeap :: Maybe Double
+  -- ^ The live heap of the document as one plain 'Data.Text.Text'.
+  , chartFootprints :: [Footprint]
+  }
+
+------------------------------------------------------------------------------
+-- Reading
+
+-- | The rows of tasty-bench's CSV file, named @All.<group>.<workload>.<library>@.
+readSamples :: String -> [Sample]
+readSamples = concatMap sample . drop 1 . csvRows
+  where
+    sample (name : mean : _ : rest) =
+      [ Sample
+          { sampleWorkload = snd (breakLast path)
+          , sampleLibrary = library
+          , sampleSeconds = read mean / 1e12
+          , sampleAllocated = case rest of
+              allocated : _ -> Just (read allocated)
+              [] -> Nothing
+          }
+      ]
+      where
+        (path, library) = breakLast name
+    sample _ = []
+    breakLast s = let (b, a) = break (== '.') (reverse s) in (reverse (drop 1 a), reverse b)
+
+csvRows :: String -> [[String]]
+csvRows [] = []
+csvRows s = let (row, rest) = fields s in row : csvRows rest
+  where
+    fields xs = case field xs of
+      (f, ',' : more) -> let (fs, r) = fields more in (f : fs, r)
+      (f, '\r' : '\n' : more) -> ([f], more)
+      (f, '\n' : more) -> ([f], more)
+      (f, _) -> ([f], [])
+    field ('"' : xs) = quoted xs
+    field xs = break (`elem` ",\r\n") xs
+    quoted ('"' : '"' : xs) = let (f, r) = quoted xs in ('"' : f, r)
+    quoted ('"' : xs) = ([], xs)
+    quoted (c : xs) = let (f, r) = quoted xs in (c : f, r)
+    quoted [] = ([], [])
+
+------------------------------------------------------------------------------
+-- Layout
+
+-- | Column positions for labels, plots, and relative performance factors.
+width, margin, stateX, timeX0, timeX1, allocX0, allocX1, factorX :: Double
+width = 900
+margin = 20
+stateX = 222
+timeX0 = 236
+timeX1 = 526
+allocX0 = 552
+allocX1 = 712
+factorX = 812
+
+-- | Rows of runs.
+runH, rowPad :: Double
+runH = 24
+rowPad = 6
+
+-- | A block's height and a renderer taking its top coordinate.
+type Block = (Double, Double -> [String])
+
+stack :: Double -> [Block] -> (Double, [String])
+stack y [] = (y, [])
+stack y ((h, draw) : blocks) = let (end, rest) = stack (y + h) blocks in (end, draw y ++ rest)
+
+render :: Chart -> String
+render c =
+  concat $
+    [ "<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"0 0 " ++ num width ++ " " ++ num height
+        ++ "\" width=\"" ++ num width ++ "\" height=\"" ++ num height
+        ++ "\" role=\"img\" aria-label=\"" ++ escape (chartTitle c) ++ "\">"
+    , tag "title" [] [escape (chartTitle c)]
+    , tag "style" [] [style]
+    , tag "rect" [("class", "bg"), ("width", "100%"), ("height", "100%"), ("rx", "10")] []
+    ]
+      ++ body
+      ++ ["</svg>\n"]
+  where
+    (bottom, body) = stack 0 (header c : timePanel c ++ memoryPanel c ++ [notes c])
+    height = bottom + 16
+
+-- | Light and dark palettes. Distinct marker shapes provide an additional
+-- way to identify libraries without relying on colour alone.
+style :: String
+style =
+  concat
+    [ "svg{font-family:system-ui,-apple-system,\"Segoe UI\",Roboto,sans-serif;"
+    , "--surface:#fcfcfb;--ink:#0b0b0b;--ink2:#52514e;--muted:#898781;--grid:#e8e7e1;--axis:#c3c2b7;--rule:#d6d5ce;"
+    , "--hover:rgba(11,11,11,.04);--s0:#2a78d6;--s1:#e87ba4;--s2:#eda100;--s3:#008300}"
+    , "@media (prefers-color-scheme:dark){svg{"
+    , "--surface:#1a1a19;--ink:#fff;--ink2:#c3c2b7;--muted:#898781;--grid:#262624;--axis:#44443f;--rule:#383835;"
+    , "--hover:rgba(255,255,255,.05);--s0:#3987e5;--s1:#d55181;--s2:#c98500;--s3:#008300}}"
+    , ".bg{fill:var(--surface)}"
+    , "text{fill:var(--ink2);font-size:12.5px}"
+    , ".t{fill:var(--ink);font-size:20px;font-weight:650;letter-spacing:-.01em}"
+    , ".st{font-size:12.5px}"
+    , ".gh{fill:var(--ink);font-size:13px;font-weight:650}"
+    , ".ch{fill:var(--ink);font-size:11.5px;font-weight:600}"
+    , ".rl{fill:var(--ink)}"
+    , ".sl{fill:var(--muted);font-size:11px}"
+    , ".k{fill:var(--muted);font-size:10.5px;font-variant-numeric:tabular-nums}"
+    , ".q{fill:var(--ink);font-size:15px;font-weight:650;font-variant-numeric:tabular-nums}"
+    , ".q.w{fill:var(--ink2);font-weight:500}"
+    , ".qw{fill:var(--muted);font-size:11px;font-weight:400}"
+    , ".n{fill:var(--muted);font-size:11.5px}"
+    , ".g{stroke:var(--grid);stroke-width:1}"
+    , ".a{stroke:var(--axis);stroke-width:1}"
+    , ".ru{stroke:var(--rule);stroke-width:1}"
+    , ".c{stroke:var(--axis);stroke-width:2;stroke-linecap:round}"
+    , ".m{stroke:var(--surface);stroke-width:4;paint-order:stroke;stroke-linejoin:round}"
+    , ".s0{fill:var(--s0)}.s1{fill:var(--s1)}.s2{fill:var(--s2)}.s3{fill:var(--s3)}"
+    , ".o{stroke-width:1.5;paint-order:normal}"
+    , ".o.s0{fill:var(--surface);stroke:var(--s0)}.o.s1{fill:var(--surface);stroke:var(--s1)}"
+    , ".o.s2{fill:var(--surface);stroke:var(--s2)}.o.s3{fill:var(--surface);stroke:var(--s3)}"
+    , ".hit{fill:transparent}.run:hover .hit{fill:var(--hover)}"
+    ]
+
+-- | Libraries present in the results, paired with their stable palette slot.
+present :: Chart -> [(Int, String)]
+present c =
+  [ (i, l)
+  | (i, l) <- zip [0 ..] (chartLibraries c)
+  , l `elem` map sampleLibrary (chartSamples c) ++ map footprintLibrary (chartFootprints c)
+  ]
+
+subject :: Chart -> String
+subject c = case chartLibraries c of
+  l : _ -> l
+  [] -> ""
+
+header :: Chart -> Block
+header c =
+  ( 112
+  , \y ->
+      [ text margin (y + 40) [("class", "t")] (chartTitle c)
+      , text margin (y + 62) [("class", "st")] (chartSubtitle c)
+      ]
+        ++ legend (y + 92)
+  )
+  where
+    legend y = go margin (present c)
+      where
+        go _ [] = []
+        go x ((i, l) : rest) =
+          mark i (x + 6) (y - 4)
+            : text (x + 18) y [("class", "rl")] l
+            : go (x + 18 + 7.2 * fromIntegral (length l) + 26) rest
+
+notes :: Chart -> Block
+notes c = (28 + 17 * fromIntegral (length ls), \y -> rule y : [text margin (y + 30 + 17 * i) [("class", "n")] l | (i, l) <- zip [0 ..] ls])
+  where
+    ls = concatMap (wrapAt 118) (chartNotes c)
+
+rule :: Double -> String
+rule y = line margin y (width - margin) y "ru"
+
+groupHeading :: String -> Block
+groupHeading title = (38, \y -> [text margin (y + 27) [("class", "gh")] title])
+
+------------------------------------------------------------------------------
+-- Time and allocation
+
+-- | Configured groups followed by any ungrouped workloads.
+groups :: Chart -> [Group]
+groups c = chartGroups c ++ [Group "Other" [Row w [("", w)] | w <- rest] | not (null rest)]
+  where
+    placed = [w | Group _ rows <- chartGroups c, Row _ runs <- rows, (_, w) <- runs]
+    rest = filter (`notElem` placed) (nub (map sampleWorkload (chartSamples c)))
+
+timePanel :: Chart -> [Block]
+timePanel c
+  | null samples = []
+  | otherwise = [(headH + sum (map fst items) + footH, draw)]
+  where
+    samples = chartSamples c
+    headH = 58
+    footH = 30
+    items =
+      concat
+        [ groupHeading title : map (timeRow c times bytes) rows
+        | Group title all' <- groups c
+        , let rows = filter (any (`elem` map sampleWorkload samples) . map snd . runs) all'
+        , not (null rows)
+        ]
+    runs (Row _ rs) = rs
+    times = decades (map sampleSeconds samples)
+    allocs = [a | s <- samples, Just a <- [sampleAllocated s], a > 0]
+    bytes = decades allocs
+
+    draw y =
+      [ rule (y + 4)
+      , text timeX0 (y + 26) [("class", "ch")] "Time per run"
+      , text factorX (y + 26) [("class", "ch"), ("text-anchor", "end")] (subject c ++ " against")
+      , text factorX (y + 40) [("class", "ch"), ("text-anchor", "end")] "the fastest other"
+      ]
+        ++ logAxis times timeTick (timeX0, timeX1) (y + 46) (y + headH) bottom (bottom + 18)
+        ++ ( if null allocs
+               then []
+               else
+                 text allocX0 (y + 26) [("class", "ch")] "Allocated per run"
+                   : logAxis bytes byteTick (allocX0, allocX1) (y + 46) (y + headH) bottom (bottom + 18)
+           )
+        ++ snd (stack (y + headH) items)
+      where
+        bottom = y + headH + sum (map fst items)
+
+timeRow :: Chart -> (Int, Int) -> (Int, Int) -> Row -> Block
+timeRow c times bytes (Row label runs) =
+  (fromIntegral (length runs) * runH + rowPad, \y -> concat [drawRun (y + rowPad / 2 + runH * fromIntegral k) k r | (k, r) <- zip [0 ..] runs])
+  where
+    shown = length runs > 1
+    drawRun y k (state, w) =
+      [ "<g class=\"run\">"
+      , tag "title" [] [escape tip]
+      , hit y runH
+      ]
+        ++ [text margin (cy + 4) [("class", "rl")] label | k == (0 :: Int)]
+        ++ [text stateX (cy + 4) [("class", "sl"), ("text-anchor", "end")] state | shown]
+        ++ dots cy [(i, logX times (timeX0, timeX1) (sampleSeconds s)) | (i, s) <- got]
+        ++ [mark' "m o" i (timeX1 - 1) cy | (i, l) <- present c, (w, l) `elem` chartSkipped c, i `notElem` map fst got]
+        ++ factor cy "faster" "slower" [(sampleSeconds s, others) | (0, s) <- got]
+        ++ dots cy [(i, logX bytes (allocX0, allocX1) a) | (i, s) <- got, Just a <- [sampleAllocated s], a > 0]
+        ++ ["</g>"]
+      where
+        cy = y + runH / 2
+        cells = [(i, l, find (\s -> sampleWorkload s == w && sampleLibrary s == l) (chartSamples c)) | (i, l) <- present c]
+        got = [(i, s) | (i, _, Just s) <- cells]
+        others = [sampleSeconds s | (i, s) <- got, i /= 0]
+        tip =
+          unlines $
+            (label ++ (if null state then "" else ", " ++ state))
+              : [ l ++ ": " ++ maybe (if (w, l) `elem` chartSkipped c then "omitted: run time" else "not benchmarked") describe s
+                | (_, l, s) <- cells
+                ]
+        describe s = showSeconds (sampleSeconds s) ++ maybe "" (\a -> ", " ++ showBytes a ++ " allocated") (sampleAllocated s)
+
+-- | Logarithmic gridlines with labels above and below the panel, spaced
+-- to avoid overlapping text.
+logAxis :: (Int, Int) -> (Int -> String) -> (Double, Double) -> Double -> Double -> Double -> Double -> [String]
+logAxis scale@(lo, hi) label (x0, x1) topLabelY top bottom bottomLabelY =
+  line x0 top x1 top "a"
+    : line x0 bottom x1 bottom "a"
+    : concat
+      [ line x top x bottom "g"
+          : concat
+            [ [ text x topLabelY [("class", "k"), ("text-anchor", "middle")] (label k)
+              , text x bottomLabelY [("class", "k"), ("text-anchor", "middle")] (label k)
+              ]
+            | k `mod` every == 0
+            ]
+      | k <- [lo .. hi]
+      , let x = logX scale (x0, x1) (10 ^^ k)
+      ]
+  where
+    perDecade = (x1 - x0) / fromIntegral (hi - lo)
+    every = case [e | e <- [1, 2, 3, 6], perDecade * fromIntegral e >= 46] of
+      e : _ -> e
+      [] -> 6 :: Int
+
+decades :: [Double] -> (Int, Int)
+decades [] = (0, 1)
+decades vs = (lo, max (lo + 1) (ceiling (logBase 10 (maximum vs))))
+  where
+    lo = floor (logBase 10 (minimum vs))
+
+logX :: (Int, Int) -> (Double, Double) -> Double -> Double
+logX (lo, hi) (x0, x1) v = x0 + (logBase 10 v - fromIntegral lo) / fromIntegral (hi - lo) * (x1 - x0)
+
+timeTick, byteTick :: Int -> String
+timeTick k = seconds num (10 ^^ k)
+byteTick k = trimBytes (10 ^^ k)
+
+------------------------------------------------------------------------------
+-- Memory
+
+memoryPanel :: Chart -> [Block]
+memoryPanel c
+  | null fps = []
+  | otherwise = [groupHeading "Memory", (headH + rowH + footH, draw)]
+  where
+    fps = chartFootprints c
+    headH = 46
+    footH = maybe 8 (const 26) (chartTextHeap c)
+    states = nub (map footprintState fps)
+    rowH = fromIntegral (length states) * runH + rowPad
+    top = niceTop (maximum (map footprintBytes fps ++ maybe [] pure (chartTextHeap c)))
+    step = niceStep top
+    x0 = timeX0
+    x1 = allocX1
+    x v = x0 + v / top * (x1 - x0)
+
+    draw y =
+      [ text factorX (y + 8) [("class", "ch"), ("text-anchor", "end")] (subject c ++ " against")
+      , text factorX (y + 22) [("class", "ch"), ("text-anchor", "end")] "the smallest other"
+      , line x0 (y + headH) x1 (y + headH) "a"
+      , line x0 bottom x1 bottom "a"
+      ]
+        ++ concat
+          [ [ line (x v) (y + headH) (x v) bottom "g"
+            , text (x v) (y + headH - 8) [("class", "k"), ("text-anchor", "middle")] (trimBytes v)
+            ]
+          | v <- takeWhile (<= top * 1.0001) (iterate (+ step) 0)
+          ]
+        ++ reference
+        ++ concat [drawRun (y + headH + rowPad / 2 + runH * fromIntegral k) k st | (k, st) <- zip [0 ..] states]
+      where
+        bottom = y + headH + rowH
+        reference = case chartTextHeap c of
+          Nothing -> []
+          Just t ->
+            [ line (x t) (y + headH) (x t) (bottom + 5) "c"
+            , text (x t) (bottom + 19) [("class", "k"), ("text-anchor", "middle")] ("the Text alone, " ++ showBytes t)
+            ]
+
+    drawRun y k st =
+      [ "<g class=\"run\">"
+      , tag "title" [] [escape tip]
+      , hit y runH
+      ]
+        ++ [text margin (cy + 4) [("class", "rl")] "Live heap" | k == (0 :: Int)]
+        ++ [text stateX (cy + 4) [("class", "sl"), ("text-anchor", "end")] st | length states > 1]
+        ++ dots cy [(i, x b) | (i, b) <- got]
+        ++ factor cy "smaller" "larger" [(b, [o | (i, o) <- got, i /= 0]) | (0, b) <- got]
+        ++ ["</g>"]
+      where
+        cy = y + runH / 2
+        cells = [(i, l, find (\f -> footprintState f == st && footprintLibrary f == l) fps) | (i, l) <- present c]
+        got = [(i, footprintBytes f) | (i, _, Just f) <- cells]
+        tip =
+          unlines $
+            ("Live heap, " ++ st)
+              : [l ++ ": " ++ maybe "not measured" (showBytes . footprintBytes) f | (_, l, f) <- cells]
+              ++ maybe [] (\t -> ["the Text alone: " ++ showBytes t]) (chartTextHeap c)
+
+niceTop :: Double -> Double
+niceTop v = niceStep v * fromIntegral (ceiling (v / niceStep v) :: Int)
+
+-- | A round step that cuts the range into at most six parts.
+niceStep :: Double -> Double
+niceStep v = case [s | s <- map (* 10 ^^ p) [1, 2, 2.5, 5], v / s <= 6] of
+  s : _ -> s
+  [] -> 10 ^^ (p + 1)
+  where
+    p = floor (logBase 10 v) - 1 :: Int
+
+------------------------------------------------------------------------------
+-- Marks
+
+-- | Connect a run's smallest and largest values, then draw its markers.
+-- Draw the subject last so it remains visible when markers overlap.
+dots :: Double -> [(Int, Double)] -> [String]
+dots _ [] = []
+dots cy ms =
+  [line (minimum xs) cy (maximum xs) cy "c" | length ms > 1]
+    ++ [mark i x cy | (i, x) <- reverse ms]
+  where
+    xs = map snd ms
+
+-- | A filled shape in the colour of a slot, ringed with the surface.
+mark :: Int -> Double -> Double -> String
+mark = mark' "m"
+
+mark' :: String -> Int -> Double -> Double -> String
+mark' cls0 i x y = case i `mod` 4 of
+  0 -> tag "circle" [cls, ("cx", num x), ("cy", num y), ("r", "5.5")] []
+  1 -> tag "rect" [cls, ("x", num (x - 4.75)), ("y", num (y - 4.75)), ("width", "9.5"), ("height", "9.5"), ("rx", "1.5")] []
+  2 -> polygon [(x, y - 6.5), (x + 6.5, y), (x, y + 6.5), (x - 6.5, y)]
+  _ -> polygon [(x, y - 6.5), (x + 6.5, y + 5), (x - 6.5, y + 5)]
+  where
+    cls = ("class", cls0 ++ " s" ++ show i)
+    polygon ps = tag "polygon" [cls, ("points", unwords [num px ++ "," ++ num py | (px, py) <- ps])] []
+
+-- | Ratio to the lowest comparison value, with differences below 5%
+-- labelled as approximately equal.
+factor :: Double -> String -> String -> [(Double, [Double])] -> [String]
+factor cy better worse cmp = case cmp of
+  [(mine, others@(_ : _))] ->
+    let f = minimum others / mine
+        (cls, n, s)
+          | f >= 1.05 = ("q", times f, better)
+          | f <= 1 / 1.05 = ("q w", times (1 / f), worse)
+          | otherwise = ("q w", "1.0×", "on par")
+     in [ text factorX (cy + 5) [("class", cls), ("text-anchor", "end")] n
+        , text (factorX + 6) (cy + 4) [("class", "qw")] s
+        ]
+  [(_, [])] -> [text factorX (cy + 4) [("class", "qw"), ("text-anchor", "end")] "no comparison"]
+  _ -> []
+  where
+    times x
+      | x >= 10 = commas (round x) ++ "×"
+      | otherwise = showFFloat (Just 1) x "×"
+
+hit :: Double -> Double -> String
+hit y h = tag "rect" [("class", "hit"), ("x", num (margin - 8)), ("y", num y), ("width", num (width - 2 * margin + 16)), ("height", num h), ("rx", "4")] []
+
+-- | Wrap at word boundaries. A single word longer than the limit stays intact.
+wrapAt :: Int -> String -> [String]
+wrapAt n = go . words
+  where
+    go [] = []
+    go (w : ws) = let (l, rest) = fill w ws in l : go rest
+    fill l (w : ws) | length l + 1 + length w <= n = fill (l ++ " " ++ w) ws
+    fill l ws = (l, ws)
+
+------------------------------------------------------------------------------
+-- SVG and numbers
+
+tag :: String -> [(String, String)] -> [String] -> String
+tag name attrs [] = "<" ++ name ++ attributes attrs ++ "/>"
+tag name attrs body = "<" ++ name ++ attributes attrs ++ ">" ++ concat body ++ "</" ++ name ++ ">"
+
+attributes :: [(String, String)] -> String
+attributes = concatMap (\(k, v) -> ' ' : k ++ "=\"" ++ escape v ++ "\"")
+
+text :: Double -> Double -> [(String, String)] -> String -> String
+text x y attrs s = tag "text" (("x", num x) : ("y", num y) : attrs) [escape s]
+
+line :: Double -> Double -> Double -> Double -> String -> String
+line x1 y1 x2 y2 cls = tag "line" [("class", cls), ("x1", num x1), ("y1", num y1), ("x2", num x2), ("y2", num y2)] []
+
+escape :: String -> String
+escape = concatMap $ \ch -> case ch of
+  '&' -> "&amp;"
+  '<' -> "&lt;"
+  '>' -> "&gt;"
+  '"' -> "&quot;"
+  _ -> [ch]
+
+num :: Double -> String
+num v = let s = showFFloat (Just 1) v "" in if drop (length s - 2) s == ".0" then take (length s - 2) s else s
+
+-- | Three significant digits.
+sig :: Double -> String
+sig v = showFFloat (Just (if v >= 100 then 0 else if v >= 10 then 1 else 2)) v ""
+
+-- | Format a quantity in the largest supplied unit with a value of at
+-- least one, falling back to the smallest unit. Units are powers of 1000.
+scaled :: Int -> [String] -> (Double -> String) -> Double -> String
+scaled e0 units shown v = last [shown (scale e) ++ u | (e, u) <- zip [e0, e0 + 3 ..] units, e == e0 || v >= 10 ^^ e]
+  where
+    -- Multiply or divide by an integer scale to avoid reciprocal rounding.
+    scale e = if e < 0 then v * 10 ^^ negate e else v / 10 ^^ e
+
+seconds :: (Double -> String) -> Double -> String
+seconds = scaled (-9) [" ns", " µs", " ms", " s"]
+
+showSeconds, showBytes, trimBytes :: Double -> String
+showSeconds = seconds sig
+showBytes = scaled 0 [" B", " kB", " MB", " GB", " TB"] sig
+-- A round number of bytes, without trailing zeros.
+trimBytes = scaled 0 [" B", " kB", " MB", " GB", " TB"] num
+
+-- | With a comma every three digits.
+commas :: Int -> String
+commas = reverse . intercalate "," . unfoldr (\s -> if null s then Nothing else Just (splitAt 3 s)) . reverse . show

@@ -0,0 +1,342 @@+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Rope workloads modelled on @lsp@ and @haskell-language-server@.
+-- These isolate document operations rather than running a full server.
+--
+-- * @applyChange@ of @Language.LSP.VFS@: two UTF-16 positions to byte
+--   offsets, each checked for landing inside a code point, and a 'replace'.
+-- * @getCompletionPrefix@ of ghcide: read the line after each keystroke.
+-- * The tokenizer of the semantic tokens: where every token of the module
+--   starts and ends, its text, and its columns in UTF-16.
+-- * @positionToCodePointPosition@ and back: convert between GHC's code point
+--   columns and the client's UTF-16 columns.
+-- * @rangeLinesFromVfs@ and @takeLineRange@: read nearby lines for code actions.
+--
+-- The generated document is mostly ASCII with occasional non-ASCII comments.
+--
+-- Compare the combined 'Rope.metricsAtLineAndPosition' lookup with separate
+-- line-start and position lookups, labelled "in two descents". This measures
+-- the effect of using the combined API as well as the underlying rope.
+module Lsp
+  ( LspEnv (..)
+  , mkLspEnv
+  , lspBenchmarks
+  ) where
+
+import Control.DeepSeq (NFData (..))
+import Data.Char (isAlpha, isAlphaNum, ord)
+import qualified Data.List as L
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.NanoRope (Metrics (..), Position (..), Rope, Unit (..))
+import qualified Data.Text.NanoRope as Rope
+import Rand (rands)
+import Test.Tasty.Bench
+
+------------------------------------------------------------------------------
+-- The document and the session
+
+-- | A module: short lines, an accent or an emoji in a comment now and then.
+moduleText :: Int -> Text
+moduleText n = T.concat (zipWith line [0 :: Int ..] (L.take n (rands 5)))
+  where
+    line i r =
+      T.concat
+        [ T.replicate (r `mod` 4) "  "
+        , case r `mod` 7 of
+            0 -> "import qualified Data.Map.Strict as Map"
+            1 -> "  where go acc (x : xs) = go (acc <> render x) xs"
+            2 -> ""
+            _ -> T.concat ["let value", T.pack (show i), " = compute (arg", T.pack (show (r `mod` 1000)), ") Map.empty"]
+        , case r `mod` 97 of
+            0 -> " -- caf\233 \20013\25991 \128512"
+            1 -> " -- na\239ve r\233sum\233"
+            _ -> ""
+        , "\n"
+        ]
+
+-- | A client change: a UTF-16 range and its replacement text.
+data Change = Change !Position !Position !Text
+
+-- | A change, and where it leaves the cursor.
+data Step = Step !Change !Position
+
+instance NFData Change where
+  rnf (Change _ _ t) = rnf t
+
+instance NFData Step where
+  rnf (Step c _) = rnf c
+
+snippets :: [Text]
+snippets =
+  [ "\n  where\n    go acc (x : xs) = go (acc <> render x) xs\n    go acc [] = acc"
+  , " -- TODO: na\239ve, see the r\233sum\233 \128512"
+  , "\nimport qualified Data.Map.Strict as Map"
+  , "\n    , fieldName :: !(Maybe Text)"
+  , "\n\nhelper :: Monad m => Int -> m [Int]\nhelper n = traverse (pure . (+ 1)) [0 .. n]"
+  , " <> mempty"
+  , "\n  let result = fromMaybe defaultValue (Map.lookup key table)\n  pure result"
+  ]
+
+width16 :: Char -> Int
+width16 c = if ord c > 0xFFFF then 2 else 1
+
+utf16Length :: Text -> Int
+utf16Length = T.foldl' (\n c -> n + width16 c) 0
+
+-- | Generate typing at line ends, including occasional typos and backspaces.
+-- Return both the changes and the resulting document to avoid replaying
+-- them during environment setup.
+typing :: Int -> Rope -> ([Step], Rope)
+typing bursts rope0 = go bursts (rands 7) rope0
+  where
+    go :: Int -> [Int] -> Rope -> ([Step], Rope)
+    go n (r1 : r2 : rs) rope
+      | n > 0 =
+          let line = r1 `mod` Rope.lineCount rope
+              col = utf16Length (Rope.getLine line rope)
+              steps = keys (T.unpack (snippets !! (r2 `mod` L.length snippets))) (1 :: Int) line col
+              rope' = L.foldl' (\r (Step c _) -> applyChange TwoDescents r c) rope steps
+              (rest, final) = go (n - 1) rs rope'
+           in (steps ++ rest, final)
+    go _ _ rope = ([], rope)
+
+    keys [] _ _ _ = []
+    keys (c : cs) i line col
+      | i `mod` 17 == 0 =
+          Step (Change (Position line col) (Position line col) "x") (Position line (col + 1))
+            : Step (Change (Position line col) (Position line (col + 1)) "") (Position line col)
+            : keys (c : cs) (i + 1) line col
+      | c == '\n' = Step (Change (Position line col) (Position line col) "\n") (Position (line + 1) 0) : keys cs (i + 1) (line + 1) 0
+      | otherwise =
+          let col' = col + width16 c
+           in Step (Change (Position line col) (Position line col) (T.singleton c)) (Position line col') : keys cs (i + 1) line col'
+
+-- | Generate a batch of rename-like edits in reverse document order.
+renaming :: Int -> Text -> [Change]
+renaming edits text =
+  [ Change (Position l 2) (Position l 6) "renamedIdentifier"
+  | l <- L.reverse (L.nub (L.sort [candidates !! (r `mod` L.length candidates) | r <- L.take edits (rands 11)]))
+  ]
+  where
+    candidates = [l | (l, line) <- zip [0 ..] (T.lines text), T.length line >= 8, T.all (< '\x80') line]
+
+-- | A token's line, start and end code point columns, and UTF-16 start column.
+data Token = Token !Int !Int !Int !Int
+
+instance NFData Token where
+  rnf !_ = ()
+
+tokens :: Text -> [Token]
+tokens text = concat (zipWith (\l -> go l 0 0) [0 ..] (T.lines text))
+  where
+    go l !col !col16 t =
+      let (skipped, rest) = T.break (\c -> isAlpha c || c == '_') t
+          (word, rest') = T.span (\c -> isAlphaNum c || c == '_' || c == '\'') rest
+          from = col + T.length skipped
+          from16 = col16 + utf16Length skipped
+          to = from + T.length word
+       in if T.null word
+            then []
+            else Token l from to from16 : go l to (from16 + utf16Length word) rest'
+
+------------------------------------------------------------------------------
+-- Language.LSP.VFS
+
+-- | Combined or separate lookups for a position and its line start.
+data Asking
+  = -- | 'Rope.metricsAtLineAndPosition'.
+    OneDescent
+  | -- | 'Rope.metricsAtPosition' and 'Rope.metricsAt', each on its own.
+    TwoDescents
+
+lineAndPosition :: Asking -> Unit -> Position -> Rope -> (Metrics, Metrics)
+lineAndPosition OneDescent u pos rope = Rope.metricsAtLineAndPosition u pos rope
+lineAndPosition TwoDescents u pos rope = (Rope.metricsAt Lines (posLine pos) rope, Rope.metricsAtPosition u pos rope)
+{-# INLINE lineAndPosition #-}
+
+-- | The byte offset of a position in UTF-16 code units, or 'Nothing' if it
+-- lies within a code point.
+utf16PositionToBytes :: Asking -> Position -> Rope -> Maybe Int
+utf16PositionToBytes asking pos@(Position l c) str
+  | reached line loc == c = Just (bytes loc)
+  -- Short of the column: clamped to the end of the line, or rounded down to
+  -- the start of a surrogate pair, the end of which is then one further.
+  | uncurry reached (lineAndPosition asking Utf16 (Position l (c + 1)) str) == c + 1 = Nothing
+  | otherwise = Just (bytes loc)
+  where
+    (line, loc) = lineAndPosition asking Utf16 pos str
+    reached from m = utf16Units m - utf16Units from
+{-# INLINE utf16PositionToBytes #-}
+
+applyChange :: Asking -> Rope -> Change -> Rope
+applyChange asking str (Change start finish new) = case asking of
+  -- An insertion starts where it finishes, and is asked for once.
+  OneDescent | start == finish -> case utf16PositionToBytes asking start str of
+    Nothing -> str
+    Just i -> Rope.replace Bytes i i new str
+  _ -> case utf16PositionToBytes asking finish str of
+    Nothing -> str
+    Just j -> case utf16PositionToBytes asking start str of
+      Nothing -> str
+      Just i -> Rope.replace Bytes (min i j) j new str
+{-# INLINE applyChange #-}
+
+lineBounds :: Rope -> Int -> Maybe (Metrics, Metrics)
+lineBounds rope l
+  | l < Rope.lineCount rope = Just (Rope.metricsAt Lines l rope, Rope.metricsAt Lines (l + 1) rope)
+  | otherwise = Nothing
+
+-- | Convert column units, returning 'Nothing' for an invalid column or one
+-- inside a code point. Content positions use the combined lookup; positions
+-- at line endings need an additional bounds check.
+convertPosition :: Unit -> Unit -> Asking -> Rope -> Position -> Maybe Position
+convertPosition from to OneDescent text pos@(Position l c)
+  | (line, loc) <- Rope.metricsAtLineAndPosition from pos text
+  , newlines line == l
+  , Rope.count from loc - Rope.count from line == c =
+      Just (Position l (Rope.count to loc - Rope.count to line))
+convertPosition from to _ text (Position l c) = do
+  (lineStart, lineEnd) <- lineBounds text l
+  let target = Rope.count from lineStart + c
+      loc = Rope.metricsAt from target text
+  if target <= Rope.count from lineEnd && Rope.count from loc == target
+    then Just (Position l (Rope.count to loc - Rope.count to lineStart))
+    else Nothing
+{-# INLINE convertPosition #-}
+
+rangeLines :: Rope -> Int -> Int -> Text
+rangeLines rope lf lt = Rope.sliceText Lines lf lt rope
+
+------------------------------------------------------------------------------
+-- ghcide and the plugins
+
+takeLineRange :: Int -> Int -> Rope -> [Text]
+takeLineRange from to rope
+  | to < from = []
+  | otherwise = Rope.lines (Rope.slice Lines from (to + 1) rope)
+
+-- | Read a line, excluding an empty final line after a trailing terminator.
+lineAt :: Asking -> Int -> Rope -> Maybe Text
+lineAt OneDescent line rope
+  | line < lastLine || line == lastLine && not (T.null text) = Just text
+  | otherwise = Nothing
+  where
+    lastLine = Rope.lineCount rope - 1
+    text = Rope.getLine line rope
+lineAt TwoDescents line rope
+  | Rope.convert Lines Bytes line rope < Rope.length Bytes rope = Just (Rope.getLine line rope)
+  | otherwise = Nothing
+{-# INLINE lineAt #-}
+
+-- | Read the identifier prefix used for completion after a keystroke.
+completionPrefix :: Asking -> Rope -> Position -> Int
+completionPrefix asking rope (Position l c) = case lineAt asking l rope of
+  Nothing -> 0
+  Just curLine -> T.length (T.takeWhileEnd (\x -> isAlphaNum x || x == '.' || x == '_' || x == '\'') (T.take c curLine))
+
+-- | Locate a valid code point position and its UTF-16 column for token lookup.
+locate :: Asking -> Position -> Rope -> Maybe (Metrics, Int)
+locate asking pos@(Position l c) rpe =
+  let (lineStart, at) = lineAndPosition asking Chars pos rpe
+   in if newlines lineStart == l && chars at - chars lineStart == c
+        then Just (at, utf16Units at - utf16Units lineStart)
+        else Nothing
+{-# INLINE locate #-}
+
+focusToken :: Asking -> Rope -> Token -> Int
+focusToken asking rope (Token l from to _) =
+  case (locate asking (Position l from) rope, locate asking (Position l to) rope) of
+    (Just (tokenStart, ncs), Just (tokenEnd, nce)) ->
+      let token = Rope.sliceText Bytes (bytes tokenStart) (bytes tokenEnd) rope
+       in ncs + nce + T.length token
+    _ -> -1
+
+------------------------------------------------------------------------------
+-- Workloads
+
+-- | Replay changes and run the supplied observer after each one.
+replay :: Asking -> (Rope -> Position -> Int) -> Rope -> [Step] -> Int
+replay asking observe = go 0
+  where
+    go !acc !rope [] = acc + Rope.length Bytes rope
+    go !acc !rope (Step c cursor : steps) =
+      let rope' = applyChange asking rope c
+       in go (acc + observe rope' cursor) rope' steps
+{-# INLINE replay #-}
+
+observeNothing :: Rope -> Position -> Int
+observeNothing rope _ = rope `seq` 1
+
+semanticTokens :: Asking -> Rope -> [Token] -> Int
+semanticTokens asking rope = L.foldl' (\n t -> n + focusToken asking rope t) 0
+{-# INLINE semanticTokens #-}
+
+convertPositions :: Asking -> Rope -> [Position] -> Int
+convertPositions asking rope = L.foldl' step 0
+  where
+    step n p = case convertPosition Utf16 Chars asking rope p of
+      Just cp | Just (Position l c) <- convertPosition Chars Utf16 asking rope cp -> n + l + c
+      _ -> n - 1
+{-# INLINE convertPositions #-}
+
+readLines :: Rope -> [Position] -> Int
+readLines rope = L.foldl' step 0
+  where
+    step n (Position l _) =
+      n + T.length (rangeLines rope l (l + 3)) + sum (map T.length (takeLineRange l (l + 2) rope))
+
+rename :: Asking -> Rope -> [Change] -> Int
+rename asking rope changes = T.length (Rope.toText (L.foldl' (applyChange asking) rope changes))
+{-# INLINE rename #-}
+
+data LspEnv = LspEnv
+  { lspOpened :: !Rope
+  , lspEdited :: !Rope
+  -- ^ Document after the generated typing session.
+  , lspTyping :: ![Step]
+  , lspRenaming :: ![Change]
+  , lspTokens :: ![Token]
+  -- ^ Tokens from the edited document.
+  , lspPositions :: ![Position]
+  -- ^ UTF-16 start positions of every fourth token.
+  }
+
+instance NFData LspEnv where
+  rnf e = rnf (lspTyping e) `seq` rnf (lspRenaming e) `seq` rnf (lspTokens e) `seq` rnf (lspPositions e)
+
+mkLspEnv :: Int -> LspEnv
+mkLspEnv nLines =
+  LspEnv
+    { lspOpened = opened
+    , lspEdited = edited
+    , lspTyping = steps
+    , lspRenaming = renaming 200 text
+    , lspTokens = toks
+    , lspPositions = every 4 [Position l c | Token l _ _ c <- toks]
+    }
+  where
+    text = moduleText nLines
+    opened = Rope.fromText text
+    (steps, edited) = typing 100 opened
+    toks = tokens (Rope.toText edited)
+    every n xs = case xs of
+      [] -> []
+      x : _ -> x : every n (L.drop n xs)
+
+lspBenchmarks :: LspEnv -> [Benchmark]
+lspBenchmarks e =
+  asked OneDescent
+    ++ [ bench "reading lines" $ whnf (readLines (lspEdited e)) (lspPositions e)
+       , bgroup "in two descents" (asked TwoDescents)
+       ]
+  where
+    -- Inlined, so that each workload is compiled for the one way of asking.
+    asked asking =
+      [ bench "typing, the edits alone" $ whnf (replay asking observeNothing (lspOpened e)) (lspTyping e)
+      , bench "typing, completion prefix after each key" $ whnf (replay asking (completionPrefix asking) (lspOpened e)) (lspTyping e)
+      , bench "rename, 200 edits at once" $ whnf (rename asking (lspOpened e)) (lspRenaming e)
+      , bench "semantic tokens" $ whnf (semanticTokens asking (lspEdited e)) (lspTokens e)
+      , bench "position conversions" $ whnf (convertPositions asking (lspEdited e)) (lspPositions e)
+      ]
+    {-# INLINE asked #-}

@@ -0,0 +1,514 @@+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Editor and language-server workloads. Optional @compare-text-rope@,
+-- @compare-yi-rope@, and @compare-core-text@ Cabal flags enable comparisons
+-- for workloads supported by each benchmark adapter.
+--
+-- @--chart FILE.svg@ plots timings, allocation, and retained heap.
+module Main (main) where
+
+import Chart (Chart (..), Footprint (..), Group (..), Row (..), Sample (..), commas, readSamples, render, showBytes)
+import Control.DeepSeq (NFData (..))
+import Control.Exception (throwIO, try)
+import Control.Monad (forM_, unless)
+import qualified Data.List as L
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.NanoRope (Position (..), Unit (..))
+import qualified Data.Text.NanoRope as Nano
+import Data.Text.NanoRope.Internal (kernels, kernelsName)
+import Data.Version (showVersion)
+import GHC.Stats (getRTSStatsEnabled)
+import Lsp (lspBenchmarks, mkLspEnv)
+import Memory (footprint, fresh)
+import Rand (rands)
+import System.Environment (getArgs, withArgs)
+import System.Exit (ExitCode (..))
+import System.IO (IOMode (..), hGetContents', hPutStr, hSetEncoding, utf8, withFile)
+import System.Info (fullCompilerVersion)
+import Test.Tasty.Bench
+import Text.Printf (printf)
+
+#ifdef COMPARE_TEXT_ROPE
+import qualified Data.Text.Rope as TR
+import qualified Data.Text.Utf16.Rope as TR16
+#endif
+
+#ifdef COMPARE_YI_ROPE
+import qualified Yi.Rope as Yi
+#endif
+
+#ifdef COMPARE_CORE_TEXT
+import qualified Core.Text.Rope as CT
+#endif
+
+------------------------------------------------------------------------------
+-- Data
+
+-- | Generated source-like text: short, mostly ASCII lines with occasional
+-- accented characters, CJK characters, and emoji.
+sourceText :: Int -> Text
+sourceText n = T.concat (zipWith line [0 :: Int ..] (L.take n (rands 1)))
+  where
+    line i r =
+      T.concat
+        [ T.replicate (r `mod` 5) "  "
+        , "let value"
+        , T.pack (show i)
+        , " = compute (arg"
+        , T.pack (show (r `mod` 1000))
+        , ")"
+        , case r `mod` 16 of
+            0 -> " -- caf\233 \20013\25991 \128512"
+            1 -> " -- na\239ve r\233sum\233"
+            _ -> ""
+        , "\n"
+        ]
+
+-- | Remove line feeds to model a single-line document such as minified output.
+minified :: Text -> Text
+minified = T.filter (/= '\n')
+
+-- | Three input states: freshly loaded, without line feeds, and after
+-- 10,000 random inserts.
+data Ropes r = Ropes {ropeFresh :: !r, ropeOneLine :: !r, ropeEdited :: !r}
+  deriving (Foldable)
+
+ropes :: (Text -> r) -> ([Int] -> r -> r) -> Text -> [Int] -> Ropes r
+ropes load edit text offsets = Ropes r (load (minified text)) (edit offsets r)
+  where
+    r = load text
+
+data Env = Env
+  { envText :: !Text
+  , envNano :: !(Ropes Nano.Rope)
+  , envChars :: ![Int]
+  -- ^ Random character offsets.
+  , envBursts :: ![(Int, Int)]
+  -- ^ One hundred typing locations, each paired with its line index.
+  , envPositions :: ![Position]
+  -- ^ Random positions with their column in UTF-16 code units.
+  , envByteOffsets :: ![Int]
+#ifdef COMPARE_TEXT_ROPE
+  , envTR :: !(Ropes TR.Rope)
+  , envTR16 :: !TR16.Rope
+#endif
+#ifdef COMPARE_YI_ROPE
+  , envYi :: !(Ropes Yi.YiString)
+#endif
+#ifdef COMPARE_CORE_TEXT
+  , envCT :: !(Ropes CT.Rope)
+#endif
+  }
+
+-- | Force lazy lists and finger trees before timing. The strict record
+-- fields already evaluate the nano-rope and text-rope input trees.
+instance NFData Env where
+  rnf e =
+    rnf (envChars e)
+      `seq` rnf (envBursts e)
+      `seq` rnf (envPositions e)
+      `seq` rnf (envByteOffsets e)
+#ifdef COMPARE_YI_ROPE
+      `seq` foldr (seq . forceYi) () (envYi e)
+#endif
+#ifdef COMPARE_CORE_TEXT
+      `seq` foldr (seq . rnf) () (envCT e)
+#endif
+
+mkEnv :: Int -> Int -> Env
+mkEnv nLines nOps =
+  Env
+    { envText = text
+    , envNano = nano
+    , envChars = offsets
+    , envBursts = [(i, Nano.convert Chars Lines i (ropeFresh nano)) | i <- L.take 100 offsets]
+    , envPositions = [Position (r `mod` nLines) (r `mod` 40) | r <- L.take nOps (rands 3)]
+    , envByteOffsets = [r `mod` (Nano.length Bytes (ropeFresh nano) + 1) | r <- L.take nOps (rands 4)]
+#ifdef COMPARE_TEXT_ROPE
+    , envTR = ropes TR.fromText (edits trOps) text offsets
+    , envTR16 = TR16.fromText text
+#endif
+#ifdef COMPARE_YI_ROPE
+    , envYi = ropes Yi.fromText (edits yiOps) text offsets
+#endif
+#ifdef COMPARE_CORE_TEXT
+    , envCT = ropes ctFromText (edits ctOps) text offsets
+#endif
+    }
+  where
+    text = sourceText nLines
+    nano = ropes Nano.fromText (edits nanoOps) text offsets
+    offsets = editOffsets nOps text
+
+-- | Deterministic code point offsets within the original document.
+editOffsets :: Int -> Text -> [Int]
+editOffsets nOps text = [r `mod` (chars + 1) | r <- L.take nOps (rands 2)]
+  where
+    chars = T.length text
+
+------------------------------------------------------------------------------
+-- Workloads
+
+-- | Named workloads supported by a library's benchmark adapter.
+type Workloads = [(String, Benchmarkable)]
+
+-- | Label a workload on an already-edited rope. Edits change chunk
+-- boundaries, so fresh and edited trees are measured separately.
+afterEdits :: String -> String
+afterEdits w = "after 10k edits, " ++ w
+
+-- | Operations used by the shared workloads. Inlining resolves each
+-- adapter's fields to known functions in the benchmark loops.
+data Ops r = Ops
+  { opLoad :: Text -> Benchmarkable
+  , opToText :: r -> Text
+  , opInsert :: Int -> r -> r
+  -- ^ Insert @x@ at a code point offset.
+  , opDelete :: Int -> r -> r
+  -- ^ Delete the code point at an offset.
+  , opSize :: r -> Int
+  -- ^ Read the length after forcing any pending tree update.
+  , opSplit :: Int -> r -> Int
+  -- ^ Split at a character offset, and look at both halves.
+  , opGetLine :: Maybe (Int -> r -> Text)
+  -- ^ Read a line without its terminator, if supported by the adapter.
+  }
+
+-- | Insert a character at each of the given offsets.
+edits :: Ops r -> [Int] -> r -> r
+edits ops offsets = \r0 -> L.foldl' (flip (opInsert ops)) r0 offsets
+{-# INLINE edits #-}
+
+-- | Type a run of characters starting at each of the given offsets.
+typing :: Ops r -> Int -> [Int] -> r -> Int
+typing ops n offsets = \r0 -> opSize ops (L.foldl' burst r0 offsets)
+  where
+    burst r i = L.foldl' (\acc k -> opInsert ops (i + k) acc) r [0 .. n - 1]
+{-# INLINE typing #-}
+
+-- | Type in bursts and read the line after each key, modelling an editor redraw.
+typingRead :: Ops r -> (Int -> r -> Text) -> [(Int, Int)] -> r -> Int
+typingRead ops lineOf bursts = \r0 -> snd (L.foldl' burst (r0, 0) bursts)
+  where
+    burst acc (i, l) = L.foldl' (key i l) acc [0 .. 99 :: Int]
+    key i l (r, n) k =
+      let r' = opInsert ops (i + k) r
+          !n' = n + T.length (lineOf l r')
+       in (r', n')
+{-# INLINE typingRead #-}
+
+-- | Build shared workloads, excluding unsupported line reads and runs
+-- explicitly omitted because of run time.
+workloads :: Ops r -> [String] -> Ropes r -> Env -> Workloads
+workloads ops tooSlow rs e =
+  filter ((`notElem` tooSlow) . fst) . concat $
+    [ [("fromText", opLoad ops (envText e))]
+    , both "toText" (whnf (opToText ops))
+    , both "10k random inserts" (whnf (opSize ops . edits ops (envChars e)))
+    , both "100 bursts of 100 keystrokes" (whnf (typing ops 100 (L.take 100 (envChars e))))
+    , both "10k keystrokes in one spot" (whnf (typing ops 10000 (L.take 1 (envChars e))))
+    , [("10k random deletes", whnf (\r0 -> opSize ops (L.foldl' (flip (opDelete ops)) r0 (envChars e))) (ropeFresh rs))]
+    , both "10k random splits" (whnf (\r -> L.foldl' (\n i -> n + opSplit ops i r) 0 (envChars e)))
+    , [("one long line, 10k random inserts", whnf (opSize ops . edits ops (envChars e)) (ropeOneLine rs))]
+    , concat
+        [ ("100 bursts of 100 keystrokes, reading the line after each", whnf (typingRead ops lineOf (envBursts e)) (ropeFresh rs))
+            : both "10k getLine" (whnf (\r -> L.foldl' (\n (Position l _) -> n + T.length (lineOf l r)) 0 (envPositions e)))
+        | Just lineOf <- [opGetLine ops]
+        ]
+    ]
+  where
+    -- On the fresh rope and on the edited one.
+    both w run = [(w, run (ropeFresh rs)), (afterEdits w, run (ropeEdited rs))]
+{-# INLINE workloads #-}
+
+nanoOps :: Ops Nano.Rope
+nanoOps =
+  Ops
+    { opLoad = whnf Nano.fromText
+    , opToText = Nano.toText
+    , opInsert = \i -> Nano.insert Chars i "x"
+    , opDelete = \i -> Nano.delete Chars i (i + 1)
+    , -- Include the final buffered insertion in the measured work.
+      opSize = \r -> if T.null (Nano.chunkAt Bytes 0 r) then 0 else Nano.length Chars r
+    , opSplit = \i r -> let (a, b) = Nano.splitAt Chars i r in Nano.length Lines a + Nano.length Lines b
+    , opGetLine = Just Nano.getLine
+    }
+
+nanoWorkloads :: Env -> Workloads
+nanoWorkloads e =
+  workloads nanoOps [] (envNano e) e
+    ++ [ ("10k edits at UTF-16 positions", whnf (opSize nanoOps . lspEdits) rope)
+       , ("10k byte offsets to UTF-16 positions", whnf byteToPosition rope)
+       ]
+  where
+    rope = ropeFresh (envNano e)
+    -- Convert incoming UTF-16 positions to byte offsets and insert there.
+    lspEdits r0 = L.foldl' (\r pos -> Nano.insert Bytes (Nano.positionToOffset Utf16 Bytes pos r) "x" r) r0 (envPositions e)
+    -- Convert byte-based tool results to UTF-16 positions.
+    byteToPosition r = L.foldl' (\n i -> n + posColumn (Nano.offsetToPosition Bytes Utf16 i r)) 0 (envByteOffsets e)
+
+#ifdef COMPARE_TEXT_ROPE
+trOps :: Ops TR.Rope
+trOps =
+  Ops
+    { opLoad = whnf TR.fromText
+    , opToText = TR.toText
+    , opInsert = \i r -> let (a, b) = TR.splitAt (fromIntegral i) r in a <> "x" <> b
+    , opDelete = \i r ->
+        let (a, b) = TR.splitAt (fromIntegral i) r
+            (_, c) = TR.splitAt 1 b
+         in a <> c
+    , opSize = fromIntegral . TR.length
+    , opSplit = \i r -> let (a, b) = TR.splitAt (fromIntegral i) r in lineBreaks a + lineBreaks b
+    , opGetLine = Just (\l -> TR.toText . TR.getLine (fromIntegral l))
+    }
+  where
+    lineBreaks = fromIntegral . TR.posLine . TR.lengthAsPosition
+
+trWorkloads :: Env -> Workloads
+trWorkloads e = workloads trOps [] (envTR e) e ++ [("10k edits at UTF-16 positions", whnf lspEdits (envTR16 e))]
+  where
+    lspEdits r0 = fromIntegral (TR16.length (L.foldl' edit r0 (envPositions e))) :: Int
+    edit r (Position l c) =
+      case TR16.splitAtPosition (TR16.Position (fromIntegral l) (fromIntegral c)) r of
+        Just (a, b) -> a <> "x" <> b
+        Nothing -> r
+#endif
+
+#ifdef COMPARE_YI_ROPE
+-- | Force both the finger tree and its cached newline count before timing.
+forceYi :: Yi.YiString -> ()
+forceYi r = Yi.countNewLines r `seq` rnf r
+
+-- | Construct a rope and evaluate its newline count for line-based workloads.
+yiFromText :: Text -> Yi.YiString
+yiFromText t = let r = Yi.fromText t in Yi.countNewLines r `seq` r
+
+-- | Code point and line operations for the yi-rope adapter.
+yiOps :: Ops Yi.YiString
+yiOps =
+  Ops
+    { opLoad = whnf yiFromText
+    , opToText = Yi.toText
+    , -- Implement insertion through splitting and concatenation.
+      opInsert = \i r -> let (a, b) = Yi.splitAt i r in a <> "x" <> b
+    , opDelete = \i r -> let (a, b) = Yi.splitAt i r in a <> Yi.drop 1 b
+    , opSize = Yi.length
+    , opSplit = \i r -> let (a, b) = Yi.splitAt i r in Yi.countNewLines a + Yi.countNewLines b
+    , opGetLine = Just (\l -> Yi.toText . Yi.takeWhile (/= '\n') . snd . Yi.splitAtLine l)
+    }
+#endif
+
+#ifdef COMPARE_CORE_TEXT
+-- | Wrap the input text in a rope. Benchmark to normal form to account for
+-- lazy tree construction.
+ctFromText :: Text -> CT.Rope
+ctFromText = CT.intoRope
+
+-- | Code point operations for the core-text adapter. Force split results
+-- through their widths; this adapter has no line lookup.
+ctOps :: Ops CT.Rope
+ctOps =
+  Ops
+    { opLoad = nf ctFromText
+    , opToText = CT.fromRope
+    , opInsert = \i -> CT.insertRope i "x"
+    , opDelete = \i r ->
+        let (a, b) = CT.splitRope i r
+            (_, c) = CT.splitRope 1 b
+         in a <> c
+    , opSize = CT.widthRope
+    , opSplit = \i r -> let (a, b) = CT.splitRope i r in CT.widthRope a + CT.widthRope b
+    , opGetLine = Nothing
+    }
+
+-- | Omit fresh-rope workloads where repeated measurement of the initial
+-- large piece made the recorded benchmark impractically slow.
+ctTooSlow :: [String]
+ctTooSlow = ["10k keystrokes in one spot", "10k random splits"]
+#endif
+
+------------------------------------------------------------------------------
+
+-- | The size of the document, and the number of operations in a workload.
+documentLines, workloadOps :: Int
+documentLines = 100000
+workloadOps = 10000
+
+-- | The size of the module of the language server workloads: some 300 kB.
+lspLines :: Int
+lspLines = 8000
+
+-- | A library's name, workloads, and retained-heap measurement action.
+data Library = Library String (Env -> Workloads) ([Int] -> IO [Footprint])
+
+libraries :: [Library]
+libraries =
+  [ Library "nano-rope" nanoWorkloads (measure "nano-rope" Nano.fromText (edits nanoOps) rnf)
+#ifdef COMPARE_TEXT_ROPE
+  , Library "text-rope" trWorkloads (measure "text-rope" TR.fromText (edits trOps) rnf)
+#endif
+#ifdef COMPARE_YI_ROPE
+  , Library "yi-rope" (\e -> workloads yiOps [] (envYi e) e) (measure "yi-rope" yiFromText (edits yiOps) forceYi)
+#endif
+#ifdef COMPARE_CORE_TEXT
+  , Library "core-text" (\e -> workloads ctOps ctTooSlow (envCT e) e) (measure "core-text" ctFromText (edits ctOps) rnf)
+#endif
+  ]
+
+benchmarks :: [Benchmark]
+benchmarks =
+    [ env (pure (mkEnv documentLines workloadOps)) $ \e ->
+        bgroup
+          "100k lines"
+          -- Use nano-rope's workload names and include each available adapter.
+          [ bgroup w [bench name run | Library name have _ <- libraries, Just run <- [lookup w (have e)]]
+          | (w, _) <- nanoWorkloads e
+          ]
+    , -- Model language-server operations on a large module; see "Lsp".
+      env (pure (mkLspEnv lspLines)) $ \e ->
+        bgroup "language server, 8k lines" (lspBenchmarks e)
+    ]
+
+------------------------------------------------------------------------------
+-- The chart
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case chartArgs args of
+    Nothing -> defaultMain benchmarks
+    Just (svg, csv, redraw, rest) -> do
+      stats <- getRTSStatsEnabled
+      unless stats $ putStrLn "No RTS statistics (+RTS -T): leaving memory out."
+      (textHeap, fps) <- if stats then footprints else pure (Nothing, [])
+      forM_ textHeap $ \t -> do
+        putStrLn "Live heap holding the document"
+        printf "  %-10s %s\n" ("Text" :: String) (showBytes t)
+        forM_ fps $ \f ->
+          printf "  %-10s %-8s %s\n" (footprintLibrary f) (footprintState f) (showBytes (footprintBytes f))
+      unless redraw $ do
+        done <- try (withArgs rest (defaultMain benchmarks))
+        case done of
+          Left ExitSuccess -> pure ()
+          Left failure -> throwIO failure
+          Right () -> pure ()
+      -- The comparison chart excludes nano-rope-only language-server runs.
+      -- Their results remain in the CSV.
+      samples <- filter ((`elem` libraryNames) . sampleLibrary) . readSamples <$> withFile csv ReadMode hGetContents'
+      bytes <- Nano.length Bytes . Nano.fromText <$> fresh sourceText documentLines
+      let ran = map sampleLibrary samples ++ map footprintLibrary fps
+          others = filter (`elem` ran) (drop 1 libraryNames)
+      withFile svg WriteMode $ \h -> do
+        hSetEncoding h utf8
+        hPutStr h . render $
+          Chart
+            { chartTitle = "nano-rope benchmarks" ++ (if null others then "" else ": " ++ andList others ++ " comparisons")
+            , chartSubtitle =
+                printf
+                  "%s operations on %s generated lines (%.1f MB), or one Text conversion. GHC %s; %s scans."
+                  (commas workloadOps)
+                  (commas documentLines)
+                  (fromIntegral bytes / 1e6 :: Double)
+                  (showVersion fullCompilerVersion)
+                  (kernelsName (last kernels))
+            , chartNotes =
+                [ "Fresh: built from Text. Edited: after " ++ commas workloadOps
+                    ++ " random inserts. Rows with one run use a fresh rope. Timings depend on hardware, compiler, and document shape."
+                , "Text conversions measure in-memory construction and flattening, not file I/O. Sharing the original buffer can make fresh-rope conversions much cheaper than edited-rope conversions."
+                , "No mark: not implemented by this benchmark adapter. Hollow mark: omitted because of run time. Adapters cover different indexing and line APIs; see bench/Main.hs."
+                , "Live heap: retained bytes after a major collection, with no separate reference to the source Text. Shared input buffers are included. Earlier rope versions are not retained."
+                ]
+            , chartLibraries = libraryNames
+            , chartGroups = chartRows
+            , chartSamples = samples
+            , chartSkipped = skipped
+            , chartTextHeap = textHeap
+            , chartFootprints = fps
+            }
+      putStrLn ("Chart: " ++ svg)
+  where
+    libraryNames = ["nano-rope", "text-rope", "yi-rope", "core-text"]
+    andList [x] = x
+    andList [x, y] = x ++ " and " ++ y
+    andList (x : xs) = x ++ ", " ++ andList xs
+    andList [] = ""
+    skipped =
+#ifdef COMPARE_CORE_TEXT
+      [(w, "core-text") | w <- ctTooSlow]
+#else
+      []
+#endif
+
+-- | Group workloads by operation, pairing fresh and edited runs where available.
+chartRows :: [Group]
+chartRows =
+  [ Group
+      "Text conversion"
+      [ Row "fromText" [("", "fromText")]
+      , inBoth "toText" "toText"
+      ]
+  , Group
+      "Editing"
+      [ inBoth "Random inserts" "10k random inserts"
+      , Row "Random deletes" [("", "10k random deletes")]
+      , Row "Random inserts, one long line" [("", "one long line, 10k random inserts")]
+      , Row "Edits at UTF-16 positions" [("", "10k edits at UTF-16 positions")]
+      ]
+  , Group
+      "Typing"
+      [ inBoth "100 bursts of 100 keystrokes" "100 bursts of 100 keystrokes"
+      , Row "The same, reading the line" [("", "100 bursts of 100 keystrokes, reading the line after each")]
+      , inBoth "10,000 keystrokes in one spot" "10k keystrokes in one spot"
+      ]
+  , Group
+      "Reading"
+      [ inBoth "Random splits" "10k random splits"
+      , inBoth "getLine" "10k getLine"
+      , Row "Byte offsets to UTF-16 positions" [("", "10k byte offsets to UTF-16 positions")]
+      ]
+  ]
+  where
+    inBoth label w = Row label [(freshState, w), (editedState, afterEdits w)]
+
+freshState, editedState :: String
+freshState = "fresh"
+editedState = "edited"
+
+-- | Parse the chart path, CSV path, and redraw flag. The CSV defaults to
+-- the chart path with a @.csv@ extension. @--redraw@ reuses saved timings
+-- and allocation results; live-heap measurements still run.
+chartArgs :: [String] -> Maybe (FilePath, FilePath, Bool, [String])
+chartArgs args = case break (== "--chart") (filter (/= "--redraw") args) of
+  (before, _ : svg : after) ->
+    let rest = before ++ after
+     in Just $ case lookup "--csv" (zip rest (drop 1 rest)) of
+          Just csv -> (svg, csv, redraw, rest)
+          Nothing -> let csv = dropSvg svg ++ ".csv" in (svg, csv, redraw, rest ++ ["--csv", csv])
+  _ -> Nothing
+  where
+    redraw = "--redraw" `elem` args
+    dropSvg f = maybe f reverse (L.stripPrefix "gvs." (reverse f))
+
+------------------------------------------------------------------------------
+-- Memory
+
+-- | Measure retained heap for fresh and edited ropes and for the source 'Text'.
+footprints :: IO (Maybe Double, [Footprint])
+footprints = do
+  offsets <- fresh (\n -> let o = editOffsets workloadOps (sourceText n) in rnf o `seq` o) documentLines
+  text <- footprint sourceText documentLines id rnf
+  fps <- sequence [heap offsets | Library _ _ heap <- libraries]
+  pure (Just text, concat fps)
+
+-- | The heap of a library holding the document, fresh and edited.
+measure :: String -> (Text -> a) -> ([Int] -> a -> a) -> (a -> ()) -> [Int] -> IO [Footprint]
+measure library load edit deep offsets = do
+  loaded <- footprint sourceText documentLines load deep
+  edited <- footprint sourceText documentLines (edit offsets . load) deep
+  pure
+    [ Footprint freshState library loaded
+    , Footprint editedState library edited
+    ]

@@ -0,0 +1,42 @@+-- Prevent full laziness from sharing an input across measurements, which
+-- would undercount the memory retained by later runs.
+{-# OPTIONS_GHC -fno-full-laziness #-}
+
+-- | Measure retained heap with RTS statistics. Requires @+RTS -T@.
+module Memory
+  ( fresh
+  , footprint
+  ) where
+
+import Control.Exception (evaluate)
+import Foreign.StablePtr (freeStablePtr, newStablePtr)
+import GHC.Stats (GCDetails (..), RTSStats (..), getRTSStats)
+import System.Mem (performMajorGC)
+
+-- | Construct and evaluate a fresh input for one measurement.
+fresh :: (n -> a) -> n -> IO a
+fresh make n = evaluate (make n)
+{-# NOINLINE fresh #-}
+
+-- | Live bytes after a major collection.
+liveBytes :: IO Double
+liveBytes = do
+  performMajorGC
+  fromIntegral . gcdetails_live_bytes . gc <$> getRTSStats
+
+-- | Measure additional live bytes while retaining the built value but no
+-- separate reference to its input. Input buffers shared by the result
+-- remain live and are included in the measurement.
+footprint :: (n -> i) -> n -> (i -> a) -> (a -> ()) -> IO Double
+footprint make n build deep = do
+  before <- liveBytes
+  input <- fresh make n
+  let a = build input
+  _ <- evaluate (deep a)
+  -- Keep the builder alive across both measurements so collecting its
+  -- captured inputs cannot reduce the apparent size of the result.
+  keep <- newStablePtr (a, build)
+  after <- liveBytes
+  freeStablePtr keep
+  pure (after - before)
+{-# NOINLINE footprint #-}

@@ -0,0 +1,12 @@+-- | Shared deterministic pseudo-random generator for benchmark documents
+-- and workloads. Seeds keep each input reproducible.
+module Rand (rands) where
+
+import Data.Bits (shiftR)
+import Data.Word (Word64)
+
+-- | Deterministic pseudo-random numbers.
+rands :: Word64 -> [Int]
+rands = map (\x -> fromIntegral (x `shiftR` 33)) . drop 1 . iterate step
+  where
+    step x = x * 6364136223846793005 + 1442695040888963407

@@ -0,0 +1,510 @@+/*
+ * UTF-8 chunk scans with portable C, SSE2, and AVX2 implementations.
+ *
+ * Scans read bytes without allocating or modifying the input. Unit scans
+ * assume valid UTF-8; byte-counting scans also accept partial sequences.
+ * Data.Text.NanoRope.Internal passes unpinned array payloads through unsafe
+ * foreign calls. The default build handles slices shorter than 32 bytes in
+ * Haskell; the small-chunk test build also sends those slices here.
+ *
+ * Three levels, all computing exactly the same results:
+ *
+ *   0  portable C, which compilers are free to vectorise;
+ *   1  SSE2, 16 bytes at a time (every x86-64 has it);
+ *   2  AVX2, 32 bytes at a time, if the CPU and the OS support it.
+ *
+ * Each exported scan takes a level no higher than nano_rope_simd_level().
+ * Haskell caches this choice; tests compare all supported levels.
+ *
+ * Short tails use an overlapping vector load with already-counted lanes
+ * masked out. Loads stay within the supplied buffer bounds. Scans given a
+ * whole-array bound may load bytes before the requested start, but exclude
+ * them from the result.
+ */
+
+#ifndef LEVEL
+
+#include <stddef.h>
+#include <stdint.h>
+#include <string.h>
+
+#include "HsFFI.h"
+
+#if defined(__x86_64__) && (defined(__GNUC__) || defined(__clang__))
+#define NR_X86 1
+#include <cpuid.h>
+#include <immintrin.h>
+#else
+#define NR_X86 0
+#endif
+
+typedef const uint8_t *bytes;
+
+/* Pack three counts into 21 bits each. Requires an input shorter than
+ * 2^21 bytes; Haskell handles larger slices separately. */
+#define PACK(conts, fours, nls) \
+  ((HsWord64)(conts) | (HsWord64)(fours) << 21 | (HsWord64)(nls) << 42)
+
+/* ------------------------------------------------------------------------
+ * Level 0: portable C, also used for inputs shorter than a vector.
+ */
+
+static HsWord64 metrics_c(bytes s, size_t n)
+{
+  size_t conts = 0, fours = 0, nls = 0;
+  for (size_t i = 0; i < n; i++) {
+    uint8_t b = s[i];
+    conts += (b & 0xC0) == 0x80;
+    fours += b >= 0xF0;
+    nls += b == '\n';
+  }
+  return PACK(conts, fours, nls);
+}
+
+static HsInt newlines_c(bytes s, size_t n)
+{
+  size_t nls = 0;
+  for (size_t i = 0; i < n; i++)
+    nls += s[i] == '\n';
+  return (HsInt)nls;
+}
+
+/* The first '\n' at or after i, or n. */
+static HsInt find_newline_c(bytes s, size_t i, size_t n)
+{
+  const uint8_t *p = i < n ? memchr(s + i, '\n', n - i) : NULL;
+  return p ? (HsInt)(p - s) : (HsInt)n;
+}
+
+/* The last '\n' before i, or -1. */
+static HsInt find_newline_back_c(bytes s, size_t i)
+{
+  while (i > 0)
+    if (s[--i] == '\n')
+      return (HsInt)i;
+  return -1;
+}
+
+/* Offset after the k-th '\n' at or after i (k >= 1), or n. */
+static HsInt nth_newline_c(bytes s, size_t i, size_t n, HsInt k)
+{
+  for (; i < n; i++)
+    if (s[i] == '\n' && --k == 0)
+      return (HsInt)(i + 1);
+  return (HsInt)n;
+}
+
+/* Return the offset of the first code point that would exceed k units, or `to`.
+ * Start at i with u units already counted. Continuation bytes are skipped,
+ * so scans may resume inside a sequence. `wide` selects UTF-16 units
+ * rather than code points. */
+static HsInt scan_units_c(bytes s, size_t i, size_t to, HsInt k, HsInt u, int wide)
+{
+  for (; i < to; i++) {
+    uint8_t b = s[i];
+    if ((b & 0xC0) == 0x80)
+      continue;
+    HsInt w = wide && b >= 0xF0 ? 2 : 1;
+    if (u + w > k)
+      return (HsInt)i;
+    u += w;
+  }
+  return (HsInt)to;
+}
+
+#if NR_X86
+
+/* Flush byte counters to wider sums every 255 vectors to avoid overflow. */
+#define FLUSH 255
+
+/* Count set bits without POPCNT or compiler-runtime calls, so the baseline
+ * scan works on x86-64 CPUs without POPCNT and with GHC's runtime linker. */
+static inline uint32_t popcount_sse2(uint32_t m)
+{
+  m = m - ((m >> 1) & 0x55555555u);
+  m = (m & 0x33333333u) + ((m >> 2) & 0x33333333u);
+  return (((m + (m >> 4)) & 0x0F0F0F0Fu) * 0x01010101u) >> 24;
+}
+
+/* Bits set, with the instruction, which every CPU with AVX2 has. */
+#define AVX2 __attribute__((target("avx2,popcnt")))
+
+AVX2 static inline uint32_t popcount_avx2(uint32_t m)
+{
+  return (uint32_t)__builtin_popcount(m);
+}
+
+/* Position of the k-th set bit; requires 1 <= k <= popcount(m). */
+static inline uint32_t nth_bit(uint32_t m, HsInt k)
+{
+  while (--k > 0)
+    m &= m - 1;
+  return (uint32_t)__builtin_ctz(m);
+}
+
+#define NR_CAT_(a, b) a##b
+#define NR_CAT(a, b) NR_CAT_(a, b)
+
+/* ------------------------------------------------------------------------
+ * Instantiate the shared vector scans twice: SSE2 with 16-byte vectors,
+ * then AVX2 with 32-byte vectors. Short inputs fall back to the lower level.
+ */
+
+static inline HsWord64 sum128(__m128i v)
+{
+  return (HsWord64)_mm_cvtsi128_si64(v) + (HsWord64)_mm_cvtsi128_si64(_mm_unpackhi_epi64(v, v));
+}
+
+#define LEVEL sse2
+#define LOWER c
+#define ATTR
+#define W 16
+#define V __m128i
+#define MM(op) _mm_##op
+#define LOAD(p) _mm_loadu_si128((const __m128i *)(p))
+#define ZERO _mm_setzero_si128()
+#define SUM(v) sum128(v)
+#include "scan.c"
+
+AVX2 static inline HsWord64 sum256(__m256i v)
+{
+  __m128i w = _mm_add_epi64(_mm256_castsi256_si128(v), _mm256_extracti128_si256(v, 1));
+  return (HsWord64)_mm_cvtsi128_si64(w) + (HsWord64)_mm_extract_epi64(w, 1);
+}
+
+#define LEVEL avx2
+#define LOWER sse2
+#define ATTR AVX2
+#define W 32
+#define V __m256i
+#define MM(op) _mm256_##op
+#define LOAD(p) _mm256_loadu_si256((const __m256i *)(p))
+#define ZERO _mm256_setzero_si256()
+#define SUM(v) sum256(v)
+#include "scan.c"
+
+#endif /* NR_X86 */
+
+/* ------------------------------------------------------------------------
+ * Exported scans. Callers must provide valid bounds and a supported level.
+ */
+
+#if NR_X86
+/* Check CPU and OS support for AVX2 directly. Compiler feature-detection
+ * builtins depend on runtime symbols that GHCi's Windows linker cannot
+ * resolve, including when loading code for Template Haskell. */
+static int has_avx2(void)
+{
+  unsigned int a, b, c, d;
+  if (__get_cpuid_max(0, NULL) < 7)
+    return 0;
+  __cpuid_count(1, 0, a, b, c, d);
+  /* OSXSAVE, so that XGETBV may be asked, and AVX. */
+  if ((c & (1u << 27)) == 0 || (c & (1u << 28)) == 0)
+    return 0;
+  /* XCR0: the state of the XMM and of the YMM registers is kept. */
+  unsigned int lo, hi;
+  __asm__ volatile("xgetbv" : "=a"(lo), "=d"(hi) : "c"(0));
+  (void)hi;
+  if ((lo & 6) != 6)
+    return 0;
+  __cpuid_count(7, 0, a, b, c, d);
+  return (b & (1u << 5)) != 0;
+}
+#endif
+
+HsInt nano_rope_simd_level(void)
+{
+#if NR_X86
+  return has_avx2() ? 2 : 1;
+#else
+  return 0;
+#endif
+}
+
+#if NR_X86
+#define DISPATCH(level, name, ...)           \
+  switch (level) {                            \
+  case 2: return name##_avx2(__VA_ARGS__);    \
+  case 1: return name##_sse2(__VA_ARGS__);    \
+  default: return name##_c(__VA_ARGS__);      \
+  }
+#else
+#define DISPATCH(level, name, ...) \
+  (void)(level);                   \
+  return name##_c(__VA_ARGS__);
+#endif
+
+/* Continuation bytes, 4-byte leaders and '\n' in s[off .. off+len), packed
+ * by PACK. len < 2^21. */
+HsWord64 nano_rope_metrics(HsInt level, bytes s, HsInt off, HsInt len)
+{
+  DISPATCH(level, metrics, s + off, (size_t)len)
+}
+
+/* Number of '\n' in s[off .. off+len). */
+HsInt nano_rope_newlines(HsInt level, bytes s, HsInt off, HsInt len)
+{
+  DISPATCH(level, newlines, s + off, (size_t)len)
+}
+
+/* The first '\n' in s[from .. n), or n; from <= n. */
+HsInt nano_rope_find_newline(HsInt level, bytes s, HsInt from, HsInt n)
+{
+  DISPATCH(level, find_newline, s, (size_t)from, (size_t)n)
+}
+
+/* The last '\n' in s[0 .. to), or -1. */
+HsInt nano_rope_find_newline_back(HsInt level, bytes s, HsInt to)
+{
+  DISPATCH(level, find_newline_back, s, (size_t)to)
+}
+
+/* The offset just after the k-th '\n' in s[0 .. n) for k >= 1, or n. */
+HsInt nano_rope_nth_newline(HsInt level, bytes s, HsInt n, HsInt k)
+{
+  if (k <= 0)
+    return n;
+  DISPATCH(level, nth_newline, s, 0, (size_t)n, k)
+}
+
+/* Find a line start and its terminator in one foreign call. Pack the offset
+ * after the k-th '\n' (zero for k <= 0) into the low 32 bits, and the next
+ * '\n' offset into the high 32 bits. Missing endpoints use n. */
+HsWord64 nano_rope_line_span(HsInt level, bytes s, HsInt n, HsInt k)
+{
+  HsInt from = k <= 0 ? 0 : nano_rope_nth_newline(level, s, n, k);
+  HsInt lf = nano_rope_find_newline(level, s, from, n);
+  return (HsWord64)from | (HsWord64)lf << 32;
+}
+
+/* Return the end of the longest prefix of s[from .. to) fitting in k units.
+ * Both endpoints must be code point boundaries in valid UTF-8. `wide`
+ * selects UTF-16 units rather than code points. */
+HsInt nano_rope_scan_units(HsInt level, bytes s, HsInt from, HsInt to, HsInt k, HsInt wide)
+{
+  /* Handle empty prefixes before entering loops that require k >= 0. */
+  if (k <= 0)
+    return from < to ? from : to;
+  DISPATCH(level, scan_units, s, (size_t)from, (size_t)to, k, 0, (int)wide)
+}
+
+#else
+/* ------------------------------------------------------------------------
+ * Shared scans over W-byte vectors. Each self-include supplies:
+ *
+ *   LEVEL     the suffix of the functions of this level
+ *   LOWER     the fallback implementation for shorter inputs
+ *   ATTR      the attributes of a function of this level
+ *   W         the bytes in a vector, V its type, MM(op) its intrinsics
+ *   LOAD(p)   the vector at p, unaligned; ZERO, the one of zeros
+ *   SUM(v)    the sum of the 64-bit lanes of a vector
+ *
+ * plus popcount_LEVEL, the matching population-count function.
+ */
+
+#define FN(name) NR_CAT(name##_, LEVEL)
+#define LO(name) NR_CAT(name##_, LOWER)
+/* Every lane of a vector, as movemask bits. */
+#define ALL ((uint32_t)(((uint64_t)1 << W) - 1))
+
+/* Continuation bytes 0x80 .. 0xBF are signed bytes below -64.
+ * In valid UTF-8, 4-byte sequence leaders are unsigned bytes >= 0xF0. */
+ATTR static inline V FN(is_cont)(V x)
+{
+  return MM(cmpgt_epi8)(MM(set1_epi8)((char)0xC0), x);
+}
+
+ATTR static inline V FN(is_four)(V x)
+{
+  return MM(cmpeq_epi8)(MM(max_epu8)(x, MM(set1_epi8)((char)0xF0)), x);
+}
+
+ATTR static inline V FN(is_newline)(V x)
+{
+  return MM(cmpeq_epi8)(x, MM(set1_epi8)('\n'));
+}
+
+ATTR static inline uint32_t FN(bits)(V m)
+{
+  return (uint32_t)MM(movemask_epi8)(m);
+}
+
+ATTR static inline uint32_t FN(newline_mask)(bytes p)
+{
+  return FN(bits)(FN(is_newline)(LOAD(p)));
+}
+
+/* The counts of a metrics scan in the last t lanes of a vector. */
+ATTR static inline HsWord64 FN(pack_tail)(uint32_t conts, uint32_t fours, uint32_t nls, size_t t)
+{
+  int shift = W - (int)t;
+  return PACK(FN(popcount)(conts >> shift), FN(popcount)(fours >> shift), FN(popcount)(nls >> shift));
+}
+
+/* Count units in selected lanes using continuation and 4-byte leader masks. */
+ATTR static inline HsInt FN(units)(uint32_t lanes, uint32_t conts, uint32_t fours, int wide)
+{
+  return (HsInt)FN(popcount)(lanes & ~conts) + (wide ? (HsInt)FN(popcount)(lanes & fours) : 0);
+}
+
+/* Find the first code point lane that would exceed k units. Requires u <= k
+ * units already counted and more than k - u units in the selected lanes.
+ * When each code point counts once, select the next leader bit directly. */
+ATTR static inline uint32_t FN(units_stop)(uint32_t lanes, uint32_t conts, uint32_t fours, HsInt k, HsInt u,
+                                           int wide)
+{
+  uint32_t leaders = lanes & ~conts;
+  if (!wide || (fours & lanes) == 0)
+    return nth_bit(leaders, k - u + 1);
+  for (;;) {
+    uint32_t lane = (uint32_t)__builtin_ctz(leaders);
+    HsInt w = (fours >> lane) & 1 ? 2 : 1;
+    if (u + w > k)
+      return lane;
+    u += w;
+    leaders &= leaders - 1;
+  }
+}
+
+ATTR static HsWord64 FN(metrics)(bytes s, size_t n)
+{
+  if (n < W)
+    return LO(metrics)(s, n);
+  const V zero = ZERO;
+  V sum = zero; /* packed as by PACK, in each 64-bit lane */
+  size_t i = 0;
+  while (n - i >= W) {
+    size_t v = (n - i) / W;
+    if (v > FLUSH)
+      v = FLUSH;
+    V ac = zero, af = zero, an = zero;
+    for (; v > 0; v--, i += W) {
+      V x = LOAD(s + i);
+      ac = MM(sub_epi8)(ac, FN(is_cont)(x));
+      af = MM(sub_epi8)(af, FN(is_four)(x));
+      an = MM(sub_epi8)(an, FN(is_newline)(x));
+    }
+    sum = MM(add_epi64)(sum, MM(sad_epu8)(ac, zero));
+    sum = MM(add_epi64)(sum, MM(slli_epi64)(MM(sad_epu8)(af, zero), 21));
+    sum = MM(add_epi64)(sum, MM(slli_epi64)(MM(sad_epu8)(an, zero), 42));
+  }
+  HsWord64 packed = SUM(sum);
+  if (i < n) {
+    V x = LOAD(s + n - W);
+    packed += FN(pack_tail)(FN(bits)(FN(is_cont)(x)), FN(bits)(FN(is_four)(x)), FN(bits)(FN(is_newline)(x)), n - i);
+  }
+  return packed;
+}
+
+ATTR static HsInt FN(newlines)(bytes s, size_t n)
+{
+  if (n < W)
+    return LO(newlines)(s, n);
+  const V zero = ZERO;
+  V sn = zero;
+  size_t i = 0;
+  while (n - i >= W) {
+    size_t v = (n - i) / W;
+    if (v > FLUSH)
+      v = FLUSH;
+    V an = zero;
+    for (; v > 0; v--, i += W)
+      an = MM(sub_epi8)(an, FN(is_newline)(LOAD(s + i)));
+    sn = MM(add_epi64)(sn, MM(sad_epu8)(an, zero));
+  }
+  HsInt nls = (HsInt)SUM(sn);
+  if (i < n)
+    nls += FN(popcount)(FN(newline_mask)(s + n - W) >> (W - (n - i)));
+  return nls;
+}
+
+ATTR static HsInt FN(find_newline)(bytes s, size_t i, size_t n)
+{
+  if (n < W)
+    return LO(find_newline)(s, i, n);
+  for (; n - i >= W; i += W) {
+    uint32_t m = FN(newline_mask)(s + i);
+    if (m)
+      return (HsInt)(i + __builtin_ctz(m));
+  }
+  if (i < n) {
+    uint32_t m = FN(newline_mask)(s + n - W) >> (W - (n - i));
+    if (m)
+      return (HsInt)(i + __builtin_ctz(m));
+  }
+  return (HsInt)n;
+}
+
+ATTR static HsInt FN(find_newline_back)(bytes s, size_t i)
+{
+  if (i < W)
+    return LO(find_newline_back)(s, i);
+  for (; i >= W; i -= W) {
+    uint32_t m = FN(newline_mask)(s + i - W);
+    if (m)
+      return (HsInt)(i - W + 31 - __builtin_clz(m));
+  }
+  if (i > 0) {
+    uint32_t m = FN(newline_mask)(s) & ((1u << i) - 1);
+    if (m)
+      return (HsInt)(31 - __builtin_clz(m));
+  }
+  return -1;
+}
+
+ATTR static HsInt FN(nth_newline)(bytes s, size_t i, size_t n, HsInt k)
+{
+  if (n < W)
+    return LO(nth_newline)(s, i, n, k);
+  for (; n - i >= W; i += W) {
+    uint32_t m = FN(newline_mask)(s + i);
+    HsInt c = FN(popcount)(m);
+    if (c >= k)
+      return (HsInt)(i + nth_bit(m, k) + 1);
+    k -= c;
+  }
+  if (i < n) {
+    uint32_t m = FN(newline_mask)(s + n - W) >> (W - (n - i));
+    if (FN(popcount)(m) >= k)
+      return (HsInt)(i + nth_bit(m, k) + 1);
+  }
+  return (HsInt)n;
+}
+
+ATTR static HsInt FN(scan_units)(bytes s, size_t i, size_t to, HsInt k, HsInt u, int wide)
+{
+  if (to < W)
+    return LO(scan_units)(s, i, to, k, u, wide);
+  for (; to - i >= W; i += W) {
+    V x = LOAD(s + i);
+    uint32_t conts = FN(bits)(FN(is_cont)(x)), fours = FN(bits)(FN(is_four)(x));
+    HsInt c = FN(units)(ALL, conts, fours, wide);
+    if (u + c > k)
+      return (HsInt)(i + FN(units_stop)(ALL, conts, fours, k, u, wide));
+    u += c;
+  }
+  if (i < to) {
+    V x = LOAD(s + to - W);
+    uint32_t conts = FN(bits)(FN(is_cont)(x)), fours = FN(bits)(FN(is_four)(x));
+    uint32_t lanes = ALL & ~((1u << (W - (to - i))) - 1);
+    if (u + FN(units)(lanes, conts, fours, wide) > k)
+      return (HsInt)(to - W + FN(units_stop)(lanes, conts, fours, k, u, wide));
+  }
+  return (HsInt)to;
+}
+
+#undef FN
+#undef LO
+#undef ALL
+#undef LEVEL
+#undef LOWER
+#undef ATTR
+#undef W
+#undef V
+#undef MM
+#undef LOAD
+#undef ZERO
+#undef SUM
+
+#endif /* LEVEL */

@@ -0,0 +1,175 @@+cabal-version:      3.0
+name:               nano-rope
+version:            0.1.0.0
+synopsis:
+    B-tree text rope with flat chunks, multi-unit indexing and custom measures
+
+description:
+    A persistent text rope for editors, language servers and parsers.
+
+    * UTF-8 chunks of at most 512 bytes keep local edits small, even in
+      documents with very long lines.
+
+    * A B-tree with up to 16 children per node shares unchanged text between
+      versions, making snapshots and undo inexpensive.
+
+    * Consecutive insertions can use a bounded keystroke buffer to reduce
+      tree updates.
+
+    * Cached byte, code point, UTF-16 and newline counts support
+      logarithmic-time indexing and conversion between units.
+
+    * Chunk scans use SSE2 or AVX2 on supported x86-64 systems, with portable
+      C elsewhere. Build with @-f -simd@ for Haskell-only scans.
+
+    * Chunk views and buffered UTF-8 output avoid flattening the document.
+
+    * Custom monoidal measures support application-specific summaries
+      and prefix searches.
+
+license:            MIT
+license-file:       LICENSE
+author:             goolord
+maintainer:         zacharyachurchill@gmail.com
+category:           Text
+build-type:         Simple
+tested-with:        GHC ==9.14.1
+extra-doc-files:
+    CHANGELOG.md
+    README.md
+
+flag simd
+    description:
+        Enable C chunk scans, with runtime-selected SSE2 or AVX2 on supported
+        x86-64 systems and portable C elsewhere. Disable for Haskell-only
+        scans that process up to 8 bytes at a time.
+    default:     True
+    manual:      True
+
+flag compare-text-rope
+    description: Run the benchmarks on text-rope as well, for comparison.
+    default:     False
+    manual:      True
+
+flag compare-yi-rope
+    description: Run the benchmarks on yi-rope as well, for comparison.
+    default:     False
+    manual:      True
+
+flag compare-core-text
+    description: Run the benchmarks on core-text as well, for comparison.
+    default:     False
+    manual:      True
+
+common extensions
+    default-language: GHC2021
+
+common ghc-options
+    ghc-options: -Wall -Widentities
+
+common rts-options
+    ghc-options: -rtsopts -threaded "-with-rtsopts=-N"
+
+common library-depends
+    build-depends:
+        base      >=4.17 && <4.23,
+        deepseq   >=1.4  && <1.6,
+        primitive >=0.9  && <0.10,
+        text      >=2.0  && <2.2
+
+-- Compile the C scans and enable their Haskell bindings together.
+common simd
+    if flag(simd)
+        c-sources:   cbits/scan.c
+        cc-options:  -O2
+        cpp-options: -DNANO_ROPE_SIMD
+
+common test-depends
+    build-depends:
+        base,
+        bytestring              >=0.11  && <0.13,
+        directory               >=1.3   && <1.4,
+        primitive,
+        QuickCheck              >=2.14  && <2.19,
+        quickcheck-classes-base >=0.6.2 && <0.7,
+        tasty                   >=1.4   && <1.6,
+        tasty-quickcheck        >=0.10  && <0.12,
+        text
+
+library
+    import:           extensions
+    import:           ghc-options
+    import:           library-depends
+    import:           simd
+    exposed-modules:
+        Data.Text.NanoRope
+        Data.Text.NanoRope.Internal
+        Data.Text.NanoRope.Measured
+
+    hs-source-dirs:   src
+
+    -- Optimise the scan and tree traversal hot paths.
+    ghc-options:      -O2
+
+-- Test the library with its default chunk and node sizes.
+test-suite nano-rope-test
+    import:           extensions
+    import:           ghc-options
+    import:           rts-options
+    import:           test-depends
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   test
+    main-is:          Main.hs
+    build-depends:    nano-rope
+
+-- Run the same properties with small chunks and nodes, so short inputs
+-- exercise deep trees and frequent splits and merges.
+test-suite nano-rope-test-small
+    import:           extensions
+    import:           ghc-options
+    import:           rts-options
+    import:           library-depends
+    import:           test-depends
+    import:           simd
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   test src
+    main-is:          Main.hs
+    other-modules:
+        Data.Text.NanoRope
+        Data.Text.NanoRope.Internal
+        Data.Text.NanoRope.Measured
+
+    cpp-options:      -DNANO_ROPE_SMALL
+
+benchmark nano-rope-bench
+    import:           extensions
+    import:           ghc-options
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   bench
+    main-is:          Main.hs
+    other-modules:
+        Chart
+        Lsp
+        Memory
+        Rand
+
+    -- Enable RTS statistics for allocation and live-heap measurements.
+    ghc-options:      -O2 -rtsopts "-with-rtsopts=-A32m -T"
+    build-depends:
+        base,
+        nano-rope,
+        deepseq,
+        tasty-bench >=0.3 && <0.6,
+        text
+
+    if flag(compare-text-rope)
+        build-depends: text-rope >=0.3 && <0.4
+        cpp-options:   -DCOMPARE_TEXT_ROPE
+
+    if flag(compare-yi-rope)
+        build-depends: yi-rope >=0.11 && <0.12
+        cpp-options:   -DCOMPARE_YI_ROPE
+
+    if flag(compare-core-text)
+        build-depends: core-text >=0.3.8 && <0.4
+        cpp-options:   -DCOMPARE_CORE_TEXT

@@ -0,0 +1,396 @@+-- |
+-- Module      : Data.Text.NanoRope
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- A persistent UTF-8 text rope for editors, language servers, and parsers.
+--
+-- * __Multi-unit indexing.__ Cached metrics support /O(log n)/ lookups and
+--   conversions in bytes, code points, UTF-16 code units, and lines.
+-- * __Small edits.__ A B-tree of chunks up to 512 bytes shares unchanged
+--   subtrees between versions. Consecutive keystrokes can be buffered; see
+--   'insert'.
+-- * __Bounded chunks.__ Chunk sizes depend on bytes, not line lengths.
+-- * __Chunk-based I/O.__ Read chunk views or stream UTF-8 without flattening
+--   the document.
+-- * __Custom summaries.__ "Data.Text.NanoRope.Measured" adds cached monoidal
+--   measures and searches over them.
+--
+-- Import this module qualified:
+--
+-- > import Data.Text.NanoRope (Rope, Unit (..), Position (..))
+-- > import qualified Data.Text.NanoRope as Rope
+--
+-- Offsets are zero-based, clamped to the document, and rounded down to code
+-- point boundaries. Ranges are half-open: the start is included and the end
+-- is excluded. 'Chars' counts code points, not grapheme clusters or display
+-- columns. Only @\\n@ starts a new line.
+--
+-- Complexity bounds use /n/ for the document's byte length. They assume the
+-- tree is evaluated: a read after buffered typing may first apply a pending
+-- insertion. 'null', 'length', 'lineCount', and 'metrics' do not force it.
+--
+-- = Example: a language server
+--
+-- Convert a client's UTF-16 range to byte offsets before replacing it.
+-- The returned offsets refer to the original document.
+--
+-- > import Data.Text (Text)
+-- >
+-- > applyChange :: Position -> Position -> Text -> Rope -> (Rope, (Int, Int))
+-- > applyChange from to new rope = (Rope.replace Bytes i j new rope, (i, j))
+-- >   where
+-- >     i = Rope.positionToOffset Utf16 Bytes from rope
+-- >     j = Rope.positionToOffset Utf16 Bytes to rope
+module Data.Text.NanoRope
+  ( -- * Ropes
+    Rope
+
+    -- * Units and metrics
+  , Unit (..)
+  , Metrics (..)
+  , count
+
+    -- * Construction
+  , empty
+  , singleton
+  , fromText
+  , fromLazyText
+
+    -- * Deconstruction
+  , toText
+  , toLazyText
+  , toString
+  , toChunks
+  , foldrChunks
+  , foldlChunks'
+  , chunkAt
+
+    -- * Output
+  , hPutUtf8
+  , writeFileUtf8
+
+    -- * Queries
+  , null
+  , length
+  , lineCount
+  , metrics
+
+    -- * Combining and breaking
+  , append
+  , splitAt
+  , take
+  , drop
+  , slice
+  , sliceText
+
+    -- * Editing
+  , insert
+  , delete
+  , replace
+
+    -- * Lines
+  , getLine
+  , lines
+
+    -- * Converting between units
+    -- $conversions
+  , metricsAt
+  , convert
+
+    -- * Positions
+  , Position (..)
+  , splitAtPosition
+  , metricsAtPosition
+  , metricsAtLineAndPosition
+  , metricsToPosition
+  , offsetToPosition
+  , positionToOffset
+
+    -- * Searching by metrics
+  , splitWhere
+  , metricsWhere
+
+    -- * Custom measures
+  , measured
+  , unmeasured
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import Data.Text.NanoRope.Internal (Measure, Metrics (..), Position (..), Unit (..), count)
+import qualified Data.Text.NanoRope.Internal as M
+import System.IO (Handle)
+import Prelude hiding (drop, getLine, length, lines, null, splitAt, take)
+
+-- | A rope with only the built-in metrics. This is the measured rope
+-- specialised to @()@, with the same 'Eq', 'Ord', 'Show', 'Semigroup',
+-- 'Monoid', 'Data.String.IsString', and 'Control.DeepSeq.NFData' instances.
+type Rope = M.Rope ()
+
+-- $conversions
+-- Prefix t'Metrics' describe a location in all four units. Obtain them with
+-- 'metricsAt', 'metricsAtPosition', or 'metricsWhere', then use 'count' for
+-- absolute offsets. Reusing the metrics avoids repeating the lookup for
+-- each unit. 'metricsToPosition' also looks up the line start to calculate
+-- a column; use metrics from the same rope.
+
+-- | The empty rope.
+empty :: Rope
+empty = M.empty
+
+-- | A rope of one character.
+singleton :: Char -> Rope
+singleton = M.singleton
+
+-- | /O(n)/. Build a rope from strict text. Copies the text into chunks,
+-- unless it is at most 512 bytes and occupies its entire backing buffer.
+fromText :: Text -> Rope
+fromText = M.fromText
+
+-- | Build a rope by appending the chunks of a lazy 'TL.Text'.
+fromLazyText :: TL.Text -> Rope
+fromLazyText = M.fromLazyText
+
+-- | /O(n)/. Flatten the rope to strict text. A single chunk is shared
+-- without copying; multiple chunks are copied into one buffer.
+toText :: Rope -> Text
+toText = M.toText
+
+-- | /O(n)/. Convert to lazy text, sharing the chunk buffers.
+toLazyText :: Rope -> TL.Text
+toLazyText = M.toLazyText
+
+-- | /O(n)/. Decode the rope to a 'String'.
+toString :: Rope -> String
+toString = M.toString
+
+-- | The chunks of the rope as zero-copy views, in order. They are non-empty,
+-- at most 512 bytes long and produced lazily.
+toChunks :: Rope -> [Text]
+toChunks = M.toChunks
+
+-- | Lazy right fold over non-empty chunks in document order, without
+-- building the list returned by 'toChunks'.
+foldrChunks :: (Text -> b -> b) -> b -> Rope -> b
+foldrChunks = M.foldrChunks
+
+-- | Strict left fold over non-empty chunks in document order. Walks the
+-- tree directly, sharing text buffers and avoiding an intermediate list.
+-- Useful for consumers such as hashes and parsers.
+foldlChunks' :: (b -> Text -> b) -> b -> Rope -> b
+foldlChunks' = M.foldlChunks'
+
+-- | /O(log n)/. Zero-copy view of the rest of the chunk containing the given
+-- offset. Returns empty text when the clamped offset is at the end.
+--
+-- For a parser read callback, request a byte offset, consume the returned
+-- text, then advance by its byte length. Offsets are clamped and rounded
+-- as described at 'Unit'.
+chunkAt :: Unit -> Int -> Rope -> Text
+chunkAt = M.chunkAt
+
+-- | /O(n)/. Write UTF-8 to a handle through a 32 KiB buffer, without
+-- constructing a 'Text' for the whole document.
+--
+-- Like 'System.IO.hPutBuf', this bypasses the handle's encoding and newline
+-- translation, preserving the rope's bytes on every platform. To use the
+-- handle's text encoding instead, pass 'toLazyText' to text I/O.
+hPutUtf8 :: Handle -> Rope -> IO ()
+hPutUtf8 = M.hPutUtf8
+
+-- | Write UTF-8 to a file with 'hPutUtf8', replacing its contents.
+--
+-- Evaluates the tree, including pending input, before opening the file.
+-- An evaluation failure leaves an existing file untouched. The write itself
+-- is not atomic.
+writeFileUtf8 :: FilePath -> Rope -> IO ()
+writeFileUtf8 = M.writeFileUtf8
+
+-- | /O(1)/. Whether the rope is empty, including pending input.
+null :: Rope -> Bool
+null = M.null
+
+-- | /O(1)/. Length in any unit; for 'Lines' this is the number of @\\n@.
+--
+-- >>> map (`length` "a😀\nb") [Bytes, Chars, Utf16, Lines]
+-- [7,4,5,1]
+length :: Unit -> Rope -> Int
+length = M.length
+
+-- | /O(1)/. Number of @\\n@ characters plus one. An empty rope has one line;
+-- a trailing @\\n@ adds an empty final line. Valid indices range from zero
+-- to @lineCount rope - 1@. See 'lines' for a list that omits that final empty line.
+lineCount :: Rope -> Int
+lineCount = M.lineCount
+
+-- | /O(1)/. All built-in measurements, including pending input.
+metrics :: Rope -> Metrics
+metrics = M.metrics
+
+-- | /O(log n)/. Concatenate two ropes, sharing unaffected subtrees.
+-- Equivalent to '<>'. The traversal follows the difference in tree heights.
+append :: Rope -> Rope -> Rope
+append = M.append
+
+-- | /O(log n)/. Split at an offset, clamped to the rope and rounded down to
+-- a code point boundary (see 'Unit'). Finds both halves in one descent.
+-- Use 'take' or 'drop' if you need only one half.
+--
+-- >>> splitAt Lines 1 "fst\nsnd\n"
+-- ("fst\n","snd\n")
+splitAt :: Unit -> Int -> Rope -> (Rope, Rope)
+splitAt = M.splitAt
+
+-- | /O(log n)/. The prefix before an offset, clamped and rounded as in 'splitAt'.
+take :: Unit -> Int -> Rope -> Rope
+take = M.take
+
+-- | /O(log n)/. The suffix from an offset, clamped and rounded as in 'splitAt'.
+drop :: Unit -> Int -> Rope -> Rope
+drop = M.drop
+
+-- | /O(log n)/. Extract the half-open range @[i, j)@. Both offsets are
+-- clamped and rounded in the original rope. Returns empty when @j <= i@.
+slice :: Unit -> Int -> Int -> Rope -> Rope
+slice = M.slice
+
+-- | /O(log n + result bytes)/. Like 'slice', but returns 'Text' directly.
+-- A range within one chunk is a zero-copy view; a range spanning chunks
+-- is copied into one buffer.
+sliceText :: Unit -> Int -> Int -> Rope -> Text
+sliceText = M.sliceText
+
+-- | /O(log n + inserted bytes)/. Insert text at a clamped, code-point-aligned
+-- offset. Empty input leaves the rope unchanged.
+--
+-- Small insertions copy the affected chunk and its path through the tree.
+-- An overflowing chunk can split in two.
+--
+-- Consecutive insertions in the same unit ('Bytes', 'Chars', or 'Utf16')
+-- can use a buffer of up to 128 bytes, limited by the target chunk's free
+-- space. Updating that bounded buffer is /O(1)/ in document size. A tree
+-- read, an edit elsewhere, or an insertion that exceeds the buffer's capacity
+-- forces the pending insertion.
+-- 'length' and 'metrics' include pending input without forcing it.
+-- Evaluating a rope to weak head normal form may leave this insertion deferred.
+insert :: Unit -> Int -> Text -> Rope -> Rope
+insert = M.insert
+
+-- | /O(log n)/. Remove the half-open range @[i, j)@, clamping and rounding
+-- both offsets in the original rope. Does nothing when @j <= i@.
+-- Deleting a suffix of buffered 'Chars' input can take /O(1)/; see 'insert'.
+delete :: Unit -> Int -> Int -> Rope -> Rope
+delete = M.delete
+
+-- | /O(log n + inserted bytes)/. Replace the half-open range @[i, j)@ with
+-- text, clamping and rounding both offsets in the original rope. When
+-- @j <= i@, insert at @i@ instead.
+--
+-- An edit that stays within one chunk and keeps it within its size bounds
+-- copies only that chunk and the path to it.
+replace :: Unit -> Int -> Int -> Text -> Rope -> Rope
+replace = M.replace
+
+-- | /O(log n + length of the line)/. The content of a line by 0-based index,
+-- without its terminating @\\n@ or @\\r\\n@; empty if there is no such line.
+-- A line within a single chunk is returned as a zero-copy view.
+getLine :: Int -> Rope -> Text
+getLine = M.getLine
+
+-- | /O(n)/. Lines without their @\\n@ or @\\r\\n@ terminators, produced
+-- lazily. Returns @[]@ for an empty rope and omits the empty line after a
+-- trailing @\\n@. A lone @\\r@ is preserved. Lines within one chunk share
+-- its buffer.
+lines :: Rope -> [Text]
+lines = M.lines
+
+-- | /O(log n)/. Measure the prefix ending at an offset to express that
+-- location in all four units. The offset is clamped and rounded as in 'splitAt'.
+--
+-- >>> metricsAt Chars 3 "a😀\nb"
+-- Metrics {bytes = 6, chars = 3, utf16Units = 4, newlines = 1}
+metricsAt :: Unit -> Int -> Rope -> Metrics
+metricsAt = M.metricsAt
+
+-- | /O(log n)/. @convert from to@ re-expresses an offset in another unit.
+-- Converting to 'Lines' gives the index of the line containing the offset,
+-- converting from 'Lines' the offset of the start of a line.
+--
+-- >>> convert Bytes Utf16 5 "a😀\nb"
+-- 3
+convert :: Unit -> Unit -> Int -> Rope -> Int
+convert = M.convert
+
+-- | /O(log n)/. Split at a zero-based line and column, with the column in
+-- the given unit. Negative coordinates clamp to zero. A column beyond the
+-- line's content clamps to before its @\\n@ or @\\r\\n@; a line beyond the
+-- document clamps to its end. Offsets inside code points round down.
+-- For 'Lines' columns, zero means the line start and any positive value
+-- means the end of its content.
+splitAtPosition :: Unit -> Position -> Rope -> (Rope, Rope)
+splitAtPosition = M.splitAtPosition
+
+-- | /O(log n)/. The location of a position in every unit, clamped like
+-- 'splitAtPosition'.
+metricsAtPosition :: Unit -> Position -> Rope -> Metrics
+metricsAtPosition = M.metricsAtPosition
+
+-- | /O(log n)/. Return prefix metrics for the line start and the position,
+-- sharing their lookup. Clamps coordinates as in 'metricsAtPosition'.
+-- Subtract corresponding counts to get the reached column in any unit.
+-- Comparing it with the requested column detects clamping or rounding:
+--
+-- >>> let (line, at) = metricsAtLineAndPosition Utf16 (Position 1 3) "a😀\nb😀c"
+-- >>> (utf16Units at - utf16Units line, chars at - chars line, bytes at)
+-- (3,2,11)
+metricsAtLineAndPosition :: Unit -> Position -> Rope -> (Metrics, Metrics)
+metricsAtLineAndPosition = M.metricsAtLineAndPosition
+{-# INLINE metricsAtLineAndPosition #-}
+
+-- | /O(log n)/. The position, with its column in the given unit, of a
+-- location obtained from 'metricsAt', 'metricsAtPosition', or 'metricsWhere'
+-- on the same rope. Does not clamp or validate the supplied metrics.
+metricsToPosition :: Unit -> Metrics -> Rope -> Position
+metricsToPosition = M.metricsToPosition
+
+-- | /O(log n)/. @offsetToPosition from to@ turns an offset in unit @from@
+-- into a position with its column in unit @to@.
+-- An offset inside a line terminator remains there; converting the result
+-- back with 'positionToOffset' clamps it to the end of the line's content.
+--
+-- >>> offsetToPosition Bytes Utf16 11 "a😀\nb😀c"
+-- Position {posLine = 1, posColumn = 3}
+offsetToPosition :: Unit -> Unit -> Int -> Rope -> Position
+offsetToPosition = M.offsetToPosition
+
+-- | /O(log n)/. @positionToOffset from to@ turns a position with its column
+-- in unit @from@ into an offset in unit @to@.
+-- Coordinates are clamped as in 'splitAtPosition'.
+--
+-- >>> positionToOffset Utf16 Bytes (Position 1 3) "a😀\nb😀c"
+-- 11
+positionToOffset :: Unit -> Unit -> Position -> Rope -> Int
+positionToOffset = M.positionToOffset
+
+-- | /O(log n)/ for a constant-time predicate. Split after the longest
+-- code-point-aligned prefix for which the predicate is false. The predicate
+-- must be monotone: once true, it must stay true as the prefix grows.
+-- If true for the empty prefix, split at the start; if never true, split
+-- at the end.
+splitWhere :: (Metrics -> Bool) -> Rope -> (Rope, Rope)
+splitWhere p = M.splitWhere (\m _ -> p m)
+
+-- | /O(log n)/ for a constant-time predicate. Prefix metrics at the split
+-- point chosen by 'splitWhere', without constructing either half.
+metricsWhere :: (Metrics -> Bool) -> Rope -> Metrics
+metricsWhere p = M.metricsWhere (\m _ -> p m)
+
+-- | /O(n)/. Annotate the text with a custom measure for use with
+-- "Data.Text.NanoRope.Measured". The text itself is shared, not copied.
+measured :: Measure a => Rope -> M.Rope a
+measured = M.remeasure
+
+-- | /O(n)/. Forget a custom measure. The text itself is shared, not copied.
+unmeasured :: M.Rope a -> Rope
+unmeasured = M.remeasure

@@ -0,0 +1,2576 @@+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE ViewPatterns #-}
+-- Constructor specialisation can clone recursive workers before measure
+-- specialisation, leaving runtime dictionary arguments in the clones.
+-- Use the explicit SPECIALIZE pragmas below instead.
+{-# OPTIONS_GHC -fno-spec-constr #-}
+
+-- |
+-- Module      : Data.Text.NanoRope.Internal
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- B-tree representation, chunk scans, and invariant checks. These internals
+-- are exposed for testing and benchmarking, with __no API stability guarantees__.
+-- Use "Data.Text.NanoRope" or "Data.Text.NanoRope.Measured" in application code.
+--
+-- = Representation
+--
+-- Leaves hold exactly-sized, unpinned UTF-8 arrays of at most 'maxChunk'
+-- bytes, split at code point boundaries. Inner nodes have up to 'maxChildren'
+-- children. Each node caches its subtree's t'Metrics'; leaves pack these into
+-- 64 bits. Seeking scans at most 'maxChildren' child headers per level.
+--
+-- Parents store child pointers rather than duplicating each child's metrics.
+-- A small edit copies the affected leaf and the nodes and pointer arrays on
+-- its path, sharing the rest of the tree.
+--
+-- Nodes are unlifted, so GHC knows that reading a child cannot require
+-- evaluating a thunk. This avoids evaluation checks and register spills
+-- in traversal loops.
+--
+-- Allocation in the hot paths depends on GHC's strictness and inlining
+-- decisions. Strict arguments, unpacked result records, and carefully placed
+-- helpers keep offsets and metrics unboxed. See the seeking and scanning
+-- notes, and check benchmark allocation after changing these paths.
+--
+-- = Scanning
+--
+-- Chunk scans measure text, find line feeds, and locate code point or UTF-16
+-- offsets. In the default build, slices of at least 32 bytes use C: SSE2 or
+-- AVX2 on supported x86-64 systems, portable C elsewhere. Shorter slices use
+-- Haskell scans processing up to 8 bytes at a time. Build with @-f -simd@ to
+-- use only Haskell scans. See 'kernels' for the available implementations.
+module Data.Text.NanoRope.Internal
+  ( -- * Types
+    Rope (.., Rope)
+  , Node (.., Leaf)
+  , Lazy (..)
+  , Children
+  , sizeofChildren
+  , indexChildren
+  , Measure (..)
+  , Metrics (..)
+  , Unit (..)
+  , Position (..)
+  , count
+  , subMetrics
+  , PackedMetrics
+  , packMetrics
+  , unpackMetrics
+
+    -- * Tuning constants
+  , maxChunk
+  , minChunk
+  , maxChildren
+  , minChildren
+  , maxPending
+  , outputBuffer
+
+    -- * Construction
+  , empty
+  , singleton
+  , fromText
+  , fromLazyText
+
+    -- * Deconstruction
+  , toText
+  , toLazyText
+  , toString
+  , toChunks
+  , foldrChunks
+  , foldlChunks'
+  , chunkAt
+
+    -- * Output
+  , hPutUtf8
+  , writeFileUtf8
+
+    -- * Queries
+  , null
+  , length
+  , lineCount
+  , metrics
+  , measure
+
+    -- * Combining and breaking
+  , append
+  , splitAt
+  , take
+  , drop
+  , slice
+  , sliceText
+
+    -- * Editing
+  , insert
+  , delete
+  , replace
+
+    -- * Lines
+  , getLine
+  , lines
+
+    -- * Converting between units
+  , metricsAt
+  , convert
+
+    -- * Positions
+  , splitAtPosition
+  , metricsAtPosition
+  , metricsAtLineAndPosition
+  , metricsToPosition
+  , offsetToPosition
+  , positionToOffset
+
+    -- * Custom measures
+  , splitWhere
+  , metricsWhere
+  , remeasure
+
+    -- * Debugging
+  , invariants
+  , height
+
+    -- * Chunk primitives
+  , sliceMetrics
+  , offsetInChunk
+  , chunkText
+  , ChunkLine (..)
+  , Kernels (..)
+  , kernels
+  ) where
+
+import Control.DeepSeq (NFData (..))
+import Control.Monad (when)
+import Control.Monad.ST (RealWorld)
+import Data.Bits (complement, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.))
+import Data.Kind (Type)
+import qualified Data.List as L
+import Data.Primitive.ByteArray
+import Data.String (IsString (..))
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Array as A
+import qualified Data.Text.Internal as TI
+import qualified Data.Text.Lazy as TL
+import Data.Word (Word8)
+import Foreign.Ptr (Ptr)
+import GHC.Exts
+  ( Int (..)
+  , Int#
+  , SmallArray#
+  , SmallMutableArray#
+  , TYPE
+  , UnliftedType
+  , cloneSmallArray#
+  , copySmallArray#
+  , indexSmallArray#
+  , indexWord8ArrayAsWord64#
+  , newSmallArray#
+  , runRW#
+  , sizeofSmallArray#
+  , thawSmallArray#
+  , unsafeFreezeSmallArray#
+  , writeSmallArray#
+  , (-#)
+  )
+import GHC.ST (ST (..))
+import GHC.Word (Word64 (..))
+import System.IO (Handle, IOMode (WriteMode), hPutBuf, withBinaryFile)
+#ifdef NANO_ROPE_SIMD
+import System.IO.Unsafe (unsafeDupablePerformIO)
+#endif
+import Prelude hiding (drop, getLine, length, lines, null, splitAt, take)
+
+------------------------------------------------------------------------------
+-- Tuning constants
+
+-- | Maximum leaf size in bytes. Must not exceed @65535 / maxChildren@:
+-- @sumMetrics@ adds packed 16-bit leaf counts without unpacking them.
+maxChunk :: Int
+
+-- | Maximum number of children of an inner node.
+maxChildren :: Int
+#ifdef NANO_ROPE_SMALL
+-- Small nodes exercise deep trees with short test inputs. Six children
+-- allow non-root inner nodes with two children to be undersized.
+maxChunk = 16
+maxChildren = 6
+#else
+maxChunk = 512
+maxChildren = 16
+#endif
+
+-- | Minimum number of bytes in a leaf, unless the leaf is the root.
+--
+-- A quarter (rather than half) of 'maxChunk' gives hysteresis: a leaf that
+-- was just split in two does not merge back after deleting a character.
+minChunk :: Int
+minChunk = maxChunk `quot` 4
+
+-- | Minimum number of children of an inner node, unless it is the root
+-- (which has at least two).
+minChildren :: Int
+minChildren = maxChildren `quot` 2
+
+-- | Maximum buffered input in bytes; see 'Typing'. Each keystroke copies
+-- the buffer, so it stays smaller than a chunk.
+maxPending :: Int
+maxPending = maxChunk `quot` 4
+
+-- | UTF-8 output buffer size in bytes: 32 KiB in the default build.
+-- Holds whole chunks and batches writes to reduce per-chunk I/O overhead.
+outputBuffer :: Int
+#ifdef NANO_ROPE_SMALL
+-- A small buffer makes tests exercise repeated flushes.
+outputBuffer = 4 * maxChunk
+#else
+outputBuffer = 64 * maxChunk
+#endif
+
+------------------------------------------------------------------------------
+-- Metrics
+
+-- | Built-in counts cached at every tree node. The metrics of a rope's
+-- prefix also describe its endpoint in all four units; see 'metricsAt'.
+data Metrics = Metrics
+  { bytes :: {-# UNPACK #-} !Int
+  -- ^ UTF-8 bytes.
+  , chars :: {-# UNPACK #-} !Int
+  -- ^ Unicode code points, not grapheme clusters or display columns.
+  , utf16Units :: {-# UNPACK #-} !Int
+  -- ^ UTF-16 code units, the default position unit in LSP.
+  , newlines :: {-# UNPACK #-} !Int
+  -- ^ Line feeds (@\\n@).
+  }
+  deriving (Eq, Show)
+
+instance Semigroup Metrics where
+  Metrics b1 c1 u1 l1 <> Metrics b2 c2 u2 l2 =
+    Metrics (b1 + b2) (c1 + c2) (u1 + u2) (l1 + l2)
+  {-# INLINE (<>) #-}
+
+instance Monoid Metrics where
+  mempty = Metrics 0 0 0 0
+  {-# INLINE mempty #-}
+
+instance NFData Metrics where
+  rnf !_ = ()
+
+-- | Componentwise subtraction.
+subMetrics :: Metrics -> Metrics -> Metrics
+subMetrics (Metrics b1 c1 u1 l1) (Metrics b2 c2 u2 l2) =
+  Metrics (b1 - b2) (c1 - c2) (u1 - u2) (l1 - l2)
+{-# INLINE subMetrics #-}
+
+-- | A unit for offsets and lengths. Public offset operations clamp negative
+-- offsets to the start and offsets beyond the document to its end.
+data Unit
+  = -- | UTF-8 bytes. An offset inside a code point is rounded down to
+    -- the start of that code point.
+    Bytes
+  | -- | Unicode code points, not grapheme clusters or display columns.
+    Chars
+  | -- | UTF-16 code units. An offset between the two halves of a surrogate
+    -- pair is rounded down to the start of that code point.
+    Utf16
+  | -- | Zero-based line starts. Offset zero is the document start; offset
+    -- @n > 0@ is just after the @n@-th @\\n@. Length in this unit counts
+    -- line feeds, not lines. A lone @\\r@ does not start a line.
+    Lines
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
+-- | Read the count for one unit from t'Metrics'.
+count :: Unit -> Metrics -> Int
+count Bytes = bytes
+count Chars = chars
+count Utf16 = utf16Units
+count Lines = newlines
+{-# INLINE count #-}
+
+-- | A zero-based line and column. Position functions take the column's
+-- unit separately; columns are not necessarily display widths.
+data Position = Position
+  { posLine :: !Int
+  -- ^ Zero-based line index.
+  , posColumn :: !Int
+  -- ^ Offset from the line start, in the unit supplied to the operation.
+  }
+  deriving (Eq, Ord, Show)
+
+instance NFData Position where
+  rnf !_ = ()
+
+------------------------------------------------------------------------------
+-- Custom measures
+
+-- | A user-defined monoidal summary of text, cached at every node of the
+-- tree alongside the built-in t'Metrics'.
+--
+-- Chunk boundaries are an implementation detail and can fall between any two
+-- code points, so 'measureChunk' must be a monoid homomorphism:
+--
+-- > measureChunk (x <> y) == measureChunk x <> measureChunk y
+-- > measureChunk mempty   == mempty
+--
+-- A context-sensitive measure may need boundary information. For example,
+-- counting @\\r\\n@ as one break requires tracking whether each non-empty
+-- piece starts with @\\n@ or ends with @\\r@, then adjusting the count in '<>'.
+--
+-- Annotations are kept in weak head normal form; give your measure strict
+-- fields to avoid building up thunks.
+class Monoid a => Measure a where
+  -- | Measure a piece of text. The argument is a zero-copy view of at most
+  -- 'maxChunk' bytes.
+  measureChunk :: Text -> a
+
+-- | No custom measure.
+instance Measure () where
+  measureChunk _ = ()
+  {-# INLINE measureChunk #-}
+
+instance (Measure a, Measure b) => Measure (a, b) where
+  measureChunk t = (measureChunk t, measureChunk t)
+  {-# INLINE measureChunk #-}
+
+instance (Measure a, Measure b, Measure c) => Measure (a, b, c) where
+  measureChunk t = (measureChunk t, measureChunk t, measureChunk t)
+  {-# INLINE measureChunk #-}
+
+------------------------------------------------------------------------------
+-- The tree
+
+-- | A rope of text annotated with a custom measure @a@. Use @()@ (or the
+-- monomorphic interface in "Data.Text.NanoRope") when the built-in t'Metrics'
+-- are all you need.
+--
+-- The v'Rope' pattern exposes the tree after applying pending input.
+-- Editing and metric queries can inspect the buffer directly.
+data Rope a
+  = -- | A tree, the unit and end offset of the last insertion, and the known
+    -- free space in its target leaf. A negative offset disables buffering
+    -- of a subsequent insertion.
+    Settled
+      (Node a)
+      !Unit
+      {-# UNPACK #-} !Int
+      {-# UNPACK #-} !Int
+  | -- | A tree with a pending insertion. Further keystrokes extend the
+    -- buffer without copying a tree path. The first field lazily applies
+    -- the whole insertion when a reader needs the tree.
+    --
+    -- Remaining fields: the base tree, insertion unit and offset, buffered
+    -- text (at most 'maxPending' bytes), its packed metrics, and remaining
+    -- buffer capacity.
+    --
+    -- To keep this constructor small, @typingNext@ and 'metrics' calculate
+    -- the next insertion offset and total metrics rather than storing them.
+    Typing
+      (Lazy a)
+      (Node a)
+      !Unit
+      {-# UNPACK #-} !Int
+      {-# UNPACK #-} !ByteArray
+      {-# UNPACK #-} !PackedMetrics
+      {-# UNPACK #-} !Int
+
+-- | A lifted wrapper that can defer construction of an unlifted node.
+-- Used for the pending tree update in 'Typing'.
+data Lazy a = Lazy (Node a)
+
+-- | Match or build a rope's tree. Matching applies pending input and
+-- returns the evaluated, unlifted root.
+pattern Rope :: Node a -> Rope a
+pattern Rope root <- (rootOf -> root)
+  where
+    Rope root = Settled root Bytes (-1) 0
+
+{-# COMPLETE Rope #-}
+
+rootOf :: Rope a -> Node a
+rootOf (Settled root _ _ _) = root
+rootOf (Typing (Lazy root) _ _ _ _ _ _) = root
+{-# INLINE rootOf #-}
+
+-- | An unlifted B-tree node. Nodes cannot be thunks;
+-- custom annotations are evaluated only to weak head normal form.
+--
+-- Both constructors start with the metrics of their subtree, which is all
+-- that seeking reads of a node it does not descend into.
+type Node :: Type -> UnliftedType
+data Node a
+  = -- | Metrics, annotation and UTF-8 payload, which is what the pattern
+    -- v'Leaf' matches and builds. The payload occupies the whole array:
+    -- there is no offset or length to chase.
+    --
+    -- All four metrics fit in 16 bits each (see 'PackedMetrics'), saving
+    -- three machine words per leaf on a 64-bit system.
+    PackedLeaf
+      {-# UNPACK #-} !PackedMetrics
+      !a
+      {-# UNPACK #-} !ByteArray
+  | -- | Metrics, height (at least 1), annotation and children.
+    Inner
+      {-# UNPACK #-} !Metrics
+      {-# UNPACK #-} !Int
+      !a
+      {-# UNPACK #-} !(Children a)
+
+-- | A leaf: metrics, annotation and UTF-8 payload.
+pattern Leaf :: Metrics -> a -> ByteArray -> Node a
+pattern Leaf m a arr <- PackedLeaf (unpackMetrics -> !m) a arr
+  where
+    Leaf m a arr = PackedLeaf (packMetrics m) a arr
+
+{-# COMPLETE Leaf, Inner #-}
+
+-- | Four 16-bit counts in a 64-bit word, from low to high: bytes, code
+-- points, UTF-16 code units, and line feeds. Supports up to 65535 bytes.
+type PackedMetrics = Word64
+
+-- | Pack metrics whose fields each fit in 16 bits. Does not check bounds.
+packMetrics :: Metrics -> PackedMetrics
+packMetrics (Metrics b c u l) =
+  fromIntegral b
+    .|. (fromIntegral c `unsafeShiftL` 16)
+    .|. (fromIntegral u `unsafeShiftL` 32)
+    .|. (fromIntegral l `unsafeShiftL` 48)
+{-# INLINE packMetrics #-}
+
+-- | Decode the four counts in a packed leaf metric.
+unpackMetrics :: PackedMetrics -> Metrics
+unpackMetrics w = Metrics (field 0) (field 16) (field 32) (field 48)
+  where
+    field s = fromIntegral ((w `unsafeShiftR` s) .&. 0xFFFF)
+{-# INLINE unpackMetrics #-}
+
+nodeMetrics :: Node a -> Metrics
+nodeMetrics (Leaf m _ _) = m
+nodeMetrics (Inner m _ _ _) = m
+{-# INLINE nodeMetrics #-}
+
+nodeAnn :: Node a -> a
+nodeAnn (Leaf _ a _) = a
+nodeAnn (Inner _ _ a _) = a
+{-# INLINE nodeAnn #-}
+
+nodeHeight :: Node a -> Int
+nodeHeight Leaf{} = 0
+nodeHeight (Inner _ h _ _) = h
+{-# INLINE nodeHeight #-}
+
+nodeBytes :: Node a -> Int
+nodeBytes node = bytes (nodeMetrics node)
+{-# INLINE nodeBytes #-}
+
+nodeIsEmpty :: Node a -> Bool
+nodeIsEmpty node = nodeBytes node == 0
+{-# INLINE nodeIsEmpty #-}
+
+-- | Construct an empty leaf. Unlifted values cannot be top-level constants,
+-- so this allocates a leaf for each empty result.
+emptyNode :: Monoid a => Node a
+emptyNode = PackedLeaf 0 mempty emptyByteArray
+{-# INLINE emptyNode #-}
+
+------------------------------------------------------------------------------
+-- Arrays of nodes
+
+-- | A small array of unlifted child nodes. The wrappers below provide the
+-- subset of array operations needed by the tree.
+data Children a = Children (SmallArray# (Node a))
+
+data MutableChildren s a = MutableChildren (SmallMutableArray# s (Node a))
+
+-- | How many children there are.
+sizeofChildren :: Children a -> Int
+sizeofChildren (Children cs) = I# (sizeofSmallArray# cs)
+{-# INLINE sizeofChildren #-}
+
+-- | Read a child without bounds checking. Unlifted elements need no
+-- evaluation check after loading.
+indexChildren :: Children a -> Int -> Node a
+indexChildren (Children cs) (I# i) = case indexSmallArray# cs i of (# node #) -> node
+{-# INLINE indexChildren #-}
+
+-- | Allocate an array filled with the supplied node.
+newChildren :: Int -> Node a -> ST s (MutableChildren s a)
+newChildren (I# n) node = ST $ \s -> case newSmallArray# n node s of
+  (# s', m #) -> (# s', MutableChildren m #)
+{-# INLINE newChildren #-}
+
+writeChildren :: MutableChildren s a -> Int -> Node a -> ST s ()
+writeChildren (MutableChildren m) (I# i) node = ST $ \s -> (# writeSmallArray# m i node s, () #)
+{-# INLINE writeChildren #-}
+
+-- | Copy @cnt@ children from @src@ at @off@ to @dst@ at @d@.
+copyChildren :: MutableChildren s a -> Int -> Children a -> Int -> Int -> ST s ()
+copyChildren (MutableChildren dst) (I# d) (Children src) (I# off) (I# cnt) =
+  ST $ \s -> (# copySmallArray# src off dst d cnt s, () #)
+{-# INLINE copyChildren #-}
+
+thawChildren :: Children a -> Int -> Int -> ST s (MutableChildren s a)
+thawChildren (Children cs) (I# off) (I# cnt) = ST $ \s -> case thawSmallArray# cs off cnt s of
+  (# s', m #) -> (# s', MutableChildren m #)
+{-# INLINE thawChildren #-}
+
+cloneChildren :: Children a -> Int -> Int -> Children a
+cloneChildren (Children cs) (I# off) (I# cnt) = Children (cloneSmallArray# cs off cnt)
+{-# INLINE cloneChildren #-}
+
+runChildren :: (forall s. ST s (MutableChildren s a)) -> Children a
+runChildren (ST build) =
+  case runRW# (\s -> case build s of (# s', MutableChildren m #) -> unsafeFreezeSmallArray# m s') of
+    (# _, cs #) -> Children cs
+{-# INLINE runChildren #-}
+
+------------------------------------------------------------------------------
+-- Seeking
+
+-- Non-inlined workers with unpacked result records let GHC return these
+-- fields in registers. An unboxed tuple containing boxed Int or Metrics
+-- values can instead allocate at every tree level.
+
+-- | A child index and the total metrics of preceding children.
+data Seek = Seek {-# UNPACK #-} !Int {-# UNPACK #-} !Metrics
+
+-- | A child index and an offset within it.
+data Sought = Sought {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+
+-- | A child index, an offset within it, and the byte count before it.
+data SoughtBytes = SoughtBytes {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+
+-- | Find the first child whose cumulative count reaches @k@, or the last
+-- child. Also return the metrics of preceding children.
+--
+-- Find the child before summing metrics to reduce register pressure.
+-- Use the supplied total to sum whichever side is shorter.
+seekChild :: Unit -> Int -> Metrics -> Children a -> Seek
+seekChild !u !k !total !cs = case seekUnit u k (count u total) cs of
+  Sought i _
+    | 2 * i > n -> Seek i (total `subMetrics` sumMetrics cs i (n - i))
+    | otherwise -> Seek i (sumMetrics cs 0 i)
+  where
+    n = sizeofChildren cs
+{-# NOINLINE seekChild #-}
+
+-- | Like 'seekChild', but return only the child index and relative offset.
+-- Use the supplied total to search from the nearer end of the node.
+seekUnit :: Unit -> Int -> Int -> Children a -> Sought
+seekUnit !u !k !total !cs = case u of
+  Bytes -> scan bytes
+  Chars -> scan chars
+  Utf16 -> scan utf16Units
+  Lines -> scan newlines
+  where
+    n = sizeofChildren cs
+    scan sel
+      | 2 * k > total = backwards (n - 1) 0
+      | otherwise = forwards 0 k
+      where
+        forwards !i !j
+          | i >= n - 1 || m >= j = Sought i j
+          | otherwise = forwards (i + 1) (j - m)
+          where
+            m = sel (nodeMetrics (indexChildren cs i))
+        -- The same child, from the other end: the last one with less than k
+        -- in front of it, which is the total without the child and what is
+        -- after it.
+        backwards !i !after
+          | i <= 0 = Sought 0 k
+          | before < k = Sought i (k - before)
+          | otherwise = backwards (i - 1) (total - before)
+          where
+            before = total - after - sel (nodeMetrics (indexChildren cs i))
+    {-# INLINE scan #-}
+{-# NOINLINE seekUnit #-}
+
+-- | Like 'seekUnit', also returning the byte count before the child.
+seekUnitBytes :: Unit -> Int -> Metrics -> Children a -> SoughtBytes
+seekUnitBytes !u !k !total !cs = case u of
+  Bytes -> case seekUnit Bytes k (bytes total) cs of Sought i j -> SoughtBytes i j (k - j)
+  Chars -> scan chars
+  Utf16 -> scan utf16Units
+  Lines -> scan newlines
+  where
+    n = sizeofChildren cs
+    scan sel = go 0 k 0
+      where
+        go !i !j !b
+          | i >= n - 1 || sel m >= j = SoughtBytes i j b
+          | otherwise = go (i + 1) (j - sel m) (b + bytes m)
+          where
+            m = nodeMetrics (indexChildren cs i)
+    {-# INLINE scan #-}
+{-# NOINLINE seekUnitBytes #-}
+
+-- | Find the child containing byte @i@ and its relative offset. Unlike
+-- 'seekChild', an offset at a boundary selects the following child.
+seekByte :: Int -> Children a -> Sought
+seekByte !i !cs = go 0 i
+  where
+    n = sizeofChildren cs
+    go !c !j
+      | c >= n - 1 || j < m = Sought c j
+      | otherwise = go (c + 1) (j - m)
+      where
+        m = nodeBytes (indexChildren cs c)
+{-# NOINLINE seekByte #-}
+
+------------------------------------------------------------------------------
+-- Building inner nodes
+
+-- | Combine child annotations with a right fold. The @()@ measure does not
+-- evaluate its arguments, so it avoids traversing the children.
+foldAnn :: Monoid a => Children a -> a
+foldAnn cs = go 0
+  where
+    n = sizeofChildren cs
+    go !i
+      | i >= n - 1 = nodeAnn (indexChildren cs i)
+      | otherwise = nodeAnn (indexChildren cs i) <> go (i + 1)
+{-# INLINE foldAnn #-}
+
+-- | Metrics of children @off .. off + cnt - 1@.
+--
+-- Children all have the same height. For leaves, add packed counts directly:
+-- @maxChildren * maxChunk < 65536@ prevents carries between 16-bit fields.
+sumMetrics :: Children a -> Int -> Int -> Metrics
+sumMetrics !cs !off !cnt
+  | cnt <= 0 = mempty
+  | otherwise = case indexChildren cs off of
+      PackedLeaf{} -> unpackMetrics (packed off 0)
+      Inner{} -> spelled off 0 0 0 0
+  where
+    end = off + cnt
+    packed !i !acc
+      | i >= end = acc
+      | otherwise = case indexChildren cs i of
+          PackedLeaf m _ _ -> packed (i + 1) (acc + m)
+          Inner{} -> unreachable "sumMetrics"
+    spelled !i !b !c !w !l
+      | i >= end = Metrics b c w l
+      | otherwise = case indexChildren cs i of
+          Inner (Metrics b' c' w' l') _ _ _ -> spelled (i + 1) (b + b') (c + c') (w + w') (l + l')
+          PackedLeaf{} -> unreachable "sumMetrics"
+
+-- | Build an inner node with known height and metrics and at least one
+-- child. Reusing metrics avoids scanning the children again.
+inner :: Monoid a => Int -> Metrics -> Children a -> Node a
+inner h m cs = Inner m h (foldAnn cs) cs
+{-# INLINE inner #-}
+
+-- | Build an inner node out of at least one child.
+mkInner :: Monoid a => Children a -> Node a
+mkInner cs = inner (nodeHeight (indexChildren cs 0) + 1) (sumMetrics cs 0 (sizeofChildren cs)) cs
+{-# INLINABLE mkInner #-}
+{-# SPECIALIZE mkInner :: Children () -> Node () #-}
+
+mkInner2 :: Monoid a => Node a -> Node a -> Node a
+mkInner2 x y = inner (nodeHeight x + 1) (nodeMetrics x <> nodeMetrics y) $ runChildren $ do
+  m <- newChildren 2 x
+  writeChildren m 1 y
+  pure m
+{-# INLINABLE mkInner2 #-}
+{-# SPECIALIZE mkInner2 :: Node () -> Node () -> Node () #-}
+
+replaceAt :: Children a -> Int -> Node a -> Children a
+replaceAt arr i x = runChildren $ do
+  m <- thawChildren arr 0 (sizeofChildren arr)
+  writeChildren m i x
+  pure m
+
+-- | The first @cnt@ elements followed by two more. One allocation if the
+-- array has two elements to spare, which are copied along and overwritten.
+snoc2 :: Children a -> Int -> Node a -> Node a -> Children a
+snoc2 arr cnt x y = runChildren $ do
+  m <-
+    if cnt + 2 <= sizeofChildren arr
+      then thawChildren arr 0 (cnt + 2)
+      else do
+        out <- newChildren (cnt + 2) y
+        copyChildren out 0 arr 0 cnt
+        pure out
+  writeChildren m cnt x
+  writeChildren m (cnt + 1) y
+  pure m
+
+-- | Two elements followed by all but the first @off@ of an array.
+cons2 :: Node a -> Node a -> Children a -> Int -> Children a
+cons2 x y arr off = runChildren $ do
+  let cnt = sizeofChildren arr - off
+  m <-
+    if off >= 2
+      then thawChildren arr (off - 2) (cnt + 2)
+      else do
+        out <- newChildren (cnt + 2) x
+        copyChildren out 2 arr off cnt
+        pure out
+  writeChildren m 0 x
+  writeChildren m 1 y
+  pure m
+
+-- | Replace element @c@ by two.
+insert2 :: Children a -> Int -> Node a -> Node a -> Children a
+insert2 arr c x y = runChildren $ do
+  let n = sizeofChildren arr
+  m <- newChildren (n + 1) x
+  copyChildren m 0 arr 0 c
+  writeChildren m (c + 1) y
+  copyChildren m (c + 2) arr (c + 1) (n - c - 1)
+  pure m
+
+-- | A slice of one array followed by a slice of another, at least one of
+-- them not empty.
+append2 :: Children a -> Int -> Int -> Children a -> Int -> Int -> Children a
+append2 a offa cnta b offb cntb = runChildren $ do
+  m <- newChildren (cnta + cntb) (if cnta > 0 then indexChildren a offa else indexChildren b offb)
+  copyChildren m 0 a offa cnta
+  copyChildren m cnta b offb cntb
+  pure m
+
+------------------------------------------------------------------------------
+-- Scanning chunks
+
+isContByte :: Word8 -> Bool
+isContByte b = b .&. 0xC0 == 0x80
+{-# INLINE isContByte #-}
+
+byteAt :: ByteArray -> Int -> Word8
+byteAt = indexByteArray
+{-# INLINE byteAt #-}
+
+-- | Unaligned read of 8 bytes. Only ever used for counting, so the byte
+-- order does not matter.
+indexWord64 :: ByteArray -> Int -> Word64
+indexWord64 (ByteArray ba) (I# i) = W64# (indexWord8ArrayAsWord64# ba i)
+{-# INLINE indexWord64 #-}
+
+lows, highs :: Word64
+lows = 0x0101010101010101
+highs = 0x8080808080808080
+
+-- | Sum of the bytes of a word whose bytes are all 0 or 1.
+byteSum :: Word64 -> Int
+byteSum m = fromIntegral ((m * lows) `unsafeShiftR` 56)
+{-# INLINE byteSum #-}
+
+-- | Number of UTF-8 continuation bytes (@10xxxxxx@) in a word.
+contCount :: Word64 -> Int
+contCount w = byteSum ((w `unsafeShiftR` 7) .&. (complement w `unsafeShiftR` 6) .&. lows)
+{-# INLINE contCount #-}
+
+-- | Count 4-byte sequence leaders (@1111xxxx@). For valid UTF-8, each marks
+-- a code point requiring two UTF-16 code units.
+fourCount :: Word64 -> Int
+fourCount w =
+  byteSum
+    ( (w .&. (w `unsafeShiftL` 1) .&. (w `unsafeShiftL` 2) .&. (w `unsafeShiftL` 3) .&. highs)
+        `unsafeShiftR` 7
+    )
+{-# INLINE fourCount #-}
+
+-- | Number of @\\n@ bytes in a word.
+nlCount :: Word64 -> Int
+nlCount w = byteSum ((complement t .&. highs) `unsafeShiftR` 7)
+  where
+    x = w `xor` 0x0A0A0A0A0A0A0A0A
+    -- High bit of every non-zero byte of x. Exact: no carry crosses a byte.
+    t = ((x .&. 0x7F7F7F7F7F7F7F7F) + 0x7F7F7F7F7F7F7F7F) .|. x
+{-# INLINE nlCount #-}
+
+-- | Metrics of @len@ bytes of valid UTF-8 starting at @off@.
+sliceMetrics :: ByteArray -> Int -> Int -> Metrics
+sliceMetrics !arr !off !len
+  | len >= simdMin = cMetrics simdLevel arr off len
+  | otherwise = swarMetrics arr off len
+{-# NOINLINE sliceMetrics #-}
+
+-- | 'sliceMetrics', 8 bytes at a time.
+swarMetrics :: ByteArray -> Int -> Int -> Metrics
+swarMetrics !arr !off !len = goWord off 0 0 0
+  where
+    end = off + len
+    goWord !i !conts !fours !nls
+      | i + 8 <= end =
+          let w = indexWord64 arr i
+           in if w .&. highs == 0
+                then -- ASCII needs only the newline count.
+                  goWord (i + 8) conts fours (nls + nlCount w)
+                else goWord (i + 8) (conts + contCount w) (fours + fourCount w) (nls + nlCount w)
+      | otherwise = goByte i conts fours nls
+    goByte !i !conts !fours !nls
+      | i >= end =
+          let cs = len - conts
+           in Metrics len cs (cs + fours) nls
+      | otherwise =
+          let b = byteAt arr i
+           in goByte
+                (i + 1)
+                (conts + fromEnum (isContByte b))
+                (fours + fromEnum (b >= 0xF0))
+                (nls + fromEnum (b == 0x0A))
+
+-- | Largest code point boundary @<= i@. Relies on some byte at or before @i@
+-- (and inside the text) being a boundary.
+roundDownFrom :: ByteArray -> Int -> Int
+roundDownFrom !arr (I# i) = I# (go i)
+  where
+    -- On unboxed offsets: a loop that returns its argument would box it on
+    -- every turn.
+    go j
+      | isContByte (byteAt arr (I# j)) = go (j -# 1#)
+      | otherwise = j
+{-# INLINE roundDownFrom #-}
+
+-- | Largest code point boundary @<= i@ of a chunk, clamped to the chunk.
+roundDown :: ByteArray -> Int -> Int
+roundDown arr i
+  | i <= 0 = 0
+  | i >= sizeofByteArray arr = sizeofByteArray arr
+  | otherwise = roundDownFrom arr i
+
+-- | Smallest code point boundary @>= i@ of a chunk, for @i >= 0@.
+roundUp :: ByteArray -> Int -> Int
+roundUp arr = go
+  where
+    len = sizeofByteArray arr
+    go !j
+      | j >= len = len
+      | isContByte (byteAt arr j) = go (j + 1)
+      | otherwise = j
+
+-- | Byte offset of a location within a chunk: the largest code point boundary
+-- with at most @k@ units before it, or for 'Lines' the offset just after the
+-- @k@-th line feed. Clamped to the chunk.
+offsetInChunk :: Unit -> Int -> ByteArray -> Int
+offsetInChunk !u !k !arr
+  | k <= 0 = 0
+  | otherwise = case u of
+      Bytes -> roundDown arr k
+      Chars -> scanUnits False k arr 0 (sizeofByteArray arr)
+      Utf16 -> scanUnits True k arr 0 (sizeofByteArray arr)
+      Lines -> scanLines k arr
+
+-- | @scanUnits wide k arr from to@ walks over code points from the boundary
+-- @from@ and stops in front of the first one that does not fit into @k@
+-- units, or at @to@.
+scanUnits :: Bool -> Int -> ByteArray -> Int -> Int -> Int
+scanUnits !wide !k !arr !from !to
+  | to - from >= simdMin = cScanUnits simdLevel wide k arr from to
+  | otherwise = swarScanUnits wide k arr from to
+{-# NOINLINE scanUnits #-}
+
+-- | 'scanUnits', skipping whole words as long as everything in them fits.
+swarScanUnits :: Bool -> Int -> ByteArray -> Int -> Int -> Int
+swarScanUnits !wide !k !arr !from !to = goWord from 0
+  where
+    goWord !i !n
+      | i + 8 <= to =
+          let w = indexWord64 arr i
+              c
+                | w .&. highs == 0 = 8
+                | wide = 8 - contCount w + fourCount w
+                | otherwise = 8 - contCount w
+           in if n + c <= k then goWord (i + 8) (n + c) else goByte i n
+      | otherwise = goByte i n
+    goByte !i !n
+      | i >= to = to
+      | isContByte b = goByte (i + 1) n
+      | n + u > k = i
+      | otherwise = goByte (i + 1) (n + u)
+      where
+        b = byteAt arr i
+        u = if wide && b >= 0xF0 then 2 else 1
+{-# INLINE swarScanUnits #-}
+
+-- | Whether the text is ASCII, so byte, code point, and UTF-16 offsets
+-- coincide without a scan.
+isAscii :: Metrics -> Bool
+isAscii m = bytes m == chars m
+{-# INLINE isAscii #-}
+
+-- | 'offsetInChunk' for a leaf with known metrics.
+leafOffset :: Unit -> Int -> Metrics -> ByteArray -> Int
+leafOffset !u !k !m !arr
+  | k <= 0 = 0
+  | u == Lines = scanLines k arr
+  | isAscii m = min k (bytes m)
+  | otherwise = offsetInChunk u k arr
+{-# NOINLINE leafOffset #-}
+
+-- | Metrics of the first @b@ bytes of a leaf with known metrics, counting
+-- whichever side of the cut is shorter.
+leafPrefixMetrics :: Metrics -> ByteArray -> Int -> Metrics
+leafPrefixMetrics m arr b
+  | b <= 0 = mempty
+  | b >= bytes m = m
+  | otherwise = leafCutMetrics m arr b
+{-# INLINE leafPrefixMetrics #-}
+
+-- | Like 'leafPrefixMetrics', with a known newline count. ASCII leaves
+-- need no additional scan.
+leafPrefixWithLines :: Metrics -> ByteArray -> Int -> Int -> Metrics
+leafPrefixWithLines m arr b nls
+  | isAscii m && 0 < b && b < bytes m = Metrics b b b nls
+  | otherwise = leafPrefixMetrics m arr b
+{-# INLINE leafPrefixWithLines #-}
+
+-- | Measure a cut strictly inside a leaf. Kept separate from
+-- 'leafPrefixMetrics' so GHC can pass the input metrics unboxed.
+leafCutMetrics :: Metrics -> ByteArray -> Int -> Metrics
+leafCutMetrics !m !arr !b
+  | 2 * b > size = m `subMetrics` leafSliceMetrics m arr b (size - b)
+  | otherwise = leafSliceMetrics m arr 0 b
+  where
+    size = bytes m
+{-# NOINLINE leafCutMetrics #-}
+
+-- | Metrics of a slice of a leaf with known metrics. (Not local to
+-- 'leafCutMetrics', where it would be allocated as a closure.)
+leafSliceMetrics :: Metrics -> ByteArray -> Int -> Int -> Metrics
+leafSliceMetrics !m !arr !off !len
+  | isAscii m = Metrics len len len (if newlines m == 0 then 0 else countNewlines arr off len)
+  | otherwise = sliceMetrics arr off len
+
+countNewlines :: ByteArray -> Int -> Int -> Int
+countNewlines !arr !off !len
+  | len >= simdMin = cNewlines simdLevel arr off len
+  | otherwise = swarNewlines arr off len
+{-# NOINLINE countNewlines #-}
+
+swarNewlines :: ByteArray -> Int -> Int -> Int
+swarNewlines !arr !off !len = goWord off 0
+  where
+    end = off + len
+    goWord !i !n
+      | i + 8 <= end = goWord (i + 8) (n + nlCount (indexWord64 arr i))
+      | otherwise = goByte i n
+    goByte !i !n
+      | i >= end = n
+      | otherwise = goByte (i + 1) (n + fromEnum (byteAt arr i == 0x0A))
+
+-- | Offset of the first @\\n@ at or after @from@, or the size of the chunk.
+findNewline :: ByteArray -> Int -> Int
+findNewline !arr !from
+  | sizeofByteArray arr - from >= simdMin = cFindNewline simdLevel arr from
+  | otherwise = swarFindNewline arr from
+{-# NOINLINE findNewline #-}
+
+swarFindNewline :: ByteArray -> Int -> Int
+swarFindNewline !arr = goWord
+  where
+    len = sizeofByteArray arr
+    goWord !i
+      | i + 8 <= len && nlCount (indexWord64 arr i) == 0 = goWord (i + 8)
+      | otherwise = goByte i
+    goByte !i
+      | i >= len || byteAt arr i == 0x0A = i
+      | otherwise = goByte (i + 1)
+
+-- | Offset of the last @\\n@ before @to@, or @-1@.
+findNewlineBack :: ByteArray -> Int -> Int
+findNewlineBack !arr !to
+  | to >= simdMin = cFindNewlineBack simdLevel arr to
+  | otherwise = swarFindNewlineBack arr to
+{-# NOINLINE findNewlineBack #-}
+
+swarFindNewlineBack :: ByteArray -> Int -> Int
+swarFindNewlineBack !arr = goWord
+  where
+    goWord !i
+      | i >= 8 && nlCount (indexWord64 arr (i - 8)) == 0 = goWord (i - 8)
+      | otherwise = goByte i
+    goByte !i
+      | i <= 0 = -1
+      | byteAt arr (i - 1) == 0x0A = i - 1
+      | otherwise = goByte (i - 1)
+
+-- | The number of line feeds among the first @b@ bytes of a leaf with known
+-- metrics, counting whichever side of the cut is shorter.
+leafNewlinesBefore :: Metrics -> ByteArray -> Int -> Int
+leafNewlinesBefore !m !arr !b
+  | newlines m == 0 || b <= 0 = 0
+  | b >= size = newlines m
+  | 2 * b > size = newlines m - countNewlines arr b (size - b)
+  | otherwise = countNewlines arr 0 b
+  where
+    size = bytes m
+
+-- | The offset just after the @k@-th @\\n@ of a chunk, for @k >= 1@, or the
+-- size of the chunk.
+scanLines :: Int -> ByteArray -> Int
+scanLines !k !arr
+  | sizeofByteArray arr >= simdMin = cNthNewline simdLevel k arr
+  | otherwise = swarScanLines k arr
+{-# NOINLINE scanLines #-}
+
+swarScanLines :: Int -> ByteArray -> Int
+swarScanLines !k !arr = goWord 0 0
+  where
+    len = sizeofByteArray arr
+    goWord !i !n
+      | i + 8 <= len =
+          let c = nlCount (indexWord64 arr i)
+           in if n + c < k then goWord (i + 8) (n + c) else goByte i n
+      | otherwise = goByte i n
+    goByte !i !n
+      | i >= len = len
+      | byteAt arr i == 0x0A = if n + 1 == k then i + 1 else goByte (i + 1) (n + 1)
+      | otherwise = goByte (i + 1) n
+
+-- | Byte offsets of a line's start and terminating @\\n@ within a chunk.
+-- A missing endpoint is represented by the chunk size.
+data ChunkLine = ChunkLine {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+  deriving (Eq, Show)
+
+-- | Find a chunk's zero-based line start and terminator in one scan entry
+-- point, avoiding separate foreign calls to 'scanLines' and 'findNewline'.
+chunkLine :: Int -> ByteArray -> ChunkLine
+chunkLine !k !arr
+  | sizeofByteArray arr >= simdMin = cLineSpan simdLevel k arr
+  | otherwise = swarLineSpan k arr
+{-# NOINLINE chunkLine #-}
+
+swarLineSpan :: Int -> ByteArray -> ChunkLine
+swarLineSpan !k !arr = ChunkLine from (swarFindNewline arr from)
+  where
+    from = if k <= 0 then 0 else swarScanLines k arr
+
+------------------------------------------------------------------------------
+-- Scanning chunks with SIMD
+
+-- | A set of chunk scan implementations. Exposed so tests can compare
+-- every available implementation against the same model.
+data Kernels = Kernels
+  { kernelsName :: String
+  -- ^ Implementation name, such as Haskell, SSE2, or AVX2.
+  , kernelMetrics :: ByteArray -> Int -> Int -> Metrics
+  -- ^ Like 'sliceMetrics'.
+  , kernelNewlines :: ByteArray -> Int -> Int -> Int
+  -- ^ Line feeds in a slice.
+  , kernelFindNewline :: ByteArray -> Int -> Int
+  -- ^ The first line feed at or after an offset, or the size.
+  , kernelFindNewlineBack :: ByteArray -> Int -> Int
+  -- ^ The last line feed before an offset, or -1.
+  , kernelScanUnits :: Bool -> Int -> ByteArray -> Int -> Int -> Int
+  -- ^ @kernelScanUnits wide k arr from to@: from a code point boundary, the
+  -- offset in front of the first code point that does not fit into @k@ code
+  -- points (UTF-16 code units if @wide@), or @to@.
+  , kernelLineSpan :: Int -> ByteArray -> ChunkLine
+  -- ^ Just after the @k@-th line feed, or 0 for @k <= 0@, and the first line
+  -- feed at or after that, or the size.
+  }
+
+-- | The scans in Haskell, 8 bytes at a time.
+swarKernels :: Kernels
+swarKernels = Kernels "Haskell" swarMetrics swarNewlines swarFindNewline swarFindNewlineBack swarScanUnits swarLineSpan
+
+-- | Available scans: Haskell, then C implementations in increasing SIMD
+-- order. The last is used on long slices. Without the @simd@ flag, only
+-- the Haskell implementation is included.
+kernels :: [Kernels]
+kernels = swarKernels : map simdKernels [0 .. simdLevel]
+
+-- | Minimum slice length for C scans, chosen to offset foreign-call overhead.
+--
+-- Dispatch directly to known functions. Selecting from a t'Kernels' record
+-- can leave indirect calls with boxed arguments and results when not inlined.
+simdMin :: Int
+
+-- | The best level of SIMD support of the machine, as the C numbers them.
+simdLevel :: Int
+
+-- | The scans in C at a level of SIMD support, which must be supported.
+simdKernels :: Int -> Kernels
+simdKernels level =
+  Kernels
+    (["portable C", "SSE2", "AVX2"] !! level)
+    (cMetrics level)
+    (cNewlines level)
+    (cFindNewline level)
+    (cFindNewlineBack level)
+    (cScanUnits level)
+    (cLineSpan level)
+
+-- The scans of a t'Kernels' in C, given the level of SIMD support.
+cMetrics :: Int -> ByteArray -> Int -> Int -> Metrics
+cNewlines :: Int -> ByteArray -> Int -> Int -> Int
+cFindNewline :: Int -> ByteArray -> Int -> Int
+cFindNewlineBack :: Int -> ByteArray -> Int -> Int
+cNthNewline :: Int -> Int -> ByteArray -> Int
+cScanUnits :: Int -> Bool -> Int -> ByteArray -> Int -> Int -> Int
+cLineSpan :: Int -> Int -> ByteArray -> ChunkLine
+
+#ifdef NANO_ROPE_SIMD
+-- Unsafe foreign calls keep the unpinned array payload stable for the call:
+-- GHC cannot perform a moving garbage collection until the call returns.
+
+#ifdef NANO_ROPE_SMALL
+-- Exercise C scans even with the test suite's tiny chunks.
+simdMin = 0
+#else
+simdMin = 32
+#endif
+
+-- Cache CPU detection. A pure foreign call could be inlined and repeated
+-- on every scan.
+simdLevel = unsafeDupablePerformIO c_simdLevel
+{-# NOINLINE simdLevel #-}
+
+-- C packs each count into 21 bits. Use Haskell for larger slices to avoid
+-- overflow (normal chunks are much smaller).
+cMetrics level arr@(ByteArray ba) off len
+  | len >= 0x200000 = swarMetrics arr off len
+  | otherwise =
+      let w = c_metrics level ba off len
+          field s = fromIntegral ((w `unsafeShiftR` s) .&. 0x1FFFFF)
+          cs = len - field 0
+       in Metrics len cs (cs + field 21) (field 42)
+{-# INLINE cMetrics #-}
+
+cNewlines level (ByteArray ba) off len = c_newlines level ba off len
+{-# INLINE cNewlines #-}
+
+cFindNewline level arr@(ByteArray ba) from = c_findNewline level ba from (sizeofByteArray arr)
+{-# INLINE cFindNewline #-}
+
+cFindNewlineBack level (ByteArray ba) to = c_findNewlineBack level ba to
+{-# INLINE cFindNewlineBack #-}
+
+cNthNewline level k arr@(ByteArray ba) = c_nthNewline level ba (sizeofByteArray arr) k
+{-# INLINE cNthNewline #-}
+
+cScanUnits level wide k (ByteArray ba) from to = c_scanUnits level ba from to k (fromEnum wide)
+{-# INLINE cScanUnits #-}
+
+-- Two offsets into a chunk, 32 bits each.
+cLineSpan level k arr@(ByteArray ba) =
+  let w = c_lineSpan level ba (sizeofByteArray arr) k
+   in ChunkLine (fromIntegral (w .&. 0xFFFFFFFF)) (fromIntegral (w `unsafeShiftR` 32))
+{-# INLINE cLineSpan #-}
+
+foreign import ccall unsafe "nano_rope_simd_level" c_simdLevel :: IO Int
+foreign import ccall unsafe "nano_rope_metrics" c_metrics :: Int -> ByteArray# -> Int -> Int -> Word64
+foreign import ccall unsafe "nano_rope_newlines" c_newlines :: Int -> ByteArray# -> Int -> Int -> Int
+foreign import ccall unsafe "nano_rope_find_newline" c_findNewline :: Int -> ByteArray# -> Int -> Int -> Int
+foreign import ccall unsafe "nano_rope_find_newline_back" c_findNewlineBack :: Int -> ByteArray# -> Int -> Int
+foreign import ccall unsafe "nano_rope_nth_newline" c_nthNewline :: Int -> ByteArray# -> Int -> Int -> Int
+foreign import ccall unsafe "nano_rope_scan_units" c_scanUnits :: Int -> ByteArray# -> Int -> Int -> Int -> Int -> Int
+foreign import ccall unsafe "nano_rope_line_span" c_lineSpan :: Int -> ByteArray# -> Int -> Int -> Word64
+#else
+simdMin = maxBound
+simdLevel = -1
+cMetrics _ = swarMetrics
+cNewlines _ = swarNewlines
+cFindNewline _ = swarFindNewline
+cFindNewlineBack _ = swarFindNewlineBack
+cNthNewline _ = swarScanLines
+cScanUnits _ = swarScanUnits
+cLineSpan _ = swarLineSpan
+#endif
+
+------------------------------------------------------------------------------
+-- Leaves
+
+-- | Zero-copy view of a slice of a chunk.
+viewSlice :: ByteArray -> Int -> Int -> Text
+viewSlice (ByteArray ba) off len
+  | len <= 0 = T.empty
+  | otherwise = TI.Text (A.ByteArray ba) off len
+{-# INLINE viewSlice #-}
+
+-- | Zero-copy view of a whole chunk.
+chunkText :: ByteArray -> Text
+chunkText arr = viewSlice arr 0 (sizeofByteArray arr)
+{-# INLINE chunkText #-}
+
+mkLeaf :: Measure a => ByteArray -> Node a
+mkLeaf arr = Leaf (sliceMetrics arr 0 (sizeofByteArray arr)) (measureChunk (chunkText arr)) arr
+{-# INLINE mkLeaf #-}
+
+-- | A leaf whose metrics are already known.
+mkLeafWith :: Measure a => Metrics -> ByteArray -> Node a
+mkLeafWith m arr = Leaf m (measureChunk (chunkText arr)) arr
+{-# INLINE mkLeafWith #-}
+
+concat2 :: ByteArray -> ByteArray -> ByteArray
+concat2 a b = concatSlices a 0 (sizeofByteArray a) b 0 (sizeofByteArray b)
+
+-- | A slice of one chunk followed by a slice of another.
+concatSlices :: ByteArray -> Int -> Int -> ByteArray -> Int -> Int -> ByteArray
+concatSlices a offa la b offb lb = runByteArray $ do
+  out <- newByteArray (la + lb)
+  copyByteArray out 0 a offa la
+  copyByteArray out la b offb lb
+  pure out
+
+-- | @spliceArray arr i j src off len@ replaces bytes @[i, j)@ of @arr@
+-- with @len@ bytes of @src@ starting at @off@.
+spliceArray :: ByteArray -> Int -> Int -> ByteArray -> Int -> Int -> ByteArray
+spliceArray arr i j src soff slen = runByteArray $ do
+  out <- newByteArray (sizeofByteArray arr - (j - i) + slen)
+  copyByteArray out 0 arr 0 i
+  copyByteArray out i src soff slen
+  copyByteArray out (i + slen) arr j (sizeofByteArray arr - j)
+  pure out
+
+-- | Read a byte from the result of 'spliceArray' without allocating that result.
+splicedByte :: ByteArray -> Int -> Int -> ByteArray -> Int -> Int -> Int -> Word8
+splicedByte arr i j src soff slen at
+  | at < i = byteAt arr at
+  | at < i + slen = byteAt src (soff + at - i)
+  | otherwise = byteAt arr (j + at - i - slen)
+{-# INLINE splicedByte #-}
+
+-- | Copy bytes @[from, to)@ of a splice directly, without allocating the
+-- full splice. Used to split an overflowing leaf into two buffers.
+splicedSlice :: ByteArray -> Int -> Int -> ByteArray -> Int -> Int -> Int -> Int -> ByteArray
+splicedSlice !arr !i !j !src !soff !slen !from !to = runByteArray $ do
+  out <- newByteArray (to - from)
+  -- Copy the overlap with each piece: prefix, inserted text, and suffix.
+  let piece !start !end source !sourceOff =
+        let lo = max from start
+            hi = min to end
+         in when (lo < hi) $ copyByteArray out (lo - from) source (sourceOff + lo - start) (hi - lo)
+  piece 0 i arr 0
+  piece i (i + slen) src soff
+  piece (i + slen) (sizeofByteArray arr - (j - i) + slen) arr j
+  pure out
+
+-- | First @b@ bytes of a leaf.
+leafPrefix :: Measure a => Int -> Node a -> Node a
+leafPrefix b node = case node of
+  Leaf m _ arr
+    | b <= 0 -> emptyNode
+    | b >= sizeofByteArray arr -> node
+    | otherwise -> mkLeafWith (leafPrefixMetrics m arr b) (cloneByteArray arr 0 b)
+  Inner{} -> error "Data.Text.NanoRope: leafPrefix on an inner node"
+{-# INLINE leafPrefix #-}
+
+-- | All but the first @b@ bytes of a leaf.
+leafSuffix :: Measure a => Int -> Node a -> Node a
+leafSuffix b node = case node of
+  Leaf m _ arr
+    | b <= 0 -> node
+    | b >= sizeofByteArray arr -> emptyNode
+    | otherwise ->
+        mkLeafWith (m `subMetrics` leafPrefixMetrics m arr b) (cloneByteArray arr b (sizeofByteArray arr - b))
+  Inner{} -> error "Data.Text.NanoRope: leafSuffix on an inner node"
+{-# INLINE leafSuffix #-}
+
+-- | A tree over more than 'maxChunk' bytes, cut into evenly sized leaves.
+-- Aiming a little below 'maxChunk' leaves room for moving every cut back to a
+-- code point boundary.
+--
+-- Build top-down into each parent's child array, avoiding intermediate
+-- lists of leaves and levels.
+treeFromSlice :: Measure a => ByteArray -> Int -> Int -> Node a
+treeFromSlice !arr !off !len = node (levelSizes leaves) 0
+  where
+    target = maxChunk - 4
+    leaves = (len + target - 1) `quot` target
+    (q, r) = len `quotRem` leaves
+    -- Where leaf @j@ starts.
+    cut j
+      | j <= 0 = off
+      | j >= leaves = off + len
+      | otherwise = roundDownFrom arr (off + j * q + (j * r) `quot` leaves)
+    -- Node @j@ of a level, given the sizes of that level and the ones below.
+    -- Strict in everything: a lazy index is a thunk for every node.
+    node sizes !j = case sizes of
+      parents : below@(children : _) ->
+        -- The children are spread evenly, so that no parent ends up below
+        -- 'minChildren'.
+        let !cq = children `quot` parents
+            !cr = children `rem` parents
+            !first = j * cq + min j cr
+            !size = if j < cr then cq + 1 else cq
+         in mkInner $ runChildren $ do
+              -- At least one child, and the array starts out full of it.
+              m <- newChildren size (node below first)
+              let go !i
+                    | i >= size = pure m
+                    | otherwise = do
+                        writeChildren m i (node below (first + i))
+                        go (i + 1)
+              go 1
+      [_] -> let !from = cut j in mkLeaf (cloneByteArray arr from (cut (j + 1) - from))
+      [] -> emptyNode
+{-# INLINABLE treeFromSlice #-}
+{-# SPECIALIZE treeFromSlice :: ByteArray -> Int -> Int -> Node () #-}
+
+-- | Node counts per level for the given leaf count, from root to leaves.
+levelSizes :: Int -> [Int]
+levelSizes = go []
+  where
+    go above n
+      | n <= 1 = n : above
+      | otherwise = go (n : above) ((n + maxChildren - 1) `quot` maxChildren)
+
+fromTextNode :: Measure a => Text -> Node a
+fromTextNode (TI.Text (A.ByteArray ba) off len)
+  | len <= 0 = emptyNode
+  | len <= maxChunk =
+      -- Share the array when the text owns all of it.
+      mkLeaf (if off == 0 && len == sizeofByteArray arr then arr else cloneByteArray arr off len)
+  | otherwise = treeFromSlice arr off len
+  where
+    arr = ByteArray ba
+{-# INLINABLE fromTextNode #-}
+{-# SPECIALIZE fromTextNode :: Text -> Node () #-}
+
+------------------------------------------------------------------------------
+-- Concatenation
+
+-- | Outcome of merging two trees: one or two nodes of the height of the
+-- taller tree. Also the outcome of an edit within a leaf, which is 'None' if
+-- the edit does not stay there.
+--
+-- An unboxed sum, so that handing a node up a level allocates nothing.
+type Result a = (# (# #) | Node a | (# Node a, Node a #) #)
+
+pattern None :: Result a
+pattern None = (# (# #) | | #)
+
+pattern One :: Node a -> Result a
+pattern One n = (# | n | #)
+
+pattern Two :: Node a -> Node a -> Result a
+pattern Two x y = (# | | (# x, y #) #)
+
+{-# COMPLETE None, One, Two #-}
+
+appendNode :: Measure a => Node a -> Node a -> Node a
+appendNode l r
+  | nodeIsEmpty l = r
+  | nodeIsEmpty r = l
+  | otherwise = case merge l r of
+      One n -> n
+      Two x y -> mkInner2 x y
+      None -> unreachable "appendNode"
+{-# INLINABLE appendNode #-}
+{-# SPECIALIZE appendNode :: Node () -> Node () -> Node () #-}
+
+unreachable :: forall r (a :: TYPE r). String -> a
+unreachable fun = error ("Data.Text.NanoRope: " ++ fun)
+{-# NOINLINE unreachable #-}
+
+-- | The outcome of an edit with the room it leaves, see 'editNode'.
+roomy :: Result a -> Int -> (# Result a, Int# #)
+roomy r (I# room) = (# r, room #)
+{-# INLINE roomy #-}
+
+-- | Merge two non-empty trees whose roots are allowed to be undersized.
+-- Walks down the spine of the taller tree to the height of the shorter one,
+-- merges there, and propagates at most one extra node back up.
+merge :: Measure a => Node a -> Node a -> Result a
+merge l r = case compare (nodeHeight l) (nodeHeight r) of
+  EQ -> mergeEq l r
+  GT -> case l of
+    Inner ml h _ cs ->
+      let k = sizeofChildren cs - 1
+          m = ml <> nodeMetrics r
+       in case merge (indexChildren cs k) r of
+            One x -> One (inner h m (replaceAt cs k x))
+            Two x y -> fromChildren h m (snoc2 cs k x y)
+            None -> None
+    Leaf{} -> unreachable "merge"
+  LT -> case r of
+    Inner mr h _ cs ->
+      let m = nodeMetrics l <> mr
+       in case merge l (indexChildren cs 0) of
+            One x -> One (inner h m (replaceAt cs 0 x))
+            Two x y -> fromChildren h m (cons2 x y cs 1)
+            None -> None
+    Leaf{} -> unreachable "merge"
+{-# INLINABLE merge #-}
+{-# SPECIALIZE merge :: Node () -> Node () -> Result () #-}
+
+-- | Merge two trees of equal height. Nodes that are both large enough become
+-- siblings untouched; otherwise their contents are pooled and redistributed.
+mergeEq :: Measure a => Node a -> Node a -> Result a
+mergeEq l@(Leaf ml al bl) r@(Leaf mr ar br)
+  | sl >= minChunk && sr >= minChunk = Two l r
+  | total <= maxChunk = One (Leaf (ml <> mr) (al <> ar) (concat2 bl br))
+  | half < sl =
+      -- Even them out: the end of the left leaf goes to the right one.
+      let cut = roundDownFrom bl half
+          mx = leafPrefixMetrics ml bl cut
+       in Two
+            (mkLeafWith mx (cloneByteArray bl 0 cut))
+            (mkLeafWith ((ml <> mr) `subMetrics` mx) (concatSlices bl cut (sl - cut) br 0 sr))
+  | otherwise =
+      let cut = roundDownFrom br (half - sl)
+          mx = leafPrefixMetrics mr br cut
+       in Two
+            (mkLeafWith (ml <> mx) (concatSlices bl 0 sl br 0 cut))
+            (mkLeafWith (mr `subMetrics` mx) (cloneByteArray br cut (sr - cut)))
+  where
+    sl = sizeofByteArray bl
+    sr = sizeofByteArray br
+    total = sl + sr
+    half = total `quot` 2
+mergeEq l@(Inner ml h _ csl) r@(Inner mr _ _ csr)
+  | nl >= minChildren && nr >= minChildren = Two l r
+  | nl + nr <= maxChildren = One (inner h (ml <> mr) (append2 csl 0 nl csr 0 nr))
+  | half <= nl =
+      -- Hand the last children of the left node over to the right one.
+      let moved = sumMetrics csl half (nl - half)
+       in Two
+            (inner h (ml `subMetrics` moved) (cloneChildren csl 0 half))
+            (inner h (moved <> mr) (append2 csl half (nl - half) csr 0 nr))
+  | otherwise =
+      let cnt = half - nl
+          moved = sumMetrics csr 0 cnt
+       in Two
+            (inner h (ml <> moved) (append2 csl 0 nl csr 0 cnt))
+            (inner h (mr `subMetrics` moved) (cloneChildren csr cnt (nr - cnt)))
+  where
+    nl = sizeofChildren csl
+    nr = sizeofChildren csr
+    half = (nl + nr + 1) `quot` 2
+mergeEq _ _ = unreachable "mergeEq"
+{-# INLINABLE mergeEq #-}
+{-# SPECIALIZE mergeEq :: Node () -> Node () -> Result () #-}
+
+-- | One node of height @h@ if the children fit, else two.
+fromChildren :: Monoid a => Int -> Metrics -> Children a -> Result a
+fromChildren !h !m !cs
+  | n <= maxChildren = One (inner h m cs)
+  | otherwise =
+      let half = (n + 1) `quot` 2
+          ml = sumMetrics cs 0 half
+       in Two
+            (inner h ml (cloneChildren cs 0 half))
+            (inner h (m `subMetrics` ml) (cloneChildren cs half (n - half)))
+  where
+    n = sizeofChildren cs
+{-# INLINABLE fromChildren #-}
+{-# SPECIALIZE fromChildren :: Int -> Metrics -> Children () -> Result () #-}
+
+------------------------------------------------------------------------------
+-- Breaking
+
+-- | Whether @k@ reaches the document end. In 'Lines', an offset equal to
+-- the newline count selects the final line start, which may precede the end.
+beyondEnd :: Unit -> Int -> Metrics -> Bool
+beyondEnd u k total = k > n || (k == n && u /= Lines)
+  where
+    n = count u total
+{-# INLINE beyondEnd #-}
+
+takeRoot :: Measure a => Unit -> Int -> Node a -> Node a
+takeRoot u k root
+  | k <= 0 = emptyNode
+  | beyondEnd u k (nodeMetrics root) = root
+  | otherwise = takeNode u k root
+{-# INLINABLE takeRoot #-}
+{-# SPECIALIZE takeRoot :: Unit -> Int -> Node () -> Node () #-}
+
+dropRoot :: Measure a => Unit -> Int -> Node a -> Node a
+dropRoot u k root
+  | k <= 0 = root
+  | beyondEnd u k (nodeMetrics root) = emptyNode
+  | otherwise = dropNode u k root
+{-# INLINABLE dropRoot #-}
+{-# SPECIALIZE dropRoot :: Unit -> Int -> Node () -> Node () #-}
+
+splitRoot :: Measure a => Unit -> Int -> Node a -> (# Node a, Node a #)
+splitRoot u k root
+  | k <= 0 = (# emptyNode, root #)
+  | beyondEnd u k (nodeMetrics root) = (# root, emptyNode #)
+  | otherwise = splitNode u k root
+{-# INLINABLE splitRoot #-}
+{-# SPECIALIZE splitRoot :: Unit -> Int -> Node () -> (# Node (), Node () #) #-}
+
+-- | Join children @[0, i)@ (with metrics @before@) to a lower tree.
+-- Merge the boundary sibling as needed to repair an undersized root.
+joinLeft :: Measure a => Int -> Children a -> Int -> Metrics -> Node a -> Node a
+joinLeft !h !cs !i !before !l
+  | i == 0 = l
+  | nodeIsEmpty l = if i == 1 then indexChildren cs 0 else inner h before (cloneChildren cs 0 i)
+  | otherwise = case merge (indexChildren cs (i - 1)) l of
+      One x
+        | i == 1 -> x
+        | otherwise -> inner h m $ runChildren $ do
+            out <- thawChildren cs 0 i
+            writeChildren out (i - 1) x
+            pure out
+      Two x y -> inner h m (snoc2 cs (i - 1) x y)
+      None -> unreachable "joinLeft"
+  where
+    m = before <> nodeMetrics l
+{-# INLINABLE joinLeft #-}
+{-# SPECIALIZE joinLeft :: Int -> Children () -> Int -> Metrics -> Node () -> Node () #-}
+
+-- | A lower tree followed by the children after child @i@ of a node of
+-- height @h@, whose metrics are @after@.
+joinRight :: Measure a => Int -> Children a -> Int -> Metrics -> Node a -> Node a
+joinRight !h !cs !i !after !r
+  | rest == 0 = r
+  | nodeIsEmpty r = if rest == 1 then indexChildren cs (i + 1) else inner h after (cloneChildren cs (i + 1) rest)
+  | otherwise = case merge r (indexChildren cs (i + 1)) of
+      One x
+        | rest == 1 -> x
+        | otherwise -> inner h m $ runChildren $ do
+            out <- thawChildren cs (i + 1) rest
+            writeChildren out 0 x
+            pure out
+      Two x y -> inner h m (cons2 x y cs (i + 2))
+      None -> unreachable "joinRight"
+  where
+    rest = sizeofChildren cs - i - 1
+    m = nodeMetrics r <> after
+{-# INLINABLE joinRight #-}
+{-# SPECIALIZE joinRight :: Int -> Children () -> Int -> Metrics -> Node () -> Node () #-}
+
+takeNode :: Measure a => Unit -> Int -> Node a -> Node a
+takeNode u k node = case node of
+  Leaf m _ arr -> leafPrefix (leafOffset u k m arr) node
+  Inner total h _ cs -> case seekChild u k total cs of
+    Seek i before -> joinLeft h cs i before (takeNode u (k - count u before) (indexChildren cs i))
+{-# INLINABLE takeNode #-}
+{-# SPECIALIZE takeNode :: Unit -> Int -> Node () -> Node () #-}
+
+dropNode :: Measure a => Unit -> Int -> Node a -> Node a
+dropNode u k node = case node of
+  Leaf m _ arr -> leafSuffix (leafOffset u k m arr) node
+  Inner total h _ cs -> case seekChild u k total cs of
+    Seek i before ->
+      let child = indexChildren cs i
+          after = total `subMetrics` before `subMetrics` nodeMetrics child
+       in joinRight h cs i after (dropNode u (k - count u before) child)
+{-# INLINABLE dropNode #-}
+{-# SPECIALIZE dropNode :: Unit -> Int -> Node () -> Node () #-}
+
+-- | 'takeNode' and 'dropNode' in one descent.
+splitNode :: Measure a => Unit -> Int -> Node a -> (# Node a, Node a #)
+splitNode u k node = case node of
+  Leaf m _ arr
+    | b <= 0 -> (# emptyNode, node #)
+    | b >= size -> (# node, emptyNode #)
+    | otherwise ->
+        let pm = leafPrefixMetrics m arr b
+         in (# mkLeafWith pm (cloneByteArray arr 0 b), mkLeafWith (m `subMetrics` pm) (cloneByteArray arr b (size - b)) #)
+    where
+      size = sizeofByteArray arr
+      b = leafOffset u k m arr
+  Inner total h _ cs -> case seekChild u k total cs of
+    Seek i before ->
+      let child = indexChildren cs i
+          after = total `subMetrics` before `subMetrics` nodeMetrics child
+       in case splitNode u (k - count u before) child of
+            (# l, r #) -> (# joinLeft h cs i before l, joinRight h cs i after r #)
+{-# INLINABLE splitNode #-}
+{-# SPECIALIZE splitNode :: Unit -> Int -> Node () -> (# Node (), Node () #) #-}
+
+------------------------------------------------------------------------------
+-- Read-only descents
+
+metricsAtNode :: Unit -> Int -> Node a -> Metrics
+metricsAtNode u k root
+  | k <= 0 = mempty
+  | beyondEnd u k (nodeMetrics root) = nodeMetrics root
+  | otherwise = go mempty k root
+  where
+    go !acc !j node = case node of
+      Leaf m _ arr ->
+        let !b = leafOffset u j m arr
+         in -- Sought by lines, the offset is just after the j-th line feed
+            -- of this leaf, which it has: there are j of them before it.
+            acc <> if u == Lines then leafPrefixWithLines m arr b j else leafPrefixMetrics m arr b
+      Inner total _ _ cs -> case seekChild u j total cs of
+        Seek i before -> go (acc <> before) (j - count u before) (indexChildren cs i)
+
+-- | Find only the byte offset, avoiding prefix measurement within the leaf.
+byteOffsetAtNode :: Unit -> Int -> Node a -> Int
+byteOffsetAtNode u k root
+  | k <= 0 = 0
+  | beyondEnd u k (nodeMetrics root) = nodeBytes root
+  | otherwise = go 0 k root
+  where
+    go !acc !j node = case node of
+      Leaf m _ arr -> acc + leafOffset u j m arr
+      Inner total _ _ cs -> case seekUnitBytes u j total cs of
+        SoughtBytes i j' b -> go (acc + b) j' (indexChildren cs i)
+
+-- | The byte at offset @i@, for @0 <= i < size@.
+indexByteNode :: Int -> Node a -> Word8
+indexByteNode !i node = case node of
+  Leaf _ _ arr -> byteAt arr i
+  Inner _ _ _ cs -> case seekByte i cs of
+    Sought c i' -> indexByteNode i' (indexChildren cs c)
+
+-- | Bytes @i .. j-1@ as a 'Text', given boundaries @0 <= i <= j <= size@.
+-- A range inside a single chunk is returned as a view of that chunk.
+sliceToText :: Int -> Int -> Node a -> Text
+sliceToText !i !j node
+  | i >= j = T.empty
+  | otherwise = case node of
+      Leaf _ _ arr -> viewSlice arr i (j - i)
+      Inner _ _ _ cs -> case seekByte i cs of
+        Sought c i'
+          | j' <= nodeBytes child -> sliceToText i' j' child
+          | otherwise ->
+              let !(ByteArray ba) = runByteArray $ do
+                    out <- newByteArray (j - i)
+                    copyRange out 0 i j node
+                    pure out
+               in TI.Text (A.ByteArray ba) 0 (j - i)
+          where
+            child = indexChildren cs c
+            j' = j - (i - i')
+
+-- | Copy bytes @i .. j-1@ of a node to offset @d@ of a buffer.
+--
+-- Only boundary children need partial copies. Copy fully covered subtrees
+-- with 'copyNode'.
+copyRange :: MutableByteArray s -> Int -> Int -> Int -> Node a -> ST s ()
+copyRange !out !d !i !j node = case node of
+  Leaf _ _ arr -> copyByteArray out d arr i (j - i)
+  Inner _ _ _ cs -> case seekByte i cs of
+    Sought c0 i0 -> go c0 (i - i0)
+    where
+      n = sizeofChildren cs
+      go !c !start = when (c < n && start < j) $ do
+        let child = indexChildren cs c
+            end = start + nodeBytes child
+        if i <= start && end <= j
+          then () <$ copyNode out (d + start - i) child
+          else do
+            let lo = max i start
+                hi = min j end
+            when (lo < hi) $ copyRange out (d + lo - i) (lo - start) (hi - start) child
+        go (c + 1) end
+
+-- | Copy a whole subtree to buffer offset @d@ and return the next offset.
+-- Full-subtree copies need no seeking or bounds clamping.
+copyNode :: MutableByteArray s -> Int -> Node a -> ST s Int
+copyNode !out !d node = case node of
+  Leaf _ _ arr -> do
+    let size = sizeofByteArray arr
+    copyByteArray out d arr 0 size
+    pure (d + size)
+  Inner _ _ _ cs -> go 0 d
+    where
+      n = sizeofChildren cs
+      go !c !d'
+        | c >= n = pure d'
+        | otherwise = copyNode out d' (indexChildren cs c) >>= go (c + 1)
+
+-- | Locations of the start of line @l@ and of the end of its content, that
+-- is before the terminating @\\n@ or @\\r\\n@, or at the end of the rope.
+data Span = Span {-# UNPACK #-} !Metrics {-# UNPACK #-} !Metrics
+
+lineSpan :: Int -> Node a -> Span
+lineSpan !l root = Span start (lineEnd start (metricsAtNode Lines (max 0 l + 1) root) root)
+  where
+    start = metricsAtNode Lines l root
+{-# NOINLINE lineSpan #-}
+
+-- | End of the content of the line starting at @start@, given the start of
+-- the next line.
+lineEnd :: Metrics -> Metrics -> Node a -> Metrics
+lineEnd start next root
+  | newlines next == newlines start = next
+  | bytes lf > bytes start && indexByteNode (bytes lf - 1) root == 0x0D = lf `subMetrics` Metrics 1 1 1 0
+  | otherwise = lf
+  where
+    lf = next `subMetrics` Metrics 1 1 1 1
+{-# INLINE lineEnd #-}
+
+-- | The end of the content of a line that starts at @from@ and is terminated
+-- by the line feed at @lf@ of the same chunk.
+contentEnd :: ByteArray -> Int -> Int -> Int
+contentEnd arr from lf
+  | lf > from && byteAt arr (lf - 1) == 0x0D = lf - 1
+  | otherwise = lf
+{-# INLINE contentEnd #-}
+
+-- | Text of line @l >= 0@. If its start and terminator are in one leaf,
+-- return a view after one descent. Otherwise use the general range lookup.
+lineText :: Int -> Node a -> Text
+lineText !l root
+  | l > newlines (nodeMetrics root) = T.empty
+  | otherwise = go l root
+  where
+    go !j node = case node of
+      Leaf _ _ arr -> case chunkLine j arr of
+        ChunkLine from lf
+          | lf >= sizeofByteArray arr -> across
+          | otherwise -> viewSlice arr from (contentEnd arr from lf - from)
+      Inner total _ _ cs
+        | j <= 0 -> go j (indexChildren cs 0)
+        | otherwise -> case seekUnit Lines j (newlines total) cs of
+            Sought i j' -> go j' (indexChildren cs i)
+    -- The general case: a line across leaves.
+    across = case lineSpan l root of
+      Span start end -> sliceToText (bytes start) (bytes end) root
+
+-- | Find an offset's position. One descent suffices when its line starts
+-- in the same leaf or at the document start.
+positionAtNode :: Unit -> Unit -> Int -> Node a -> Position
+positionAtNode !from !to !k root
+  | k <= 0 = Position 0 0
+  | beyondEnd from k (nodeMetrics root) = general
+  | otherwise = go 0 0 k root
+  where
+    go !ls !bs !j node = case node of
+      Leaf m _ arr ->
+        let !b = leafOffset from j m arr
+            lf = if newlines m == 0 then -1 else findNewlineBack arr b
+            start = lf + 1
+            column
+              | to == Lines = 0
+              | to == Bytes || isAscii m = b - start
+              | otherwise = count to (sliceMetrics arr start (b - start))
+         in if lf < 0 && bs > 0
+              then general
+              else Position (ls + leafNewlinesBefore m arr b) column
+      Inner total _ _ cs -> case seekChild from j total cs of
+        Seek i before -> go (ls + newlines before) (bs + bytes before) (j - count from before) (indexChildren cs i)
+    -- The general case: a line that starts in another leaf.
+    general = positionOfMetrics to (metricsAtNode from k root) root
+
+-- | The position, with its column in the given unit, of a location.
+positionOfMetrics :: Unit -> Metrics -> Node a -> Position
+positionOfMetrics u m root =
+  Position (newlines m) (count u m - count u (metricsAtNode Lines (newlines m) root))
+{-# INLINE positionOfMetrics #-}
+
+metricsAtPositionNode :: Unit -> Position -> Node a -> Metrics
+metricsAtPositionNode u pos root = case linePositionNode False u pos root of
+  Span _ at -> at
+{-# INLINE metricsAtPositionNode #-}
+
+-- | Locate a position, optionally computing its line start as well.
+-- When the line start is not requested, its field may repeat the position.
+linePositionNode :: Bool -> Unit -> Position -> Node a -> Span
+linePositionNode !wanted !u (Position l0 c) root
+  | l > newlines (nodeMetrics root) = general
+  | otherwise = go mempty l root
+  where
+    l = max 0 l0
+    -- Fast path: the line start and terminator are in the same leaf.
+    go !acc !j node = case node of
+      Leaf m _ arr -> case chunkLine j arr of
+        ChunkLine from lf ->
+          if lf >= sizeofByteArray arr
+            then general
+            else
+              let !to = contentEnd arr from lf
+                  !b = column m arr from to
+                  -- Reuse the known newline count. Recover the line start
+                  -- by measuring only the column, rather than another prefix.
+                  !at = acc <> leafPrefixWithLines m arr b j
+               in Span (if wanted then at `subMetrics` sliceOfLine m arr from b else at) at
+      Inner total _ _ cs
+        | j <= 0 -> go acc j (indexChildren cs 0)
+        | otherwise -> case seekChild Lines j total cs of
+            Seek i before -> go (acc <> before) (j - newlines before) (indexChildren cs i)
+    -- The offset of the column within a leaf, given those of the start of
+    -- the line and of the end of its content.
+    column !m !arr !from !to
+      | c <= 0 = from
+      | u == Lines || (u == Bytes || isAscii m) && c >= to - from = to
+      | isAscii m = from + c
+      | otherwise = case u of
+          Bytes -> roundDownFrom arr (from + c)
+          Utf16 -> scanUnits True c arr from to
+          _ -> scanUnits False c arr from to
+    -- The general case: a line across leaves, or no such line.
+    general = case lineSpan l0 root of
+      Span start end
+        | c <= 0 -> Span start start
+        | u == Lines || bytes there > bytes end -> Span start end
+        | otherwise -> Span start there
+        where
+          there = metricsAtNode u (count u start + min c (count u (nodeMetrics root))) root
+
+-- | Metrics of bytes @from .. to-1@ of a leaf with known metrics, which are
+-- on one line.
+sliceOfLine :: Metrics -> ByteArray -> Int -> Int -> Metrics
+sliceOfLine m arr from to
+  | to <= from = mempty
+  | isAscii m = let d = to - from in Metrics d d d 0
+  | otherwise = sliceMetrics arr from (to - from)
+{-# INLINE sliceOfLine #-}
+
+-- | Location of the end of the longest prefix not satisfying a monotone
+-- predicate.
+metricsWhereNode :: Measure a => (Metrics -> a -> Bool) -> Node a -> Metrics
+metricsWhereNode p root
+  | p mempty mempty = mempty
+  | not (p (nodeMetrics root) (nodeAnn root)) = nodeMetrics root
+  | otherwise = go mempty mempty root
+  where
+    -- Invariant: the predicate fails at the start of the node and holds at
+    -- its end.
+    go !m !a node = case node of
+      Leaf _ _ arr ->
+        let at b = p (m <> sliceMetrics arr 0 b) (a <> measureChunk (viewSlice arr 0 b))
+            -- Bisect over code point boundaries: fails at lo, holds at hi.
+            search !lo !hi
+              | mid <= lo || mid >= hi = lo
+              | at mid = search lo mid
+              | otherwise = search mid hi
+              where
+                half = (lo + hi) `quot` 2
+                down = roundDown arr half
+                mid = if down > lo then down else roundUp arr (half + 1)
+         in m <> sliceMetrics arr 0 (search 0 (sizeofByteArray arr))
+      Inner _ _ _ cs ->
+        let n = sizeofChildren cs
+            loop !i !m' !a'
+              | i >= n - 1 || p m'' a'' = go m' a' c
+              | otherwise = loop (i + 1) m'' a''
+              where
+                c = indexChildren cs i
+                m'' = m' <> nodeMetrics c
+                a'' = a' <> nodeAnn c
+         in loop 0 m a
+{-# INLINABLE metricsWhereNode #-}
+{-# SPECIALIZE metricsWhereNode :: (Metrics -> () -> Bool) -> Node () -> Metrics #-}
+
+------------------------------------------------------------------------------
+-- Editing
+
+-- | Replace @[k, k + d)@ with a byte-array slice in one descent, if the
+-- range fits within one leaf. Copy the leaf and rebuild its path, splitting
+-- an overflowing leaf into two. Return 'None' if the range spans leaves,
+-- the leaf would shrink below @least@, or the result is too large to split.
+--
+-- Also return a conservative estimate of free space in the target leaf.
+--
+-- @least@ is 'minChunk', or zero for a root leaf. Using an integer rather
+-- than a Boolean avoids constructor specialisation preceding measure
+-- specialisation.
+editNode :: Measure a => Int -> Unit -> Int -> Int -> ByteArray -> Int -> Int -> Node a -> (# Result a, Int# #)
+editNode !least u !k !d !src !soff !slen node = case node of
+  Leaf m _ arr
+    | d > 0 && kj > count u m -> (# None, 0# #)
+    | slen <= 0 && bj <= bi -> (# None, 0# #)
+    | size' < least || size' > 2 * maxChunk - 8 -> (# None, 0# #)
+    | size' <= maxChunk -> roomy (One (mkLeafWith m' (spliceArray arr bi bj src soff slen))) (maxChunk - size')
+    | otherwise ->
+        -- The 8-byte margin above leaves room to align the split to UTF-8.
+        let cut = boundary (size' `quot` 2)
+            boundary !at
+              | isContByte (splicedByte arr bi bj src soff slen at) = boundary (at - 1)
+              | otherwise = at
+            left = splicedSlice arr bi bj src soff slen 0 cut
+            mx = sliceMetrics left 0 cut
+         in roomy
+              ( Two
+                  (mkLeafWith mx left)
+                  (mkLeafWith (m' `subMetrics` mx) (splicedSlice arr bi bj src soff slen cut size'))
+              )
+              (maxChunk - max cut (size' - cut))
+    where
+      !kj = max 0 k + d
+      bi = leafOffset u k m arr
+      bj = if d > 0 then leafOffset u kj m arr else bi
+      size' = sizeofByteArray arr - (bj - bi) + slen
+      kept = if bj > bi then m `subMetrics` sliceMetrics arr bi (bj - bi) else m
+      m' = kept <> sliceMetrics src soff slen
+  Inner m h _ cs -> case seekUnit u k (count u m) cs of
+    Sought c k' ->
+      let old = indexChildren cs c
+       in case editNode least u k' d src soff slen old of
+            (# None, _ #) -> (# None, 0# #)
+            (# One new, room #) ->
+              (# One (inner h (m <> (nodeMetrics new `subMetrics` nodeMetrics old)) (replaceAt cs c new)), room #)
+            (# Two x y, room #) ->
+              (# fromChildren h (m <> ((nodeMetrics x <> nodeMetrics y) `subMetrics` nodeMetrics old)) (insert2 cs c x y), room #)
+{-# INLINABLE editNode #-}
+{-# SPECIALIZE editNode :: Int -> Unit -> Int -> Int -> ByteArray -> Int -> Int -> Node () -> (# Result (), Int# #) #-}
+
+-- | Replace @[i, j)@, returning the free-space estimate from 'editNode'
+-- or zero when the general split-and-append path is needed.
+editRoot :: Measure a => Unit -> Int -> Int -> Text -> Node a -> (# Node a, Int# #)
+editRoot u i j t@(TI.Text (A.ByteArray ba) off len) root =
+  case editNode (if nodeHeight root == 0 then 0 else minChunk) u from (max 0 (j - from)) (ByteArray ba) off len root of
+    (# One node, room #) -> (# node, room #)
+    (# Two x y, room #) -> (# mkInner2 x y, room #)
+    (# None, _ #)
+      | bi < bj -> (# takeRoot Bytes bi root `appendNode` fromTextNode t `appendNode` dropRoot Bytes bj root, 0# #)
+      | len <= 0 -> (# root, 0# #)
+      | otherwise -> case splitRoot Bytes bi root of
+          (# l, r #) -> (# l `appendNode` fromTextNode t `appendNode` r, 0# #)
+  where
+    from = max 0 i
+    -- Resolve both endpoints in the original rope so rounding is consistent.
+    bi = byteOffsetAtNode u i root
+    bj = if j <= i then bi else byteOffsetAtNode u j root
+{-# INLINABLE editRoot #-}
+{-# SPECIALIZE editRoot :: Unit -> Int -> Int -> Text -> Node () -> (# Node (), Int# #) #-}
+
+edited :: Measure a => Unit -> Int -> Int -> Text -> Node a -> Node a
+edited u i j t root = case editRoot u i j t root of
+  (# root', _ #) -> root'
+{-# INLINE edited #-}
+
+------------------------------------------------------------------------------
+-- Typing
+
+-- Buffered input must produce the same text as individual insertions.
+-- For byte, code point, and UTF-16 offsets:
+--
+-- > insert u (max 0 i + n) t2 (insert u i t1 r) == insert u i (t1 <> t2) r
+-- >   where n = count u (metrics (fromText t1))
+--
+-- This also holds for clamped or rounded @i@: offsets beyond the end append,
+-- and offsets inside a code point retain the same displacement after @t1@.
+-- 'Lines' does not satisfy this rule, since inserted text need not end at
+-- a line boundary.
+--
+-- A read after each keystroke applies the growing buffer to its base tree.
+-- Limit buffering to the target leaf's estimated free space to avoid
+-- repeatedly splitting it. The preceding insertion supplies that estimate;
+-- an inaccurate estimate affects performance, not correctness.
+
+-- | A rope with a run of keystrokes, of the given metrics, to be inserted at
+-- an offset.
+typing :: Measure a => Node a -> Unit -> Int -> ByteArray -> Metrics -> Int -> Rope a
+typing base u start run typed room =
+  -- The lifted wrapper defers the insertion until a reader needs the tree.
+  let root = Lazy (edited u start start (chunkText run) base)
+   in Typing root base u start run (packMetrics typed) room
+{-# INLINE typing #-}
+
+-- | The offset at which a keystroke would continue a run.
+typingNext :: Unit -> Int -> PackedMetrics -> Int
+typingNext u start typed = start + count u (unpackMetrics typed)
+{-# INLINE typingNext #-}
+
+-- | Insert immediately at a new location and remember the endpoint.
+-- A subsequent insertion there may start or extend a bounded input buffer.
+insertText :: Measure a => Unit -> Int -> Text -> Rope a -> Rope a
+insertText u i t@(TI.Text (A.ByteArray ba) off len) r = case r of
+  Typing lazyRoot base ru start run typed room
+    | typingNext ru start typed == i && ru == u && len <= room ->
+        let tm = sliceMetrics src off len
+         in typing base u start (concatSlices run 0 (sizeofByteArray run) src off len) (unpackMetrics typed <> tm) (room - len)
+    | otherwise -> case lazyRoot of
+        Lazy root -> settled root ru (typingNext ru start typed) room
+  Settled root hu hint room -> settled root hu hint room
+  where
+    src = ByteArray ba
+    settled root !hu !hint !room
+      | hint == i && i >= 0 && hu == u && len <= min room maxPending =
+          let tm = sliceMetrics src off len
+           in typing root u i (cloneByteArray src off len) tm (min room maxPending - len)
+      | otherwise = case editRoot u i i t root of
+          (# root', room' #) ->
+            let grown = count u (nodeMetrics root') - count u (nodeMetrics root)
+             in Settled root' u (if u == Lines then -1 else max 0 i + grown) (I# room')
+{-# INLINABLE insertText #-}
+{-# SPECIALIZE insertText :: Unit -> Int -> Text -> Rope () -> Rope () #-}
+
+-- | Delete @[i, j)@ for @j > i@. Shorten a buffered suffix directly when
+-- both operations use 'Chars' and the buffer's start was not clamped.
+deleteRange :: Measure a => Unit -> Int -> Int -> Rope a -> Rope a
+deleteRange u i j r = case r of
+  Typing _ base Chars start run typed room
+    | u == Chars && j == typingNext Chars start typed && i >= start && start <= chars (nodeMetrics base) ->
+        let size = sizeofByteArray run
+            keep = dropCharsEnd (j - i) run
+            typed' = unpackMetrics typed `subMetrics` sliceMetrics run keep (size - keep)
+         in if keep <= 0
+              then Settled base Chars start (room + size)
+              else typing base Chars start (cloneByteArray run 0 keep) typed' (room + size - keep)
+  _ -> Rope (edited u i j T.empty (rootOf r))
+{-# INLINABLE deleteRange #-}
+{-# SPECIALIZE deleteRange :: Unit -> Int -> Int -> Rope () -> Rope () #-}
+
+-- | The size of a chunk without its last @k@ code points.
+dropCharsEnd :: Int -> ByteArray -> Int
+dropCharsEnd k0 arr = go k0 (sizeofByteArray arr)
+  where
+    go !k !end
+      | k <= 0 || end <= 0 = end
+      | otherwise = go (k - 1) (roundDownFrom arr (end - 1))
+
+------------------------------------------------------------------------------
+-- Instances
+
+instance Eq (Rope a) where
+  Rope a == Rope b = nodeMetrics a == nodeMetrics b && compareNodes a b == EQ
+
+-- | Lexicographic by code point, like 'Text'.
+instance Ord (Rope a) where
+  compare (Rope a) (Rope b) = compareNodes a b
+
+-- | Compare the UTF-8 (whose byte order is code point order) of two trees
+-- with unrelated chunk boundaries.
+compareNodes :: Node a -> Node b -> Ordering
+compareNodes a b = go (chunksOf a) 0 (chunksOf b) 0
+  where
+    chunksOf = foldrNode (:) []
+    go [] _ [] _ = EQ
+    go [] _ _ _ = LT
+    go _ _ [] _ = GT
+    go xs@(x : xs') !i ys@(y : ys') !j =
+      let rx = sizeofByteArray x - i
+          ry = sizeofByteArray y - j
+          n = min rx ry
+       in case compareByteArrays x i y j n of
+            EQ
+              | rx == ry -> go xs' 0 ys' 0
+              | rx < ry -> go xs' 0 ys (j + n)
+              | otherwise -> go xs (i + n) ys' 0
+            o -> o
+
+instance Show (Rope a) where
+  showsPrec p = showsPrec p . toLazyText
+
+instance Measure a => Semigroup (Rope a) where
+  (<>) = append
+  {-# INLINE (<>) #-}
+
+instance Measure a => Monoid (Rope a) where
+  mempty = empty
+  {-# INLINE mempty #-}
+
+instance Measure a => IsString (Rope a) where
+  fromString = fromText . T.pack
+  {-# INLINE fromString #-}
+
+instance NFData a => NFData (Rope a) where
+  rnf (Rope root) = go root
+    where
+      go (Leaf _ a _) = rnf a
+      go (Inner _ _ a cs) = rnf a `seq` children 0
+        where
+          children !i
+            | i >= sizeofChildren cs = ()
+            | otherwise = go (indexChildren cs i) `seq` children (i + 1)
+
+------------------------------------------------------------------------------
+-- Construction
+
+-- | The empty rope.
+empty :: Measure a => Rope a
+empty = Rope emptyNode
+{-# INLINE empty #-}
+
+-- | A rope of one character.
+singleton :: Measure a => Char -> Rope a
+singleton = fromText . T.singleton
+{-# INLINE singleton #-}
+
+-- | /O(n)/. Build a rope from strict text. Copies the text into chunks,
+-- unless it is at most 'maxChunk' bytes and occupies its entire backing buffer.
+fromText :: Measure a => Text -> Rope a
+fromText t = Rope (fromTextNode t)
+{-# INLINE fromText #-}
+
+-- | Build a rope by appending the chunks of a lazy 'TL.Text'.
+fromLazyText :: Measure a => TL.Text -> Rope a
+fromLazyText = TL.foldlChunks (\acc t -> acc <> fromText t) empty
+{-# INLINABLE fromLazyText #-}
+
+------------------------------------------------------------------------------
+-- Deconstruction
+
+-- | /O(n)/. Flatten the rope to strict text. A single chunk is shared
+-- without copying; multiple chunks are copied into one buffer.
+toText :: Rope a -> Text
+toText (Rope root) = sliceToText 0 (nodeBytes root) root
+
+-- | /O(n)/. Convert to lazy text, sharing the chunk buffers.
+toLazyText :: Rope a -> TL.Text
+toLazyText = TL.fromChunks . toChunks
+
+-- | /O(n)/. Decode the rope to a 'String'.
+toString :: Rope a -> String
+toString = TL.unpack . toLazyText
+
+-- | The chunks of the rope as zero-copy views, in order. They are non-empty,
+-- at most 'maxChunk' bytes long and produced lazily.
+toChunks :: Rope a -> [Text]
+toChunks = foldrChunks (:) []
+
+-- | Lazy right fold over non-empty chunks in document order, without
+-- building the list returned by 'toChunks'.
+foldrChunks :: (Text -> b -> b) -> b -> Rope a -> b
+-- Keep the rope argument behind a lambda, here and in foldlChunks', so GHC
+-- can inline a partial application and specialise the per-chunk function.
+foldrChunks f z = \(Rope root) -> foldrNode (f . chunkText) z root
+{-# INLINE foldrChunks #-}
+
+foldrNode :: (ByteArray -> b -> b) -> b -> Node a -> b
+foldrNode f = go
+  where
+    go z (Leaf _ _ arr)
+      | sizeofByteArray arr == 0 = z
+      | otherwise = f arr z
+    go z (Inner _ _ _ cs) = children 0
+      where
+        children !i
+          | i >= sizeofChildren cs = z
+          | otherwise = go (children (i + 1)) (indexChildren cs i)
+{-# INLINE foldrNode #-}
+
+-- | Strict left fold over non-empty chunks in document order. Walks the
+-- tree directly, sharing text buffers and avoiding an intermediate list.
+-- Useful for consumers such as hashes and parsers.
+foldlChunks' :: (b -> Text -> b) -> b -> Rope a -> b
+foldlChunks' f z = \(Rope root) -> foldlNode' (\acc arr -> f acc (chunkText arr)) z root
+{-# INLINE foldlChunks' #-}
+
+foldlNode' :: (b -> ByteArray -> b) -> b -> Node a -> b
+foldlNode' f = go
+  where
+    go !acc (Leaf _ _ arr)
+      | sizeofByteArray arr == 0 = acc
+      | otherwise = f acc arr
+    go !acc (Inner _ _ _ cs) = children acc 0
+      where
+        children !acc' !i
+          | i >= sizeofChildren cs = acc'
+          | otherwise = children (go acc' (indexChildren cs i)) (i + 1)
+{-# INLINE foldlNode' #-}
+
+------------------------------------------------------------------------------
+-- Output
+
+-- | /O(n)/. Write UTF-8 to a handle through a fixed-size buffer, without
+-- constructing a 'Text' for the whole document. See 'outputBuffer'.
+--
+-- Like 'hPutBuf', this bypasses the handle's encoding and newline
+-- translation, preserving the rope's bytes on every platform. To use the
+-- handle's text encoding instead, pass 'toLazyText' to text I/O.
+hPutUtf8 :: Handle -> Rope a -> IO ()
+hPutUtf8 h (Rope root) = do
+  buf <- newPinnedByteArray outputBuffer
+  withMutableByteArrayContents buf $ \ptr -> do
+    I# used <- pourNode h buf ptr 0 root
+    flushBuffer h ptr used
+
+-- | Copy a subtree into the output buffer, starting at @used@. Flush when
+-- the next chunk would not fit, and return the number of bytes left buffered.
+--
+-- Kept at the top level so GHC can unbox the returned count.
+pourNode :: Handle -> MutableByteArray RealWorld -> Ptr Word8 -> Int -> Node a -> IO Int
+pourNode h !buf !ptr used@(I# used#) node = case node of
+  Leaf _ _ arr
+    | used + size <= outputBuffer -> used + size <$ copyByteArray buf used arr 0 size
+    | otherwise -> do
+        flushBuffer h ptr used#
+        size <$ copyByteArray buf 0 arr 0 size
+    where
+      size = sizeofByteArray arr
+  Inner _ _ _ cs -> go 0 used
+    where
+      n = sizeofChildren cs
+      go !c !used'
+        | c >= n = pure used'
+        | otherwise = pourNode h buf ptr used' (indexChildren cs c) >>= go (c + 1)
+
+-- | Write the occupied part of the buffer.
+--
+-- Box the count only at the 'hPutBuf' call. Keeping that conversion here
+-- avoids propagating boxed counts through 'pourNode'.
+flushBuffer :: Handle -> Ptr Word8 -> Int# -> IO ()
+flushBuffer h ptr used# = when (used > 0) $ hPutBuf h ptr used
+  where
+    used = I# used#
+{-# NOINLINE flushBuffer #-}
+
+-- | Write UTF-8 to a file with 'hPutUtf8', replacing its contents.
+--
+-- Evaluates the tree, including pending input and annotations to weak head
+-- normal form, before opening the file. An evaluation failure at this stage
+-- leaves an existing file untouched. The write itself is not atomic.
+writeFileUtf8 :: FilePath -> Rope a -> IO ()
+writeFileUtf8 path rope@(Rope _) = withBinaryFile path WriteMode (`hPutUtf8` rope)
+
+-- | /O(log n)/. Zero-copy view of the rest of the chunk containing the given
+-- offset. Returns empty text when the clamped offset is at the end.
+--
+-- For a parser read callback, request a byte offset, consume the returned
+-- text, then advance by its byte length. Offsets are clamped and rounded
+-- as described at 'Unit'.
+chunkAt :: Unit -> Int -> Rope a -> Text
+chunkAt u k (Rope root)
+  | b >= nodeBytes root = T.empty
+  | otherwise = go b root
+  where
+    b = byteOffsetAtNode u k root
+    go !i node = case node of
+      Leaf _ _ arr -> viewSlice arr i (sizeofByteArray arr - i)
+      Inner _ _ _ cs -> case seekByte i cs of
+        Sought c i' -> go i' (indexChildren cs c)
+
+------------------------------------------------------------------------------
+-- Queries
+
+-- | /O(1)/. Whether the rope is empty, including pending input.
+null :: Rope a -> Bool
+null r = bytes (metrics r) == 0
+{-# INLINE null #-}
+
+-- | /O(1)/. Length in any unit; for 'Lines' this is the number of @\\n@.
+length :: Unit -> Rope a -> Int
+length u = count u . metrics
+{-# INLINE length #-}
+
+-- | /O(1)/. Number of @\\n@ characters plus one. An empty rope has one line;
+-- a trailing @\\n@ adds an empty final line. Valid indices range from zero
+-- to @lineCount rope - 1@. See 'lines' for a list that omits that final empty line.
+lineCount :: Rope a -> Int
+lineCount r = newlines (metrics r) + 1
+{-# INLINE lineCount #-}
+
+-- | /O(1)/. All built-in measurements, including pending input.
+metrics :: Rope a -> Metrics
+metrics (Settled root _ _ _) = nodeMetrics root
+metrics (Typing _ base _ _ _ typed _) = nodeMetrics base <> unpackMetrics typed
+{-# INLINE metrics #-}
+
+-- | /O(1)/ on an evaluated tree. Return the cached custom measure.
+-- Applies any pending insertion first, which may take /O(log n)/ plus
+-- the cost of updating the measure.
+measure :: Rope a -> a
+measure (Rope root) = nodeAnn root
+{-# INLINE measure #-}
+
+-- | Number of levels of inner nodes above the leaves.
+height :: Rope a -> Int
+height (Rope root) = nodeHeight root
+
+------------------------------------------------------------------------------
+-- Combining and breaking
+
+-- | /O(log n)/. Concatenate two ropes, sharing unaffected subtrees.
+-- Equivalent to '<>'. The traversal follows the difference in tree heights.
+append :: Measure a => Rope a -> Rope a -> Rope a
+append (Rope l) (Rope r) = Rope (appendNode l r)
+{-# INLINABLE append #-}
+
+-- | /O(log n)/. Split at an offset, clamped to the rope and rounded down to
+-- a code point boundary (see 'Unit'). Finds both halves in one descent.
+-- Use 'take' or 'drop' if you need only one half.
+--
+-- >>> splitAt Lines 1 "fst\nsnd\n"
+-- ("fst\n","snd\n")
+splitAt :: Measure a => Unit -> Int -> Rope a -> (Rope a, Rope a)
+splitAt u k (Rope root) = case splitRoot u k root of
+  (# l, r #) -> (Rope l, Rope r)
+{-# INLINABLE splitAt #-}
+
+-- | /O(log n)/. The prefix before an offset, clamped and rounded as in 'splitAt'.
+take :: Measure a => Unit -> Int -> Rope a -> Rope a
+take u k (Rope root) = Rope (takeRoot u k root)
+{-# INLINABLE take #-}
+
+-- | /O(log n)/. The suffix from an offset, clamped and rounded as in 'splitAt'.
+drop :: Measure a => Unit -> Int -> Rope a -> Rope a
+drop u k (Rope root) = Rope (dropRoot u k root)
+{-# INLINABLE drop #-}
+
+-- | /O(log n)/. Extract the half-open range @[i, j)@. Both offsets are
+-- clamped and rounded in the original rope. Returns empty when @j <= i@.
+-- Descends both endpoints together, avoiding reconstruction above the
+-- lowest node containing the range.
+slice :: Measure a => Unit -> Int -> Int -> Rope a -> Rope a
+slice u i j (Rope root)
+  | j <= i || j <= 0 = empty
+  | beyondEnd u j (nodeMetrics root) = Rope (dropRoot u i root)
+  | otherwise = Rope (sliceNode u (max 0 i) j root)
+{-# INLINABLE slice #-}
+
+-- | The lowest node containing a range, with both offsets relative to it.
+data Sliced a = Sliced !(Node a) {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+
+-- | Follow both ends of a range down as long as they lead into the same
+-- child, for @0 <= i < j@ and @j@ not beyond the end.
+--
+-- Shared descent for 'slice' and 'sliceText'. Both endpoints remain relative
+-- to the original text, so rounding is consistent across the two operations.
+sliceDescend :: Unit -> Int -> Int -> Node a -> Sliced a
+sliceDescend !u !i !j node = case node of
+  Leaf{} -> Sliced node i j
+  Inner total _ _ cs -> case seekUnit u i (count u total) cs of
+    Sought c i'
+      | j' <= count u (nodeMetrics child) -> sliceDescend u i' j' child
+      | otherwise -> Sliced node i j
+      where
+        child = indexChildren cs c
+        j' = j - (i - i')
+
+-- | The text from offset @i@ up to offset @j@ of a node, for @0 <= i < j@
+-- and @j@ not beyond its end.
+sliceNode :: Measure a => Unit -> Int -> Int -> Node a -> Node a
+sliceNode u i j root = case sliceDescend u i j root of
+  Sliced node@(Leaf m _ arr) i' j' ->
+    let !bi = leafOffset u i' m arr
+        !bj = leafOffset u j' m arr
+     in if bi <= 0 && bj >= sizeofByteArray arr
+          then node
+          else
+            if bj <= bi
+              then emptyNode
+              else mkLeafWith (leafSliceMetrics m arr bi (bj - bi)) (cloneByteArray arr bi (bj - bi))
+  Sliced node i' j' -> dropRoot Bytes (byteOffsetAtNode u i' node) (takeRoot Bytes (byteOffsetAtNode u j' node) node)
+{-# INLINABLE sliceNode #-}
+{-# SPECIALIZE sliceNode :: Unit -> Int -> Int -> Node () -> Node () #-}
+
+-- | /O(log n + result bytes)/. Like 'slice', but returns 'Text' directly.
+-- A range within one chunk is found in one descent and returned as a
+-- zero-copy view; a range spanning chunks is copied into one buffer.
+sliceText :: Unit -> Int -> Int -> Rope a -> Text
+sliceText u i j (Rope root)
+  | j <= i || j <= 0 = T.empty
+  | beyondEnd u j (nodeMetrics root) = sliceToText (byteOffsetAtNode u i root) (nodeBytes root) root
+  | otherwise = sliceTextNode u (max 0 i) j root
+
+-- | 'sliceNode' as a 'Text'.
+sliceTextNode :: Unit -> Int -> Int -> Node a -> Text
+sliceTextNode u i j root = case sliceDescend u i j root of
+  Sliced (Leaf m _ arr) i' j' ->
+    let !bi = leafOffset u i' m arr
+        !bj = leafOffset u j' m arr
+     in viewSlice arr bi (bj - bi)
+  Sliced node i' j' -> sliceToText (byteOffsetAtNode u i' node) (byteOffsetAtNode u j' node) node
+
+------------------------------------------------------------------------------
+-- Editing
+
+-- | /O(log n + inserted bytes)/. Insert text at a clamped, code-point-aligned
+-- offset. Empty input leaves the rope unchanged.
+--
+-- Small insertions copy the affected chunk and its path through the tree.
+-- An overflowing chunk can split in two.
+--
+-- Consecutive insertions in the same unit ('Bytes', 'Chars', or 'Utf16')
+-- can use a buffer of up to 'maxPending' bytes, limited by the target chunk's
+-- free space. Updating that bounded buffer is /O(1)/ in document size.
+-- A tree read, an edit elsewhere, or an insertion that exceeds the buffer's
+-- capacity forces the pending insertion. 'length' and 'metrics' include
+-- pending input without forcing it.
+-- Evaluating a rope to weak head normal form may leave this insertion deferred.
+insert :: Measure a => Unit -> Int -> Text -> Rope a -> Rope a
+insert u i t r
+  | T.null t = r
+  | otherwise = insertText u i t r
+{-# INLINABLE insert #-}
+
+-- | /O(log n)/. Remove the half-open range @[i, j)@, clamping and rounding
+-- both offsets in the original rope. Does nothing when @j <= i@.
+-- Deleting a suffix of buffered 'Chars' input can take /O(1)/; see 'insert'.
+delete :: Measure a => Unit -> Int -> Int -> Rope a -> Rope a
+delete u i j r
+  | j <= i = r
+  | otherwise = deleteRange u i j r
+{-# INLINABLE delete #-}
+
+-- | /O(log n + inserted bytes)/. Replace the half-open range @[i, j)@ with
+-- text, clamping and rounding both offsets in the original rope. When
+-- @j <= i@, insert at @i@ instead.
+--
+-- An edit that stays within one chunk and keeps it within its size bounds
+-- copies only that chunk and the path to it.
+replace :: Measure a => Unit -> Int -> Int -> Text -> Rope a -> Rope a
+replace u i j t r
+  | j <= i = insert u i t r
+  | T.null t = deleteRange u i j r
+  | otherwise = Rope (edited u i j t (rootOf r))
+{-# INLINABLE replace #-}
+
+------------------------------------------------------------------------------
+-- Lines
+
+-- | /O(log n + length of the line)/. The content of a line by 0-based index,
+-- without its terminating @\\n@ or @\\r\\n@; empty if there is no such line.
+-- A line within a single chunk is returned as a zero-copy view.
+getLine :: Int -> Rope a -> Text
+getLine l (Rope root)
+  | l < 0 = T.empty
+  | otherwise = lineText l root
+
+-- | /O(n)/. Lines without their @\\n@ or @\\r\\n@ terminators, produced
+-- lazily. Returns @[]@ for an empty rope and omits the empty line after a
+-- trailing @\\n@. A lone @\\r@ is preserved. Lines within one chunk share
+-- its buffer.
+lines :: Rope a -> [Text]
+lines (Rope root) = go [] (foldrNode (:) [] root)
+  where
+    -- Carry non-empty pieces of an unfinished line in reverse order.
+    go carry [] = [T.concat (reverse carry) | not (L.null carry)]
+    go carry (arr : arrs) = from carry arr 0 arrs
+    from carry arr i arrs
+      | i >= size = go carry arrs
+      | lf >= size = go (viewSlice arr i (size - i) : carry) arrs
+      | otherwise = stripCR (T.concat (reverse (viewSlice arr i (lf - i) : carry))) : from [] arr (lf + 1) arrs
+      where
+        size = sizeofByteArray arr
+        lf = findNewline arr i
+    stripCR t
+      | not (T.null t) && T.last t == '\r' = T.init t
+      | otherwise = t
+
+------------------------------------------------------------------------------
+-- Conversions
+
+-- | /O(log n)/. Measure the prefix ending at an offset to express that
+-- location in all four units. The offset is clamped and rounded as in 'splitAt'.
+--
+-- >>> metricsAt Chars 3 "a😀\nb"
+-- Metrics {bytes = 6, chars = 3, utf16Units = 4, newlines = 1}
+metricsAt :: Unit -> Int -> Rope a -> Metrics
+metricsAt u k (Rope root) = metricsAtNode u k root
+
+-- | /O(log n)/. @convert from to@ re-expresses an offset in another unit.
+-- Converting to 'Lines' gives the index of the line containing the offset,
+-- converting from 'Lines' the offset of the start of a line.
+--
+-- >>> convert Bytes Utf16 5 "a😀\nb"
+-- 3
+convert :: Unit -> Unit -> Int -> Rope a -> Int
+convert from to k = count to . metricsAt from k
+{-# INLINE convert #-}
+
+------------------------------------------------------------------------------
+-- Positions
+
+-- | /O(log n)/. Split at a zero-based line and column, with the column in
+-- the given unit. Negative coordinates clamp to zero. A column beyond the
+-- line's content clamps to before its @\\n@ or @\\r\\n@; a line beyond the
+-- document clamps to its end. Offsets inside code points round down.
+-- For 'Lines' columns, zero means the line start and any positive value
+-- means the end of its content.
+splitAtPosition :: Measure a => Unit -> Position -> Rope a -> (Rope a, Rope a)
+splitAtPosition u pos r = splitAt Bytes (bytes (metricsAtPosition u pos r)) r
+{-# INLINE splitAtPosition #-}
+
+-- | /O(log n)/. The location of a position in every unit, clamped like
+-- 'splitAtPosition'.
+metricsAtPosition :: Unit -> Position -> Rope a -> Metrics
+metricsAtPosition u pos (Rope root) = metricsAtPositionNode u pos root
+
+-- | /O(log n)/. Return prefix metrics for the line start and the position,
+-- sharing their lookup. Clamps coordinates as in 'metricsAtPosition'.
+-- Subtract corresponding counts to get the reached column in any unit.
+-- Comparing it with the requested column detects clamping or rounding:
+--
+-- >>> let (line, at) = metricsAtLineAndPosition Utf16 (Position 1 3) "a😀\nb😀c"
+-- >>> (utf16Units at - utf16Units line, chars at - chars line, bytes at)
+-- (3,2,11)
+metricsAtLineAndPosition :: Unit -> Position -> Rope a -> (Metrics, Metrics)
+metricsAtLineAndPosition u pos (Rope root) = case linePositionNode True u pos root of
+  Span line at -> (line, at)
+{-# INLINE metricsAtLineAndPosition #-}
+
+-- | /O(log n)/. The position, with its column in the given unit, of a
+-- location obtained from 'metricsAt', 'metricsAtPosition', or 'metricsWhere'
+-- on the same rope. Does not clamp or validate the supplied metrics.
+metricsToPosition :: Unit -> Metrics -> Rope a -> Position
+metricsToPosition u m (Rope root) = positionOfMetrics u m root
+
+-- | /O(log n)/. @offsetToPosition from to@ turns an offset in unit @from@
+-- into a position with its column in unit @to@.
+-- An offset inside a line terminator remains there; converting the result
+-- back with 'positionToOffset' clamps it to the end of the line's content.
+--
+-- >>> offsetToPosition Bytes Utf16 11 "a😀\nb😀c"
+-- Position {posLine = 1, posColumn = 3}
+offsetToPosition :: Unit -> Unit -> Int -> Rope a -> Position
+offsetToPosition from to k (Rope root) = positionAtNode from to k root
+
+-- | /O(log n)/. @positionToOffset from to@ turns a position with its column
+-- in unit @from@ into an offset in unit @to@.
+-- Coordinates are clamped as in 'splitAtPosition'.
+--
+-- >>> positionToOffset Utf16 Bytes (Position 1 3) "a😀\nb😀c"
+-- 11
+positionToOffset :: Unit -> Unit -> Position -> Rope a -> Int
+positionToOffset from to pos = count to . metricsAtPosition from pos
+{-# INLINE positionToOffset #-}
+
+------------------------------------------------------------------------------
+-- Custom measures
+
+-- | /O(log n)/ for constant-time measure combination and predicates.
+-- Split after the longest code-point-aligned prefix for which the predicate
+-- is false. The predicate receives both built-in metrics and the custom
+-- measure, and must stay true once it becomes true as the prefix grows.
+--
+-- If true for the empty prefix, split at the start; if never true, split
+-- at the end. See "Data.Text.NanoRope.Measured" for a tab-count example.
+splitWhere :: Measure a => (Metrics -> a -> Bool) -> Rope a -> (Rope a, Rope a)
+splitWhere p r = splitAt Bytes (bytes (metricsWhere p r)) r
+{-# INLINE splitWhere #-}
+
+-- | Prefix metrics at the split point chosen by 'splitWhere', without
+-- constructing either half. Has the same search cost as 'splitWhere'.
+metricsWhere :: Measure a => (Metrics -> a -> Bool) -> Rope a -> Metrics
+metricsWhere p (Rope root) = metricsWhereNode p root
+{-# INLINABLE metricsWhere #-}
+
+-- | /O(n)/. Annotate the same text with another measure. The text itself is
+-- shared, not copied.
+remeasure :: forall a b. Measure b => Rope a -> Rope b
+remeasure (Rope root) = Rope (go root)
+  where
+    go :: Node a -> Node b
+    go (Leaf m _ arr) = mkLeafWith m arr
+    go (Inner m h _ cs) = inner h m $ runChildren $ do
+      let n = sizeofChildren cs
+      out <- newChildren n (go (indexChildren cs 0))
+      let fill !i
+            | i >= n = pure out
+            | otherwise = writeChildren out i (go (indexChildren cs i)) >> fill (i + 1)
+      fill 1
+{-# INLINABLE remeasure #-}
+
+------------------------------------------------------------------------------
+-- Debugging
+
+-- | List violated tree invariants. Returns @[]@ for ropes built through
+-- the public API with a lawful 'Measure'.
+invariants :: (Measure a, Eq a) => Rope a -> [String]
+invariants rope = case rope of
+  Settled root _ _ _ -> go True root
+  Typing (Lazy root) base u start run typed room ->
+    go True root
+      ++ map ("without what was typed: " ++) (go True base)
+      ++ [ "a run of " ++ show (sizeofByteArray run) ++ " bytes with room for " ++ show room | sizeofByteArray run <= 0 || room < 0 || sizeofByteArray run + room > maxPending ]
+      ++ [ "a run by lines" | u == Lines ]
+      ++ [ "a run at " ++ show start | start < 0 ]
+      ++ [ "the run caches " ++ show (unpackMetrics typed) ++ " instead of " ++ show (naive run) | unpackMetrics typed /= naive run ]
+      ++ [ "the rope reports " ++ show (metrics rope) ++ " instead of " ++ show (nodeMetrics root) | metrics rope /= nodeMetrics root ]
+  where
+    go :: (Measure a, Eq a) => Bool -> Node a -> [String]
+    go isRoot node = case node of
+      Leaf m a arr ->
+        let size = sizeofByteArray arr
+         in [ "leaf of " ++ show size ++ " bytes is too large" | size > maxChunk ]
+              ++ [ "leaf of " ++ show size ++ " bytes is too small" | not isRoot, size < minChunk ]
+              ++ [ "leaf starts inside a code point" | size > 0, isContByte (byteAt arr 0) ]
+              ++ [ "leaf caches " ++ show m ++ " instead of " ++ show (naive arr) | m /= naive arr ]
+              ++ [ "leaf caches a wrong annotation" | a /= measureChunk (chunkText arr) ]
+      Inner m h a cs ->
+        let n = sizeofChildren cs
+            -- Lists require lifted elements, so wrap each unlifted node.
+            kids = [Lazy (indexChildren cs i) | i <- [0 .. n - 1]]
+            total = mconcat [nodeMetrics c | Lazy c <- kids]
+         in [ "inner node with " ++ show n ++ " children is too large" | n > maxChildren ]
+              ++ [ "inner node with " ++ show n ++ " children is too small" | n < (if isRoot then 2 else minChildren) ]
+              ++ [ "child of height " ++ show (nodeHeight c) ++ " below a node of height " ++ show h | Lazy c <- kids, nodeHeight c /= h - 1 ]
+              ++ [ "inner node caches " ++ show m ++ " instead of " ++ show total | m /= total ]
+              ++ [ "inner node caches a wrong annotation" | a /= mconcat [nodeAnn c | Lazy c <- kids] ]
+              ++ concat [go False c | Lazy c <- kids]
+    naive arr =
+      let bs = [ byteAt arr i | i <- [0 .. sizeofByteArray arr - 1] ]
+          cs = L.length (filter (not . isContByte) bs)
+       in Metrics (L.length bs) cs (cs + L.length (filter (>= 0xF0) bs)) (L.length (filter (== 0x0A) bs))

@@ -0,0 +1,128 @@+-- |
+-- Module      : Data.Text.NanoRope.Measured
+-- Copyright   : (c) 2026 goolord
+-- License     : MIT
+--
+-- A persistent text rope with a custom monoidal 'Measure' cached alongside
+-- the built-in t'Metrics'. Use "Data.Text.NanoRope" when the built-in byte,
+-- code point, UTF-16, and newline counts are enough.
+--
+-- Import this module qualified:
+--
+-- > import Data.Text.NanoRope.Measured (Rope, Measure (..), Unit (..))
+-- > import qualified Data.Text.NanoRope.Measured as Rope
+--
+-- Offsets are zero-based, clamped to the document, and rounded down to code
+-- point boundaries. Ranges are half-open. Only @\\n@ starts a new line;
+-- 'Chars' counts code points, not grapheme clusters or display columns.
+--
+-- Complexity bounds use /n/ for the document's byte length. They assume
+-- constant-time measure combination, linear-time chunk measurement, and an
+-- evaluated tree. Reads, including 'measure', may first apply buffered
+-- input; 'null', 'length', 'lineCount', and 'metrics' do not force it.
+--
+-- = Example: counting tabs
+--
+-- A tab count is independent of chunk boundaries and grows monotonically,
+-- so it supports prefix searches. Enable @OverloadedStrings@ for this example.
+--
+-- > import qualified Data.Text as T
+-- >
+-- > newtype Tabs = Tabs Int deriving (Eq, Ord, Show)
+-- >
+-- > instance Semigroup Tabs where Tabs a <> Tabs b = Tabs (a + b)
+-- > instance Monoid Tabs where mempty = Tabs 0
+-- >
+-- > instance Measure Tabs where
+-- >   measureChunk = Tabs . T.count "\t"
+-- >
+-- > document :: Rope Tabs
+-- > document = Rope.fromText "a\tb\tc\td"
+-- >
+-- > tabCount = Rope.measure document  -- Tabs 3
+-- > beforeThirdTab = Rope.toText (fst (Rope.splitWhere (\_ n -> n >= Tabs 3) document))
+-- > -- "a\tb\tc"
+--
+-- See 'Measure' for the laws every annotation must satisfy.
+module Data.Text.NanoRope.Measured
+  ( -- * Ropes
+    Rope
+  , Measure (..)
+
+    -- * Units and metrics
+  , Unit (..)
+  , Metrics (..)
+  , count
+
+    -- * Construction
+  , empty
+  , singleton
+  , fromText
+  , fromLazyText
+
+    -- * Deconstruction
+  , toText
+  , toLazyText
+  , toString
+  , toChunks
+  , foldrChunks
+  , foldlChunks'
+  , chunkAt
+
+    -- * Output
+  , hPutUtf8
+  , writeFileUtf8
+
+    -- * Queries
+  , null
+  , length
+  , lineCount
+  , metrics
+  , measure
+
+    -- * Combining and breaking
+  , append
+  , splitAt
+  , take
+  , drop
+  , slice
+  , sliceText
+
+    -- * Editing
+  , insert
+  , delete
+  , replace
+
+    -- * Lines
+  , getLine
+  , lines
+
+    -- * Converting between units
+    -- $conversions
+  , metricsAt
+  , convert
+
+    -- * Positions
+  , Position (..)
+  , splitAtPosition
+  , metricsAtPosition
+  , metricsAtLineAndPosition
+  , metricsToPosition
+  , offsetToPosition
+  , positionToOffset
+
+    -- * Searching by measure
+  , splitWhere
+  , metricsWhere
+  , remeasure
+  ) where
+
+import Data.Text.NanoRope.Internal
+import Prelude ()
+
+-- $conversions
+-- Prefix t'Metrics' describe a location in all four units. Obtain them with
+-- 'metricsAt', 'metricsAtPosition', or 'metricsWhere', then use 'count' for
+-- absolute offsets. Reusing the metrics avoids repeating the lookup for
+-- each unit. 'metricsToPosition' also looks up the line start to calculate
+-- a column; use metrics from the same rope.

@@ -0,0 +1,1037 @@+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Compare rope operations with a simple 'Text' model. Check tree
+-- invariants, cached metrics, and annotations after each operation, and
+-- test the laws of the public instances and custom measures.
+--
+-- Compiled with both default and small chunk/node sizes; see nano-rope.cabal.
+module Main (main) where
+
+import Control.Exception (ErrorCall, bracket, try)
+import qualified Data.ByteString as B
+import qualified Data.List as L
+import Data.Maybe (fromMaybe)
+import Data.Primitive.ByteArray (ByteArray (..), cloneByteArray, indexByteArray, sizeofByteArray)
+import Data.Proxy (Proxy (..))
+import Data.String (IsString (..))
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Array as A
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Internal as TI
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.NanoRope as Plain
+import Data.Text.NanoRope.Internal (ChunkLine (..), Kernels (..), height, invariants, kernels, maxChunk)
+import Data.Text.NanoRope.Measured (Measure (..), Metrics (..), Position (..), Rope, Unit (..))
+import qualified Data.Text.NanoRope.Measured as Rope
+import Data.Text.Unsafe (dropWord8, takeWord8)
+import Data.Word (Word8)
+import System.Directory (getTemporaryDirectory, removeFile)
+import System.IO (Handle, hClose, openBinaryTempFile)
+import Test.QuickCheck.Classes.Base (Laws (..), commutativeMonoidLaws, eqLaws, monoidLaws, ordLaws, semigroupLaws, semigroupMonoidLaws, showLaws)
+import Test.Tasty (TestTree, adjustOption, defaultMain, localOption, testGroup)
+import Test.Tasty.QuickCheck
+
+main :: IO ()
+main =
+  defaultMain $
+    testGroup
+      ("nano-rope, chunks of " ++ show maxChunk ++ " bytes")
+      [ testGroup
+          "conversions"
+          [ testProperty "fromText / toText" prop_roundtrip
+          , testProperty "lazy text" prop_lazy
+          , testProperty "toChunks" prop_chunks
+          , testProperty "chunkAt" prop_chunkAt
+          , testProperty "hPutUtf8 / writeFileUtf8" prop_output
+          , testProperty "output of more than the buffer" (once prop_outputLarge)
+          , testProperty "output of a rope that fails" (once prop_outputFails)
+          , testProperty "remeasure" prop_remeasure
+          ]
+      , testGroup
+          "combining and breaking"
+          [ testProperty "append" prop_append
+          , testProperty "mconcat of many pieces" prop_mconcat
+          , testProperty "splitAt" prop_splitAt
+          , testProperty "slice / sliceText" prop_slice
+          ]
+      , testGroup
+          "editing"
+          [ testProperty "sequences of operations" prop_ops
+          , testProperty "typing and erasing at a cursor" prop_typing
+          , testProperty "keystrokes that continue each other" prop_run
+          , testProperty "typing on from the same rope twice" prop_branching
+          , testProperty "an insertion anywhere near a run" prop_nearRun
+          ]
+      , testGroup
+          "units"
+          [ testProperty "metricsAt" prop_metricsAt
+          , testProperty "convert" prop_convert
+          , testProperty "metricsAtPosition / metricsAtLineAndPosition / splitAtPosition" prop_position
+          , testProperty "metricsToPosition" prop_toPosition
+          , testProperty "position round trip" prop_positionRoundtrip
+          ]
+      , testGroup
+          "lines"
+          [ testProperty "lines / lineCount" prop_lines
+          , testProperty "getLine" prop_getLine
+          ]
+      , testGroup
+          "measures"
+          [ testProperty "splitWhere by width" prop_splitWhereWidth
+          , testProperty "splitWhere by line breaks" prop_splitWhereBreaks
+          , testProperty "splitWhere by metrics" prop_splitWhereMetrics
+          ]
+      , testGroup
+          "instances"
+          [ testProperty "Eq ignores the shape of the tree" prop_eq
+          , testProperty "Ord agrees with Text" prop_ord
+          , testProperty "Show agrees with Text" prop_show
+          ]
+      , testGroup
+          "laws"
+          [ testProperty "the ropes they are tried on" prop_lawRopes
+          , -- Use enough samples to exercise laws requiring three equal ropes.
+            adjustOption (\(QuickCheckTests n) -> QuickCheckTests (max 500 n)) $
+              lawsOf "Rope" $
+                map ($ Proxy @R) [eqLaws, ordLaws, eqOrdLaws, semigroupLaws, monoidLaws, semigroupMonoidLaws, showLaws]
+                  ++ [homomorphismLaws, isStringLaws]
+          , lawsOf "Metrics" $ map ($ Proxy @Metrics) [semigroupLaws, monoidLaws, commutativeMonoidLaws, semigroupMonoidLaws]
+          , testGroup
+              "Measure"
+              [ lawsOf "()" [measureLaws (Proxy @())]
+              , lawsOf "pairs" [measureLaws (Proxy @(Breaks, Width))]
+              , lawsOf "triples" [measureLaws (Proxy @((), Width, Breaks))]
+              ]
+          , -- Validate the custom measures used by the other properties.
+            testGroup
+              "test measures"
+              [ lawsOf "Breaks" $ map ($ Proxy @Breaks) [semigroupLaws, monoidLaws, semigroupMonoidLaws, measureLaws]
+              , lawsOf "Width" $ map ($ Proxy @Width) [semigroupLaws, monoidLaws, semigroupMonoidLaws, measureLaws]
+              ]
+          ]
+      , testGroup
+          "plain interface"
+          [ testProperty "agrees with the measured one" prop_plain
+          ]
+      , testGroup
+          "big"
+          [ localOption (QuickCheckTests 5) (testProperty "a tall tree" prop_big)
+          ]
+      , testGroup
+          ("chunk scans: " ++ L.intercalate ", " (map kernelsName kernels))
+          [ testProperty "metrics" prop_scanMetrics
+          , testProperty "line feeds" prop_scanNewlines
+          , testProperty "the next line feed" prop_scanNext
+          , testProperty "the previous line feed" prop_scanPrevious
+          , testProperty "the k-th line" prop_scanLine
+          , testProperty "code points and UTF-16 code units" prop_scanUnits
+          ]
+      ]
+
+------------------------------------------------------------------------------
+-- Custom test measures
+
+-- | Count CRLF, CR, and LF as one break each. Track boundary characters
+-- so combining @"a\\r"@ and @"\\nb"@ counts their shared CRLF only once.
+data Breaks
+  = NoText
+  | Breaks !Int !Bool !Bool
+  deriving (Eq, Show)
+
+breakCount :: Breaks -> Int
+breakCount NoText = 0
+breakCount (Breaks n _ _) = n
+
+instance Semigroup Breaks where
+  NoText <> b = b
+  a <> NoText = a
+  Breaks n1 lf1 cr1 <> Breaks n2 lf2 cr2 =
+    Breaks (n1 + n2 - (if cr1 && lf2 then 1 else 0)) lf1 cr2
+
+instance Monoid Breaks where
+  mempty = NoText
+
+instance Measure Breaks where
+  measureChunk t
+    | T.null t = NoText
+    | otherwise =
+        Breaks
+          (T.count "\r" t + T.count "\n" t - T.count "\r\n" t)
+          (T.head t == '\n')
+          (T.last t == '\r')
+
+-- | A synthetic width measure for testing: code points from U+1100 count
+-- as two, all others as one. This is not a Unicode display-width algorithm.
+newtype Width = Width Int
+  deriving (Eq, Ord, Show)
+
+instance Semigroup Width where
+  Width a <> Width b = Width (a + b)
+
+instance Monoid Width where
+  mempty = Width 0
+
+charWidth :: Char -> Int
+charWidth c = if c >= '\x1100' then 2 else 1
+
+instance Measure Width where
+  measureChunk = Width . T.foldl' (\n c -> n + charWidth c) 0
+
+type R = Rope (Breaks, Width)
+
+------------------------------------------------------------------------------
+-- The model
+
+utf8Len, utf16Len :: Char -> Int
+utf8Len c
+  | c < '\x80' = 1
+  | c < '\x800' = 2
+  | c < '\x10000' = 3
+  | otherwise = 4
+utf16Len c = if c < '\x10000' then 1 else 2
+
+naiveMetrics :: Text -> Metrics
+naiveMetrics t =
+  Metrics
+    { bytes = sum (map utf8Len s)
+    , chars = L.length s
+    , utf16Units = sum (map utf16Len s)
+    , newlines = L.length (filter (== '\n') s)
+    }
+  where
+    s = T.unpack t
+
+-- | Convert a clamped, rounded offset to a code point count.
+charsAt :: Unit -> Int -> Text -> Int
+charsAt u k t
+  | k <= 0 = 0
+  | otherwise = case u of
+      Chars -> min k (T.length t)
+      Bytes -> fitting utf8Len
+      Utf16 -> fitting utf16Len
+      Lines -> case L.drop (k - 1) [i + 1 | (i, '\n') <- zip [0 ..] s] of
+        p : _ -> p
+        [] -> L.length s
+  where
+    s = T.unpack t
+    fitting w = L.length (takeWhile (<= k) (drop 1 (scanl (+) 0 (map w s))))
+
+-- | Resolve both range endpoints to code point counts in the original text.
+charRange :: Unit -> Int -> Int -> Text -> (Int, Int)
+charRange u i j t = (ni, if j <= i then ni else charsAt u j t)
+  where
+    ni = charsAt u i t
+
+-- | Code point offset and content of each line, keeping an empty final line
+-- when present.
+lineTable :: Text -> [(Int, Text)]
+lineTable = go 0 . T.splitOn "\n"
+  where
+    go _ [] = []
+    go s [final] = [(s, final)]
+    go s (l : ls) = (s, fromMaybe l (T.stripSuffix "\r" l)) : go (s + T.length l + 1) ls
+
+naiveLines :: Text -> [Text]
+naiveLines t
+  | T.null t || T.last t == '\n' = L.init table
+  | otherwise = table
+  where
+    table = map snd (lineTable t)
+
+-- | The number of characters before a position.
+charsAtPosition :: Unit -> Position -> Text -> Int
+charsAtPosition u (Position l c) t = case L.drop (max 0 l) (lineTable t) of
+  [] -> T.length t
+  (s, content) : _ -> s + charsAt u c content
+
+naivePosition :: Unit -> Int -> Text -> Position
+naivePosition u n t = Position (T.count "\n" before) (Rope.count u (naiveMetrics column))
+  where
+    before = T.take n t
+    column = T.takeWhileEnd (/= '\n') before
+
+------------------------------------------------------------------------------
+-- Generators
+
+-- | Scale inputs by chunk size (1 for the small build, 32 for the default)
+-- so both builds exercise trees with several levels.
+sizeFactor :: Int
+sizeFactor = maxChunk `quot` 16
+
+genPiece :: Gen String
+genPiece =
+  frequency
+    [ (12, pure <$> elements "abcxyz ")
+    , (3, pure "\n")
+    , (1, pure "\r")
+    , (1, pure "\r\n")
+    , (2, pure <$> elements "\233\223\241") -- two bytes
+    , (2, pure <$> elements "\8364\20013\12354") -- three bytes
+    , (2, pure <$> elements "\128512\119070\127881") -- four bytes, surrogate pairs
+    ]
+
+-- | Generate ASCII-only chunks to exercise paths skipped by mixed UTF-8 input.
+genAsciiPiece :: Gen String
+genAsciiPiece =
+  frequency
+    [ (12, pure <$> elements "abcxyz ")
+    , (3, pure "\n")
+    , (1, pure "\r\n")
+    ]
+
+-- | Generate mixed UTF-8, ASCII-only, and mostly ASCII documents so trees
+-- exercise both ASCII and general Unicode paths.
+genText :: Int -> Gen Text
+genText n = do
+  oneLine <- frequency [(4, pure False), (1, pure True)]
+  piece <-
+    frequency
+      [ (3, pure genPiece)
+      , (2, pure genAsciiPiece)
+      , (1, pure (frequency [(40 * sizeFactor, genAsciiPiece), (1, genPiece)]))
+      ]
+  t <- T.pack . concat <$> vectorOf n piece
+  pure (if oneLine then T.filter (/= '\n') t else t)
+
+-- | Produce strictly shorter candidates so shrinking terminates.
+shrinkText :: Text -> [Text]
+shrinkText t =
+  [half | h > 0, half <- [T.take h t, T.drop h t]]
+    ++ [T.take i t <> T.drop (i + 1) t | i <- [0 .. min 30 (n - 1)]]
+  where
+    n = T.length t
+    h = n `quot` 2
+
+-- | A document.
+newtype Doc = Doc Text
+  deriving (Show)
+
+instance Arbitrary Doc where
+  arbitrary = do
+    n <- frequency [(1, pure 0), (2, choose (0, 8)), (8, choose (0, 200 * sizeFactor))]
+    Doc <$> genText n
+  shrink (Doc t) = Doc <$> shrinkText t
+
+-- | Inserted text, weighted toward keystrokes with occasional larger pastes.
+newtype Snippet = Snippet Text
+  deriving (Show)
+
+instance Arbitrary Snippet where
+  arbitrary = do
+    n <- frequency [(4, choose (0, 3)), (2, choose (0, 40)), (1, choose (0, 80 * sizeFactor))]
+    Snippet <$> genText n
+  shrink (Snippet t) = Snippet <$> shrinkText t
+
+instance Arbitrary Unit where
+  arbitrary = elements [minBound .. maxBound]
+
+-- | A relative offset, resolved against the input length with values just
+-- outside both ends to exercise clamping.
+newtype Offset = Offset Int
+  deriving (Show)
+
+instance Arbitrary Offset where
+  arbitrary = Offset <$> choose (0, 1000)
+  shrink (Offset k) = Offset <$> shrink k
+
+resolve :: Unit -> Offset -> Text -> Int
+resolve u (Offset k) t = k * (Rope.count u (naiveMetrics t) + 5) `quot` 1000 - 2
+
+data Op
+  = Insert Unit Offset Snippet
+  | Delete Unit Offset Offset
+  | Replace Unit Offset Offset Snippet
+  | Append Snippet
+  | Prepend Snippet
+  | Take Unit Offset
+  | Drop Unit Offset
+  | Slice Unit Offset Offset
+  | Rejoin Unit Offset
+  | Typed Unit Offset [Snippet] Int
+  deriving (Show)
+
+instance Arbitrary Op where
+  arbitrary =
+    frequency
+      [ (6, Insert <$> arbitrary <*> arbitrary <*> arbitrary)
+      , (6, Delete <$> arbitrary <*> arbitrary <*> nearby)
+      , (4, Replace <$> arbitrary <*> arbitrary <*> nearby <*> arbitrary)
+      , (2, Append <$> arbitrary)
+      , (2, Prepend <$> arbitrary)
+      , (1, Take <$> arbitrary <*> arbitrary)
+      , (1, Drop <$> arbitrary <*> arbitrary)
+      , (1, Slice <$> arbitrary <*> arbitrary <*> arbitrary)
+      , (3, Rejoin <$> arbitrary <*> arbitrary)
+      , (4, Typed <$> arbitrary <*> arbitrary <*> resize 6 (listOf arbitrary) <*> choose (0, 4))
+      ]
+    where
+      -- Prefer short ranges so edit sequences retain enough text to test.
+      nearby = Offset <$> frequency [(5, choose (0, 20)), (1, choose (0, 1000))]
+  shrink op = case op of
+    Insert u i s -> Insert u i <$> shrink s
+    Replace u i j s -> Delete u i j : (Replace u i j <$> shrink s)
+    Append s -> Append <$> shrink s
+    Prepend s -> Prepend <$> shrink s
+    Typed u i ss erased -> [Typed u i ss' erased | ss' <- shrink ss] ++ [Typed u i ss 0 | erased > 0]
+    _ -> []
+
+-- | Ranges are generated as a start and a length.
+range :: Unit -> Offset -> Offset -> Text -> (Int, Int)
+range u i (Offset len) t = (start, start + len * (Rope.count u (naiveMetrics t) + 5) `quot` 1000)
+  where
+    start = resolve u i t
+
+apply :: Op -> (R, Text) -> (R, Text)
+apply op (r, t) = case op of
+  Insert u i (Snippet s) ->
+    let k = resolve u i t
+        n = charsAt u k t
+     in (Rope.insert u k s r, T.take n t <> s <> T.drop n t)
+  Delete u i j ->
+    let (a, b) = range u i j t
+        (na, nb) = charRange u a b t
+     in (Rope.delete u a b r, T.take na t <> T.drop nb t)
+  Replace u i j (Snippet s) ->
+    let (a, b) = range u i j t
+        (na, nb) = charRange u a b t
+     in (Rope.replace u a b s r, T.take na t <> s <> T.drop nb t)
+  Append (Snippet s) -> (r <> Rope.fromText s, t <> s)
+  Prepend (Snippet s) -> (Rope.fromText s <> r, s <> t)
+  Take u i ->
+    let k = resolve u i t
+     in (Rope.take u k r, T.take (charsAt u k t) t)
+  Drop u i ->
+    let k = resolve u i t
+     in (Rope.drop u k r, T.drop (charsAt u k t) t)
+  Slice u i j ->
+    let (a, b) = range u i j t
+        (na, nb) = charRange u a b t
+     in (Rope.slice u a b r, T.take (nb - na) (T.drop na t))
+  Rejoin u i ->
+    let (a, b) = Rope.splitAt u (resolve u i t) r
+     in (a <> b, t)
+  Typed u i snippets erased ->
+    let (r', t', cursor) = L.foldl' (keystroke u) (r, t, resolve u i t) snippets
+        (na, nb) = charRange u (cursor - erased) cursor t'
+     in (Rope.delete u (cursor - erased) cursor r', T.take na t' <> T.drop nb t')
+
+-- | Insert at the cursor and advance by the inserted text's length in the
+-- chosen unit, starting from at least zero.
+keystroke :: Unit -> (R, Text, Int) -> Snippet -> (R, Text, Int)
+keystroke u (r, t, cursor) (Snippet s) =
+  (Rope.insert u cursor s r, T.take n t <> s <> T.drop n t, max 0 cursor + Rope.count u (naiveMetrics s))
+  where
+    n = charsAt u cursor t
+
+-- | A rope after a sequence of edits, paired with its expected text.
+data Edited = Edited R Text
+
+instance Show Edited where
+  show (Edited r t) = show t ++ " as a tree of height " ++ show (height r)
+
+instance Arbitrary Edited where
+  arbitrary = do
+    Doc t <- arbitrary
+    ops <- resize 8 (listOf arbitrary)
+    pure (uncurry Edited (L.foldl' (flip apply) (Rope.fromText t, t) ops))
+  shrink (Edited _ t) = [Edited (Rope.fromText t') t' | t' <- shrinkText t]
+
+------------------------------------------------------------------------------
+-- Properties
+
+-- | The rope is a valid tree holding exactly this text.
+holds :: R -> Text -> Property
+holds r t =
+  conjoin
+    [ counterexample "invariants" (invariants r === [])
+    , counterexample "text" (Rope.toText r === t)
+    , counterexample "metrics" (Rope.metrics r === naiveMetrics t)
+    , counterexample "measure" (Rope.measure r === (measureChunk t, measureChunk t))
+    ]
+
+prop_roundtrip :: Doc -> Property
+prop_roundtrip (Doc t) = holds (Rope.fromText t) t
+
+prop_lazy :: [Doc] -> Property
+prop_lazy docs =
+  holds (Rope.fromLazyText lazy) (TL.toStrict lazy)
+    .&&. Rope.toLazyText (Rope.fromLazyText lazy :: R) === lazy
+    .&&. Rope.toString (Rope.fromLazyText lazy :: R) === TL.unpack lazy
+  where
+    lazy = TL.fromChunks [t | Doc t <- docs]
+
+prop_chunks :: Edited -> Property
+prop_chunks (Edited r t) =
+  T.concat chunks === t
+    .&&. counterexample "empty chunk" (not (any T.null chunks))
+    .&&. counterexample "oversized chunk" (all ((<= maxChunk) . bytes . naiveMetrics) chunks)
+    .&&. Rope.foldrChunks (\c n -> T.length c + n) 0 r === T.length t
+    .&&. reverse (Rope.foldlChunks' (flip (:)) [] r) === chunks
+  where
+    chunks = Rope.toChunks r
+
+-- | Check exact UTF-8 bytes when writing to an existing handle and when
+-- replacing a file.
+prop_output :: Edited -> Property
+prop_output (Edited r t) = ioProperty $ do
+  (written, replaced) <- withTempFile $ \path h -> do
+    B.hPut h "before "
+    Rope.hPutUtf8 h r
+    hClose h
+    written <- B.readFile path
+    Rope.writeFileUtf8 path r
+    replaced <- B.readFile path
+    pure (written, replaced)
+  pure (written === "before " <> TE.encodeUtf8 t .&&. replaced === TE.encodeUtf8 t)
+
+-- | Exercise multiple output-buffer flushes and a partially filled final
+-- buffer with a document larger than the default buffer.
+prop_outputLarge :: Property
+prop_outputLarge = ioProperty $ do
+  written <- withTempFile $ \path h -> do
+    Rope.hPutUtf8 h (Rope.fromText t :: R)
+    hClose h
+    B.readFile path
+  pure (written == TE.encodeUtf8 t)
+  where
+    t = T.replicate 9000 "na\239ve \20013\25991 \128512\r\n"
+
+-- | A deliberately partial measure that throws on @!@.
+data Calm = Calm
+  deriving (Eq, Show)
+
+instance Semigroup Calm where
+  Calm <> Calm = Calm
+
+instance Monoid Calm where
+  mempty = Calm
+
+instance Measure Calm where
+  measureChunk t
+    | T.any (== '!') t = error "not calm"
+    | otherwise = Calm
+
+-- | A failure while measuring pending input must occur before the existing
+-- file is opened and truncated.
+prop_outputFails :: Property
+prop_outputFails = ioProperty $ do
+  (outcome, kept) <- withTempFile $ \path h -> do
+    B.hPut h "kept"
+    hClose h
+    outcome <- try (Rope.writeFileUtf8 path typed) :: IO (Either ErrorCall ())
+    kept <- B.readFile path
+    pure (outcome, kept)
+  pure (counterexample "it was written" (either (const True) (const False) outcome) .&&. kept === "kept")
+  where
+    typed = L.foldl' (\r (i, key) -> Rope.insert Chars i key r) (Rope.fromText "calm" :: Rope Calm) [(4, "a"), (5, "b"), (6, "!")]
+
+withTempFile :: (FilePath -> Handle -> IO a) -> IO a
+withTempFile act = do
+  dir <- getTemporaryDirectory
+  bracket
+    (openBinaryTempFile dir "nano-rope.txt")
+    (\(path, h) -> hClose h >> removeFile path)
+    (uncurry act)
+
+prop_chunkAt :: Edited -> Unit -> Offset -> Property
+prop_chunkAt (Edited r t) u i =
+  counterexample (show chunk) $
+    (chunk `T.isPrefixOf` rest) .&&. (T.null chunk === T.null rest)
+  where
+    k = resolve u i t
+    chunk = Rope.chunkAt u k r
+    rest = T.drop (charsAt u k t) t
+
+prop_remeasure :: Edited -> Property
+prop_remeasure (Edited r t) =
+  invariants plain === []
+    .&&. Rope.toText plain === t
+    .&&. holds (Rope.remeasure plain) t
+  where
+    plain = Rope.remeasure r :: Rope ()
+
+prop_append :: Edited -> Edited -> Property
+prop_append (Edited a ta) (Edited b tb) = holds (a <> b) (ta <> tb)
+
+prop_mconcat :: [Snippet] -> Property
+prop_mconcat snippets =
+  holds (mconcat (map Rope.fromText ts)) (T.concat ts)
+    .&&. holds (L.foldl' (\acc t -> Rope.fromText t <> acc) mempty ts) (T.concat (reverse ts))
+  where
+    ts = [t | Snippet t <- snippets]
+
+prop_splitAt :: Edited -> Unit -> Offset -> Property
+prop_splitAt (Edited r t) u i =
+  counterexample (show (u, k)) $
+    holds a (T.take n t) .&&. holds b (T.drop n t)
+  where
+    k = resolve u i t
+    n = charsAt u k t
+    (a, b) = Rope.splitAt u k r
+
+prop_slice :: Edited -> Unit -> Offset -> Offset -> Property
+prop_slice (Edited r t) u i j =
+  counterexample (show (u, a, b)) $
+    holds (Rope.slice u a b r) expected .&&. Rope.sliceText u a b r === expected
+  where
+    (a, b) = range u i j t
+    (na, nb) = charRange u a b t
+    expected = T.take (nb - na) (T.drop na t)
+
+prop_ops :: Doc -> [Op] -> Property
+prop_ops (Doc t0) = go (1 :: Int) (Rope.fromText t0, t0)
+  where
+    go _ (r, t) [] = holds r t
+    go i (r, t) (op : ops) =
+      holds r t .&&. counterexample ("operation " ++ show i) (go (i + 1) (apply op (r, t)) ops)
+
+-- | A burst of keystrokes at the cursor.
+data Burst
+  = Typing Text Int
+  | Erasing Int
+  deriving (Show)
+
+instance Arbitrary Burst where
+  arbitrary =
+    oneof
+      [ Typing <$> (choose (1, 3) >>= genText) <*> choose (1, 8 * sizeFactor)
+      , Erasing <$> choose (1, 16 * sizeFactor)
+      ]
+
+-- | Repeated typing and erasing at a cursor exercises chunk splits and merges.
+prop_typing :: Doc -> Offset -> Property
+prop_typing (Doc t0) start = forAll (resize 10 (listOf arbitrary)) $ \bursts ->
+  let cursor = max 0 (min (T.length t0) (resolve Chars start t0))
+   in go (Rope.fromText t0, t0, cursor) bursts
+  where
+    go (r, t, _) [] = holds r t
+    go st@(r, t, _) (b : bs) = holds r t .&&. counterexample (show b) (go (burst b st) bs)
+
+    burst (Typing s n) st = L.foldl' (\acc _ -> typeOne s acc) st [1 .. n]
+    burst (Erasing n) st = L.foldl' (\acc _ -> eraseOne acc) st [1 .. n]
+
+    typeOne s (r, t, c) = (Rope.insert Chars c s r, T.take c t <> s <> T.drop c t, c + T.length s)
+    eraseOne st@(r, t, c)
+      | c <= 0 = st
+      | otherwise = (Rope.delete Chars (c - 1) c r, T.take (c - 1) t <> T.drop c t, c - 1)
+
+-- | Consecutive insertions agree with the model in every unit, including
+-- clamped offsets and offsets inside code points. Check intermediate ropes
+-- as well as a run whose intermediate values are not read.
+prop_run :: Edited -> Unit -> Offset -> Property
+prop_run (Edited r0 t0) u i = forAll (resize 12 (listOf arbitrary)) $ \snippets ->
+  let steps = L.scanl (keystroke u) (r0, t0, resolve u i t0) snippets
+      (unread, final, _) = L.foldl' (keystroke u) (r0, t0, resolve u i t0) snippets
+   in counterexample (show (u, resolve u i t0)) $
+        holds unread final .&&. conjoin [holds r t | (r, t, _) <- steps]
+
+-- | Insertions near buffered input must use the actual offset, rather than
+-- incorrectly extending the buffer at an interior or differently counted offset.
+prop_nearRun :: Edited -> Unit -> Offset -> Property
+prop_nearRun (Edited r0 t0) u i = forAll ((,) <$> key <*> key) $ \(s1, s2) ->
+  let (r, t, _) = L.foldl' (keystroke u) (r0, t0, start) [Snippet "a", Snippet s1, Snippet s2]
+      -- Byte length bounds the inserted length in every unit.
+      typed = Rope.count Bytes (naiveMetrics t) - Rope.count Bytes (naiveMetrics t0)
+   in conjoin
+        [ counterexample (show (u, start, k)) (holds (Rope.insert u k "-" r) (T.take n t <> "-" <> T.drop n t))
+        | k <- [start - 1 .. start + typed + 1]
+        , let n = charsAt u k t
+        ]
+  where
+    start = resolve u i t0
+    -- Short inputs can stay in the typing buffer.
+    key = choose (1, 2) >>= genText
+
+-- | Branching from a rope with pending input preserves the original and
+-- produces independent edited versions.
+prop_branching :: Edited -> Offset -> Snippet -> Snippet -> Snippet -> Property
+prop_branching (Edited r0 t0) i s1 s2 s3 =
+  conjoin
+    [ counterexample "one way" (holds ra ta)
+    , counterexample "the other way" (holds rb tb)
+    , counterexample "erased" (holds rc tc)
+    , counterexample "the rope they came from" (holds r t)
+    ]
+  where
+    start = max 0 (min (T.length t0) (resolve Chars i t0))
+    (r, t, cursor) = L.foldl' (keystroke Chars) (r0, t0, start) [Snippet "ab", s1]
+    (ra, ta, _) = keystroke Chars (r, t, cursor) s2
+    (rb, tb, _) = keystroke Chars (r, t, cursor) s3
+    rc = Rope.delete Chars (cursor - 1) cursor r
+    tc = T.take (cursor - 1) t <> T.drop cursor t
+
+prop_metricsAt :: Edited -> Unit -> Offset -> Property
+prop_metricsAt (Edited r t) u i =
+  counterexample (show (u, k)) $
+    Rope.metricsAt u k r === naiveMetrics (T.take (charsAt u k t) t)
+  where
+    k = resolve u i t
+
+prop_convert :: Edited -> Unit -> Unit -> Offset -> Property
+prop_convert (Edited r t) from to i =
+  counterexample (show (from, to, k)) $
+    Rope.convert from to k r === Rope.count to (naiveMetrics (T.take (charsAt from k t) t))
+  where
+    k = resolve from i t
+
+genPosition :: Text -> Gen Position
+genPosition t =
+  Position
+    <$> choose (-1, T.count "\n" t + 1)
+    <*> frequency [(6, choose (-1, 12)), (2, choose (0, 40 * sizeFactor)), (1, pure maxBound)]
+
+prop_position :: Edited -> Unit -> Property
+prop_position (Edited r t) u = forAll (genPosition t) $ \pos ->
+  let n = charsAtPosition u pos t
+      (a, b) = Rope.splitAtPosition u pos r
+      -- The position again, with the start of its line.
+      (line, at) = Rope.metricsAtLineAndPosition u pos r
+   in Rope.metricsAtPosition u pos r === naiveMetrics (T.take n t)
+        .&&. at === naiveMetrics (T.take n t)
+        .&&. line === naiveMetrics (T.take (charsAt Lines (posLine pos) t) t)
+        .&&. Rope.toText a === T.take n t
+        .&&. Rope.toText b === T.drop n t
+        .&&. Rope.positionToOffset u Chars pos r === n
+
+prop_toPosition :: Edited -> Unit -> Unit -> Offset -> Property
+prop_toPosition (Edited r t) from to i =
+  counterexample (show (from, to, k)) $
+    Rope.offsetToPosition from to k r === naivePosition to (charsAt from k t) t
+  where
+    k = resolve from i t
+
+-- | Positions round-trip through offsets except inside CRLF, where input
+-- positions clamp to the end of the line's content.
+prop_positionRoundtrip :: Edited -> Unit -> Unit -> Offset -> Property
+prop_positionRoundtrip (Edited r t) u via i =
+  via /= Lines && not insideTerminator ==>
+    Rope.offsetToPosition via u (Rope.positionToOffset u via pos r) r === pos
+  where
+    n = charsAt Chars (resolve Chars i t) t
+    pos = naivePosition u n t
+    insideTerminator = T.take 1 (T.drop n t) == "\n" && T.takeEnd 1 (T.take n t) == "\r"
+
+prop_lines :: Edited -> Property
+prop_lines (Edited r t) =
+  Rope.lines r === naiveLines t
+    .&&. Rope.lineCount r === T.count "\n" t + 1
+    .&&. Rope.length Lines r === T.count "\n" t
+
+prop_getLine :: Edited -> Property
+prop_getLine (Edited r t) = forAll (choose (-1, L.length table + 1)) $ \l ->
+  Rope.getLine l r === (if l < 0 then "" else maybe "" snd (L.lookup l (zip [0 ..] table)))
+  where
+    table = lineTable t
+
+-- | The longest prefix (in characters) on which a predicate fails.
+longestPrefix :: (Text -> Bool) -> Text -> Int
+longestPrefix p t = L.length (takeWhile (not . p) (drop 1 (T.inits t)))
+
+prop_splitWhereWidth :: Edited -> Offset -> Property
+prop_splitWhereWidth (Edited r t) (Offset k) =
+  counterexample (show limit) $
+    holds a (T.take n t) .&&. holds b (T.drop n t)
+  where
+    Width whole = measureChunk t
+    limit = k * (whole + 5) `quot` 1000 - 2
+    (a, b) = Rope.splitWhere (\_ (_, Width w) -> w > limit) r
+    n = longestPrefix (\p -> measureChunk p > Width limit) t
+
+prop_splitWhereBreaks :: Edited -> Offset -> Property
+prop_splitWhereBreaks (Edited r t) (Offset k) =
+  counterexample (show limit) $
+    Rope.metricsWhere (\_ (bs, _) -> breakCount bs >= limit) r === naiveMetrics (T.take n t)
+  where
+    limit = k * (breakCount (measureChunk t) + 3) `quot` 1000
+    n = longestPrefix (\p -> breakCount (measureChunk p) >= limit) t
+
+prop_splitWhereMetrics :: Edited -> Unit -> Offset -> Property
+prop_splitWhereMetrics (Edited r t) u i =
+  u /= Lines ==>
+    Rope.metricsWhere (\m _ -> Rope.count u m > k) r === Rope.metricsAt u k r
+  where
+    k = max 0 (resolve u i t)
+
+prop_eq :: Edited -> Property
+prop_eq (Edited r t) =
+  r === Rope.fromText t
+    .&&. compare r (Rope.fromText t) === EQ
+    .&&. (r /= Rope.fromText (t <> "!")) === True
+    .&&. (r == Rope.fromText swapped) === (t == swapped)
+  where
+    -- Same metrics, so that equality has to look at the text.
+    swapped = T.map (\c -> case c of 'a' -> 'b'; 'b' -> 'a'; _ -> c) t
+
+prop_ord :: Edited -> Edited -> Offset -> Property
+prop_ord (Edited a ta) (Edited b tb) i =
+  compare a b === compare ta tb
+    .&&. (a == b) === (ta == tb)
+    .&&. compare a (Rope.fromText grafted) === compare ta grafted
+  where
+    -- Shares a prefix with the first text.
+    grafted = T.take (resolve Chars i ta) ta <> tb
+
+prop_show :: Edited -> Property
+prop_show (Edited r t) = show r === show t
+
+------------------------------------------------------------------------------
+-- Laws
+
+-- | The laws of some classes as a group of tests.
+lawsOf :: String -> [Laws] -> TestTree
+lawsOf name sets =
+  testGroup name [testGroup cls [testProperty law p | (law, p) <- properties] | Laws cls properties <- sets]
+
+-- | Related texts make equality and ordering laws useful: some are equal,
+-- some differ only near the end, and some share metrics despite differing
+-- in content. Sizes exercise multiple chunks and tree heights in both builds.
+lawTexts :: [(Int, Text)]
+lawTexts =
+  [ (1, "")
+  , (3, stem <> "xyz")
+  , (2, stem <> "xzy")
+  , (2, stem <> "xyz\128512")
+  , (2, T.replicate 8 stem <> "xyz")
+  , (1, T.replicate 8 stem <> "xzy")
+  ]
+  where
+    stem = T.take (2 * maxChunk) (T.replicate maxChunk "ab\nc\233 \8364\r\n\128512xyz")
+
+-- | Build the same text with different chunk boundaries: directly, by
+-- concatenation, by typing a suffix, by filling a gap, or by slicing.
+ropeOf :: Measure a => Text -> Gen (Rope a)
+ropeOf t =
+  oneof
+    [ pure (Rope.fromText t)
+    , do
+        cuts <- L.sort <$> resize 6 (listOf (choose (0, n)))
+        pure (mconcat [Rope.fromText (T.take (j - i) (T.drop i t)) | (i, j) <- zip (0 : cuts) (cuts ++ [n])])
+    , do
+        k <- choose (max 0 (n - 8 * sizeFactor), n)
+        pure (L.foldl' (\r (i, c) -> Rope.insert Chars i (T.singleton c) r) (Rope.fromText (T.take k t)) (zip [k ..] (T.unpack (T.drop k t))))
+    , do
+        i <- choose (0, n)
+        j <- choose (i, n)
+        pure (Rope.insert Chars i (T.take (j - i) (T.drop i t)) (Rope.fromText (T.take i t <> T.drop j t)))
+    , do
+        Snippet before <- arbitrary
+        Snippet after <- arbitrary
+        let i = T.length before
+        pure (Rope.slice Chars i (i + n) (Rope.fromText (before <> t <> after)))
+    ]
+  where
+    n = T.length t
+
+-- | Generator for instance laws; see 'lawTexts'. Operation tests use 'Edited'.
+instance Measure a => Arbitrary (Rope a) where
+  arbitrary = frequency [(w, pure t) | (w, t) <- lawTexts] >>= ropeOf
+  shrink r = Rope.fromText <$> shrinkText (Rope.toText r)
+
+-- | Require coverage of equal ropes with different chunks and unequal ropes
+-- with identical metrics.
+prop_lawRopes :: R -> R -> Property
+prop_lawRopes a b =
+  checkCoverage $
+    cover 10 (a == b && Rope.toChunks a /= Rope.toChunks b) "equal, in different chunks" $
+      cover 5 (a /= b && Rope.metrics a == Rope.metrics b) "different, with the same metrics" $
+        holds a (Rope.toText a) .&&. holds b (Rope.toText b)
+
+-- | Additional checks that derived comparison operators agree with '=='
+-- and 'compare'.
+eqOrdLaws :: forall a. (Ord a, Arbitrary a, Show a) => Proxy a -> Laws
+eqOrdLaws _ =
+  Laws
+    "Eq and Ord"
+    [ ("Negation", property $ \(a :: a) b -> (a /= b) === not (a == b))
+    , ("compare is EQ where == holds", property $ \(a :: a) b -> (compare a b == EQ) === (a == b))
+    , ("compare, turned around", property $ \(a :: a) b -> compare a b === opposite (compare b a))
+    ,
+      ( "Operators"
+      , property $ \(a :: a) b ->
+          let o = compare a b
+           in conjoin [(a < b) === (o == LT), (a <= b) === (o /= GT), (a > b) === (o == GT), (a >= b) === (o /= LT)]
+      )
+    , ("min and max", property $ \(a :: a) b -> (min a b, max a b) === (if a <= b then (a, b) else (b, a)))
+    ]
+  where
+    opposite o = case o of
+      LT -> GT
+      EQ -> EQ
+      GT -> LT
+
+-- | Text, metrics, and measures preserve concatenation and the empty rope.
+homomorphismLaws :: Laws
+homomorphismLaws =
+  Laws
+    "Monoid homomorphisms"
+    [ ("toText", homomorphism Rope.toText)
+    , ("metrics", homomorphism Rope.metrics)
+    , ("measure", homomorphism Rope.measure)
+    ]
+  where
+    homomorphism :: (Monoid b, Eq b, Show b) => (R -> b) -> Property
+    homomorphism f = property $ \a b -> f (a <> b) === f a <> f b .&&. f mempty === mempty
+
+-- | String conversion matches 'Text', including replacement of surrogate
+-- code points with the Unicode replacement character.
+isStringLaws :: Laws
+isStringLaws =
+  Laws
+    "IsString"
+    [ ("fromString, like Text", forAll genString $ \s -> holds (fromString s) (fromString s))
+    , ("toString . fromString", forAll genString $ \s -> Rope.toString (fromString s :: R) === T.unpack (fromString s))
+    ]
+  where
+    genString = concat <$> listOf (frequency [(9, genPiece), (1, vectorOf 1 (choose ('\xD800', '\xDFFF')))])
+
+-- | Measures preserve concatenation and identity, independent of chunk boundaries.
+measureLaws :: forall a. (Measure a, Eq a, Show a) => Proxy a -> Laws
+measureLaws _ =
+  Laws
+    "Measure"
+    [ ("Homomorphism", property $ \(Snippet x) (Snippet y) -> (measureChunk (x <> y) :: a) === measureChunk x <> measureChunk y)
+    , ("Identity", (measureChunk T.empty :: a) === mempty)
+    ]
+
+-- | Generate a measurement from text rather than arbitrary field values.
+measured :: (Text -> a) -> Gen a
+measured f = (\(Snippet t) -> f t) <$> arbitrary
+
+instance Arbitrary Metrics where
+  arbitrary = measured naiveMetrics
+
+instance Arbitrary Breaks where
+  arbitrary = measured measureChunk
+
+instance Arbitrary Width where
+  arbitrary = measured measureChunk
+
+prop_plain :: Edited -> Unit -> Offset -> Snippet -> Property
+prop_plain (Edited r t) u i (Snippet s) =
+  conjoin
+    [ Plain.toText plain === t
+    , Plain.metrics plain === Rope.metrics r
+    , Plain.toText (Plain.insert u k s plain) === Rope.toText (Rope.insert u k s r)
+    , Plain.toText (fst (Plain.splitAt u k plain)) === Rope.toText (Rope.take u k r)
+    , Plain.metricsWhere (\m -> Rope.count Chars m > k) plain === Rope.metricsAt Chars k r
+    , holds (Plain.measured plain) t
+    , Plain.fromText t === plain
+    ]
+  where
+    k = resolve u i t
+    plain = Plain.unmeasured r
+
+-- | Exercise edits on a tree of height at least two in both builds.
+prop_big :: Property
+prop_big = forAll (genText (6000 * sizeFactor)) $ \t0 ->
+  forAll (vectorOf 30 arbitrary) $ \ops ->
+    let r0 = Rope.fromText t0 :: R
+     in counterexample ("height " ++ show (height r0)) $
+          height r0 >= 2 .&&. prop_ops (Doc t0) ops
+
+------------------------------------------------------------------------------
+-- Chunk scans
+
+-- | UTF-8 inputs for comparing every scan implementation with a model.
+-- Long lines exercise searches beyond the first vector. Repeated pieces
+-- exercise counter flushing at the 255-vector limit.
+newtype Scanned = Scanned Text
+  deriving (Show)
+
+instance Arbitrary Scanned where
+  arbitrary =
+    Scanned
+      <$> frequency
+        [ (6, choose (0, 1100) >>= \n -> T.pack . concat <$> vectorOf n genPiece)
+        , (3, choose (0, 1100) >>= \n -> T.pack . concat <$> vectorOf n (frequency [(1, pure "\n"), (60, filter (/= '\n') <$> genPiece)]))
+        , (1, genPiece >>= \p -> choose (8000, 9000) >>= \n -> pure (T.pack (concat (replicate n p))))
+        ]
+  shrink (Scanned t) = Scanned <$> shrinkText t
+
+bytesOfText :: Text -> ByteArray
+bytesOfText (TI.Text (A.ByteArray ba) off len) = cloneByteArray (ByteArray ba) off len
+
+byteList :: ByteArray -> [Word8]
+byteList arr = [indexByteArray arr i | i <- [0 .. sizeofByteArray arr - 1]]
+
+isContByte :: Word8 -> Bool
+isContByte b = b >= 0x80 && b < 0xC0
+
+-- | Check every available scan implementation against the expected result.
+allKernels :: (Eq b, Show b) => (Kernels -> b) -> b -> Property
+allKernels run expected = conjoin [counterexample (kernelsName k) (run k === expected) | k <- kernels]
+
+-- | Generate short and long slices, including array boundaries.
+genSlice :: Int -> Gen (Int, Int)
+genSlice size = do
+  off <- frequency [(1, pure 0), (4, choose (0, size))]
+  len <- frequency [(1, pure (size - off)), (2, choose (0, min 40 (size - off))), (2, choose (0, size - off))]
+  pure (off, len)
+
+prop_scanMetrics :: Scanned -> Property
+prop_scanMetrics (Scanned t) = forAll (genSlice (sizeofByteArray arr)) $ \(off, len) ->
+  let bs = L.take len (L.drop off (byteList arr))
+      cs = len - L.length (filter isContByte bs)
+   in allKernels
+        (\k -> kernelMetrics k arr off len)
+        (Metrics len cs (cs + L.length (filter (>= 0xF0) bs)) (L.length (filter (== 0x0A) bs)))
+  where
+    arr = bytesOfText t
+
+prop_scanNewlines :: Scanned -> Property
+prop_scanNewlines (Scanned t) = forAll (genSlice (sizeofByteArray arr)) $ \(off, len) ->
+  allKernels (\k -> kernelNewlines k arr off len) (L.length (filter (== 0x0A) (L.take len (L.drop off (byteList arr)))))
+  where
+    arr = bytesOfText t
+
+-- | Offsets of the line feeds.
+lineFeeds :: ByteArray -> [Int]
+lineFeeds arr = [i | (i, b) <- zip [0 ..] (byteList arr), b == 0x0A]
+
+prop_scanNext :: Scanned -> Property
+prop_scanNext (Scanned t) = forAll (choose (0, size)) $ \from ->
+  allKernels (\k -> kernelFindNewline k arr from) (fromMaybe size (L.find (>= from) (lineFeeds arr)))
+  where
+    arr = bytesOfText t
+    size = sizeofByteArray arr
+
+prop_scanPrevious :: Scanned -> Property
+prop_scanPrevious (Scanned t) = forAll (choose (0, sizeofByteArray arr)) $ \to ->
+  allKernels (\k -> kernelFindNewlineBack k arr to) (last (-1 : [i | i <- lineFeeds arr, i < to]))
+  where
+    arr = bytesOfText t
+
+-- | Check line-start and terminator offsets, including indices before
+-- the first line and beyond the last.
+prop_scanLine :: Scanned -> Property
+prop_scanLine (Scanned t) = forAll (choose (-1, L.length lfs + 2)) $ \n ->
+  let from
+        | n <= 0 = 0
+        | otherwise = case L.drop (n - 1) lfs of i : _ -> i + 1; [] -> size
+   in allKernels (\k -> kernelLineSpan k n arr) (ChunkLine from (fromMaybe size (L.find (>= from) lfs)))
+  where
+    arr = bytesOfText t
+    size = sizeofByteArray arr
+    lfs = lineFeeds arr
+
+-- | Compare unit scans with a decoded model of the longest prefix that fits
+-- in @k@ units. Both slice endpoints are code point boundaries.
+prop_scanUnits :: Scanned -> Bool -> Property
+prop_scanUnits (Scanned t) wide = forAll (genSlice (L.length bounds - 1)) $ \(i, n) ->
+  let from = bounds !! i
+      to = bounds !! (i + n)
+      piece = T.unpack (takeWord8 (to - from) (dropWord8 from t))
+      units c = if wide then utf16Len c else 1
+      model k = go from 0 piece
+        where
+          go b _ [] = b
+          go b u (c : cs)
+            | u + units c > k = b
+            | otherwise = go (b + utf8Len c) (u + units c) cs
+   in forAll (choose (-1, sum (map units piece) + 2)) $ \k ->
+        allKernels (\kn -> kernelScanUnits kn wide k arr from to) (model k)
+  where
+    arr = bytesOfText t
+    bounds = scanl (+) 0 (map utf8Len (T.unpack t))