kb-text-shape 0.2.0.0 → 0.2.1.0

raw patch · 9 files changed

+345/−65 lines, 9 filesdep +filepathdep +optparse-applicativenew-component:exe:ttf2kbtsPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• app/ttf2kbts/Main.hs +53/−0
• bench/Bench.hs +11/−31
• cbits/kb_text_shape.inc +30/−10
• kb-text-shape.cabal +36/−4
• src/KB/Text/Shape.hs +26/−1
• src/KB/Text/Shape/Font.hs +3/−2
• src/KB/Text/Shape/Segmentation.hs +145/−0
• test/Spec.hs +24/−17

@@ -6,6 +6,23 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## 0.2.1.0 - 2026-08-15++Added:+- `KB.Text.Shape.Segmentation` higher-level wrapper.+- `ttf2kbts` mini-app to extract kbts blobs.++Fixed in upstream with local patches:+- `kbts_BreakEntireString*` no longer leaves unwritten holes in the output+  array or over-reports `*BreakCount` when breaks merge into a written position.+- Breaks flushed after look-ahead now use the fed position increments, so+  byte positions from `kbts_BreakEntireStringUtf8` are exact around+  multi-byte codepoints and combining marks.+- `kbts_ShapePopFeature` reports the removal and no longer corrupts the+  feature stack when popping a non-topmost override.+- `Font.getFontInfo` decodes name strings leniently, so fonts with non-UTF-8+  name records (e.g. Mac Roman) load instead of failing.+ ## 0.2.0.0 - 2026-07-28  Updated `kb_text_shape` to 2.24.

@@ -0,0 +1,53 @@+module Main (main) where++import Data.ByteString qualified as ByteString+import Options.Applicative+import System.FilePath (replaceExtension)++import KB.Text.Shape.Font qualified as Font++main :: IO ()+main = do+  Options{..} <- execParser optionsInfo+  ttfData <- ByteString.readFile inputPath+  blobData <- Font.extractBlob ttfData fontIndex+  ByteString.writeFile (resolveOutput inputPath outputPath) blobData++data Options = Options+  { inputPath :: FilePath+  , outputPath :: Maybe FilePath+  , fontIndex :: Int+  }++resolveOutput :: FilePath -> Maybe FilePath -> FilePath+resolveOutput inputPath = \case+  Just explicit -> explicit+  Nothing -> replaceExtension inputPath "kbts"++optionsInfo :: ParserInfo Options+optionsInfo = info (helper <*> optionsParser) $ mconcat+  [ fullDesc+  , progDesc "Extract a pre-processed .kbts blob from a font file"+  ]++optionsParser :: Parser Options+optionsParser = do+  inputPath <- strArgument $ mconcat+    [ metavar "FONT"+    , help "Input font file (TTF/OTF)"+    ]+  outputPath <- optional . strOption $ mconcat+    [ long "output"+    , short 'o'+    , metavar "FILE"+    , help "Output .kbts file (default: FONT with the extension replaced by .kbts)"+    ]+  fontIndex <- option auto $ mconcat+    [ long "index"+    , short 'i'+    , metavar "N"+    , value 0+    , showDefault+    , help "Font index inside a collection"+    ]+  pure Options{..}

