externalize segmentation rendererHEADmaster

11 files changed, 111 insertions, 96 deletions

diff --git a/src/TextViewport/Buffer/Buffer.hs b/src/TextViewport/Buffer/Buffer.hs
index 62ce232..53eb103 100644
--- a/src/TextViewport/Buffer/Buffer.hs
+++ b/src/TextViewport/Buffer/Buffer.hs
@@ -3,33 +3,33 @@ module TextViewport.Buffer.Buffer where
 import Data.Sequence qualified as Seq
 import TextViewport.Buffer.Item (Item)
 
-newtype Buffer a = Buffer { unBuffer :: Seq.Seq (Item a) }
+newtype Buffer a seg = Buffer { unBuffer :: Seq.Seq (Item a seg) }
   deriving (Eq, Show)
 
 -- | Build a buffer from a list
-fromList :: [Item a] -> Buffer a
+fromList :: [Item a seg] -> Buffer a seg
 fromList xs = Buffer (Seq.fromList xs)
 
 -- | Modify an item at index
-modifyItem :: Int -> (Item a -> Item a) -> Buffer a -> Buffer a
+modifyItem :: Int -> (Item a seg -> Item a seg) -> Buffer a seg -> Buffer a seg
 modifyItem ix f (Buffer xs) =
     Buffer (Seq.adjust' f ix xs)
 
 -- | Insert an item
-insertItem :: Int -> Item a -> Buffer a -> Buffer a
+insertItem :: Int -> Item a seg -> Buffer a seg -> Buffer a seg
 insertItem ix x (Buffer xs) =
     Buffer (Seq.insertAt ix x xs)
 
 -- | Delete an item
-deleteItem :: Int -> Buffer a -> Buffer a
+deleteItem :: Int -> Buffer a seg -> Buffer a seg
 deleteItem ix (Buffer xs) =
     Buffer (Seq.deleteAt ix xs)
 
 -- | Append an item
-appendItem :: Item a -> Buffer a -> Buffer a
+appendItem :: Item a seg -> Buffer a seg -> Buffer a seg
 appendItem x (Buffer xs) =
     Buffer (xs Seq.|> x)
 
 -- | Extract underlying Seq (if needed)
-toSeq :: Buffer a -> Seq.Seq (Item a)
+toSeq :: Buffer a seg -> Seq.Seq (Item a seg)
 toSeq (Buffer xs) = xs
diff --git a/src/TextViewport/Buffer/Item.hs b/src/TextViewport/Buffer/Item.hs
index b5ea743..00edf7b 100644
--- a/src/TextViewport/Buffer/Item.hs
+++ b/src/TextViewport/Buffer/Item.hs
@@ -1,21 +1,8 @@
 module TextViewport.Buffer.Item where
 
-import Data.Text (Text)
-import Data.HashMap.Strict qualified as HM
-import Text.Hyphenation qualified as H
 
-
-data Item a = Item
+data Item a seg = Item
   { itemText :: a
-  , itemSegments :: SegmentStrategy a
+  , itemSegments :: seg
   }
   deriving (Eq, Show)
-
-data SegmentStrategy a
-  = NoSegments
-  | FixedWidthSegments
-  | HyphenateSegments
-      { hsLang  :: H.Language
-      , hsCache :: HM.HashMap a [(a, a)]
-      }
-  deriving (Eq, Show)
diff --git a/src/TextViewport/Render/CachedRender.hs b/src/TextViewport/Render/CachedRender.hs
index b5af8d4..48be1eb 100644
--- a/src/TextViewport/Render/CachedRender.hs
+++ b/src/TextViewport/Render/CachedRender.hs
@@ -1,12 +1,11 @@
 module TextViewport.Render.CachedRender where
 
-import TextViewport.Buffer.Item (SegmentStrategy)
 import TextViewport.Render.RenderedItem (RenderedItem)
 
 
-data CachedRender a = CachedRender
+data CachedRender a seg = CachedRender
   { crWidth    :: !Int
-  , crStrategy :: !(SegmentStrategy a)
+  , crStrategy :: !seg
   , crText     :: !a
   , crRendered :: !(RenderedItem a)
   }
diff --git a/src/TextViewport/Render/RenderBuffer.hs b/src/TextViewport/Render/RenderBuffer.hs
index fb782f5..b6378ef 100644
--- a/src/TextViewport/Render/RenderBuffer.hs
+++ b/src/TextViewport/Render/RenderBuffer.hs
@@ -8,8 +8,10 @@ import TextViewport.Render.CachedRender
 import TextViewport.Render.RenderCache
 import TextViewport.Render.RenderItem (renderItem)
 import TextViewport.Render.RenderedBuffer
+import TextViewport.Render.Segmentation (Segmenter)
 
-renderBuffer :: (Hashable t, Textual t, Index t ~ Int) => Int -> Buffer t -> RenderCache t -> (RenderCache t, RenderedBuffer t)
+
+renderBuffer :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a seg -> RenderCache a seg -> (RenderCache a seg, RenderedBuffer a)
 renderBuffer width (Buffer items) (RenderCache cache) =
   let n = Seq.length items
       go i (cAcc, rAcc)
@@ -23,7 +25,7 @@ renderBuffer width (Buffer items) (RenderCache cache) =
             in go (i + 1) (cAcc', rAcc')
   in go 0 (cache, Seq.empty)
 
-updateRenderedItem :: (Hashable t, Textual t, Index t ~ Int) => Int -> Int -> Buffer t -> RenderCache t -> RenderedBuffer t -> (RenderCache t, RenderedBuffer t)
+updateRenderedItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a seg -> RenderCache a seg -> RenderedBuffer a -> (RenderCache a seg, RenderedBuffer a)
 updateRenderedItem width itemIx (Buffer items) (RenderCache cache) (RenderedBuffer rb) =
     let item    = Seq.index items itemIx
         mOld     = Seq.index cache itemIx
diff --git a/src/TextViewport/Render/RenderCache.hs b/src/TextViewport/Render/RenderCache.hs
index dcd65e0..29cd6fc 100644
--- a/src/TextViewport/Render/RenderCache.hs
+++ b/src/TextViewport/Render/RenderCache.hs
@@ -6,16 +6,16 @@ import TextViewport.Buffer.Buffer (Buffer(Buffer))
 import TextViewport.Render.CachedRender (CachedRender)
 
 
-newtype RenderCache a = RenderCache { unRenderCache :: Seq (Maybe (CachedRender a)) }
+newtype RenderCache a seg = RenderCache { unRenderCache :: Seq (Maybe (CachedRender a seg)) }
   deriving (Eq, Show)
 
 -- | Create an empty cache matching the buffer size
-emptyRenderCacheFor :: Buffer a -> RenderCache a
+emptyRenderCacheFor :: Buffer a seg -> RenderCache a seg
 emptyRenderCacheFor (Buffer xs) =
     RenderCache (Seq.replicate (Seq.length xs) Nothing)
 
 -- | Resize cache to match buffer length
-resizeCache :: Buffer a -> RenderCache a -> RenderCache a
+resizeCache :: Buffer a seg -> RenderCache a seg -> RenderCache a seg
 resizeCache (Buffer xs) (RenderCache cache) =
     let n = Seq.length xs
         m = Seq.length cache
@@ -24,5 +24,5 @@ resizeCache (Buffer xs) (RenderCache cache) =
          else Seq.take n cache
 
 -- | Number of cached items
-length :: RenderCache a -> Int
+length :: RenderCache a seg -> Int
 length (RenderCache xs) = Seq.length xs
diff --git a/src/TextViewport/Render/RenderItem.hs b/src/TextViewport/Render/RenderItem.hs
index 7e00cf1..0cddb83 100644
--- a/src/TextViewport/Render/RenderItem.hs
+++ b/src/TextViewport/Render/RenderItem.hs
@@ -5,10 +5,13 @@ import Data.Sequences (Index, Textual)
 import TextViewport.Buffer.Item (Item(..))
 import TextViewport.Render.CachedRender
 import TextViewport.Render.RenderedItem
-import TextViewport.Render.Segmentation (applyStrategy)
+import TextViewport.Render.Segmentation (Segmenter(applySeg))
 
 
-renderItem :: (Hashable t, Textual t, Index t ~ Int) => Int -> Int -> Item t -> Maybe (CachedRender t) -> CachedRender t
+renderItem
+  :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int)
+  => Int -> Int -> Item a seg -> Maybe (CachedRender a seg)
+  -> CachedRender a seg
 renderItem width itemIx (Item txt strategy) mOld =
   case mOld of
     Just old
