Search.hs

{-# 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