module Matterhorn.Events.ChannelListWindow
  ( onEventChannelListWindow
  , channelListWindowKeybindings
  , channelListWindowKeyHandlers
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Keybindings
import qualified Graphics.Vty as Vty

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.State.ChannelListWindow
import           Matterhorn.State.ListWindow
import           Matterhorn.Types


onEventChannelListWindow :: TeamId -> Vty.Event -> MH ()
onEventChannelListWindow :: TeamId -> Event -> MH ()
onEventChannelListWindow TeamId
tId =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Lens' ChatState (ListWindowState a b)
-> (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event
-> MH Bool
onEventListWindow (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (ListWindowState Channel ChannelSearchScope)
tsChannelListWindow) (TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
channelListWindowKeybindings TeamId
tId)

-- | The keybindings we want to use while viewing a channel list window
channelListWindowKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
channelListWindowKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
channelListWindowKeybindings TeamId
tId KeyConfig KeyEvent
kc = forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (TeamId -> [MHKeyEventHandler]
channelListWindowKeyHandlers TeamId
tId)

channelListWindowKeyHandlers :: TeamId -> [MHKeyEventHandler]
channelListWindowKeyHandlers :: TeamId -> [MHKeyEventHandler]
channelListWindowKeyHandlers TeamId
tId =
    [ forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
CancelEvent Text
"Close the channel search list" (forall a b.
TeamId -> Lens' ChatState (ListWindowState a b) -> MH ()
exitListWindow TeamId
tId (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (ListWindowState Channel ChannelSearchScope)
tsChannelListWindow))
    , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
SearchSelectUpEvent Text
"Select the previous channel" forall a b. (a -> b) -> a -> b
$ TeamId -> MH ()
channelListSelectUp TeamId
tId
    , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
SearchSelectDownEvent Text
"Select the next channel" forall a b. (a -> b) -> a -> b
$ TeamId -> MH ()
channelListSelectDown TeamId
tId
    , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageDownEvent Text
"Page down in the channel list" forall a b. (a -> b) -> a -> b
$ TeamId -> MH ()
channelListPageDown TeamId
tId
    , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageUpEvent Text
"Page up in the channel list" forall a b. (a -> b) -> a -> b
$ TeamId -> MH ()
channelListPageUp TeamId
tId
    , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ActivateListItemEvent Text
"Join the selected channel" (forall a b.
TeamId -> Lens' ChatState (ListWindowState a b) -> MH ()
listWindowActivateCurrent TeamId
tId (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (ListWindowState Channel ChannelSearchScope)
tsChannelListWindow))
    ]