module Matterhorn.State.ChannelTopicWindow
  ( openChannelTopicWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Lens.Micro.Platform ( (.=) )

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


openChannelTopicWindow :: MH ()
openChannelTopicWindow :: MH ()
openChannelTopicWindow = do
    Text
t <- MH Text
getCurrentChannelTopic
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((ChannelTopicDialogState -> Identity ChannelTopicDialogState)
    -> TeamState -> Identity TeamState)
-> (ChannelTopicDialogState -> Identity ChannelTopicDialogState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelTopicDialogState -> Identity ChannelTopicDialogState)
-> TeamState -> Identity TeamState
Lens' TeamState ChannelTopicDialogState
tsChannelTopicDialog ((ChannelTopicDialogState -> Identity ChannelTopicDialogState)
 -> ChatState -> Identity ChatState)
-> ChannelTopicDialogState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TeamId -> Text -> ChannelTopicDialogState
newChannelTopicDialog TeamId
tId Text
t
    Mode -> MH ()
setMode Mode
ChannelTopicWindow