@@ -16,7 +19,7 @@ renderItem width itemIx (Item txt strategy) mOld =
       , crText old  == txt
       -> old
     _ ->
-      let linesV   = applyStrategy strategy width itemIx txt
+      let linesV   = applySeg strategy width itemIx txt
           rendered = RenderedItem linesV
       in CachedRender
            { crWidth    = width
diff --git a/src/TextViewport/Render/RenderState.hs b/src/TextViewport/Render/RenderState.hs
index 8c0cdef..978ec31 100644
--- a/src/TextViewport/Render/RenderState.hs
+++ b/src/TextViewport/Render/RenderState.hs
@@ -11,16 +11,18 @@ import TextViewport.Render.RenderBuffer (renderBuffer)
 import TextViewport.Render.RenderCache (RenderCache(..), emptyRenderCacheFor, resizeCache)
 import TextViewport.Render.RenderedBuffer (RenderedBuffer(RenderedBuffer))
 import TextViewport.Render.RenderedBuffer qualified as RenderedBuffer
+import TextViewport.Render.Segmentation (Segmenter)
 
-data RenderState a = RenderState
-  { rsBuffer    :: Buffer a           -- original items
-  , rsCache     :: RenderCache a      -- per-item cached renders
+
+data RenderState a seg = RenderState
+  { rsBuffer    :: Buffer a seg       -- original items
+  , rsCache     :: RenderCache a seg  -- per-item cached renders
   , rsRendered  :: RenderedBuffer a   -- fully segmented + hyphenated lines
   , rsWidth     :: Int                -- segmenting width
   , rsLineCount :: Int                
   } deriving (Eq, Show)
 
-mkRenderState :: (Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a -> RenderState a
+mkRenderState :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a seg -> RenderState a seg
 mkRenderState width buf =
   let (cache1, rendered) = renderBuffer width buf (emptyRenderCacheFor buf)
   in RenderState
@@ -32,7 +34,7 @@ mkRenderState width buf =
        }
 
 -- RenderState has to be rebuilt whenever the buffer or the width changes.
-updateRenderState :: (Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a -> RenderState a -> RenderState a
+updateRenderState :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a seg -> RenderState a seg -> RenderState a seg
 updateRenderState width buf rs =
   let (cache1, rendered) = renderBuffer width buf (rsCache rs)
   in rs
@@ -43,7 +45,7 @@ updateRenderState width buf rs =
       , rsLineCount = length (RenderedBuffer.flatten rendered)
       }
 
-modifyItemRS :: (Hashable a, Textual a, Index a ~ Int) => Int -> (Item a -> Item a) -> RenderState a -> RenderState a
+modifyItemRS :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> (Item a seg -> Item a seg) -> RenderState a seg -> RenderState a seg
 modifyItemRS ix f st =
   let buf'    = Buffer.modifyItem ix f (rsBuffer st)
       cache'  = resizeCache buf' (rsCache st)
@@ -54,7 +56,7 @@ modifyItemRS ix f st =
         , rsLineCount = length (RenderedBuffer.flatten rendered1)
         }
 
-insertItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> Item a -> RenderState a -> RenderState a
+insertItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Item a seg -> RenderState a seg -> RenderState a seg
 insertItem i newItem st =
   let Buffer items = rsBuffer st
       items'       = Seq.insertAt i newItem items
@@ -67,7 +69,7 @@ insertItem i newItem st =
         , rsLineCount = length (RenderedBuffer.flatten rendered1)
         }
 
-deleteItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> RenderState a -> RenderState a
+deleteItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> RenderState a seg -> RenderState a seg
 deleteItem i st =
   let Buffer items = rsBuffer st
       items'       = Seq.deleteAt i items
@@ -80,7 +82,7 @@ deleteItem i st =
         , rsLineCount = length (RenderedBuffer.flatten rendered1)
         }
 
-replaceItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> Item a -> RenderState a -> RenderState a
+replaceItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Item a seg -> RenderState a seg -> RenderState a seg
 replaceItem i newItem st =
   let Buffer items = rsBuffer st
       items'       = Seq.update i newItem items
@@ -93,11 +95,11 @@ replaceItem i newItem st =
         , rsLineCount = length (RenderedBuffer.flatten rendered1)
         }
 
-appendItem :: (Hashable a, Textual a, Index a ~ Int) => Item a -> RenderState a -> RenderState a
+appendItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Item a seg -> RenderState a seg -> RenderState a seg
 appendItem newItem st =
   insertItem (Seq.length (let Buffer xs = rsBuffer st in xs)) newItem st
 
-clearBuffer :: RenderState a -> RenderState a
+clearBuffer :: RenderState a seg -> RenderState a seg
 clearBuffer st =
   let buf' = Buffer Seq.empty
       cache' = RenderCache Seq.empty
