ListPicker.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
module Brick.Widgets.ListPicker (
  -- * ListPicker
  ListPicker(..),
  -- * Lenses
  listPickerInput,
  listPickerElements,
  listPickerAllElements,
  listPickerSelect,
  listPickerDescription,
  listPickerRenderRow,
  listPickerLabel,
  listPickerHighlightAttrName,
  -- * Render and Update
  Update(..),
  renderListPicker,
  handleListPicker,
) where

import Brick
import Brick.Forms
import Brick.Widgets.Border
import Brick.Widgets.List
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Graphics.Vty.Input as Vty
import Lens.Micro
import Lens.Micro.Platform (makeLenses)

data ListPicker name state ev element = ListPicker
  { _listPickerInput :: Form Text ev name
  , _listPickerElements :: GenericList name Seq element
  , _listPickerAllElements :: Seq element
  , _listPickerSelect :: element -> EventM name state (Update name state ev element)
  , _listPickerDescription :: element -> Text
  , _listPickerRenderRow :: Int -> element -> Widget name
  , _listPickerLabel :: Text
  , _listPickerHighlightAttrName :: AttrName
  }

data Update name state ev element
  = Changed (ListPicker name state ev element)
  | Unchanged
  | Exit

makeLenses ''ListPicker

renderListPicker :: (Ord name, Show name) => ListPicker name state ev element -> Widget name
renderListPicker picker =
  hLimit vWidth $ vLimit vHeight $
    borderWithLabel (txt (_listPickerLabel picker)) $ vBox $
      [ renderForm (_listPickerInput picker)
      , renderList
          (\elIsSelected ->
            if elIsSelected
              then withHighlighting picker . renderLine
              else renderLine
          )
          False
          (_listPickerElements picker)
      ]
  where
    renderLine = _listPickerRenderRow picker actual_width

    vHeight = length (_listPickerAllElements picker) + 4
    vWidth = actual_width + 2

    maximum_size_ = maximum (fmap (Text.length . (_listPickerDescription picker)) (_listPickerAllElements picker))
    -- we limit the size to 120 to avoid row overflow
    maximum_size = min maximum_size_ 120

    actual_width =
      maximum_size
        + 5  -- 5, maximum width of rendering a key
        + 1  -- 1, at least one padding

handleListPicker :: (Ord n) => BrickEvent n e -> ListPicker n a e element -> EventM n a (Update n a e element)
handleListPicker e picker = do
  -- Overlapping commands are up/down so handle those just via list, otherwise both
  let handle_form = nestEventM' form (handleFormEvent e)
      handle_list =
        case e of
          VtyEvent vty_e -> nestEventM' cmd_list (handleListEvent vty_e)
          _ -> return cmd_list
      k form' cmd_list' =
        if (formState form /= formState form') then do
            let filter_string = formState form'
                new_elems = Seq.filter (\cmd -> fuzzyMatcher filter_string (_listPickerDescription picker cmd)) orig_cmds
                cmd_list'' = cmd_list'
                                  & listElementsL .~ new_elems
                                  & listSelectedL .~ if Seq.null new_elems then Nothing else Just 0
            pure $ Changed $ picker
              & listPickerInput .~ form'
              & listPickerElements .~ cmd_list''
          else
            pure $ Changed $ picker
              & listPickerInput .~ form'
              & listPickerElements .~ cmd_list'

  case e of
    VtyEvent (Vty.EvKey Vty.KUp _) -> do
      list' <- handle_list
      k form list'
    VtyEvent (Vty.EvKey Vty.KDown _) -> do
      list' <- handle_list
      k form list'
    VtyEvent (Vty.EvKey Vty.KEsc _) -> do
      pure Exit
    VtyEvent (Vty.EvKey Vty.KEnter _) -> do
      case listSelectedElement cmd_list of
        Just (_, cmd) -> do
          _listPickerSelect picker cmd
        Nothing  ->
          pure Unchanged
    _ -> do
      form' <- handle_form
      list' <- handle_list
      k form' list'
  where
    form = _listPickerInput picker
    cmd_list = _listPickerElements picker
    orig_cmds = _listPickerAllElements picker

-- | Check whether the search string occurs with sufficient likelihood in the
-- given string.
fuzzyMatcher :: Text -> Text -> Bool
fuzzyMatcher filterString haystack =
  -- TODO: This should be a fuzzy search, not 'Text.isInfixOf'
  Text.toLower filterString `Text.isInfixOf` Text.toLower haystack

withHighlighting :: ListPicker name state ev element -> Widget n -> Widget n
withHighlighting picker = forceAttr (_listPickerHighlightAttrName picker)