Skip.hs

{-# LANGUAGE KindSignatures #-}
-- | Functions that brick event handlers can use to move up or down while skipping a certain kind of elements.
--
-- ![ ](demo-01.png) ![ ](demo-02.png)
--
-- For example, in the above demo program, you can move in the list while skipping separators.
module Brick.Widgets.List.Skip (
-- * Types
  Dir(..)
, Amount(..)
, Move(..)
-- * Functions
, listSkip
, listSearchFromCurrent
-- * 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 hiding (Direction(..))
import Brick.Main

-- | Should the search include the current location?
data IncludeCurrent = IncludeCurrent | ExcludeCurrent deriving (Show, Eq)

-- | The direction to move in
data Dir =
  -- | Backward, or Up
  Bwd |
  -- | Forward, or Down
  Fwd
  deriving (Show, Eq)

-- | The amount to move by
data Amount =
  -- | Move to the next element that fails the test.
  One |
  -- | Move forward or backward as much as possible, and start searching in the opposite direction.
  Most |
  -- | Move by one page. From there, start searching. If the search fails, start searching in the opposite direction.
  Page |
  -- | Move by half page. From there, start searching. If the search fails, start searching in the opposite direction.
  HalfPage
  deriving (Show, Eq)

-- | Description of a movement
data Move =
  Move Amount Dir |
  NoMove
  deriving (Show, Eq)

-- | Move by a specified amount. Skip elements that pass the test. After moving, if there is no more element that fails
-- the test in the specified direction, this function tries to show as many elements that pass the test as possible in
-- the direction.
listSkip :: (Foldable t, L.Splittable t, Searchable t, Ord n)
  => (e -> Bool) -- ^ The test
  -> Move
  -> EventM n (L.GenericList n t e) ()
listSkip t m = case m of
  Move a Bwd -> do
    case a of
      One -> modify $ listSkipBackward t
      Most -> modify $ listSkipToBeginning t
      Page -> listSkipByPages t (-1.0)
      HalfPage -> listSkipByPages t (-0.5)
    listShowAbove t
  Move a Fwd -> do
    case a of
      One -> modify $ listSkipForward t
      Most -> modify $ listSkipToEnd t
      Page -> listSkipByPages t 1.0
      HalfPage -> listSkipByPages t 0.5
    listShowBelow t
  NoMove -> return ()

-- | From the current element, search for an element that fails the test, and go to it.
listSearchFromCurrent :: Searchable t
  => (e -> Bool) -- ^ The test
  -> Dir
  -> EventM n (L.GenericList n t e) ()
listSearchFromCurrent t d = let
  searchList = case d of
    Bwd -> searchListBackward
    Fwd -> searchListForward
  in modify $ \l -> case searchList IncludeCurrent t l of
    Nothing -> l
    Just ix -> l & L.listSelectedL ?~ ix

-- | Search forward for the first element index that fails the test
searchListForward :: Searchable t
  => IncludeCurrent
  -> (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> Maybe Int -- ^ The first element index that fails the test
searchListForward incCur test l = let
    skipForward idx es = case viewHead es of
      Nothing -> Nothing
      Just (e, es') -> if test e
        then skipForward (idx+1) es'
        else Just idx
    -- 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 + case incCur of
        IncludeCurrent -> 0
        ExcludeCurrent -> 1
    es = drop start $ l ^. L.listElementsL
    in skipForward start es

-- | Search backward for the first element index that fails the test
searchListBackward :: Searchable t
  => IncludeCurrent
  -> (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> Maybe Int -- ^ The first element index that fails the test
searchListBackward incCur test l = let
    skipBackward idx es = case viewLast es of
      Nothing -> Nothing
      Just (es', e) -> if test e
        then skipBackward (idx-1) es'
        else Just idx
    -- 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 + case incCur of
        IncludeCurrent -> 1
        ExcludeCurrent -> 0
    es = take start $ l ^. L.listElementsL
    in skipBackward (start-1) es

-- | Search backward for the first element that fails the test.
--
-- The current element is not included in the search.
--
-- If backward search fails, no change is made.
listSkipBackward :: Searchable t
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipBackward test l = case searchListBackward ExcludeCurrent test l of
  Nothing -> l
  Just idx -> l & L.listSelectedL ?~ idx

-- | Search forward for the first element that fails the test.
--
-- The current element is not included in the search.
--
-- If forward search fails, no change is made.
listSkipForward :: Searchable t
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipForward test l = case searchListForward ExcludeCurrent 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 fails 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 fails 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.
listSkipByPages :: (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) ()
listSkipByPages 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 IncludeCurrent test l of
      Nothing -> case searchListOpposite ExcludeCurrent test l of
        Nothing -> origL
        Just idx -> l & L.listSelectedL ?~ idx
      Just idx -> l & L.listSelectedL ?~ idx

-- | From the first element, search forward for the first element that fails the test.
--
-- The first element is included in the search.
--
-- If forward search fails, no change is made.
listSkipToBeginning :: (Searchable t, Foldable t, L.Splittable t)
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipToBeginning test l = case searchListForward IncludeCurrent test (L.listMoveToBeginning l) of
  Nothing -> l
  Just idx -> l & L.listSelectedL ?~ idx

-- | From the last element, search backward for the first element that fails the test.
--
-- The last element is included in the search.
--
-- If backward search fails, no change is made.
listSkipToEnd :: (Searchable t, Foldable t, L.Splittable t)
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipToEnd test l = case searchListBackward IncludeCurrent test (L.listMoveToEnd l) of
  Nothing -> l
  Just idx -> l & L.listSelectedL ?~ idx

-- | If searching backward for a list element that fails 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.
listShowAbove :: Searchable t
  => (e -> Bool) -- ^ The test
  -> EventM n (L.GenericList n t e) ()
listShowAbove test = do
  l <- get
  case searchListBackward ExcludeCurrent test l of
    Nothing -> vScrollToBeginning $ viewportScroll $ l ^. L.listNameL
    Just _ -> return ()

-- | If searching forward for a list element that fails 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.
listShowBelow :: Searchable t
  => (e -> Bool) -- ^ The test
  -> EventM n (L.GenericList n t e) ()
listShowBelow test = do
  l <- get
  case searchListForward ExcludeCurrent 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