module Matterhorn.Events.ChannelTopicWindow
  ( onEventChannelTopicWindow
  , channelTopicWindowMouseHandler
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick ( BrickEvent(VtyEvent, MouseDown) )
import           Brick.Focus
import           Brick.Widgets.Edit ( handleEditorEvent, getEditContents )
import qualified Data.Text as T
import           Lens.Micro.Platform ( (%=) )
import qualified Graphics.Vty as Vty

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.Types
import           Matterhorn.State.Channels ( setChannelTopic )


onEventChannelTopicWindow :: TeamId -> Vty.Event -> MH ()
onEventChannelTopicWindow :: TeamId -> Event -> MH ()
onEventChannelTopicWindow TeamId
tId (Vty.EvKey (Vty.KChar Char
'\t') []) =
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelTopicDialogState (FocusRing Name)
channelTopicDialogFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
onEventChannelTopicWindow TeamId
tId (Vty.EvKey Key
Vty.KBackTab []) =
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelTopicDialogState (FocusRing Name)
channelTopicDialogFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
onEventChannelTopicWindow TeamId
tId e :: Event
e@(Vty.EvKey Key
Vty.KEnter []) = do
    FocusRing Name
f <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelTopicDialogState (FocusRing Name)
channelTopicDialogFocus)
    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
f of
        Just (ChannelTopicSaveButton {}) -> do
            TeamId -> MH ()
doSaveTopic TeamId
tId
        Just (ChannelTopicEditor {}) ->
            forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelTopicDialogState (Editor Text Name)
channelTopicDialogEditor)
                                forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
        Just (ChannelTopicCancelButton {}) ->
            TeamId -> MH ()
doCancelTopicEdit TeamId
tId
        Maybe Name
_ ->
            TeamId -> MH ()
popMode TeamId
tId
onEventChannelTopicWindow TeamId
tId (Vty.EvKey Key
Vty.KEsc []) = do
    TeamId -> MH ()
popMode TeamId
tId
onEventChannelTopicWindow TeamId
tId Event
e = do
    FocusRing Name
f <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelTopicDialogState (FocusRing Name)
channelTopicDialogFocus)
    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
f of
        Just (ChannelTopicEditor {}) ->
            forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelTopicDialogState (Editor Text Name)
channelTopicDialogEditor)
                                forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
        Maybe Name
_ ->
            forall (m :: * -> *) a. Monad m => a -> m a
return ()

channelTopicWindowMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
channelTopicWindowMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
channelTopicWindowMouseHandler TeamId
tId (MouseDown (ChannelTopicSaveButton {}) Button
_ [Modifier]
_ Location
_) = TeamId -> MH ()
doSaveTopic TeamId
tId
channelTopicWindowMouseHandler TeamId
tId (MouseDown (ChannelTopicCancelButton {}) Button
_ [Modifier]
_ Location
_) = TeamId -> MH ()
doCancelTopicEdit TeamId
tId
channelTopicWindowMouseHandler TeamId
_ BrickEvent Name MHEvent
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

doSaveTopic :: TeamId -> MH ()
doSaveTopic :: TeamId -> MH ()
doSaveTopic TeamId
tId = do
    Editor Text Name
ed <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelTopicDialogState (Editor Text Name)
channelTopicDialogEditor)
    let topic :: Text
topic = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
ed
    TeamId -> Text -> MH ()
setChannelTopic TeamId
tId Text
topic
    TeamId -> MH ()
popMode TeamId
tId

doCancelTopicEdit :: TeamId -> MH ()
doCancelTopicEdit :: TeamId -> MH ()
doCancelTopicEdit TeamId
tId = TeamId -> MH ()
popMode TeamId
tId