@@ -5,7 +5,7 @@ import Prelude hiding (id)  import Control.Exception (bracket)-import Control.Monad (foldM, when)+import Control.Monad (when) import Data.ByteString (ByteString) import Data.ByteString qualified as ByteString import Data.ByteString.Unsafe qualified as ByteString@@ -22,6 +22,7 @@  import KB.Text.Shape qualified as TextShape import KB.Text.Shape.Font qualified as Font+import KB.Text.Shape.Segmentation qualified as TextSegmentation  main :: IO () main = do@@ -52,13 +53,13 @@               , bench "long text" $ whnfIO $ shapeVia ctx longText               ]           , bgroup "direct shaping"-              [ bench "cold oneshot" $ whnfIO $ oneshot font testCodepoints+              [ bench "cold oneshot" $ whnfIO $ oneshot font testText               , bcompare "$NF == \"cold oneshot\"" $-                bench "warm scratchpad" $ whnfIO $ warmShot font scratchpad testCodepoints+                bench "warm scratchpad" $ whnfIO $ warmShot font scratchpad testText               ]           , bgroup "segmentation"               [ bench "BreakEntireStringUtf8" $ whnfIO $ breakUtf8 longUtf8-              , bench "incremental breaks" $ whnfIO $ breakIncremental longString+              , bench "Segmentation.breaks" $ whnf (length . TextSegmentation.breaks) longText               ]           , bgroup "glyph mapping"               [ bench "kbts_CodepointToGlyphId" $ whnfIO $@@ -75,15 +76,9 @@ testText :: Text testText = "Hello, ሰላም።, שלמלך, नमस्ते world!" -testCodepoints :: [Char]-testCodepoints = Text.unpack testText- longText :: Text longText = Text.replicate 64 testText -longString :: [Char]-longString = Text.unpack longText- longUtf8 :: ByteString longUtf8 = Text.encodeUtf8 longText @@ -92,21 +87,21 @@ shapeVia ctx text = length . show <$> TextShape.run ctx (TextShape.text_ text)  -- | Direct shaping with the full per-call setup: config, scratchpad, storage.-oneshot :: Handles.Font -> [Char] -> IO Int-oneshot font codepoints =+oneshot :: Handles.Font -> Text -> IO Int+oneshot font text =   withShapeConfig font \config ->     withScratchpad config \scratchpad ->       -- Glyphs keep the config pointer, it has to outlive the shaping.       withGlyphConfig config \glyphConfig ->         withGlyphStorage \storagePtr -> do-          pushCodepoints font storagePtr glyphConfig codepoints+          pushCodepoints font storagePtr glyphConfig (Text.unpack text)           drainShape scratchpad storagePtr  -- | Direct shaping reusing a pre-built config and scratchpad.-warmShot :: Handles.Font -> Handles.ShapeScratchpad -> [Char] -> IO Int-warmShot font scratchpad codepoints =+warmShot :: Handles.Font -> Handles.ShapeScratchpad -> Text -> IO Int+warmShot font scratchpad text =   withGlyphStorage \storagePtr -> do-    pushCodepoints font storagePtr (Handles.GlyphConfig nullPtr) codepoints+    pushCodepoints font storagePtr (Handles.GlyphConfig nullPtr) (Text.unpack text)     drainShape scratchpad storagePtr  drainShape :: Handles.ShapeScratchpad -> Ptr Structs.GlyphStorage -> IO Int@@ -139,21 +134,6 @@               (fromIntegral len)               flagCountPtr             fromIntegral <$> peek breakCountPtr--breakIncremental :: [Char] -> IO Int-breakIncremental text =-  allocaBytes Handles.sizeOfBreakState \raw -> do-    fillBytes raw 0 Handles.sizeOfBreakState-    let state = Handles.BreakState (castPtr raw)-    Segmentation.kbts_BreakBegin state Enums.DIRECTION_DONT_KNOW Enums.JAPANESE_LINE_BREAK_STYLE_NORMAL mempty-    alloca \breakPtr -> do-      let drain !n = do-            more <- Segmentation.kbts_Break state breakPtr-            if more /= 0 then drain (n + 1) else pure n-          feed !n (c, isLast) = do-            Segmentation.kbts_BreakAddCodepoint state (fromIntegral (ord c)) 1 (if isLast then 1 else 0)-            drain n-      foldM feed (0 :: Int) $ zip text (replicate (length text - 1) False <> [True])  -- * Fixtures 

@@ -20819,12 +20819,15 @@        if(Override->Tag == Tag)       {+        // LOCAL PATCH(pop_feature_returns_zero): shift with MoveIndex (the loop used to+        // copy one slot onto itself, corrupting non-topmost pops) and report the removal.         KBTS__FOR(MoveIndex, ScratchFeatureOverrideIndex, Context->ScratchFeatureOverrideCount)         {-          Context->ScratchFeatureOverrides[ScratchFeatureOverrideIndex - 1] = Context->ScratchFeatureOverrides[ScratchFeatureOverrideIndex];+          Context->ScratchFeatureOverrides[MoveIndex - 1] = Context->ScratchFeatureOverrides[MoveIndex];         }          Context->ScratchFeatureOverrideCount -= 1;+        Result = 1;         break;       }     }@@ -23894,10 +23897,14 @@     {       kbts_u64 EffectiveLineBreaks = LineBreaks & ~(LineUnbreaks | LineUnbreaksAsync); -      kbts__DoLineBreak(State, PositionOffset3 + LineBreak3PositionOffset, EffectiveLineBreaks >> 48);+      // LOCAL PATCH(break_position_skew): LineBreak2/3PositionOffset are now full offsets+      // from CurrentPosition (like ScriptPositionOffset), accumulating the actual+      // PositionIncrements across absorbed characters instead of being added to+      // PositionOffset2/3, which only track the last two fed codepoints.+      kbts__DoLineBreak(State, LineBreak3PositionOffset, EffectiveLineBreaks >> 48);       if(EndOfText)       {-        kbts__DoLineBreak(State, PositionOffset2 + LineBreak2PositionOffset, EffectiveLineBreaks >> 32);+        kbts__DoLineBreak(State, LineBreak2PositionOffset, EffectiveLineBreaks >> 32);         { // @Cleanup: This is the same flag code as DoLineBreak, but we want to use FlagState buffering for this.           // The only places where we want to manually call DoBreak is for asynchronous/buffered guys.           kbts_u8 FlushedLineFlags = 0;@@ -23912,8 +23919,9 @@      State->LineBreaks = LineBreaks;     State->LineUnbreaks = LineUnbreaks;-    State->LineBreak2PositionOffset = 0;-    State->LineBreak3PositionOffset = LineBreak2PositionOffset;+    // LOCAL PATCH(break_position_skew): keep full offsets in step with the fed increments.+    State->LineBreak2PositionOffset = (kbts_s16)-(int)PositionIncrement;+    State->LineBreak3PositionOffset = (kbts_s16)(LineBreak2PositionOffset - (int)PositionIncrement);     State->LastLineBreakClass = LineBreakClass;     State->LineBreakHistory = LineBreakHistory; @@ -24231,7 +24239,9 @@        KBTS_C2(WSS, WSS):         // WSS x WSS is a special rule, because it is supposed to happen _before_ ignores.-        if(WordBreak2PositionOffset >= 0) WordUnbreaks |= KBTS_WORD_BREAK_BITS(0, 1);+        // LOCAL PATCH(break_position_skew): "no ignores since the last word step" is now+        // "the full offset still equals the last fed increment".+        if(WordBreak2PositionOffset == PositionOffset2) WordUnbreaks |= KBTS_WORD_BREAK_BITS(0, 1);         break;        // (RI RI)* RI x RI@@ -24267,7 +24277,8 @@     kbts_u32 EffectiveWordBreaks = WordBreaks & ~WordUnbreaks;     if(EffectiveWordBreaks & KBTS_WORD_BREAK_BITS(2, 2))     {-      kbts__DoBreak(State, PositionOffset2 + WordBreak2PositionOffset, KBTS_BREAK_FLAG_WORD, 0, 0, 0);+      // LOCAL PATCH(break_position_skew): WordBreak2PositionOffset is a full offset now.+      kbts__DoBreak(State, WordBreak2PositionOffset, KBTS_BREAK_FLAG_WORD, 0, 0, 0);     }     if(EndOfText)     {@@ -24279,7 +24290,8 @@     State->WordBreaks = (kbts_u16)WordBreaks;     State->WordUnbreaks = (kbts_u16)WordUnbreaks;     State->LastWordBreakClass = WordBreakClass;-    State->WordBreak2PositionOffset = 0;+    // LOCAL PATCH(break_position_skew): keep the full offset in step with the fed increment.+    State->WordBreak2PositionOffset = (kbts_s16)-(int)PositionIncrement;     State->WordBreakHistory = WordBreakHistory;   }   State->LastWordBreakClassIncludingIgnored = WordBreakClass;@@ -24568,9 +24580,14 @@     kbts_break Break;     while(kbts_Break(&BreakState, &Break))     {+      // LOCAL PATCH(break_entire_string_holes): only advance the write cursor when a+      // record was actually written; merged breaks used to leave unwritten holes and+      // over-report *BreakCount. With a null Breaks, Found stays 0 and the count keeps+      // its old upper-bound semantics for two-pass sizing.+      int Found = 0;+       if(Breaks && (BreaksWritten < BreakCapacity))       {-        int Found = 0;         kbts_un ExistingBreakCount = KBTS__MIN(BreaksWritten, BreakCapacity);          // @Speed: Binary search!@@ -24613,7 +24630,10 @@        MaxBreakPosition = KBTS__MAX(MaxBreakPosition, (kbts_u32)Break.Position); -      BreaksWritten += 1;+      if(!Found)+      {+        BreaksWritten += 1;+      }     }   } 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           kb-text-shape-version:        0.2.0.0+version:        0.2.1.0 synopsis:       Unicode segmentation and shaping using kb_text_shape category:       Font homepage:       https://github.com/dpwiz/kb-text-shape#readme@@ -49,6 +49,7 @@       KB.Text.Shape.FFI.Iterators       KB.Text.Shape.FFI.Structs       KB.Text.Shape.Font+      KB.Text.Shape.Segmentation   other-modules:       Paths_kb_text_shape   autogen-modules:@@ -65,7 +66,6 @@       LambdaCase       NamedFieldPuns       NoFieldSelectors-      NoFieldSelectors       OverloadedRecordDot       OverloadedStrings       PatternSynonyms@@ -87,6 +87,40 @@   if flag(trace-blocks)     cc-options: -DTRACE_BLOCKS +executable ttf2kbts+  main-is: Main.hs+  other-modules:+      Paths_kb_text_shape+  autogen-modules:+      Paths_kb_text_shape+  hs-source-dirs:+      app/ttf2kbts+  default-extensions:+      BlockArguments+      DataKinds+      DerivingStrategies+      DuplicateRecordFields+      GeneralizedNewtypeDeriving+      ImplicitParams+      LambdaCase+      NamedFieldPuns+      NoFieldSelectors+      OverloadedRecordDot+      OverloadedStrings+      PatternSynonyms+      RecordWildCards+      StrictData+      ViewPatterns+      ApplicativeDo+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wredundant-constraints+  build-depends:+      base >=4.16 && <5+    , bytestring+    , filepath+    , kb-text-shape+    , optparse-applicative+  default-language: GHC2021+ test-suite kb-text-shape-test   type: exitcode-stdio-1.0   main-is: Spec.hs@@ -106,7 +140,6 @@       LambdaCase       NamedFieldPuns       NoFieldSelectors-      NoFieldSelectors       OverloadedRecordDot       OverloadedStrings       PatternSynonyms@@ -142,7 +175,6 @@       ImplicitParams       LambdaCase       NamedFieldPuns-      NoFieldSelectors       NoFieldSelectors       OverloadedRecordDot       OverloadedStrings

@@ -51,6 +51,7 @@ import GHC.Records (HasField(..))  import KB.Text.Shape.FFI.API.Context qualified as ShapeContext+import KB.Text.Shape.Font qualified as Font import KB.Text.Shape.FFI.Enums qualified as Enums import KB.Text.Shape.FFI.Flags qualified as Flags import KB.Text.Shape.FFI.Handles qualified as Handles@@ -102,6 +103,25 @@   when (err /= Enums.SHAPE_ERROR_NONE) $       error $ "kbts_ShapePushFontFromFile: failed to load font. " <> show err   _ <- keepFont ctx font mempty -- register the empty blob so the counters would look nicer+  validateFont ("kbts_ShapePushFontFromFile: " <> path) font++{- | Reject fonts that failed to load or whose metrics would poison layout downstream.++The loader hands back a null handle without setting the shape error when the+file is missing, unreadable, or not a font.+A zero 'KB.Text.Shape.Font.Info.unitsPerEm' means the font did not parse;+a missing capital height (OS/2 @sCapHeight@) breaks cap-normalized sizing+with no sensible fallback.+-}+validateFont :: String -> Handles.Font -> IO Handles.Font+validateFont origin font = do+  when (font == Handles.Font nullPtr) $+    error $ origin <> ": failed to load font"+  info <- Font.getFontInfo font+  when (info.unitsPerEm == 0) $+    error $ origin <> ": font reports zero unitsPerEm"+  when (info.capitalHeight <= 0) $+    error $ origin <> ": font has no capital height (OS/2 sCapHeight)"   pure font  pushFontFromMemory :: Context -> ByteString -> Int -> IO Handles.Font@@ -112,7 +132,7 @@     when (err /= Enums.SHAPE_ERROR_NONE) $         error $ "kbts_ShapePushFontFromMemory: failed to load font. " <> show err     _ <- keepFont ctx font fontData-    pure font+    validateFont "kbts_ShapePushFontFromMemory" font  keepFont :: Context -> Handles.Font -> ByteString -> IO Int keepFont ctx font bytes = atomicModifyIORef' ctx.fonts $ swap . IntMap.alterF addRef (Handles.intHandle font)@@ -277,6 +297,11 @@   , uid :: Word16    , codepointIndex :: Int -- was: userIdOrCodepointIndex+    {- ^ Index of the source codepoint this glyph maps to, in codepoints,+    relative to the whole shaped input (not the run). Several glyphs may+    share an index (marks), and a ligature carries the index of its first+    codepoint, leaving the rest without glyphs.+    -}    , offsetX :: Int     {- ^ This, and the next few are in the "font units".

@@ -32,7 +32,8 @@ import Data.ByteString.Unsafe qualified as ByteString import Data.Maybe (catMaybes) import Data.Text (Text)-import Data.Text.Foreign qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Text.Encoding.Error (lenientDecode)  import KB.Text.Shape.FFI.API.Direct qualified as ShapeDirect import KB.Text.Shape.FFI.Flags qualified as Flags@@ -92,7 +93,7 @@   where     loadStrings (ix, ptr) = \case       0 -> pure Nothing-      len -> Just . (Enums.FontInfoStringId ix,) <$> Text.peekCStringLen (ptr, fromIntegral len)+      len -> Just . (Enums.FontInfoStringId ix,) . Text.decodeUtf8With lenientDecode <$> ByteString.unsafePackCStringLen (ptr, fromIntegral len)  data Info = Info   { strings :: [(Enums.FontInfoStringId, Text)]

@@ -0,0 +1,145 @@+{-| Unicode segmentation over the kbts entire-string API.++All positions are UTF-8 byte offsets into the input 'Text'.+-}+module KB.Text.Shape.Segmentation+  ( Break (..)+  , breaks+  , breaksWith++    -- * Grapheme clusters+  , clusters+  , boundaries++    -- * Line break opportunities+  , softBreaks+  , softBreaksWith++    -- * Word boundaries+  , wordBreaks+  ) where++import Data.Bits ((.&.))+import Data.Char (ord)+import Data.IntSet qualified as IntSet+import Data.List (sort)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Foreign qualified as Text+import Foreign (alloca, allocaArray, fillBytes, nullPtr, peek, peekArray, sizeOf)+import System.IO.Unsafe (unsafePerformIO)++import KB.Text.Shape.FFI.API.Segmentation qualified as Segmentation+import KB.Text.Shape.FFI.Enums (JapaneseLineBreakStyle, pattern DIRECTION_DONT_KNOW, pattern JAPANESE_LINE_BREAK_STYLE_NORMAL)+import KB.Text.Shape.FFI.Flags (BreakFlags, pattern BREAK_FLAG_GRAPHEME, pattern BREAK_FLAG_LINE_SOFT, pattern BREAK_FLAG_WORD)+import KB.Text.Shape.FFI.Structs (Break (..))++{- | Extended grapheme cluster texts, in order.++The engine skips UAX #29 GB11, so 'boundaries' refuses to cut adjacent+to a ZWJ; emoji ZWJ sequences stay whole.+-}+clusters :: Text -> [Text]+clusters t = go t 0 (boundaries t)+  where+    go rest from cuts = case dropWhile (<= from) cuts of+      cut : more ->+        let n = fromIntegral (cut - from)+        in Text.takeWord8 n rest : go (Text.dropWord8 n rest) cut more+      [] -> [rest | not (Text.null rest)]++-- | Extended grapheme cluster boundaries.+boundaries :: Text -> [Int]+boundaries t = zwjFilter t (positions BREAK_FLAG_GRAPHEME (breaks t))++{- | Positions where a line may break, at 'JAPANESE_LINE_BREAK_STYLE_NORMAL'.++The engine skips UAX #14 LB8a, so positions adjacent to a ZWJ are dropped.+-}+softBreaks :: Text -> [Int]+softBreaks = softBreaksWith JAPANESE_LINE_BREAK_STYLE_NORMAL++-- | 'softBreaks' with an explicit kinsoku strictness.+softBreaksWith :: JapaneseLineBreakStyle -> Text -> [Int]+softBreaksWith style t = zwjFilter t (positions BREAK_FLAG_LINE_SOFT (breaksWith style t))++-- | UAX #29 word boundaries.+wordBreaks :: Text -> [Int]+wordBreaks = positions BREAK_FLAG_WORD . breaks++positions :: BreakFlags -> [Break] -> [Int]+positions flag found = dedupe (sort [b.position | b <- found, b.flags .&. flag /= mempty])+  where+    dedupe = \case+      x : rest@(y : _)+        | x == y -> dedupe rest+        | otherwise -> x : dedupe rest+      rest -> rest++zwjFilter :: Text -> [Int] -> [Int]+zwjFilter t+  | IntSet.null zwjs = id+  | otherwise = filter safe+  where+    zwjs = IntSet.fromList (zwjOffsets 0 (Text.unpack t))+    zwjOffsets off = \case+      [] -> []+      c : rest -> [off | c == '\x200D'] <> zwjOffsets (off + utf8Length c) rest+    total = Text.lengthWord8 t+    safe b = b <= 0 || b >= total || not (IntSet.member (b - 3) zwjs || IntSet.member b zwjs)++utf8Length :: Char -> Int+utf8Length c+  | o < 0x80 = 1+  | o < 0x800 = 2+  | o < 0x10000 = 3+  | otherwise = 4+  where+    o = ord c++-- | All breaks at 'JAPANESE_LINE_BREAK_STYLE_NORMAL'.+breaks :: Text -> [Break]+breaks = breaksWith JAPANESE_LINE_BREAK_STYLE_NORMAL++{- | 'breaks' with an explicit kinsoku strictness, in one engine pass.++The entire-string API merges the flags of same-position breaks into one+record; the 2.24 write-cursor caveat on+'Segmentation.kbts_BreakEntireString' is compensated by zeroing the output+buffer and dropping the records with empty flags.++Delayed break emissions rely on the @LOCAL PATCH(break_position_skew)@+in @cbits\/kb_text_shape.inc@: unpatched, positions of breaks pending on+lookahead skew away from the fed byte increments in both directions (see+@upstream-fixme\/break_position_skew.c@).+-}+breaksWith :: JapaneseLineBreakStyle -> Text -> [Break]+breaksWith style t+  | Text.null t = []+  | otherwise = unsafePerformIO $+      Text.withCStringLen t \(utf8Ptr, len) ->+        attempt utf8Ptr len (4 * len + 16)+  where+    attempt utf8Ptr len capacity =+      allocaArray capacity \breaksPtr ->+        alloca \breakCountPtr -> do+          fillBytes breaksPtr 0 (capacity * sizeOf (undefined :: Break))+          Segmentation.kbts_BreakEntireStringUtf8+            DIRECTION_DONT_KNOW+            style+            mempty+            utf8Ptr+            (fromIntegral len)+            breaksPtr+            (fromIntegral capacity)+            breakCountPtr+            nullPtr+            0+            nullPtr+          count <- fromIntegral <$> peek breakCountPtr+          if count > capacity+            then+              attempt utf8Ptr len count+            else+              filter (\b -> b.flags /= mempty) <$> peekArray count breaksPtr+{-# NOINLINE breaksWith #-}

@@ -33,6 +33,7 @@  import KB.Text.Shape qualified as TextShape import KB.Text.Shape.Font qualified as Font+import KB.Text.Shape.Segmentation qualified as TextSegmentation  testFontTtf :: FilePath testFontTtf = "test/Ubuntu-R.ttf"@@ -265,7 +266,7 @@           TextShape.popFeature_ Enums.FEATURE_TAG_liga >>= writeIORef popped         -- XXX: upstream kbts_ShapePopFeature loses the found-and-removed         -- result, it is always 0 as of 2.24.-        readIORef popped >>= (@?= 0)+        readIORef popped >>= (@?= 1)    , testCase "shaped codepoints can be retrieved by index" $       withFontContext ttfData \ctx _font -> do@@ -357,7 +358,7 @@           alloca @Structs.GlyphStorage \storagePtr -> do             ok <- ShapeDirect.kbts_InitializeGlyphStorageFixedMemory storagePtr (castPtr mem) (fromIntegral size)             assertBool "storage initialized" (ok /= 0)-            forM_ ("abc" :: String) \c -> do+            forM_ (Text.unpack "abc") \c -> do               glyphPtr <- ShapeDirect.kbts_PushGlyph storagePtr font (fromIntegral (ord c)) nullGlyphConfig 0               assertBool "glyph pushed" (glyphPtr /= nullPtr)             glyphs <- shapeStorage scratchpad storagePtr@@ -402,7 +403,7 @@   , testCase "clearing active glyphs empties the iterator" $       withShapeSetup ttfData \font _config _scratchpad ->         withGlyphStorage \storagePtr -> do-          forM_ ("abc" :: String) \c ->+          forM_ (Text.unpack "abc") \c ->             void $ ShapeDirect.kbts_PushGlyph storagePtr font (fromIntegral (ord c)) nullGlyphConfig 0           alloca \itPtr -> do             ShapeDirect.hs_ActiveGlyphIterator storagePtr itPtr@@ -457,6 +458,11 @@       -- real record, splitting the position across two records.       mergeBreaks incremental @?= mergeBreaks whole +  , testCase "Segmentation.breaks reports UTF-8 byte positions" $ do+      let text = "øne two\nthree fõur"+      whole <- breakEntireUtf8 text+      mergeBreaks (TextSegmentation.breaks text) @?= mergeBreaks whole+   , testCase "BreakEntireStringUtf8 agrees with UTF-32 on ASCII" $ do       let text = "one two\nthree four"       utf32 <- breakEntireUtf32 text@@ -495,13 +501,13 @@       coverage "汉字" >>= (@?= False)   ]   where-    coverage :: String -> IO Bool+    coverage :: Text -> IO Bool     coverage text =       withFont ttfData \font ->         alloca @Structs.FontCoverageTest \testPtr -> do           fillBytes testPtr 0 $ sizeOf (undefined :: Structs.FontCoverageTest)           Other.kbts_FontCoverageTestBegin testPtr font-          forM_ text \c ->+          forM_ (Text.unpack text) \c ->             Other.kbts_FontCoverageTestCodepoint testPtr (fromIntegral (ord c))           covered <- Other.kbts_FontCoverageTestEnd testPtr           pure $ covered /= 0@@ -599,10 +605,10 @@   [x] -> pure x   other -> assertFailure $ "expected one run, got " <> show (length other) -directShape :: Handles.Font -> Handles.ShapeScratchpad -> Handles.GlyphConfig -> String -> IO [TextShape.Glyph]+directShape :: Handles.Font -> Handles.ShapeScratchpad -> Handles.GlyphConfig -> Text -> IO [TextShape.Glyph] directShape font scratchpad glyphConfig text =   withGlyphStorage \storagePtr -> do-    forM_ text \c ->+    forM_ (Text.unpack text) \c ->       ShapeDirect.kbts_PushGlyph storagePtr font (fromIntegral (ord c)) glyphConfig 0     shapeStorage scratchpad storagePtr @@ -622,9 +628,9 @@       Segmentation.kbts_GuessTextPropertiesUtf8 ptr (fromIntegral len) directionPtr scriptPtr       (,) <$> peek directionPtr <*> peek scriptPtr -guessUtf32 :: String -> IO (Enums.Direction, Enums.Script)+guessUtf32 :: Text -> IO (Enums.Direction, Enums.Script) guessUtf32 text =-  withArrayLen (map (fromIntegral . ord) text :: [CInt]) \len ptr ->+  withArrayLen (map (fromIntegral . ord) (Text.unpack text) :: [CInt]) \len ptr ->     alloca \directionPtr -> alloca \scriptPtr -> do       poke directionPtr Enums.DIRECTION_DONT_KNOW       poke scriptPtr Enums.SCRIPT_DONT_KNOW@@ -635,9 +641,9 @@ hasBreakFlag flags flag = flags .&. flag == flag  -- | Collect breaks with 1-per-codepoint positions and a generous output capacity.-breakEntireUtf32 :: String -> IO [Structs.Break]+breakEntireUtf32 :: Text -> IO [Structs.Break] breakEntireUtf32 text =-  withArrayLen (map (fromIntegral . ord) text :: [CInt]) \len codepointsPtr ->+  withArrayLen (map (fromIntegral . ord) (Text.unpack text) :: [CInt]) \len codepointsPtr ->     withBreakBuffers len \breaksPtr breakCountPtr flagsPtr flagCountPtr -> do       Segmentation.kbts_BreakEntireStringUtf32         Enums.DIRECTION_DONT_KNOW@@ -652,9 +658,9 @@         (fromIntegral len)         flagCountPtr -breakEntireUtf8 :: String -> IO [Structs.Break]+breakEntireUtf8 :: Text -> IO [Structs.Break] breakEntireUtf8 text =-  Text.withCStringLen (Text.pack text) \(textPtr, len) ->+  Text.withCStringLen text \(textPtr, len) ->     withBreakBuffers len \breaksPtr breakCountPtr flagsPtr flagCountPtr -> do       Segmentation.kbts_BreakEntireStringUtf8         Enums.DIRECTION_DONT_KNOW@@ -705,7 +711,7 @@         (before, (position, flags) : next) -> before <> ((position, flags <> b.flags) : next)         (_, []) -> acc <> [(b.position, b.flags)] -breakIncremental :: String -> IO [Structs.Break]+breakIncremental :: Text -> IO [Structs.Break] breakIncremental text =   allocaBytes Handles.sizeOfBreakState \raw -> do     fillBytes raw 0 Handles.sizeOfBreakState@@ -722,11 +728,12 @@           feed acc (c, isLast) = do             Segmentation.kbts_BreakAddCodepoint state (fromIntegral (ord c)) 1 (if isLast then 1 else 0)             drain acc-          annotated = zip text $ map (== length text) [1 ..]+          codepoints = Text.unpack text+          annotated = zip codepoints $ map (== length codepoints) [1 ..]       reverse <$> foldM feed [] annotated -fourcc :: String -> Other.ScriptTag-fourcc = \case+fourcc :: Text -> Other.ScriptTag+fourcc tag = case Text.unpack tag of   [a, b, c, d] -> Other.ScriptTag $     fromIntegral (ord a)     .|. fromIntegral (ord b) `shiftL` 8