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 and list display.
, searchListForward
, searchListBackward
-- * List manipulation
, listSearchBy
, listSearchUp
, listSearchDown
, listSearchByPages
, listSearchPageUp
, listSearchPageDown
, listSearchFromBeginning
, listSearchFromEnd
-- * List display
--
-- | List display functions do not change the current list element.
, listShowTheTop
, listShowTheBottom
-- * 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
import Brick.Main

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

-- | Move by an amount of list elements in the list. If the amount to move by is 0, no change is made. Otherwise, call
-- 'L.listMoveBy'.
--
-- The element chosen by 'L.listMoveBy' is included in the search.
--
-- After calling 'L.listMoveBy', if the amount to move by was positive, search forward for the first element that passes
-- the test. If forward search fails, search backward for the first such element. If backward search fails too, no
-- change is made.
--
-- After calling 'L.listMoveBy', if the amount to move by was negative, search backward for the first element that
-- passes the test. If backward search fails, search forward for the first such element. If forward search fails too, no
-- change is made.
listSearchBy :: (Searchable t, Foldable t, L.Splittable t)
  => (e -> Bool) -- ^ The test
  -> Int -- ^ The amount of list elements to move by
  -> L.GenericList n t e
  -> L.GenericList n t e
listSearchBy test amt l = if amt == 0
    then l
    else let l' = L.listMoveBy amt l
             (searchList, searchListOpposite) = if amt < 0
               then (searchListBackward, searchListForward)
               else (searchListForward, searchListBackward)
    in case searchList True test l' of
      Nothing -> case searchListOpposite False test l' of
        Nothing -> l
        Just idx -> l & L.listSelectedL ?~ idx
      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

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

-- | Move by a (fractional) number of pages in the list. If the number of pages to move by is 0, no change is made.
-- Otherwise, call 'L.listMoveByPages' with the number of pages to move by.
--
-- The element chosen by 'L.listMoveByPages' is included in the search.
--
-- After calling 'L.listMoveByPages', if the number of pages to move by was positive, search forward for the first
-- element that passes the test. If forward search fails, then search backward for the first such element. If backward
-- search fails too, cancel movements made by this function.
--
-- After calling 'L.listMoveByPages', if the number of pages to move by was negative, search backward for the first
-- element that passes the test. If backward search fails, then search forward for the first such element. If forward
-- search fails too, cancel movements made by this function.
listSearchByPages :: (Searchable t, Foldable t, L.Splittable t, Ord n, RealFrac pages)
  => (e -> Bool) -- ^ The test
  -> pages -- ^ Pages to move by
  -> EventM n (L.GenericList n t e) ()
listSearchByPages test p = if p == 0
  then return ()
  else do
    origL <- get
    L.listMoveByPages p
    let (searchList, searchListOpposite) = if p < 0
           then (searchListBackward, searchListForward)
           else (searchListForward, searchListBackward)
    modify $ \l -> case searchList True test l of
      Nothing -> case searchListOpposite False test l of
        Nothing -> origL
        Just idx -> l & L.listSelectedL ?~ idx
      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 = listSearchByPages test (-1 :: Double)

-- | 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 = listSearchByPages test (1 :: Double)

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

-- | If searching backward for a list element that passes the test fails, show as many list elements as possible above
-- the current element.
--
-- The current list element is not included in the backward search.
--
-- Call this after moving backward by calling one of list manipulation functions.
listShowTheTop :: Searchable t
  => (e -> Bool) -- ^ The test
  -> EventM n (L.GenericList n t e) ()
listShowTheTop test = do
  l <- get
  case searchListBackward False test l of
    Nothing -> vScrollToBeginning $ viewportScroll $ l ^. L.listNameL
    Just _ -> return ()

-- | If searching forward for a list element that passes the test fails, show as many list elements as possible below
-- the current element.
--
-- The current list element is not included in the forward search.
--
-- Call this after moving forward by calling one of list manipulation functions.
listShowTheBottom :: Searchable t
  => (e -> Bool) -- ^ The test
  -> EventM n (L.GenericList n t e) ()
listShowTheBottom test = do
  l <- get
  case searchListForward False test l of
    Nothing -> vScrollToEnd $ viewportScroll $ l ^. L.listNameL
    Just _ -> return ()

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