Implements listReplace - replaces list content while preserving selected index

brick.cabal

@@ -28,11 +28,13 @@ library
     Brick.Util
   other-modules:
     Brick.Prim.Internal
+    Brick.Merge
 
   build-depends:       base >=4.7 && <4.8,
                        vty >= 5.2.9,
                        transformers,
                        data-default,
+                       Diff,
                        containers,
                        lens
 

src/Brick/List.hs

@@ -5,17 +5,19 @@ module Brick.List
   , drawList
   , listInsert
   , listRemove
+  , listReplace
   , listSelectedElement
   )
 where
 
 import Control.Applicative ((<$>), (<|>))
 import Data.Default
-import Data.Maybe (catMaybes)
+import Data.Maybe (fromMaybe, catMaybes)
 import Graphics.Vty (Event(..), Key(..), DisplayRegion)
 import qualified Data.Map as M
 
 import Brick.Core (HandleEvent(..), SetSize(..))
+import Brick.Merge (maintainSel)
 import Brick.Prim
 import Brick.Scroll (VScroll, vScroll, scrollToView)
 import Brick.Util (clamp, for)
@@ -101,6 +103,22 @@ listRemove pos l | null es                            = l
     where
         es = listElements l
 
+-- Replaces entire list with a new set of elements, but preserves selected index
+-- using a two-way merge algorithm.
+listReplace :: Eq e => [e] -> List e -> List e
+listReplace es' l | es' == es = l
+                  | otherwise =
+    let sel = fromMaybe 0 (listSelected l)
+        newSel = case (null es, null es') of
+          (_, True)      -> Nothing
+          (True, False)  -> Just 0
+          (False, False) -> Just (maintainSel es es' sel)
+    in ensureSelectedVisible $ l { listSelected = newSel
+                                 , listElements = es'
+                                 }
+    where
+        es = listElements l
+
 moveUp :: List e -> List e
 moveUp = moveBy (-1)
 

src/Brick/Merge.hs

@@ -0,0 +1,31 @@
+module Brick.Merge
+  ( maintainSel
+  )
+where
+
+import Data.Algorithm.Diff
+
+-- Assuming `xs` is an existing list that we want to update to match the state
+-- of `ys`. Given a selected index in `xs`, the goal is to compute the
+-- corresponding index in `ys`.
+maintainSel :: Eq e => [e] -> [e] -> Int -> Int
+maintainSel xs ys sel = let hunks = getDiff xs ys
+                        in merge 0 sel hunks
+
+merge :: Eq e => Int -> Int -> [Diff e] -> Int
+merge _   sel []                 = sel
+merge idx sel (h:hs) | idx > sel = sel
+                     | otherwise = case h of
+    Both _ _ -> merge sel (idx+1) hs
+
+    -- element removed in new list
+    First _  -> let newSel = if idx < sel
+                             then sel - 1
+                             else sel
+                in merge newSel idx hs
+
+    -- element added in new list
+    Second _ -> let newSel = if idx <= sel
+                             then sel + 1
+                             else sel
+                in merge newSel (idx+1) hs