externalize segmentation rendererHEADmaster

6 files changed, 51 insertions, 27 deletions

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