{-# LANGUAGE KindSignatures #-} -- | Functions that brick event handlers can use to search forward or backward for certain kinds of items in brick list. -- -- ![ ](demo-01.png) ![ ](demo-02.png) -- -- For example, in the above demo program, you can search forward or backward for a list element that is not a -- separator. module Brick.Widgets.List.Search ( -- * Types IncludeCurrent -- * Low-level functions -- -- | These functions are used in list manipulation. , searchListForward , searchListBackward -- * List manipulation , listSearchDown , listSearchUp , listSearchFromBeginning , listSearchFromEnd , listSearchPageUp , listSearchPageDown -- * Classes , Searchable(..) ) where -- base import Prelude hiding (take, drop) -- third party packages import Lens.Micro import qualified Data.Vector as V import Data.Vector hiding (take, drop, modify) import qualified Data.Sequence as S import Data.Sequence hiding (take, drop) -- brick import qualified Brick.Widgets.List as L import Brick.Types -- | Should the search include the current location? type IncludeCurrent = Bool -- | Search forward for the first element index that passes the test searchListForward :: Searchable t => IncludeCurrent -> (e -> Bool) -- ^ The test -> L.GenericList n t e -> Maybe Int -- ^ The first element index that passes the test searchListForward incCur test l = let searchForward idx es = case viewHead es of Nothing -> Nothing Just (e, es') -> if test e then Just idx else searchForward (idx+1) es' -- Start with the current list element index. If the current element is excluded, then add 1 to the current index. start = case l ^. L.listSelectedL of Nothing -> 0 Just i -> i + if incCur then 0 else 1 es = drop start $ l ^. L.listElementsL in searchForward start es -- | Search backward for the first element index that passes the test searchListBackward :: Searchable t => IncludeCurrent -> (e -> Bool) -- ^ The test -> L.GenericList n t e -> Maybe Int -- ^ The first element index that passes the test searchListBackward incCur test l = let searchBackward idx es = case viewLast es of Nothing -> Nothing Just (es', e) -> if test e then Just idx else searchBackward (idx-1) es' -- Start with the current list element index + 1 so that the current index is included. If the current element is -- excluded, don't add 1 to the current index. start = case l ^. L.listSelectedL of Nothing -> 0 Just i -> i + if incCur then 1 else 0 es = take start $ l ^. L.listElementsL in searchBackward (start-1) es -- | Search forward for the first element that passes the test. -- -- The current element is not included in the search. -- -- If forward search fails, no change is made. listSearchDown :: Searchable t => (e -> Bool) -- ^ The test -> L.GenericList n t e -> L.GenericList n t e listSearchDown test l = case searchListForward False test l of Nothing -> l Just idx -> l & L.listSelectedL ?~ idx -- | Search backward for the first element that passes the test. -- -- The current element is not included in the search. -- -- If backward search fails, no change is made. listSearchUp :: Searchable t => (e -> Bool) -- ^ The test -> L.GenericList n t e -> L.GenericList n t e listSearchUp test l = case searchListBackward False test l of Nothing -> l Just idx -> l & L.listSelectedL ?~ idx -- | From the first element, search forward for the first element that passes the test. -- -- The first element is included in the search. -- -- If forward search fails, no change is made. listSearchFromBeginning :: (Searchable t, Foldable t, L.Splittable t) => (e -> Bool) -- ^ The test -> L.GenericList n t e -> L.GenericList n t e listSearchFromBeginning test l = case searchListForward True test (L.listMoveToBeginning l) of Nothing -> l Just idx -> l & L.listSelectedL ?~ idx -- | From the last element, search backward for the first element that passes the test. -- -- The last element is included in the search. -- -- If backward search fails, no change is made. listSearchFromEnd :: (Searchable t, Foldable t, L.Splittable t) => (e -> Bool) -- ^ The test -> L.GenericList n t e -> L.GenericList n t e listSearchFromEnd test l = case searchListBackward True test (L.listMoveToEnd l) of Nothing -> l Just idx -> l & L.listSelectedL ?~ idx -- | Move up one page, and search backward for the first element that passes the test. -- -- The element chosen by moving up one page is included in the search. -- -- If backward search fails, search forward for the first element that passes the test. -- -- If forward search fails too, cancel movements made by this function. listSearchPageUp :: (Searchable t, Foldable t, L.Splittable t, Ord n) => (e -> Bool) -- ^ The test -> EventM n (L.GenericList n t e) () listSearchPageUp test = do origL <- get L.listMovePageUp modify $ \l -> case searchListBackward True test l of Nothing -> case searchListForward True test l of Nothing -> origL Just idx -> l & L.listSelectedL ?~ idx Just idx -> l & L.listSelectedL ?~ idx -- | Move down one page, and search forward for the first element that passes the test. -- -- The element chosen by moving down one page is included in the search. -- -- If forward search fails, search backward for the first element that passes the test. -- -- If backward search fails too, cancel movements made by this function. listSearchPageDown :: (Searchable t, Foldable t, L.Splittable t, Ord n) => (e -> Bool) -- ^ The test -> EventM n (L.GenericList n t e) () listSearchPageDown test = do origL <- get L.listMovePageDown modify $ \l -> case searchListForward True test l of Nothing -> case searchListBackward True test l of Nothing -> origL Just idx -> l & L.listSelectedL ?~ idx Just idx -> l & L.listSelectedL ?~ idx -- | Functions for searching elements. class Searchable (t :: * -> *) where -- | Get the head and the rest viewHead :: t a -> Maybe (a, t a) -- | Get the last element and the rest viewLast :: t a -> Maybe (t a, a) -- | Take a number of elements from the beginning take :: Int -> t a -> t a -- | Drop a number of elements from the beginning drop :: Int -> t a -> t a -- | O(1) for all operations instance Searchable Vector where viewHead = uncons viewLast = unsnoc take = V.take drop = V.drop -- | O(1) for viewHead and viewLast. O(log(min(i,n-i))) for take and drop. instance Searchable Seq where viewHead s = case S.viewl s of EmptyL -> Nothing a :< s' -> Just (a, s') viewLast s = case S.viewr s of EmptyR -> Nothing s' :> a -> Just (s', a) take = S.take drop = S.drop