@@ -107,7 +109,7 @@ clearBuffer st =
         , rsLineCount = 0
         }
 
-fromList :: (Hashable a, Textual a, Index a ~ Int) => Int -> [Item a] -> RenderState a
+fromList :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> [Item a seg] -> RenderState a seg
 fromList width xs =
   let buf     = Buffer (Seq.fromList xs)
       cache0  = RenderCache (Seq.replicate (length xs) Nothing)
@@ -120,7 +122,7 @@ fromList width xs =
        , rsLineCount = length (RenderedBuffer.flatten rendered)
        }
 
-fromSeq :: (Hashable a, Textual a, Index a ~ Int) => Int -> Seq (Item a) -> RenderState a
+fromSeq :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Seq (Item a seg) -> RenderState a seg
 fromSeq width items =
   let buf     = Buffer items
       cache0  = RenderCache (Seq.replicate (Seq.length items) Nothing)
diff --git a/src/TextViewport/Render/Segmentation.hs b/src/TextViewport/Render/Segmentation.hs
index 3d64748..2ec530a 100644
--- a/src/TextViewport/Render/Segmentation.hs
+++ b/src/TextViewport/Render/Segmentation.hs
@@ -13,11 +13,29 @@ import Data.Text qualified as T
 import Data.Vector (Vector)
 import Data.Vector qualified as V
 import Text.Hyphenation qualified as H
-import TextViewport.Buffer.Item
 import TextViewport.Render.RenderedLine (RenderedLine(..)) -- TODO qualified
 
 
-applyStrategy :: (Hashable t, Textual t, Index t ~ Int) => SegmentStrategy t -> Int -> Int -> t -> Vector (RenderedLine t)
+-- | User-pluggable segmentation interface
+class Segmenter seg a where
+  applySeg :: seg -> Int -> Int -> a -> Vector (RenderedLine a)
+
+-- | Built-in segmentation strategies (backwards compatible)
+data BuiltinSeg a
+  = NoSegments
+  | FixedWidthSegments
+  | HyphenateSegments
+      { hsLang  :: H.Language
+      , hsCache :: HM.HashMap a [(a, a)]
+      }
+  deriving (Eq, Show)
+
+-- | Built-in instance
+instance (Hashable a, Textual a, Index a ~ Int) => Segmenter (BuiltinSeg a) a where
+  applySeg = applyStrategy
+
+
+applyStrategy :: (Hashable a, Textual a, Index a ~ Int) => BuiltinSeg a -> Int -> Int -> a -> Vector (RenderedLine a)
 
 applyStrategy NoSegments width itemIx txt =
   let rawLines = S.splitWhen (=='\n') txt
