module Brick.Widgets.List.Utils where

import           Brick.Widgets.List
import           Data.Maybe
import qualified Data.Vector as V
import           Lens.Micro

-- | Replace the contents of a list with a new set of elements but preserve the
-- currently selected index.
--
-- This is a version of listReplace that doesn't try to be smart, but assumes
-- that all the elements in one list are distinct.
--
-- listReplace itself is broken as of brick-0.2 due to a bogus implementation of
-- the `merge` function.
listSimpleReplace :: Eq e => V.Vector e -> List n e -> List n e
listSimpleReplace :: Vector e -> List n e -> List n e
listSimpleReplace Vector e
elems List n e
oldList =
  let selected :: Maybe Int
selected = (e -> Vector e -> Maybe Int) -> Vector e -> e -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Vector e -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex Vector e
elems (e -> Maybe Int) -> ((Int, e) -> e) -> (Int, e) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> e
forall a b. (a, b) -> b
snd ((Int, e) -> Maybe Int) -> Maybe (Int, e) -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< List n e -> Maybe (Int, e)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List n e
oldList
      newSelected :: Maybe Int
newSelected = if Vector e -> Bool
forall a. Vector a -> Bool
V.null Vector e
elems
                       then Maybe Int
forall a. Maybe a
Nothing
                       else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
selected
  in List n e
oldList List n e -> (List n e -> List n e) -> List n e
forall a b. a -> (a -> b) -> b
& (Vector e -> Identity (Vector e))
-> List n e -> Identity (List n e)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
listElementsL ((Vector e -> Identity (Vector e))
 -> List n e -> Identity (List n e))
-> Vector e -> List n e -> List n e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Vector e
elems List n e -> (List n e -> List n e) -> List n e
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> List n e -> Identity (List n e)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> List n e -> Identity (List n e))
-> Maybe Int -> List n e -> List n e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Int
newSelected