diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,41 @@ # doclayout +## 0.6 + + * Fix `nowrap` to descend into nested Doc structures. + Previously nowrap only replaced top-level breaking spaces, so spaces + inside Styled, Linked, Prefixed, and BeforeNonBlank remained + breakable, e.g. nowrap (bold ("aa" <> space <> "bb")) still wrapped. + + * Remove deprecated `unfoldD` [API change]. + It has been deprecated since 0.5 and is no longer used internally. + + * Make `flatten` linear in the size of the Doc (formerly it was quadratic + for left-nested Concats). + + * Fix `chop`: preserve attributes, keep combining marks with base, fill left. + Previously `chop` (used for lines exceeding a block's width) lost ANSI + styling in text, folded right-to-left (sometimes orphaning + combining marks at the start of the next line), and under-filled the + first chopped line instead of the last (e.g., `lblock 3 "abcdefg"` + gave `"a/nbcd/nefg"` rather than `"abc/ndef/ng"`). + + * Fix `offset`/`minOffset`/`updateColumn` for mid-line Prefixed. + `getOffset` restarted the column at 0 for Prefixed content and + unconditionally added the prefix width, but the renderer only emits + the prefix at the start of a line: mid-line, prefixed content simply + continues at the current column. + + * Various small performance improvements and cleanups. + + * Update EastAsianWidth.txt to Unicode 17.0. + + * Make `update.hs` a cabal script and fix it for recent EastAsianWidths. + + * Update sources with latest EastAsianWidths. + + * Remove stack.yaml. + ## 0.5.0.3 * Tests: Go back to using withMaxSuccess for compatibility with older diff --git a/doclayout.cabal b/doclayout.cabal --- a/doclayout.cabal +++ b/doclayout.cabal @@ -1,5 +1,5 @@ name: doclayout -version: 0.5.0.3 +version: 0.6 synopsis: A prettyprinting library for laying out text documents. description: doclayout is a prettyprinting library for laying out text documents, with several features not present diff --git a/src/Text/DocLayout.hs b/src/Text/DocLayout.hs --- a/src/Text/DocLayout.hs +++ b/src/Text/DocLayout.hs @@ -97,8 +97,6 @@ , isSkinToneModifier , isEmojiVariation , isZWJ - -- * Utility functions - , unfoldD -- * Types , Doc(..) , HasChars(..) @@ -107,7 +105,7 @@ where import Prelude -import Data.Maybe (fromMaybe, isJust, mapMaybe) +import Data.Maybe (isJust, mapMaybe) import Safe (lastMay, initSafe) import Control.Monad import Control.Monad.State.Strict @@ -174,14 +172,6 @@ instance HasChars a => IsString (Doc a) where fromString = text -{-# DEPRECATED unfoldD "unfoldD will be removed from the API." #-} --- | Unfold a 'Doc' into a flat list. -unfoldD :: Doc a -> [Doc a] -unfoldD Empty = [] -unfoldD (Concat x@Concat{} y) = unfoldD x <> unfoldD y -unfoldD (Concat x y) = x : unfoldD y -unfoldD x = [x] - -- | True if the document is empty. isEmpty :: Doc a -> Bool isEmpty Empty = True @@ -291,31 +281,35 @@ -- * Other Docs with inner content are eliminated if the inner content is -- empty, otherwise the inner content is itself flattened and made into -- a NonEmpty. +-- The accumulator ("rest") style guarantees linear time even for +-- left-nested Concats; naive list appends would be quadratic. flatten :: HasChars a => Doc a -> [FlatDoc a] -flatten (Text n a) = [FText n a] -flatten (Block n a) = [FBlock n a] -flatten (VFill n a) = [FVFill n a] -flatten (CookedText n a) = [FCookedText n a] -flatten (Prefixed p d) | null f = [] - | otherwise = [FPrefixed p (N.fromList f)] - where f = flatten d -flatten (BeforeNonBlank d) | null f = [] - | otherwise = [FBeforeNonBlank (N.fromList f)] - where f = flatten d -flatten (Flush d) | null f = [] - | otherwise = [FFlush (N.fromList f)] - where f = flatten d -flatten BreakingSpace = [FBreakingSpace] -flatten CarriageReturn = [FCarriageReturn] -flatten (AfterBreak t) | null f = [] - | otherwise = [FAfterBreak (N.fromList f)] - where f = flatten $ fromString $ T.unpack t -flatten NewLine = [FNewLine] -flatten (BlankLines n) = [FBlankLines n] -flatten Empty = [] -flatten (Concat x y) = flatten x <> flatten y -flatten (Linked l x) = FLinkOpen l : flatten x <> [FLinkClose] -flatten (Styled f x) = FStyleOpen f : flatten x <> [FStyleClose] +flatten d = go d [] + where + go (Text n a) rest = FText n a : rest + go (Block n a) rest = FBlock n a : rest + go (VFill n a) rest = FVFill n a : rest + go (CookedText n a) rest = FCookedText n a : rest + go (Prefixed p x) rest = case go x [] of + [] -> rest + f -> FPrefixed p (N.fromList f) : rest + go (BeforeNonBlank x) rest = case go x [] of + [] -> rest + f -> FBeforeNonBlank (N.fromList f) : rest + go (Flush x) rest = case go x [] of + [] -> rest + f -> FFlush (N.fromList f) : rest + go BreakingSpace rest = FBreakingSpace : rest + go CarriageReturn rest = FCarriageReturn : rest + go (AfterBreak t) rest = case go (fromString (T.unpack t)) [] of + [] -> rest + f -> FAfterBreak (N.fromList f) : rest + go NewLine rest = FNewLine : rest + go (BlankLines n) rest = FBlankLines n : rest + go Empty rest = rest + go (Concat x y) rest = go x (go y rest) + go (Linked l x) rest = FLinkOpen l : go x (FLinkClose : rest) + go (Styled f x) rest = FStyleOpen f : go x (FStyleClose : rest) type DocState a = State (RenderState a) () @@ -385,14 +379,14 @@ renderANSI :: HasChars a => Maybe Int -> Doc a -> TL.Text renderANSI n d = B.toLazyText $ go $ prerender n d where go s = (\(_,_,o) -> o) (go' s) <> B.fromText (renderFont baseFont) <> B.fromText (renderOSC8 Nothing) - go' (Attributed s) = foldl attrRender (Nothing, baseFont, B.fromText "") s + go' (Attributed s) = foldl' attrRender (Nothing, baseFont, B.fromText "") s -- | Render a 'Doc' without using ANSI escapes. @renderPlain (Just n)@ will use -- a line length of @n@ to reflow text on breakable spaces. -- @renderPlain Nothing@ will not reflow text. renderPlain :: HasChars a => Maybe Int -> Doc a -> a renderPlain n d = go $ prerender n d where - go (Attributed s) = foldMap attrStrip s + go (Attributed s) = mconcat $ map attrStrip $ toList s attrStrip :: HasChars a => Attr a -> a attrStrip (Attr _ _ y) | isNull y = "" @@ -504,9 +498,6 @@ -- Nested links are nonsensical, we only handle the outermost and -- silently ignore any attempts to have a link inside a link - --- Nested links are nonsensical, we only handle the outermost and --- silently ignore any attempts to have a link inside a link renderList (FLinkOpen target : xs) = do st <- get case linkTarget st of @@ -600,10 +591,11 @@ heightOf _ = 1 let maxheight = maximum $ map heightOf (b:bs) let toBlockSpec (FBlock w ls) = (w, map (\l -> (realLength l, l)) ls) - toBlockSpec (FVFill w t) = (w, map (\l -> (realLength l, l)) $ - map (singleton . (Attr (linkTarget st) font)) (take maxheight $ repeat t)) + toBlockSpec (FVFill w t) = (w, replicate maxheight + (realLength t, + singleton (Attr (linkTarget st) font t))) toBlockSpec _ = (0, []) - let (_, lns') = foldl (mergeBlocks maxheight) (toBlockSpec b) + let (_, lns') = foldl' (mergeBlocks maxheight) (toBlockSpec b) (map toBlockSpec bs) let oldPref = prefix st oldPrefixA = prefixA st @@ -630,11 +622,10 @@ isBreakable (FBlankLines _) = True isBreakable _ = False +-- Whether the first character is a space. foldrChar is lazy in its +-- accumulator, so this inspects only the first character. startsBlank' :: HasChars a => a -> Bool -startsBlank' t = fromMaybe False $ foldlChar go Nothing t - where - go Nothing c = Just (isSpace c) - go (Just b) _ = Just b +startsBlank' = foldrChar (\c _ -> isSpace c) False startsBlank :: HasChars a => FlatDoc a -> Bool startsBlank (FText _ t) = startsBlank' t @@ -748,9 +739,15 @@ -- | Makes a 'Doc' non-reflowable. nowrap :: IsString a => Doc a -> Doc a -nowrap = mconcat . map replaceSpace . unfoldD - where replaceSpace BreakingSpace = Text 1 $ fromString " " - replaceSpace x = x +nowrap = go + where go BreakingSpace = Text 1 $ fromString " " + go (Concat x y) = Concat (go x) (go y) + go (Styled s d) = Styled s (go d) + go (Linked l d) = Linked l (go d) + go (Prefixed p d) = Prefixed p (go d) + go (BeforeNonBlank d) = BeforeNonBlank (go d) + go (Flush d) = Flush (go d) + go x = x -- | Content to print only if it comes at the beginning of a line, -- to be used e.g. for escaping line-initial `.` in roff man. @@ -759,47 +756,51 @@ -- | Returns the width of a 'Doc'. offset :: (IsString a, HasChars a) => Doc a -> Int -offset = uncurry max . getOffset (const False) (0, 0) +offset = uncurry max . getOffset (const False) 0 (0, 0) -- | Returns the minimal width of a 'Doc' when reflowed at breakable spaces. minOffset :: HasChars a => Doc a -> Int -minOffset = uncurry max . getOffset (> 0) (0,0) +minOffset = uncurry max . getOffset (> 0) 0 (0,0) --- l = longest, c = current +-- l = longest, c = current; pfx = width of the current line prefix, +-- to which the column returns after a line break. getOffset :: (IsString a, HasChars a) - => (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int) -getOffset breakWhen (!l, !c) x = + => (Int -> Bool) -> Int -> (Int, Int) -> Doc a -> (Int, Int) +getOffset breakWhen !pfx (!l, !c) x = case x of Text n _ -> (l, c + n) Block n _ -> (l, c + n) VFill n _ -> (l, c + n) CookedText n _ -> (l, c + n) Empty -> (l, c) - Styled _ d -> getOffset breakWhen (l, c) d - Linked _ d -> getOffset breakWhen (l, c) d - CarriageReturn -> (max l c, 0) - NewLine -> (max l c, 0) - BlankLines _ -> (max l c, 0) + Styled _ d -> getOffset breakWhen pfx (l, c) d + Linked _ d -> getOffset breakWhen pfx (l, c) d + CarriageReturn -> (max l c, pfx) + NewLine -> (max l c, pfx) + BlankLines _ -> (max l c, pfx) Prefixed t d -> - let (l',c') = getOffset breakWhen (0, 0) d - in (max l (l' + realLength t), c' + realLength t) + -- The renderer only emits prefixes at the start of a line; + -- mid-line, the first line continues at the current column. + let pfx' = pfx + realLength t + c' = if c <= pfx then pfx' else c + in getOffset breakWhen pfx' (l, c') d BeforeNonBlank _ -> (l, c) - Flush d -> getOffset breakWhen (l, c) d + Flush d -> getOffset breakWhen 0 (l, c) d -- flush disables the prefix BreakingSpace - | breakWhen c -> (max l c, 0) + | breakWhen c -> (max l c, pfx) | otherwise -> (l, c + 1) - AfterBreak t -> if c == 0 + AfterBreak t -> if c == pfx then (l, c + realLength t) else (l, c) Concat (Concat d y) z -> - getOffset breakWhen (l, c) (Concat d (Concat y z)) + getOffset breakWhen pfx (l, c) (Concat d (Concat y z)) Concat (BeforeNonBlank d) y -> if isNonBlank y - then getOffset breakWhen (l, c) (Concat d y) - else getOffset breakWhen (l, c) y + then getOffset breakWhen pfx (l, c) (Concat d y) + else getOffset breakWhen pfx (l, c) y Concat d y -> - let (l', c') = getOffset breakWhen (l, c) d - in getOffset breakWhen (l', c') y + let (l', c') = getOffset breakWhen pfx (l, c) d + in getOffset breakWhen pfx (l', c') y isNonBlank :: Doc a -> Bool isNonBlank (Text _ _) = True @@ -811,7 +812,7 @@ -- | Returns the column that would be occupied by the last -- laid out character (assuming no wrapping). updateColumn :: HasChars a => Doc a -> Int -> Int -updateColumn d k = snd . getOffset (const False) (0,k) $ d +updateColumn d k = snd . getOffset (const False) 0 (0,k) $ d -- | @lblock n d@ is a block of width @n@ characters, with -- text derived from @d@ and aligned to the left. @@ -845,7 +846,11 @@ vfill :: HasChars a => a -> Doc a vfill t = VFill (realLength t) t -chop :: HasChars a => Int -> a -> [a] +-- Split lines longer than n at width n, filling lines left to right. +-- Attributes are preserved: each Attr is split into as few pieces as +-- possible. Width-0 characters (combining marks) never start a new +-- line, so they stay with their base character. +chop :: HasChars a => Int -> Attributed a -> [Attributed a] chop n = concatMap chopLine . removeFinalEmpty . map addRealLength . splitLines where @@ -853,20 +858,26 @@ Just (0, _) -> initSafe xs _ -> xs addRealLength l = (realLength l, l) - chopLine (len, l) + chopLine (len, l@(Attributed attrs)) | len <= n = [l] - | otherwise = map snd $ - foldrChar - (\c ls -> - let clen = charWidth c - cs = replicateChar 1 c - in case ls of - (len', l'):rest - | len' + clen > n -> - (clen, cs):(len', l'):rest - | otherwise -> - (len' + clen, cs <> l'):rest - [] -> [(clen, cs)]) [] l + | otherwise = + let (_, cur, lns) = foldl' goAttr (0, [], []) (toList attrs) + in reverse (fromList (reverse cur) : lns) + -- State: (width of current line, reversed Attrs of current line, + -- reversed list of completed lines). Within an Attr, characters + -- are accumulated in reverse in pend and flushed into a single + -- Attr on line breaks and at the end of the Attr. + goAttr (w0, cur0, lns0) (Attr lk f x) = + let (w, cur, lns, pend) = foldlChar (goChar lk f) (w0, cur0, lns0, []) x + in (w, addPend lk f pend cur, lns) + goChar lk f (w, cur, lns, pend) c = + let cw = charWidth c + in if w + cw > n && w > 0 + then (cw, [], fromList (reverse (addPend lk f pend cur)) : lns, + [c]) + else (w + cw, cur, lns, c : pend) + addPend _ _ [] cur = cur + addPend lk f pend cur = Attr lk f (fromString (reverse pend)) : cur -- | Encloses a 'Doc' inside a start and end 'Doc'. inside :: Doc a -> Doc a -> Doc a -> Doc a @@ -1012,10 +1023,7 @@ -- Combining diacritical marks used in Latin and other scripts | c <= '\x036F' = combiningState -- Han ideographs - | c >= '\x3250' && c <= '\xA4CF' = - if | c <= '\x4DBF' -> wideState -- Han ideographs - | c <= '\x4DFF' -> narrowState -- Hexagrams - | otherwise -> wideState -- More Han ideographs + | c >= '\x3250' && c <= '\xA4CF' = wideState -- Arabic | c >= '\x0600' && c <= '\x06FF' = if | c <= '\x0605' -> controlState -- Number marks @@ -1057,9 +1065,7 @@ | c <= '\x09C4' -> combiningState -- Combining signs | c == '\x09CD' -> combiningState -- Combining signs | c <= '\x09E1' -> narrowState -- Bengali - | c <= '\x09E3' -> combiningState -- Combining marks - | c == '\x09E2' -> combiningState -- Bengali vocalic vowel signs - | c == '\x09E3' -> combiningState -- Bengali vocalic vowel signs + | c <= '\x09E3' -> combiningState -- Bengali vocalic vowel signs | c <= '\x09FD' -> narrowState -- Bengali digits and other symbols | otherwise -> combiningState -- Bengali sandhi mark, plus a few symbols from Gurmukhi -- Cyrillic (plus Greek and Armenian for free) @@ -1149,10 +1155,7 @@ -- ASCII | c <= '\x007E' = narrowState -- Han ideographs - | c >= '\x3250' && c <= '\xA4CF' = - if | c <= '\x4DBF' -> wideState -- Han ideographs - | c <= '\x4DFF' -> narrowState -- Hexagrams - | otherwise -> wideState -- More Han ideographs + | c >= '\x3250' && c <= '\xA4CF' = wideState -- Japanese | c >= '\x2E80' && c <= '\x324F' = if | c <= '\x3029' -> wideState -- Punctuation and others @@ -1207,9 +1210,7 @@ | c <= '\x09C4' -> combiningState -- Combining signs | c == '\x09CD' -> combiningState -- Combining signs | c <= '\x09E1' -> narrowState -- Bengali - | c <= '\x09E3' -> combiningState -- Combining marks - | c == '\x09E2' -> combiningState -- Bengali vocalic vowel signs - | c == '\x09E3' -> combiningState -- Bengali vocalic vowel signs + | c <= '\x09E3' -> combiningState -- Bengali vocalic vowel signs | c <= '\x09FD' -> narrowState -- Bengali digits and other symbols | otherwise -> combiningState -- Bengali sandhi mark, plus a few symbols from Gurmukhi -- Telugu (plus one character of Kannada) @@ -1275,13 +1276,21 @@ -- shortcuts. This should give the same answer as 'updateMatchStateNarrow', but will -- be slower. It is here to test that the shortcuts are implemented correctly. updateMatchStateNoShortcut :: MatchState -> Char -> MatchState -updateMatchStateNoShortcut match c = resolveWidth match c $ unicodeWidth (unicodeRangeMap Narrow) c +updateMatchStateNoShortcut match c = resolveWidth match c $ unicodeWidth narrowUnicodeMap c -- | Update a 'MatchState' by processing a character, without taking any -- shortcuts. This should give the same answer as 'updateMatchStateWide', but will -- be slower. It is here to test that the shortcuts are implemented correctly. updateMatchStateNoShortcutWide :: MatchState -> Char -> MatchState -updateMatchStateNoShortcutWide match c = resolveWidth match c $ unicodeWidth (unicodeRangeMap Wide) c +updateMatchStateNoShortcutWide match c = resolveWidth match c $ unicodeWidth wideUnicodeMap c + +-- | Width table resolving ambiguous characters as narrow. +narrowUnicodeMap :: UnicodeMap +narrowUnicodeMap = unicodeRangeMap Narrow + +-- | Width table resolving ambiguous characters as wide. +wideUnicodeMap :: UnicodeMap +wideUnicodeMap = unicodeRangeMap Wide -- | Update a match state given a character and its class resolveWidth :: MatchState -> Char -> UnicodeWidth -> MatchState diff --git a/src/Text/unicodeWidth.inc b/src/Text/unicodeWidth.inc --- a/src/Text/unicodeWidth.inc +++ b/src/Text/unicodeWidth.inc @@ -178,7 +178,7 @@ , ( '\2137' , Combining ) , ( '\2142' , Narrow ) , ( '\2192' , Control ) - , ( '\2200' , Combining ) + , ( '\2199' , Combining ) , ( '\2208' , Narrow ) , ( '\2250' , Combining ) , ( '\2274' , Control ) @@ -621,6 +621,8 @@ , ( '\9757' , Narrow ) , ( '\9758' , Ambiguous ) , ( '\9759' , Narrow ) + , ( '\9776' , Wide ) + , ( '\9784' , Narrow ) , ( '\9792' , Ambiguous ) , ( '\9793' , Narrow ) , ( '\9794' , Ambiguous ) @@ -639,6 +641,8 @@ , ( '\9840' , Narrow ) , ( '\9855' , Wide ) , ( '\9856' , Narrow ) + , ( '\9866' , Wide ) + , ( '\9872' , Narrow ) , ( '\9875' , Wide ) , ( '\9876' , Narrow ) , ( '\9886' , Ambiguous ) @@ -717,8 +721,6 @@ , ( '\12443' , Wide ) , ( '\12872' , Ambiguous ) , ( '\12880' , Wide ) - , ( '\19904' , Narrow ) - , ( '\19968' , Wide ) , ( '\42192' , Narrow ) , ( '\42607' , Combining ) , ( '\42611' , Narrow ) @@ -826,8 +828,12 @@ , ( '\68331' , Narrow ) , ( '\68900' , Combining ) , ( '\68912' , Narrow ) + , ( '\68969' , Combining ) + , ( '\68974' , Narrow ) , ( '\69291' , Combining ) , ( '\69293' , Narrow ) + , ( '\69370' , Combining ) + , ( '\69376' , Narrow ) , ( '\69446' , Combining ) , ( '\69457' , Narrow ) , ( '\69506' , Combining ) @@ -874,6 +880,8 @@ , ( '\70198' , Combining ) , ( '\70200' , Narrow ) , ( '\70206' , Combining ) + , ( '\70207' , Narrow ) + , ( '\70209' , Combining ) , ( '\70272' , Narrow ) , ( '\70367' , Combining ) , ( '\70368' , Narrow ) @@ -886,6 +894,16 @@ , ( '\70464' , Combining ) , ( '\70465' , Narrow ) , ( '\70502' , Combining ) + , ( '\70528' , Narrow ) + , ( '\70587' , Combining ) + , ( '\70594' , Narrow ) + , ( '\70606' , Combining ) + , ( '\70607' , Narrow ) + , ( '\70608' , Combining ) + , ( '\70609' , Narrow ) + , ( '\70610' , Combining ) + , ( '\70611' , Narrow ) + , ( '\70625' , Combining ) , ( '\70656' , Narrow ) , ( '\70712' , Combining ) , ( '\70720' , Narrow ) @@ -926,6 +944,8 @@ , ( '\71351' , Combining ) , ( '\71352' , Narrow ) , ( '\71453' , Combining ) + , ( '\71454' , Narrow ) + , ( '\71455' , Combining ) , ( '\71456' , Narrow ) , ( '\71458' , Combining ) , ( '\71462' , Narrow ) @@ -961,6 +981,12 @@ , ( '\72343' , Narrow ) , ( '\72344' , Combining ) , ( '\72346' , Narrow ) + , ( '\72544' , Combining ) + , ( '\72545' , Narrow ) + , ( '\72546' , Combining ) + , ( '\72549' , Narrow ) + , ( '\72550' , Combining ) + , ( '\72551' , Narrow ) , ( '\72752' , Combining ) , ( '\72766' , Narrow ) , ( '\72767' , Combining ) @@ -985,8 +1011,25 @@ , ( '\73112' , Narrow ) , ( '\73459' , Combining ) , ( '\73461' , Narrow ) + , ( '\73472' , Combining ) + , ( '\73474' , Narrow ) + , ( '\73526' , Combining ) + , ( '\73534' , Narrow ) + , ( '\73536' , Combining ) + , ( '\73537' , Narrow ) + , ( '\73538' , Combining ) + , ( '\73539' , Narrow ) + , ( '\73562' , Combining ) + , ( '\73648' , Narrow ) , ( '\78896' , Control ) - , ( '\82944' , Narrow ) + , ( '\78912' , Combining ) + , ( '\78913' , Narrow ) + , ( '\78919' , Combining ) + , ( '\78944' , Narrow ) + , ( '\90398' , Combining ) + , ( '\90410' , Narrow ) + , ( '\90413' , Combining ) + , ( '\90416' , Narrow ) , ( '\92912' , Combining ) , ( '\92917' , Narrow ) , ( '\92976' , Combining ) @@ -1002,6 +1045,7 @@ , ( '\113821' , Combining ) , ( '\113823' , Narrow ) , ( '\113824' , Control ) + , ( '\117760' , Narrow ) , ( '\118528' , Combining ) , ( '\118608' , Narrow ) , ( '\119143' , Combining ) @@ -1015,6 +1059,8 @@ , ( '\119214' , Narrow ) , ( '\119362' , Combining ) , ( '\119365' , Narrow ) + , ( '\119552' , Wide ) + , ( '\119671' , Narrow ) , ( '\121344' , Combining ) , ( '\121399' , Narrow ) , ( '\121403' , Combining ) @@ -1026,6 +1072,8 @@ , ( '\121499' , Combining ) , ( '\122624' , Narrow ) , ( '\122880' , Combining ) + , ( '\122928' , Narrow ) + , ( '\123023' , Combining ) , ( '\123136' , Narrow ) , ( '\123184' , Combining ) , ( '\123191' , Narrow ) @@ -1033,6 +1081,18 @@ , ( '\123584' , Narrow ) , ( '\123628' , Combining ) , ( '\123632' , Narrow ) + , ( '\124140' , Combining ) + , ( '\124144' , Narrow ) + , ( '\124398' , Combining ) + , ( '\124400' , Narrow ) + , ( '\124643' , Combining ) + , ( '\124644' , Narrow ) + , ( '\124646' , Combining ) + , ( '\124647' , Narrow ) + , ( '\124654' , Combining ) + , ( '\124656' , Narrow ) + , ( '\124661' , Combining ) + , ( '\124670' , Narrow ) , ( '\125136' , Combining ) , ( '\125184' , Narrow ) , ( '\125252' , Combining ) diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -10,6 +10,7 @@ import Data.Functor ((<&>)) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Lazy as TL #if MIN_VERSION_base(4,11,0) #else import Data.Semigroup @@ -32,11 +33,32 @@ (offset (nest 3 (text "**" <> text "thisIsGoingToBeTooLongAnyway" <> text "**") <> blankline :: Doc Text) @?= 35) + , testCase "offset with mid-line prefixed" $ + offset ("hello" <> nest 2 "world" :: Doc Text) @?= 10 + + , testCase "offset with prefixed continuation lines" $ + offset ("aa" <> nest 2 ("bb" <> cr <> "cc") :: Doc Text) @?= 4 + , renderTest "lblock with chop" Nothing (lblock 4 (text "hi there" :: Doc Text)) "hi t\nhere" + , renderTest "chop fills lines from the left" + Nothing + (lblock 3 (text "abcdefg" :: Doc Text)) + "abc\ndef\ng" + + , renderTest "chop keeps combining chars with their base" + Nothing + (lblock 2 (text "ab\770cd" :: Doc Text)) + "ab\770\ncd" + + , testCase "chop preserves styling" $ + assertBool "bold escape code survives chopping" $ + "\ESC[1m" `TL.isInfixOf` + renderANSI Nothing (lblock 4 (bold (text "hi there")) :: Doc Text) + , renderTest "lblock with blank line" Nothing (Block 5 ["a", "", "b"] :: Doc Text) @@ -80,7 +102,7 @@ , renderTest "simple box wrapping" (Just 50) (lblock 3 "aa" <> lblock 3 "bb" <> lblock 3 ("aa" <+> "bbbb")) - "aa bb aa\n b\n bbb" + "aa bb aa\n bbb\n b" , renderTest "prefixed with multi paragraphs" (Just 80) @@ -286,6 +308,16 @@ Nothing (literal "a" <> cr <> literal "\nb" <> cr <> literal "c") "a\n\nb\nc" + + , renderTest "nowrap inside styled text" + (Just 4) + (nowrap (bold ("aa" <> space <> "bb"))) + "aa bb" + + , renderTest "nowrap around prefixed" + (Just 4) + (nowrap (prefixed "> " ("aa" <> space <> "bb"))) + "> aa bb" , renderTest "breaking within styled text" (Just 5)