{-# LANGUAGE RankNTypes #-}
module Matterhorn.Events.TabbedWindow
  ( handleTabbedWindowEvent
  , tabbedWindowKeybindings
  , tabbedWindowKeyHandlers
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( Lens', (.=) )

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.Types
import           Matterhorn.Types.KeyEvents
import           Matterhorn.Events.Keybindings

handleTabbedWindowEvent :: (Show a, Eq a)
                        => Lens' ChatState (TabbedWindow ChatState MH Name a)
                        -> TeamId
                        -> Vty.Event
                        -> MH Bool
handleTabbedWindowEvent :: Lens' ChatState (TabbedWindow ChatState MH Name a)
-> TeamId -> Event -> MH Bool
handleTabbedWindowEvent Lens' ChatState (TabbedWindow ChatState MH Name a)
target TeamId
tId Event
e = do
    TabbedWindow ChatState MH Name a
w <- Getting
  (TabbedWindow ChatState MH Name a)
  ChatState
  (TabbedWindow ChatState MH Name a)
-> MH (TabbedWindow ChatState MH Name a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (TabbedWindow ChatState MH Name a)
  ChatState
  (TabbedWindow ChatState MH Name a)
Lens' ChatState (TabbedWindow ChatState MH Name a)
target
    [Event -> MH Bool] -> Event -> MH Bool
handleEventWith [ (KeyConfig -> KeyHandlerMap) -> Event -> MH Bool
handleKeyboardEvent (Lens' ChatState (TabbedWindow ChatState MH Name a)
-> TeamId -> KeyConfig -> KeyHandlerMap
forall a.
(Show a, Eq a) =>
Lens' ChatState (TabbedWindow ChatState MH Name a)
-> TeamId -> KeyConfig -> KeyHandlerMap
tabbedWindowKeybindings Lens' ChatState (TabbedWindow ChatState MH Name a)
target TeamId
tId)
                    , \Event
_ -> TabbedWindow ChatState MH Name a -> Event -> MH ()
forall a s n.
(Show a, Eq a) =>
TabbedWindow s MH n a -> Event -> MH ()
forwardEvent TabbedWindow ChatState MH Name a
w Event
e MH () -> MH Bool -> MH Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                    ] Event
e

forwardEvent :: (Show a, Eq a)
             => TabbedWindow s MH n a
             -> Vty.Event
             -> MH ()
forwardEvent :: TabbedWindow s MH n a -> Event -> MH ()
forwardEvent TabbedWindow s MH n a
w Event
e = do
    let cur :: TabbedWindowEntry s MH n a
cur = TabbedWindow s MH n a -> TabbedWindowEntry s MH n a
forall a s (m :: * -> *) n.
(Show a, Eq a) =>
TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow s MH n a
w
    TabbedWindowEntry s MH n a -> a -> Event -> MH ()
forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> Event -> m ()
tweHandleEvent TabbedWindowEntry s MH n a
cur (TabbedWindow s MH n a -> a
forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow s MH n a
w) Event
e

tabbedWindowKeybindings :: (Show a, Eq a)
                        => Lens' ChatState (TabbedWindow ChatState MH Name a)
                        -> TeamId
                        -> KeyConfig
                        -> KeyHandlerMap
tabbedWindowKeybindings :: Lens' ChatState (TabbedWindow ChatState MH Name a)
-> TeamId -> KeyConfig -> KeyHandlerMap
tabbedWindowKeybindings Lens' ChatState (TabbedWindow ChatState MH Name a)
target TeamId
tId = [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings ([KeyEventHandler] -> KeyConfig -> KeyHandlerMap)
-> [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
forall a b. (a -> b) -> a -> b
$ TeamId
-> Lens' ChatState (TabbedWindow ChatState MH Name a)
-> [KeyEventHandler]
forall a.
(Show a, Eq a) =>
TeamId
-> Lens' ChatState (TabbedWindow ChatState MH Name a)
-> [KeyEventHandler]
tabbedWindowKeyHandlers TeamId
tId Lens' ChatState (TabbedWindow ChatState MH Name a)
target

tabbedWindowKeyHandlers :: (Show a, Eq a)
                        => TeamId
                        -> Lens' ChatState (TabbedWindow ChatState MH Name a)
                        -> [KeyEventHandler]
tabbedWindowKeyHandlers :: TeamId
-> Lens' ChatState (TabbedWindow ChatState MH Name a)
-> [KeyEventHandler]
tabbedWindowKeyHandlers TeamId
tId Lens' ChatState (TabbedWindow ChatState MH Name a)
target =
    [ KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
CancelEvent Text
"Close window" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        TeamId -> MH ()
popMode TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
SelectNextTabEvent Text
"Select next tab" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
        TabbedWindow ChatState MH Name a
w' <- TabbedWindow ChatState MH Name a
-> MH (TabbedWindow ChatState MH Name a)
forall (m :: * -> *) a s n.
(Monad m, Show a, Eq a) =>
TabbedWindow s m n a -> m (TabbedWindow s m n a)
tabbedWindowNextTab (TabbedWindow ChatState MH Name a
 -> MH (TabbedWindow ChatState MH Name a))
-> MH (TabbedWindow ChatState MH Name a)
-> MH (TabbedWindow ChatState MH Name a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting
  (TabbedWindow ChatState MH Name a)
  ChatState
  (TabbedWindow ChatState MH Name a)
-> MH (TabbedWindow ChatState MH Name a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (TabbedWindow ChatState MH Name a)
  ChatState
  (TabbedWindow ChatState MH Name a)
Lens' ChatState (TabbedWindow ChatState MH Name a)
target
        (TabbedWindow ChatState MH Name a
 -> Identity (TabbedWindow ChatState MH Name a))
-> ChatState -> Identity ChatState
Lens' ChatState (TabbedWindow ChatState MH Name a)
target ((TabbedWindow ChatState MH Name a
  -> Identity (TabbedWindow ChatState MH Name a))
 -> ChatState -> Identity ChatState)
-> TabbedWindow ChatState MH Name a -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TabbedWindow ChatState MH Name a
w'

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
SelectPreviousTabEvent Text
"Select previous tab" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
        TabbedWindow ChatState MH Name a
w' <- TabbedWindow ChatState MH Name a
-> MH (TabbedWindow ChatState MH Name a)
forall (m :: * -> *) a s n.
(Monad m, Show a, Eq a) =>
TabbedWindow s m n a -> m (TabbedWindow s m n a)
tabbedWindowPreviousTab (TabbedWindow ChatState MH Name a
 -> MH (TabbedWindow ChatState MH Name a))
-> MH (TabbedWindow ChatState MH Name a)
-> MH (TabbedWindow ChatState MH Name a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting
  (TabbedWindow ChatState MH Name a)
  ChatState
  (TabbedWindow ChatState MH Name a)
-> MH (TabbedWindow ChatState MH Name a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (TabbedWindow ChatState MH Name a)
  ChatState
  (TabbedWindow ChatState MH Name a)
Lens' ChatState (TabbedWindow ChatState MH Name a)
target
        (TabbedWindow ChatState MH Name a
 -> Identity (TabbedWindow ChatState MH Name a))
-> ChatState -> Identity ChatState
Lens' ChatState (TabbedWindow ChatState MH Name a)
target ((TabbedWindow ChatState MH Name a
  -> Identity (TabbedWindow ChatState MH Name a))
 -> ChatState -> Identity ChatState)
-> TabbedWindow ChatState MH Name a -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TabbedWindow ChatState MH Name a
w'
    ]