diff --git a/src/TextViewport/Viewport/Instance.hs b/src/TextViewport/Viewport/Instance.hs
index c3ce338..e1cc560 100644
--- a/src/TextViewport/Viewport/Instance.hs
+++ b/src/TextViewport/Viewport/Instance.hs
@@ -9,69 +9,70 @@ import TextViewport.Render.RenderState qualified as RenderState
 import TextViewport.Render.RenderState (RenderState, mkRenderState)
 import TextViewport.Render.RenderedBuffer qualified as RenderedBuffer
 import TextViewport.Render.RenderedLine (RenderedLine(..)) -- TODO qualified
+import TextViewport.Render.Segmentation (Segmenter)
 import TextViewport.Viewport.Position (lookupPosition)
 import TextViewport.Viewport.Viewport (Viewport, clampViewport, mkViewport)
 import TextViewport.Viewport.Viewport qualified as Viewport
 
 
-data Instance a = Instance
-  { viRender :: RenderState a
+data Instance a seg = Instance
+  { viRender :: RenderState a seg
   , viView   :: Viewport
   } deriving (Show)
 
-mkInstance :: (Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a -> Instance a
+mkInstance :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a seg -> Instance a seg
 mkInstance width height buf =
   let rs = mkRenderState width buf
       vp = mkViewport width height rs
   in Instance rs vp
 
-visibleLines :: Instance a -> [RenderedLine a]
+visibleLines :: Instance a seg -> [RenderedLine a]
 visibleLines (Instance rs vp) =
   take (Viewport.vpHeight vp) . drop (Viewport.vpOffset vp) . RenderedBuffer.flatten $ RenderState.rsRendered rs
 
-applyToInstance :: (Viewport -> Viewport) -> Instance a -> Instance a
+applyToInstance :: (Viewport -> Viewport) -> Instance a seg -> Instance a seg
 applyToInstance f (Instance rs vp) =
   let vp' = f vp
   in Instance rs (clampViewport rs vp')
 
-applyToInstanceRS :: (RenderState a -> Viewport -> Viewport) -> Instance a -> Instance a
+applyToInstanceRS :: (RenderState a seg -> Viewport -> Viewport) -> Instance a seg -> Instance a seg
 applyToInstanceRS f (Instance rs vp) =
   let vp' = f rs vp
   in Instance rs (clampViewport rs vp')
 
-scrollByI :: Int -> Instance a -> Instance a
+scrollByI :: Int -> Instance a seg -> Instance a seg
 scrollByI delta = applyToInstance (Viewport.scrollBy delta)
 
-scrollUpI :: Int -> Instance a -> Instance a
+scrollUpI :: Int -> Instance a seg -> Instance a seg
 scrollUpI delta = applyToInstance (Viewport.scrollUp delta)
 
-scrollDownI :: Int -> Instance a -> Instance a
+scrollDownI :: Int -> Instance a seg -> Instance a seg
 scrollDownI delta = applyToInstance (Viewport.scrollDown delta)
 
-pageUpI :: Instance a -> Instance a
+pageUpI :: Instance a seg -> Instance a seg
 pageUpI = applyToInstance Viewport.pageUp
 
-pageDownI :: Instance a -> Instance a
+pageDownI :: Instance a seg -> Instance a seg
 pageDownI = applyToInstance Viewport.pageDown
 
-alignTopI :: Instance a -> Instance a
+alignTopI :: Instance a seg -> Instance a seg
 alignTopI = applyToInstance Viewport.alignTop
 
-alignBottomI :: Instance a -> Instance a
+alignBottomI :: Instance a seg -> Instance a seg
 alignBottomI = applyToInstanceRS Viewport.alignBottom
 
-modifyItemI :: (Hashable a, Textual a, Index a ~ Int) => Int -> (Item a -> Item a) -> Instance a -> Instance a
+modifyItemI :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> (Item a seg -> Item a seg) -> Instance a seg -> Instance a seg
 modifyItemI ix f (Instance rs vp) =
   let buf' = Buffer.modifyItem ix f (RenderState.rsBuffer rs)
       rs'  = mkRenderState (RenderState.rsWidth rs) buf'
       vp'  = clampViewport rs' vp
   in Instance rs' vp'
 
-lookupPositionI :: Int -> Int -> Instance a -> Maybe (Int, Int)
+lookupPositionI :: Int -> Int -> Instance a seg -> Maybe (Int, Int)
 lookupPositionI x y (Instance rs vp) =
     lookupPosition x y vp (RenderState.rsRendered rs)
 
---debugVI :: Instance a -> IO ()
+--debugVI :: Instance a seg -> IO ()
 --debugVI (Instance rs vp) = do
 --  putStrLn ("offset = " ++ show (Viewport.vpOffset vp))
 --  putStrLn ("height = " ++ show (Viewport.vpHeight vp))
diff --git a/src/TextViewport/Viewport/Viewport.hs b/src/TextViewport/Viewport/Viewport.hs
index 65f48e4..36392c7 100644
--- a/src/TextViewport/Viewport/Viewport.hs
+++ b/src/TextViewport/Viewport/Viewport.hs
@@ -10,7 +10,7 @@ data Viewport = Viewport
   , vpOffset :: !Int
   } deriving (Show)
 
-mkViewport :: Int -> Int -> RenderState a -> Viewport
+mkViewport :: Int -> Int -> RenderState a seg -> Viewport
 mkViewport width height rs =
     alignBottom rs Viewport
       { vpWidth  = width
@@ -19,7 +19,7 @@ mkViewport width height rs =
       }
 
 -- any function that sets vpOffset and can overshoot should use clampViewport
-clampViewport :: RenderState a -> Viewport -> Viewport
+clampViewport :: RenderState a seg -> Viewport -> Viewport
 clampViewport rs vp =
   let total  = RenderState.rsLineCount rs
       maxOff = max 0 (total - vpHeight vp)
@@ -48,7 +48,7 @@ alignTop :: Viewport -> Viewport
 alignTop vp =
   vp { vpOffset = 0 }
 
-alignBottom :: RenderState a -> Viewport -> Viewport
+alignBottom :: RenderState a seg -> Viewport -> Viewport
 alignBottom rs vp =
   let total = RenderState.rsLineCount rs
       off   = max 0 (total - vpHeight vp)
diff --git a/test/Spec.hs b/test/Spec.hs
index a886816..fc7ff07 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -11,7 +11,7 @@ import Test.Hspec
 import Text.Hyphenation qualified as H
 import TextViewport.Buffer.Buffer (Buffer(..))
 import TextViewport.Buffer.Buffer qualified as Buffer
-import TextViewport.Buffer.Item (Item(..), SegmentStrategy(..))
+import TextViewport.Buffer.Item (Item(..))
 import TextViewport.Render.CachedRender (CachedRender(..))
 import TextViewport.Render.RenderBuffer
 import TextViewport.Render.RenderCache (RenderCache(..), emptyRenderCacheFor)
@@ -39,19 +39,22 @@ shouldRunUnder action maxNs = do
   let dt = toNanoSecs (t2 - t1)
   dt `shouldSatisfy` (< maxNs)
 
-mkItem :: String -> Item String
+mkItem :: String -> Item String (BuiltinSeg String)
 mkItem t = Item t NoSegments
 
-mkBuf :: [String] -> Buffer String
+mkBuf :: [String] -> Buffer String (BuiltinSeg String)
 mkBuf xs = Buffer.fromList (map mkItem xs)
 
-mkRS :: Int -> [String] -> RenderState String
+mkBufSeg :: [String] -> seg -> Buffer String seg
+mkBufSeg xs seg = Buffer.fromList (map (flip Item seg) xs)
+
+mkRS :: Int -> [String] -> RenderState String (BuiltinSeg String)
 mkRS w xs = mkRenderState w (mkBuf xs)
 
 emptyCache :: HM.HashMap String [(String, String)]
 emptyCache = HM.empty
 
-emptyBuffer :: Buffer String
+emptyBuffer :: Buffer String (BuiltinSeg String)
 emptyBuffer = Buffer.empty
 
 emptyStrings :: [String]
@@ -138,17 +141,17 @@ main = hspec do
           RB.flatten rb `shouldSatisfy` (not . null)
 
         it "renderBuffer should reject mismatched cache size" do
-          let buf = Buffer.fromList [Item "a" NoSegments]
+          let buf = mkBuf ["a"]
               badCache = RenderCache Seq.empty
           evaluate (renderBuffer 10 buf badCache) `shouldThrow` anyException
 
         it "renderBuffer should reject non-positive width" do
-          let buf = Buffer.fromList [Item "hello" NoSegments]
+          let buf = mkBuf ["hello world"]
               cache = emptyRenderCacheFor buf
           evaluate (renderBuffer 0 buf cache) `shouldThrow` anyException
 
         it "renderBuffer should invalidate cache when width changes" do
-          let buf = Buffer.fromList [Item "hello world" NoSegments]
+          let buf = mkBuf ["hello world"]
               (cache1, _) = renderBuffer 10 buf (emptyRenderCacheFor buf)
               (_, rb2) = renderBuffer 5 buf cache1
           length (RB.flatten rb2) `shouldSatisfy` (> 1)
@@ -162,33 +165,33 @@ main = hspec do
 
 
         it "updateRenderedItem should reject mismatched rendered buffer size" do
-          let buf = Buffer.fromList [Item "a" NoSegments]
+          let buf = mkBuf ["a"]
               cache = emptyRenderCacheFor buf
               rb = RenderedBuffer Seq.empty
           evaluate (updateRenderedItem 10 0 buf cache rb) `shouldThrow` anyException
 
         it "updateRenderedItem should reject non-positive width" do
-          let buf = Buffer.fromList [Item "a" NoSegments]
+          let buf = mkBuf ["a"]
               cache = emptyRenderCacheFor buf
               rb = RenderedBuffer (Seq.singleton (RenderedItem V.empty))
           evaluate (updateRenderedItem 0 0 buf cache rb) `shouldThrow` anyException
 
         it "updateRenderedItem should re-render when strategy changes" do
-          let buf0 = Buffer.fromList [Item "hello world" NoSegments]
+          let buf0 = mkBuf ["hello world"]
               (cache0, rb0) = renderBuffer 10 buf0 (emptyRenderCacheFor buf0)
-              buf1 = Buffer.fromList [Item "hello world" FixedWidthSegments]
+              buf1 = mkBufSeg ["hello world"] FixedWidthSegments
               (_, rb1) = updateRenderedItem 10 0 buf1 cache0 rb0
           rb1 `shouldNotBe` rb0
 
         it "updateRenderedItem should invalidate cache when strategy changes (cache must differ)" do
-          let buf0 = Buffer.fromList [mkItem "hello world"]
+          let buf0 = mkBuf ["hello world"]
               (cache0, rb0) = renderBuffer 10 buf0 (emptyRenderCacheFor buf0)
-              buf1 = Buffer.fromList [Item "hello world" FixedWidthSegments]
+              buf1 = mkBufSeg ["hello world"] FixedWidthSegments
               (cache1, _) = updateRenderedItem 10 0 buf1 cache0 rb0
           cache1 `shouldNotBe` cache0
 
         it "renderBuffer should reject negative indices" do
-          let buf = Buffer.fromList [Item "a" NoSegments]
+          let buf = mkBuf ["a"]
               cache = emptyRenderCacheFor buf
           evaluate (updateRenderedItem 10 (-1) buf cache (RenderedBuffer Seq.empty))
             `shouldThrow` anyException
@@ -212,7 +215,7 @@ main = hspec do
         it "renderItem should invalidate cache when strategy changes" do
           let old = CachedRender
                       { crWidth    = 10
-                      , crStrategy = NoSegments
+                      , crStrategy = NoSegments :: BuiltinSeg String
                       , crText     = "hello world"
                       , crRendered = RenderedItem mempty
                       }
@@ -223,7 +226,7 @@ main = hspec do
         it "renderItem should not reuse cache from a different item index" do
           let old = CachedRender
                       { crWidth    = 10
-                      , crStrategy = NoSegments
+                      , crStrategy = NoSegments :: BuiltinSeg String
                       , crText     = "hello world"
                       , crRendered = RenderedItem mempty
                       }
@@ -232,13 +235,13 @@ main = hspec do
           crRendered new `shouldNotBe` crRendered old
 
         it "renderItem should reject non-positive width" do
-          let itm = Item "hello" NoSegments
+          let itm = mkItem "hello"
           evaluate (renderItem 0 0 itm Nothing) `shouldThrow` anyException
 
         it "renderItem should invalidate cache when segmentation output changes" do
           let old = CachedRender
                       { crWidth    = 5
-                      , crStrategy = HyphenateSegments H.German_1996 mempty
+                      , crStrategy = HyphenateSegments H.German_1996 emptyCache
                       , crText     = "Schifffahrt"
                       , crRendered = RenderedItem mempty
                       }
@@ -283,30 +286,30 @@ main = hspec do
           RS.rsLineCount rs' `shouldBe` 0
 
         it "updateRenderState should invalidate cache when width changes" do
-          let rs0 = mkRenderState 10 (Buffer.fromList [Item "hello world" NoSegments])
+          let rs0 = mkRS 10 ["hello world"]
               rs1 = updateRenderState 5 (RS.rsBuffer rs0) rs0
           RS.rsLineCount rs1 `shouldSatisfy` (> RS.rsLineCount rs0)
 
         it "modifyItemRS should fail on out-of-bounds index" do
-          evaluate (RS.modifyItemRS 99 id (mkRenderState 10 emptyBuffer))
+          evaluate (RS.modifyItemRS 99 id (mkRS 10 []))
             `shouldThrow` anyException
 
         it "insertItem should reject out-of-bounds index" do
-          let rs = mkRenderState 10 emptyBuffer
+          let rs = mkRS 10 []
               rs' = RS.insertItem 5 (Item "x" NoSegments) rs
           RS.rsBuffer rs' `shouldBe` RS.rsBuffer rs
 
         it "deleteItem should fail on out-of-bounds index" do
-          let rs = mkRenderState 10 (Buffer.fromList [Item "a" NoSegments])
+          let rs = mkRS 10 ["a"]
           evaluate (RS.deleteItem 5 rs) `shouldThrow` anyException
 
         it "replaceItem should handle out-of-bounds index consistently" do
-          let rs = mkRenderState 10 emptyBuffer
+          let rs = mkRS 10 []
           evaluate (RS.replaceItem 0 (Item "x" NoSegments) rs)
             `shouldThrow` anyException
 
         it "clearBuffer should reset width or document that width persists" do
-          let rs = mkRenderState 10 (Buffer.fromList [Item "a" NoSegments])
+          let rs = mkRS 10 ["a"]
               rs' = RS.clearBuffer rs
           RS.rsWidth rs' `shouldBe` 0
 
@@ -471,11 +474,11 @@ main = hspec do
       describe "Viewport" do
 
         it "mkViewport should reject non-positive width/height" do
-          let rs = mkRenderState 10 emptyBuffer
+          let rs = mkRS 10 []
           evaluate (mkViewport 0 0 rs) `shouldThrow` anyException
 
         it "alignBottom should place viewport at last line even when height > total lines" do
-          let rs = mkRenderState 10 (Buffer.fromList [mkItem "a", mkItem "b"])
+          let rs = mkRS 10 ["a","b"]
               vp = Viewport 10 5 0
           vpOffset (VP.alignBottom rs vp) `shouldBe` 3
 
@@ -488,7 +491,7 @@ main = hspec do
           vpOffset (VP.pageUp vp) `shouldBe` 0
 
         it "clampViewport should reject non-positive viewport height" do
-          let rs = mkRenderState 10 (Buffer.fromList [mkItem "a"])
+          let rs = mkRS 10 ["a"]
               vp = Viewport 10 0 0
           evaluate (clampViewport rs vp) `shouldThrow` anyException