kb-text-layout 0.1.0.1 → 0.1.0.2
raw patch · 4 files changed
+46/−28 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- kb-text-layout.cabal +1/−1
- src/KB/Text/Layout/Break.hs +20/−25
- test/Spec.hs +20/−2
CHANGELOG.md view
@@ -6,6 +6,11 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## 0.1.0.2 - 2026-08-28++- Keep leading spaces after a hard break and at the start of the text; only fold them after a soft wrap.+- Leading indentation no longer counts as stretchable space for justification.+ ## 0.1.0.1 - 2026-08-16 - Fix missing foldl' import.
kb-text-layout.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: kb-text-layout-version: 0.1.0.1+version: 0.1.0.2 synopsis: Multiline text measurement & layout. category: Text author: IC Rainbow
src/KB/Text/Layout/Break.hs view
@@ -69,22 +69,19 @@ Tab -> [plain i] PreservedSpace -> [plain i] ZeroWidthBreak -> [plain i]- SoftHyphen -> [Breakpoint{to = i, next = i + 1, hyphen = True, forced = False}]+ SoftHyphen -> [Breakpoint{to = i, next = skipSpaces (i + 1), hyphen = True, forced = False}] HardBreak -> [Breakpoint{to = i, next = i + 1, hyphen = False, forced = True}]- Atomic -> [Breakpoint{to = i, next = i, hyphen = False, forced = False}, Breakpoint{to = i + 1, next = i + 1, hyphen = False, forced = False}]+ Atomic -> [Breakpoint{to = i, next = i, hyphen = False, forced = False}, plain i] Word -> [] Glue -> []- plain i = Breakpoint{to = i, next = i + 1, hyphen = False, forced = False}+ plain i = Breakpoint{to = i, next = skipSpaces (i + 1), hyphen = False, forced = False} skipSpaces i | i < total, (segs Vector.! i).kind == Space = skipSpaces (i + 1) | otherwise = i - lineStart i = skipSpaces i-- lineOf from cand =+ lineOf a cand = let- a = lineStart from hyphenWidth = if cand.hyphen then (segs Vector.! cand.to).width else 0 natural = prefixFlow Vector.! cand.to - prefixFlow Vector.! a + hyphenWidth stretchable = prefixSpace Vector.! cand.to - prefixSpace Vector.! a@@ -206,21 +203,20 @@ layoutNextLineRange :: PreparedText -> Float -> Cursor -> Maybe (LineRange, Maybe Cursor) layoutNextLineRange prepared maxWidth cursor- | start.segment >= total = Nothing- | otherwise = Just (scanSeg start.segment start.grapheme 0 0 Nothing)+ | cursor.segment >= total = Nothing+ | otherwise = Just (scanSeg cursor.segment cursor.grapheme 0 0 Nothing) where segs = prepared.segments total = Vector.length segs- start = skipSpaces cursor - skipSpaces c+ resume c | c.segment < total , c.grapheme == 0 , (segs Vector.! c.segment).kind == Space =- skipSpaces Cursor{segment = c.segment + 1, grapheme = 0}- | otherwise = c+ resume Cursor{segment = c.segment + 1, grapheme = 0}+ | otherwise = Just c - emit to width ended = LineRange{from = start, to, width, ended}+ emit to width ended = LineRange{from = cursor, to, width, ended} scanSeg i g acc visible cand | i >= total = (emit (Cursor total 0) visible Finished, Nothing)@@ -235,14 +231,14 @@ 0 (acc + segWidth) visible- (Just Candidate{to = Cursor i 0, width = visible, end = Wrapped, next = after})+ (if visible > 0 then Just Candidate{to = Cursor i 0, width = visible, end = Wrapped, next = after} else cand) fitOrBreak | acc + segWidth <= maxWidth + epsilon = scanSeg (i + 1) 0 (acc + segWidth) (acc + segWidth) cand | otherwise = case cand of- Just c -> (emit c.to c.width c.end, Just c.next)- Nothing -> emergency seg i g acc+ Just c -> (emit c.to c.width c.end, resume c.next)+ Nothing -> emergency seg i g acc visible in case seg.kind of HardBreak -> (emit (Cursor i 0) visible HardBroken, Just after)@@ -271,26 +267,26 @@ scanSeg (i + 1) 0 (acc + segWidth) (acc + segWidth) $ Just Candidate{to = after, width = acc + segWidth, end = Wrapped, next = after} else case candBefore of- Just c -> (emit c.to c.width c.end, Just c.next)- Nothing -> (emit after (acc + segWidth) Overflowed, Just after)+ Just c -> (emit c.to c.width c.end, resume c.next)+ Nothing -> (emit after (acc + segWidth) Overflowed, resume after) Word -> fitOrBreak Glue -> fitOrBreak - emergency seg i g acc =+ emergency seg i g acc visible = let ws = dropChars g seg.graphemeWidths counted = countFits acc ws count- | counted == 0 && acc <= epsilon = 1+ | counted == 0 && visible <= epsilon = 1 | otherwise = counted taken = take count ws g' = g + sum (map fst taken) takenWidth = sum (map snd taken) in if count == 0 then- (emit (Cursor i g) acc Overflowed, Just (Cursor i g))+ (emit (Cursor i g) acc Overflowed, resume (Cursor i g)) else- (emit (Cursor i g') (acc + takenWidth) Overflowed, Just (advanceCursor seg i g'))+ (emit (Cursor i g') (acc + takenWidth) Overflowed, resume (advanceCursor seg i g')) countFits = fits 0 where@@ -429,8 +425,7 @@ | otherwise = line.to.segment inside = [ seg.width- | j <- [line.from.segment .. min upper (Vector.length segs - 1)]- , let seg = segs Vector.! j+ | seg <- dropWhile (\seg -> seg.kind == Space) (map (segs Vector.!) [line.from.segment .. min upper (Vector.length segs - 1)]) , seg.kind == Space ]
test/Spec.hs view
@@ -117,6 +117,22 @@ stretches w = map (Break.lineStretch prep) (Break.layoutGreedy prep w) stretches 200 @?= [LineStretch{spaces = 2, width = 20}] stretches 70 @?= [LineStretch{spaces = 1, width = 10}, LineStretch{spaces = 0, width = 0}]+ map (Break.lineStretch (fromSegments indented)) (Break.layoutGreedy (fromSegments indented) 200)+ @?= [LineStretch{spaces = 0, width = 0}, LineStretch{spaces = 0, width = 0}, LineStretch{spaces = 0, width = 0}]+ , testCase "leading spaces survive hard breaks" do+ let+ prep = fromSegments indented+ lns = Break.layoutGreedy prep 200+ map (Break.materializeLineRange prep) lns @?= ["main", "do", " putStrLn"]+ map (\l -> (l.from, l.width)) lns @?= [(Cursor 0 0, 40), (Cursor 2 0, 20), (Cursor 4 0, 100)]+ map (Break.materializeLineRange prep) (Break.layoutOptimal prep 200) @?= ["main", "do", " putStrLn"]+ materialized [space, word 40 "word"] 200 @?= [" word"]+ materialized [indent, word 80 "putStrLn"] 90 @?= [" putStrL", "n"]+ stepped indented [200, 200, 200] @?= ["main", "do", " putStrLn"]+ , testCase "leading spaces still fold after a wrap" do+ let prep = fromSegments [word 30 "aaa", indent, word 30 "bbb"]+ materialized [word 30 "aaa", indent, word 30 "bbb"] 40 @?= ["aaa", "bbb"]+ map (Break.materializeLineRange prep) (Break.layoutOptimal prep 40) @?= ["aaa", "bbb"] , testCase "shrinkwrap tightens without adding lines" do Break.shrinkwrap (fromSegments rhythm) 80 @?= 70 Break.shrinkwrap (fromSegments rhythm) 200 @?= 110@@ -179,8 +195,9 @@ Nothing -> [] Just (line, next) -> Break.materializeLineRange prep line : go next rest -prepared, hyphenated, wideHyphen, broken, glued, rhythm, styled :: [MeasuredSegment]+prepared, hyphenated, wideHyphen, broken, glued, rhythm, styled, indented :: [MeasuredSegment] prepared = [word 50 "hello", space, word 50 "world"]+indented = [word 40 "main", seg HardBreak 0 "\n", word 20 "do", seg HardBreak 0 "\n", indent, word 80 "putStrLn"] hyphenated = [word 20 "hy", seg SoftHyphen 5 "\xAD", word 30 "phen"] wideHyphen = [word 20 "hy", seg SoftHyphen 15 "\xAD", word 9 "phen"] broken = [word 30 "one", seg HardBreak 0 "\n", word 30 "two"]@@ -206,8 +223,9 @@ atom :: Float -> Text -> MeasuredSegment atom w label = MeasuredSegment{text = label, kind = Atomic, width = w, style = 0, graphemeWidths = [(Text.length label, w)]} -space :: MeasuredSegment+space, indent :: MeasuredSegment space = seg Space 10 " "+indent = seg Space 20 " " fromSegments :: [MeasuredSegment] -> PreparedText fromSegments xs = PreparedText{segments = Vector.fromList xs}