module Matterhorn.Events.DeleteChannelConfirm where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Graphics.Vty as Vty

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.Types
import           Matterhorn.State.Channels


onEventDeleteChannelConfirm :: TeamId -> Vty.Event -> MH ()
onEventDeleteChannelConfirm :: TeamId -> Event -> MH ()
onEventDeleteChannelConfirm TeamId
tId (Vty.EvKey Key
k []) = do
    case Key
k of
        Vty.KChar Char
c | Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"yY"::String) ->
            TeamId -> MH ()
deleteCurrentChannel TeamId
tId
        Key
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    TeamId -> MH ()
popMode TeamId
tId
onEventDeleteChannelConfirm TeamId
_ (Vty.EvResize {}) = do
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
onEventDeleteChannelConfirm TeamId
tId Event
_ = do
    TeamId -> MH ()
popMode TeamId
tId