brick-list-search (empty) → 0.1.0.0

raw patch · 7 files changed

+349/−0 lines, 7 filesdep +basedep +brickdep +brick-list-searchbinary-added

Dependencies added: base, brick, brick-list-search, containers, microlens, vector, vty

Files

• CHANGELOG.md +5/−0
• LICENSE +3/−0
• brick-list-search.cabal +62/−0
• demo-01.png binary
• demo-02.png binary
• demos/BrickListSearch.hs +81/−0
• src/Brick/Widgets/List/Search.hs +198/−0

@@ -0,0 +1,5 @@+# Revision history for brick-list-search++## 0.1.0.0 -- 2023-02-20++* First version with proper documentation.

@@ -0,0 +1,3 @@+Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

@@ -0,0 +1,62 @@+cabal-version: 3.0+name: brick-list-search+version: 0.1.0.0++synopsis: Search forward or backward for certain kinds of items in brick list++description:+    This package contains functions that can be used in brick event handlers to search forward or backward for certain+    kinds of items.++    For example, you can search forward or backward for a list element that is not a separator because selecting a list+    separator doesn't make sense.++    You can run demo programs to see how it works.++homepage: https://codeberg.org/amano.kenji/brick-list-search+bug-reports: https://codeberg.org/amano.kenji/brick-list-search/issues++license: 0BSD+license-file: LICENSE+author: amano.kenji+maintainer: amano.kenji@proton.me++category: User Interface+extra-source-files: CHANGELOG.md+extra-doc-files:+    demo-01.png+  , demo-02.png++source-repository head+    type: git+    location: https://codeberg.org/amano.kenji/brick-list-search.git++Flag demos+    description: Build demonstration programs+    Default: False++common all+    build-depends:+        base >=4.15.1.0 && <5+      , brick >=1.5 && <1.7+      , microlens >=0.4.13 && <0.5+      , vector >=0.12.3 && <0.13+    default-language: Haskell2010++library+    import: all+    exposed-modules: Brick.Widgets.List.Search+    build-depends:+        containers >=0.6.4 && <0.7+    hs-source-dirs: src++executable brick-list-search+    import: all+    if !flag(demos)+      buildable: False+    main-is: BrickListSearch.hs+    build-depends:+        brick-list-search+      , vty >=5.36 && <5.37+    hs-source-dirs: demos+    ghc-options: -threaded

binary file changed (absent → 21772 bytes)

binary file changed (absent → 24740 bytes)

@@ -0,0 +1,81 @@+{-# LANGUAGE LambdaCase #-}+module Main where++-- base+import Control.Monad (void)+-- Third party libraries+import Lens.Micro+import Data.Vector hiding ((++), map, modify)+-- brick & vty+import Brick.Main+import Brick.AttrMap+import Brick.Types+import Brick.Widgets.Core+import Brick.Util+import Brick.Widgets.Border+import Brick.Widgets.List+import Brick.Widgets.Center+import Brick.Widgets.List.Search+import Graphics.Vty (defAttr, Event(..), Key(..), Modifier(..), black, white)++data Name = TheList deriving (Eq, Ord, Show)++data ListElem = Sep (Maybe String) | Str String deriving Show++isItem :: ListElem -> Bool+isItem = \case+  Str _ -> True+  Sep _ -> False++handleEvent :: BrickEvent Name () -> EventM Name (GenericList Name Vector ListElem) ()+handleEvent e = case e of+  VtyEvent (EvKey KEsc []) -> halt+  VtyEvent (EvKey (KChar 'q') []) -> halt+  VtyEvent (EvKey KUp []) -> modify $ listSearchUp isItem+  VtyEvent (EvKey KDown []) -> modify $ listSearchDown isItem+  VtyEvent (EvKey KHome []) -> modify $ listSearchFromBeginning isItem+  VtyEvent (EvKey KEnd []) -> modify $ listSearchFromEnd isItem+  VtyEvent (EvKey KPageUp []) -> listSearchPageUp isItem+  VtyEvent (EvKey KPageDown []) -> listSearchPageDown isItem+  _ -> return ()++renderListElement :: Bool -> ListElem -> Widget Name+renderListElement lf e = case e of+  Str s -> padRight Max $ str s+  Sep Nothing -> hBorder+  Sep (Just title) -> hBorderWithLabel $ str title++drawUi :: GenericList Name Vector ListElem -> [Widget Name]+drawUi l = let msgs = [ "Press q or Esc to quit"+                      , "Press Up arrow to move up"+                      , "Press Down arrow to move down"+                      , "Press Home to move to the beginning"+                      , "Press End to move to the end"+                      , "Press PageUp to move up one page"+                      , "Press PageDown to move down one page" ]+  in [vCenter $ vBox $+      hCenter (border $ vLimit 20 $ hLimit 30 $ renderList renderListElement True l) : map (hCenter . str) msgs]++listElems :: Vector ListElem+listElems = fromList $+  [Sep (Just "First separator"), Str "New account", Sep (Just "Accounts")]+  ++ map (Str . ("Account "<>) . show) [1..1000]+  ++ [Sep Nothing, Str "Show account statistics.", Sep (Just "Yet Another Separator"), Str "End of List",+      Sep (Just "Last separator")]++theList :: GenericList Name Vector ListElem+theList = list TheList listElems 1++main :: IO ()+main = do+  let app = App {+    appDraw = drawUi+  , appChooseCursor = neverShowCursor+  , appHandleEvent = handleEvent+  -- If the first element is a separator, searching forward for an item is necessary.+  , appStartEvent = modify $ \l -> case searchListForward True isItem l of+      Nothing -> l & listSelectedL .~ Nothing+      Just idx -> l & listSelectedL ?~ idx+  , appAttrMap = const $ attrMap defAttr [(listSelectedAttr, black `on` white)]+  }+  void $ defaultMain app theList

@@ -0,0 +1,198 @@+{-# 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