-- |
-- Module      :  Swarm.TUI.List
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A special modified version of 'Brick.Widgets.List.handleListEvent'
-- to deal with skipping over separators.
module Swarm.TUI.List (handleListEventWithSeparators) where

import Brick (EventM)
import Brick.Widgets.List qualified as BL
import Control.Lens (set, (&), (^.))
import Control.Monad.State.Strict (modify)
import Data.Foldable (toList)
import Data.List (find)
import Graphics.Vty qualified as V

-- | Handle a list event, taking an extra predicate to identify which
--   list elements are separators; separators will be skipped if
--   possible.
handleListEventWithSeparators ::
  (Foldable t, BL.Splittable t, Ord n) =>
  V.Event ->
  -- | Is this element a separator?
  (e -> Bool) ->
  EventM n (BL.GenericList n t e) ()
handleListEventWithSeparators :: forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> (e -> Bool) -> EventM n (GenericList n t e) ()
handleListEventWithSeparators Event
e e -> Bool
isSep =
  case Event
e of
    V.EvKey Key
V.KUp [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall {n}. GenericList n t e -> GenericList n t e
backward
    V.EvKey (V.KChar Char
'k') [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall {n}. GenericList n t e -> GenericList n t e
backward
    V.EvKey Key
V.KDown [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall {n}. GenericList n t e -> GenericList n t e
forward
    V.EvKey (V.KChar Char
'j') [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall {n}. GenericList n t e -> GenericList n t e
forward
    V.EvKey Key
V.KHome [] ->
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
FindStrategy
-> (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindByStrategy FindStrategy
fwdInclusive e -> Bool
isItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
BL.listMoveToBeginning
    V.EvKey Key
V.KEnd [] ->
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
FindStrategy
-> (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindByStrategy FindStrategy
bwdInclusive e -> Bool
isItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
BL.listMoveToEnd
    V.EvKey Key
V.KPageDown [] -> do
      forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
BL.listMovePageDown
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
FindStrategy
-> (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindByStrategy FindStrategy
bwdInclusive e -> Bool
isItem
    V.EvKey Key
V.KPageUp [] -> do
      forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
BL.listMovePageUp
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
FindStrategy
-> (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindByStrategy FindStrategy
fwdInclusive e -> Bool
isItem
    Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  isItem :: e -> Bool
isItem = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Bool
isSep
  backward :: GenericList n t e -> GenericList n t e
backward = forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
FindStrategy
-> (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindByStrategy FindStrategy
bwdExclusive e -> Bool
isItem
  forward :: GenericList n t e -> GenericList n t e
forward = forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
FindStrategy
-> (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindByStrategy FindStrategy
fwdExclusive e -> Bool
isItem

-- | Which direction to search: forward or backward from the current location.
data FindDir = FindFwd | FindBwd deriving (FindDir -> FindDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FindDir -> FindDir -> Bool
$c/= :: FindDir -> FindDir -> Bool
== :: FindDir -> FindDir -> Bool
$c== :: FindDir -> FindDir -> Bool
Eq, Eq FindDir
FindDir -> FindDir -> Bool
FindDir -> FindDir -> Ordering
FindDir -> FindDir -> FindDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FindDir -> FindDir -> FindDir
$cmin :: FindDir -> FindDir -> FindDir
max :: FindDir -> FindDir -> FindDir
$cmax :: FindDir -> FindDir -> FindDir
>= :: FindDir -> FindDir -> Bool
$c>= :: FindDir -> FindDir -> Bool
> :: FindDir -> FindDir -> Bool
$c> :: FindDir -> FindDir -> Bool
<= :: FindDir -> FindDir -> Bool
$c<= :: FindDir -> FindDir -> Bool
< :: FindDir -> FindDir -> Bool
$c< :: FindDir -> FindDir -> Bool
compare :: FindDir -> FindDir -> Ordering
$ccompare :: FindDir -> FindDir -> Ordering
Ord, Int -> FindDir -> ShowS
[FindDir] -> ShowS
FindDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FindDir] -> ShowS
$cshowList :: [FindDir] -> ShowS
show :: FindDir -> String
$cshow :: FindDir -> String
showsPrec :: Int -> FindDir -> ShowS
$cshowsPrec :: Int -> FindDir -> ShowS
Show, Int -> FindDir
FindDir -> Int
FindDir -> [FindDir]
FindDir -> FindDir
FindDir -> FindDir -> [FindDir]
FindDir -> FindDir -> FindDir -> [FindDir]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FindDir -> FindDir -> FindDir -> [FindDir]
$cenumFromThenTo :: FindDir -> FindDir -> FindDir -> [FindDir]
enumFromTo :: FindDir -> FindDir -> [FindDir]
$cenumFromTo :: FindDir -> FindDir -> [FindDir]
enumFromThen :: FindDir -> FindDir -> [FindDir]
$cenumFromThen :: FindDir -> FindDir -> [FindDir]
enumFrom :: FindDir -> [FindDir]
$cenumFrom :: FindDir -> [FindDir]
fromEnum :: FindDir -> Int
$cfromEnum :: FindDir -> Int
toEnum :: Int -> FindDir
$ctoEnum :: Int -> FindDir
pred :: FindDir -> FindDir
$cpred :: FindDir -> FindDir
succ :: FindDir -> FindDir
$csucc :: FindDir -> FindDir
Enum)

-- | Should we include or exclude the current location in the search?
data FindStart = IncludeCurrent | ExcludeCurrent deriving (FindStart -> FindStart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FindStart -> FindStart -> Bool
$c/= :: FindStart -> FindStart -> Bool
== :: FindStart -> FindStart -> Bool
$c== :: FindStart -> FindStart -> Bool
Eq, Eq FindStart
FindStart -> FindStart -> Bool
FindStart -> FindStart -> Ordering
FindStart -> FindStart -> FindStart
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FindStart -> FindStart -> FindStart
$cmin :: FindStart -> FindStart -> FindStart
max :: FindStart -> FindStart -> FindStart
$cmax :: FindStart -> FindStart -> FindStart
>= :: FindStart -> FindStart -> Bool
$c>= :: FindStart -> FindStart -> Bool
> :: FindStart -> FindStart -> Bool
$c> :: FindStart -> FindStart -> Bool
<= :: FindStart -> FindStart -> Bool
$c<= :: FindStart -> FindStart -> Bool
< :: FindStart -> FindStart -> Bool
$c< :: FindStart -> FindStart -> Bool
compare :: FindStart -> FindStart -> Ordering
$ccompare :: FindStart -> FindStart -> Ordering
Ord, Int -> FindStart -> ShowS
[FindStart] -> ShowS
FindStart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FindStart] -> ShowS
$cshowList :: [FindStart] -> ShowS
show :: FindStart -> String
$cshow :: FindStart -> String
showsPrec :: Int -> FindStart -> ShowS
$cshowsPrec :: Int -> FindStart -> ShowS
Show, Int -> FindStart
FindStart -> Int
FindStart -> [FindStart]
FindStart -> FindStart
FindStart -> FindStart -> [FindStart]
FindStart -> FindStart -> FindStart -> [FindStart]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FindStart -> FindStart -> FindStart -> [FindStart]
$cenumFromThenTo :: FindStart -> FindStart -> FindStart -> [FindStart]
enumFromTo :: FindStart -> FindStart -> [FindStart]
$cenumFromTo :: FindStart -> FindStart -> [FindStart]
enumFromThen :: FindStart -> FindStart -> [FindStart]
$cenumFromThen :: FindStart -> FindStart -> [FindStart]
enumFrom :: FindStart -> [FindStart]
$cenumFrom :: FindStart -> [FindStart]
fromEnum :: FindStart -> Int
$cfromEnum :: FindStart -> Int
toEnum :: Int -> FindStart
$ctoEnum :: Int -> FindStart
pred :: FindStart -> FindStart
$cpred :: FindStart -> FindStart
succ :: FindStart -> FindStart
$csucc :: FindStart -> FindStart
Enum)

-- | A 'FindStrategy' is a pair of a 'FindDir' and a 'FindStart'.
data FindStrategy = FindStrategy FindDir FindStart

-- | Some convenient synonyms for various 'FindStrategy' values.
fwdInclusive, fwdExclusive, bwdInclusive, bwdExclusive :: FindStrategy
fwdInclusive :: FindStrategy
fwdInclusive = FindDir -> FindStart -> FindStrategy
FindStrategy FindDir
FindFwd FindStart
IncludeCurrent
fwdExclusive :: FindStrategy
fwdExclusive = FindDir -> FindStart -> FindStrategy
FindStrategy FindDir
FindFwd FindStart
ExcludeCurrent
bwdInclusive :: FindStrategy
bwdInclusive = FindDir -> FindStart -> FindStrategy
FindStrategy FindDir
FindBwd FindStart
IncludeCurrent
bwdExclusive :: FindStrategy
bwdExclusive = FindDir -> FindStart -> FindStrategy
FindStrategy FindDir
FindBwd FindStart
ExcludeCurrent

-- | Starting from the currently selected element, attempt to find and
--   select the next element matching the predicate. How the search
--   proceeds depends on the 'FindStrategy': the 'FindDir' says
--   whether to search forward or backward from the selected element,
--   and the 'FindStart' says whether the currently selected element
--   should be included in the search or not.
listFindByStrategy ::
  (Foldable t, BL.Splittable t) =>
  FindStrategy ->
  (e -> Bool) ->
  BL.GenericList n t e ->
  BL.GenericList n t e
listFindByStrategy :: forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
FindStrategy
-> (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindByStrategy (FindStrategy FindDir
dir FindStart
cur) e -> Bool
test GenericList n t e
l =
  -- Figure out what index to split on.  We will call splitAt on
  -- (current selected index + adj).
  let adj :: Int
adj =
        -- If we're search forward, split on current index; if
        -- finding backward, split on current + 1 (so that the
        -- left-hand split will include the current index).
        case FindDir
dir of FindDir
FindFwd -> Int
0; FindDir
FindBwd -> Int
1
          -- ... but if we're excluding the current index, swap that, so
          -- the current index will be excluded rather than included in
          -- the part of the split we're going to look at.
          forall a b. a -> (a -> b) -> b
& case FindStart
cur of FindStart
IncludeCurrent -> forall a. a -> a
id; FindStart
ExcludeCurrent -> (Int
1 forall a. Num a => a -> a -> a
-)

      -- Split at the index we computed.
      start :: Int
start = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
+ Int
adj) (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)
BL.listSelectedL)
      (t e
h, t e
t) = forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
BL.splitAt Int
start (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)
BL.listElementsL)

      -- Now look at either the right-hand split if searching
      -- forward, or the reversed left-hand split if searching
      -- backward.
      headResult :: Maybe (Int, e)
headResult = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ t e
h
      tailResult :: Maybe (Int, e)
tailResult = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
start ..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ t e
t
      result :: Maybe (Int, e)
result = case FindDir
dir of FindDir
FindFwd -> Maybe (Int, e)
tailResult; FindDir
FindBwd -> Maybe (Int, e)
headResult
   in forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall s t a b. ASetter s t a b -> b -> s -> t
set forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
BL.listSelectedL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (Int, e)
result GenericList n t e
l