{-# 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 :: forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward IncludeCurrent
incCur e -> IncludeCurrent
test GenericList n t e
l = let
  searchForward :: t -> t e -> Maybe t
searchForward t
idx t e
es = case forall (t :: * -> *) a. Searchable t => t a -> Maybe (a, t a)
viewHead t e
es of
    Maybe (e, t e)
Nothing -> forall a. Maybe a
Nothing
    Just (e
e, t e
es') -> if e -> IncludeCurrent
test e
e
      then forall a. a -> Maybe a
Just t
idx
      else t -> t e -> Maybe t
searchForward (t
idxforall a. Num a => a -> a -> a
+t
1) t e
es'
  -- Start with the current list element index. If the current element is excluded, then add 1 to the current index.
  start :: Int
start = case GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL of
    Maybe Int
Nothing -> Int
0
    Just Int
i -> Int
i forall a. Num a => a -> a -> a
+ if IncludeCurrent
incCur then Int
0 else Int
1
  es :: t e
es = forall (t :: * -> *) a. Searchable t => Int -> t a -> t a
drop Int
start forall a b. (a -> b) -> a -> b
$ GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
L.listElementsL
  in forall {t :: * -> *} {t}.
(Searchable t, Num t) =>
t -> t e -> Maybe t
searchForward Int
start t e
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 :: forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward IncludeCurrent
incCur e -> IncludeCurrent
test GenericList n t e
l = let
  searchBackward :: t -> t e -> Maybe t
searchBackward t
idx t e
es = case forall (t :: * -> *) a. Searchable t => t a -> Maybe (t a, a)
viewLast t e
es of
    Maybe (t e, e)
Nothing -> forall a. Maybe a
Nothing
    Just (t e
es', e
e) -> if e -> IncludeCurrent
test e
e
      then forall a. a -> Maybe a
Just t
idx
      else t -> t e -> Maybe t
searchBackward (t
idxforall a. Num a => a -> a -> a
-t
1) t e
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 :: Int
start = case GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL of
    Maybe Int
Nothing -> Int
0
    Just Int
i -> Int
i forall a. Num a => a -> a -> a
+ if IncludeCurrent
incCur then Int
1 else Int
0
  es :: t e
es = forall (t :: * -> *) a. Searchable t => Int -> t a -> t a
take Int
start forall a b. (a -> b) -> a -> b
$ GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
L.listElementsL
  in forall {t :: * -> *} {t}.
(Searchable t, Num t) =>
t -> t e -> Maybe t
searchBackward (Int
startforall a. Num a => a -> a -> a
-Int
1) t e
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 :: forall (t :: * -> *) e n.
(Searchable t, Foldable t, Splittable t) =>
(e -> IncludeCurrent)
-> Int -> GenericList n t e -> GenericList n t e
listSearchBy e -> IncludeCurrent
test Int
amt GenericList n t e
l = if Int
amt forall a. Eq a => a -> a -> IncludeCurrent
== Int
0
    then GenericList n t e
l
    else let l' :: GenericList n t e
l' = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy Int
amt GenericList n t e
l
             (IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchList, IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListOpposite) = if Int
amt forall a. Ord a => a -> a -> IncludeCurrent
< Int
0
               then (forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward, forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward)
               else (forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward, forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward)
    in case forall {e} {n}.
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchList IncludeCurrent
True e -> IncludeCurrent
test GenericList n t e
l' of
      Maybe Int
Nothing -> case forall {e} {n}.
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListOpposite IncludeCurrent
False e -> IncludeCurrent
test GenericList n t e
l' of
        Maybe Int
Nothing -> GenericList n t e
l
        Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
idx
      Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
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 :: forall (t :: * -> *) e n.
Searchable t =>
(e -> IncludeCurrent) -> GenericList n t e -> GenericList n t e
listSearchUp e -> IncludeCurrent
test GenericList n t e
l = case forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward IncludeCurrent
False e -> IncludeCurrent
test GenericList n t e
l of
  Maybe Int
Nothing -> GenericList n t e
l
  Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
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 :: forall (t :: * -> *) e n.
Searchable t =>
(e -> IncludeCurrent) -> GenericList n t e -> GenericList n t e
listSearchDown e -> IncludeCurrent
test GenericList n t e
l = case forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward IncludeCurrent
False e -> IncludeCurrent
test GenericList n t e
l of
  Maybe Int
Nothing -> GenericList n t e
l
  Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
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 :: forall (t :: * -> *) n pages e.
(Searchable t, Foldable t, Splittable t, Ord n, RealFrac pages) =>
(e -> IncludeCurrent) -> pages -> EventM n (GenericList n t e) ()
listSearchByPages e -> IncludeCurrent
test pages
p = if pages
p forall a. Eq a => a -> a -> IncludeCurrent
== pages
0
  then forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else do
    GenericList n t e
origL <- forall s (m :: * -> *). MonadState s m => m s
get
    forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> EventM n (GenericList n t e) ()
L.listMoveByPages pages
p
    let (IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchList, IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListOpposite) = if pages
p forall a. Ord a => a -> a -> IncludeCurrent
< pages
0
           then (forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward, forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward)
           else (forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward, forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward)
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \GenericList n t e
l -> case forall {e} {n}.
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchList IncludeCurrent
True e -> IncludeCurrent
test GenericList n t e
l of
      Maybe Int
Nothing -> case forall {e} {n}.
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListOpposite IncludeCurrent
False e -> IncludeCurrent
test GenericList n t e
l of
        Maybe Int
Nothing -> GenericList n t e
origL
        Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
idx
      Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
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 :: forall (t :: * -> *) n e.
(Searchable t, Foldable t, Splittable t, Ord n) =>
(e -> IncludeCurrent) -> EventM n (GenericList n t e) ()
listSearchPageUp e -> IncludeCurrent
test = forall (t :: * -> *) n pages e.
(Searchable t, Foldable t, Splittable t, Ord n, RealFrac pages) =>
(e -> IncludeCurrent) -> pages -> EventM n (GenericList n t e) ()
listSearchByPages e -> IncludeCurrent
test (-Double
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 :: forall (t :: * -> *) n e.
(Searchable t, Foldable t, Splittable t, Ord n) =>
(e -> IncludeCurrent) -> EventM n (GenericList n t e) ()
listSearchPageDown e -> IncludeCurrent
test = forall (t :: * -> *) n pages e.
(Searchable t, Foldable t, Splittable t, Ord n, RealFrac pages) =>
(e -> IncludeCurrent) -> pages -> EventM n (GenericList n t e) ()
listSearchByPages e -> IncludeCurrent
test (Double
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 :: forall (t :: * -> *) e n.
(Searchable t, Foldable t, Splittable t) =>
(e -> IncludeCurrent) -> GenericList n t e -> GenericList n t e
listSearchFromBeginning e -> IncludeCurrent
test GenericList n t e
l = case forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward IncludeCurrent
True e -> IncludeCurrent
test (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveToBeginning GenericList n t e
l) of
  Maybe Int
Nothing -> GenericList n t e
l
  Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
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 :: forall (t :: * -> *) e n.
(Searchable t, Foldable t, Splittable t) =>
(e -> IncludeCurrent) -> GenericList n t e -> GenericList n t e
listSearchFromEnd e -> IncludeCurrent
test GenericList n t e
l = case forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward IncludeCurrent
True e -> IncludeCurrent
test (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveToEnd GenericList n t e
l) of
  Maybe Int
Nothing -> GenericList n t e
l
  Just Int
idx -> GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
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 :: forall (t :: * -> *) e n.
Searchable t =>
(e -> IncludeCurrent) -> EventM n (GenericList n t e) ()
listShowTheTop e -> IncludeCurrent
test = do
  GenericList n t e
l <- forall s (m :: * -> *). MonadState s m => m s
get
  case forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListBackward IncludeCurrent
False e -> IncludeCurrent
test GenericList n t e
l of
    Maybe Int
Nothing -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning forall a b. (a -> b) -> a -> b
$ forall n. n -> ViewportScroll n
viewportScroll forall a b. (a -> b) -> a -> b
$ GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n1 (t :: * -> *) e n2.
Lens (GenericList n1 t e) (GenericList n2 t e) n1 n2
L.listNameL
    Just Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall (t :: * -> *) e n.
Searchable t =>
(e -> IncludeCurrent) -> EventM n (GenericList n t e) ()
listShowTheBottom e -> IncludeCurrent
test = do
  GenericList n t e
l <- forall s (m :: * -> *). MonadState s m => m s
get
  case forall (t :: * -> *) e n.
Searchable t =>
IncludeCurrent
-> (e -> IncludeCurrent) -> GenericList n t e -> Maybe Int
searchListForward IncludeCurrent
False e -> IncludeCurrent
test GenericList n t e
l of
    Maybe Int
Nothing -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd forall a b. (a -> b) -> a -> b
$ forall n. n -> ViewportScroll n
viewportScroll forall a b. (a -> b) -> a -> b
$ GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n1 (t :: * -> *) e n2.
Lens (GenericList n1 t e) (GenericList n2 t e) n1 n2
L.listNameL
    Just Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall a. Vector a -> Maybe (a, Vector a)
viewHead = forall a. Vector a -> Maybe (a, Vector a)
uncons
  viewLast :: forall a. Vector a -> Maybe (Vector a, a)
viewLast = forall a. Vector a -> Maybe (Vector a, a)
unsnoc
  take :: forall a. Int -> Vector a -> Vector a
take = forall a. Int -> Vector a -> Vector a
V.take
  drop :: forall a. Int -> Vector a -> Vector a
drop = forall a. Int -> Vector a -> Vector a
V.drop

-- | O(1) for viewHead and viewLast. O(log(min(i,n-i))) for take and drop.
instance Searchable Seq where
  viewHead :: forall a. Seq a -> Maybe (a, Seq a)
viewHead Seq a
s = case forall a. Seq a -> ViewL a
S.viewl Seq a
s of
    ViewL a
EmptyL -> forall a. Maybe a
Nothing
    a
a :< Seq a
s' -> forall a. a -> Maybe a
Just (a
a, Seq a
s')
  viewLast :: forall a. Seq a -> Maybe (Seq a, a)
viewLast Seq a
s = case forall a. Seq a -> ViewR a
S.viewr Seq a
s of
    ViewR a
EmptyR -> forall a. Maybe a
Nothing
    Seq a
s' :> a
a -> forall a. a -> Maybe a
Just (Seq a
s', a
a)
  take :: forall a. Int -> Seq a -> Seq a
take = forall a. Int -> Seq a -> Seq a
S.take
  drop :: forall a. Int -> Seq a -> Seq a
drop = forall a. Int -> Seq a -> Seq a
S.drop