{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
module Matterhorn.State.Channels
  ( updateViewed
  , refreshChannel
  , refreshChannelsAndUsers
  , setFocus
  , refreshChannelById
  , applyPreferenceChange
  , leaveChannel
  , leaveCurrentChannel
  , getNextUnreadChannel
  , getNextUnreadUserOrChannel
  , nextUnreadChannel
  , nextUnreadUserOrChannel
  , createOrFocusDMChannel
  , prevChannel
  , nextChannel
  , recentChannel
  , setReturnChannel
  , resetReturnChannel
  , hideDMChannel
  , createGroupChannel
  , showGroupChannelPref
  , channelHistoryForward
  , channelHistoryBackward
  , handleNewChannel
  , createOrdinaryChannel
  , handleChannelInvite
  , addUserByNameToCurrentChannel
  , addUserToCurrentChannel
  , removeUserFromCurrentChannel
  , removeChannelFromState
  , isRecentChannel
  , isReturnChannel
  , isCurrentChannel
  , deleteCurrentChannel
  , startLeaveCurrentChannel
  , joinChannel
  , joinChannel'
  , joinChannelByName
  , changeChannelByName
  , setChannelTopic
  , getCurrentChannelTopic
  , beginCurrentChannelDeleteConfirm
  , toggleExpandedChannelTopics
  , updateChannelNotifyProps
  , renameChannelUrl
  , toggleChannelFavoriteStatus
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( viewportScroll, vScrollToBeginning
                            , invalidateCache, invalidateCacheEntry )
import           Brick.Widgets.Edit ( applyEdit, getEditContents, editContentsL )
import           Control.Concurrent.Async ( runConcurrently, Concurrently(..) )
import           Control.Exception ( SomeException, try )
import           Data.Char ( isAlphaNum )
import qualified Data.HashMap.Strict as HM
import qualified Data.Foldable as F
import           Data.List ( nub )
import           Data.Maybe ( fromJust )
import qualified Data.Set as S
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import           Data.Text.Zipper ( textZipper, clearZipper, insertMany, gotoEOL )
import           Data.Time.Clock ( getCurrentTime )
import           Lens.Micro.Platform

import qualified Network.Mattermost.Endpoints as MM
import           Network.Mattermost.Lenses
import           Network.Mattermost.Types

import           Matterhorn.Constants ( normalChannelSigil )
import           Matterhorn.InputHistory
import           Matterhorn.State.Common
import {-# SOURCE #-} Matterhorn.State.Messages ( fetchVisibleIfNeeded )
import           Matterhorn.State.ChannelList
import           Matterhorn.State.Users
import           Matterhorn.State.Flagging
import           Matterhorn.Types
import           Matterhorn.Types.Common
import           Matterhorn.Zipper ( Zipper )
import qualified Matterhorn.Zipper as Z


updateViewed :: Bool -> MH ()
updateViewed :: Bool -> MH ()
updateViewed Bool
updatePrev = do
    (ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Int -> Identity Int)
    -> ClientChannel -> Identity ClientChannel)
-> (Int -> Identity Int)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Int -> Identity Int) -> ChannelInfo -> Identity ChannelInfo)
-> (Int -> Identity Int)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo Int
cdMentionCount ((Int -> Identity Int) -> ChatState -> Identity ChatState)
-> Int -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
    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
    Bool -> ChannelId -> MH ()
updateViewedChan Bool
updatePrev (ChannelId -> MH ()) -> MH ChannelId -> MH ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)

-- | When a new channel has been selected for viewing, this will
-- notify the server of the change, and also update the local channel
-- state to set the last-viewed time for the previous channel and
-- update the viewed time to now for the newly selected channel.
--
-- The boolean argument indicates whether the view time of the previous
-- channel (if any) should be updated, too. We typically want to do that
-- only on channel switching; when we just want to update the view time
-- of the specified channel, False should be provided.
updateViewedChan :: Bool -> ChannelId -> MH ()
updateViewedChan :: Bool -> ChannelId -> MH ()
updateViewedChan Bool
updatePrev ChannelId
cId = Getting ConnectionStatus ChatState ConnectionStatus
-> MH ConnectionStatus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ConnectionStatus ChatState ConnectionStatus
Lens' ChatState ConnectionStatus
csConnectionStatus MH ConnectionStatus -> (ConnectionStatus -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- Only do this if we're connected to avoid triggering noisy
    -- exceptions.
    ConnectionStatus
Connected -> do
        ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
            Maybe ChannelId
pId <- if Bool
updatePrev
                   then do
                       case ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
                           Just TeamId
tId -> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsRecentChannel)
                           Maybe TeamId
Nothing -> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsRecentChannel)
                   else Maybe ChannelId -> MH (Maybe ChannelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
forall a. Maybe a
Nothing
            DoAsyncChannelMM ()
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
              (\Session
s ChannelId
c -> UserParam -> ChannelId -> Maybe ChannelId -> Session -> IO ()
MM.mmViewChannel UserParam
UserMe ChannelId
c Maybe ChannelId
pId Session
s)
              (\ChannelId
c () -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ Maybe ChannelId -> ChannelId -> MH ()
setLastViewedFor Maybe ChannelId
pId ChannelId
c)
    ConnectionStatus
Disconnected ->
        -- Cannot update server; make no local updates to avoid getting
        -- out of sync with the server. Assumes that this is a temporary
        -- break in connectivity and that after the connection is
        -- restored, the user's normal activities will update state as
        -- appropriate. If connectivity is permanently lost, managing
        -- this state is irrelevant.
        () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

toggleExpandedChannelTopics :: MH ()
toggleExpandedChannelTopics :: MH ()
toggleExpandedChannelTopics = do
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
    (ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
 -> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
    -> ChatResources -> Identity ChatResources)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Identity Config)
-> ChatResources -> Identity ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Identity Config)
 -> ChatResources -> Identity ChatResources)
-> ((Bool -> Identity Bool) -> Config -> Identity Config)
-> (Bool -> Identity Bool)
-> ChatResources
-> Identity ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
configShowExpandedChannelTopicsL ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> (Bool -> Bool) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not

-- | If the current channel is a DM channel with a single user or a
-- group of users, hide it from the sidebar and adjust the server-side
-- preference to hide it persistently. Note that this does not actually
-- hide the channel in our UI; we hide it in response to the preference
-- change websocket event triggered by this function's API interaction
-- with the server.
--
-- If the current channel is any other kind of channel, complain with a
-- usage error.
hideDMChannel :: ChannelId -> MH ()
hideDMChannel :: ChannelId -> MH ()
hideDMChannel ChannelId
cId = do
    User
me <- (ChatState -> User) -> MH User
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
    Session
session <- MH Session
getSession
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
        case ClientChannel
chanClientChannel -> Getting Type ClientChannel Type -> Type
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Getting Type ClientChannel Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType of
            Type
Direct -> do
                let pref :: Preference
pref = UserId -> UserId -> Bool -> Preference
showDirectChannelPref (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL) UserId
uId Bool
False
                    Just UserId
uId = ClientChannel
chanClientChannel
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
-> Maybe UserId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> ClientChannel -> Const (Maybe UserId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe UserId) ChannelInfo)
 -> ClientChannel -> Const (Maybe UserId) ClientChannel)
-> ((Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
    -> ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
-> ChannelInfo -> Const (Maybe UserId) ChannelInfo
Lens' ChannelInfo (Maybe UserId)
cdDMUserId
                ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ClientChannel -> Identity ClientChannel)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ChannelInfo -> Identity ChannelInfo)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride ((Maybe UTCTime -> Identity (Maybe UTCTime))
 -> ChatState -> Identity ChatState)
-> Maybe UTCTime -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe UTCTime
forall a. Maybe a
Nothing
                AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                    UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
                    Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
            Type
Group -> do
                let pref :: Preference
pref = ChannelId -> UserId -> Preference
hideGroupChannelPref ChannelId
cId (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL)
                ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ClientChannel -> Identity ClientChannel)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ChannelInfo -> Identity ChannelInfo)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride ((Maybe UTCTime -> Identity (Maybe UTCTime))
 -> ChatState -> Identity ChatState)
-> Maybe UTCTime -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe UTCTime
forall a. Maybe a
Nothing
                AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                    UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
                    Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
            Type
_ -> do
                MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
"Cannot hide this channel. Consider using /leave instead."

-- | Called on async completion when the currently viewed channel has
-- been updated (i.e., just switched to this channel) to update local
-- state.
setLastViewedFor :: Maybe ChannelId -> ChannelId -> MH ()
setLastViewedFor :: Maybe ChannelId -> ChannelId -> MH ()
setLastViewedFor Maybe ChannelId
prevId ChannelId
cId = do
    Maybe ClientChannel
chan <- Getting (Maybe ClientChannel) ChatState (Maybe ClientChannel)
-> MH (Maybe ClientChannel)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ClientChannels -> Const (Maybe ClientChannel) ClientChannels)
-> ChatState -> Const (Maybe ClientChannel) ChatState
Lens' ChatState ClientChannels
csChannels((ClientChannels -> Const (Maybe ClientChannel) ClientChannels)
 -> ChatState -> Const (Maybe ClientChannel) ChatState)
-> ((Maybe ClientChannel
     -> Const (Maybe ClientChannel) (Maybe ClientChannel))
    -> ClientChannels -> Const (Maybe ClientChannel) ClientChannels)
-> Getting (Maybe ClientChannel) ChatState (Maybe ClientChannel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ClientChannels -> Maybe ClientChannel)
-> SimpleGetter ClientChannels (Maybe ClientChannel)
forall s a. (s -> a) -> SimpleGetter s a
to (ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId))
    -- Update new channel's viewed time, creating the channel if needed
    case Maybe ClientChannel
chan of
        Maybe ClientChannel
Nothing ->
            -- It's possible for us to get spurious WMChannelViewed
            -- events from the server, e.g. for channels that have been
            -- deleted. So here we ignore the request since it's hard to
            -- detect it before this point.
            () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ClientChannel
_  ->
          -- The server has been sent a viewed POST update, but there is
          -- no local information on what timestamp the server actually
          -- recorded. There are a couple of options for setting the
          -- local value of the viewed time:
          --
          --   1. Attempting to locally construct a value, which would
          --      involve scanning all (User) messages in the channel
          --      to find the maximum of the created date, the modified
          --      date, or the deleted date, and assuming that maximum
          --      mostly matched the server's viewed time.
          --
          --   2. Issuing a channel metadata request to get the server's
          --      new concept of the viewed time.
          --
          --   3. Having the "chan/viewed" POST that was just issued
          --      return a value from the server. See
          --      https://github.com/mattermost/platform/issues/6803.
          --
          -- Method 3 would be the best and most lightweight. Until that
          -- is available, Method 2 will be used. The downside to Method
          -- 2 is additional client-server messaging, and a delay in
          -- updating the client data, but it's also immune to any new
          -- or removed Message date fields, or anything else that would
          -- contribute to the viewed/updated times on the server.
          DoAsyncChannelMM (Channel, ChannelMember)
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId (\ Session
s ChannelId
_ ->
                                           (,) (Channel -> ChannelMember -> (Channel, ChannelMember))
-> IO Channel -> IO (ChannelMember -> (Channel, ChannelMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChannelId -> Session -> IO Channel
MM.mmGetChannel ChannelId
cId Session
s
                                               IO (ChannelMember -> (Channel, ChannelMember))
-> IO ChannelMember -> IO (Channel, ChannelMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember ChannelId
cId UserParam
UserMe Session
s)
          (\ChannelId
pcid (Channel
cwd, ChannelMember
member) -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
pcid)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((ChannelInfo -> Identity ChannelInfo)
    -> ClientChannel -> Identity ClientChannel)
-> (ChannelInfo -> Identity ChannelInfo)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo ((ChannelInfo -> Identity ChannelInfo)
 -> ChatState -> Identity ChatState)
-> (ChannelInfo -> ChannelInfo) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Channel -> ChannelMember -> ChannelInfo -> ChannelInfo
channelInfoFromChannelWithData Channel
cwd ChannelMember
member)

    -- Update the old channel's previous viewed time (allows tracking of
    -- new messages)
    case Maybe ChannelId
prevId of
      Maybe ChannelId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just ChannelId
p -> ChannelId -> MH ()
clearChannelUnreadStatus ChannelId
p

-- | Refresh information about all channels and users. This is usually
-- triggered when a reconnect event for the WebSocket to the server
-- occurs.
refreshChannelsAndUsers :: MH ()
refreshChannelsAndUsers :: MH ()
refreshChannelsAndUsers = do
    Session
session <- MH Session
getSession
    User
me <- (ChatState -> User) -> MH User
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
    [UserId]
knownUsers <- (ChatState -> [UserId]) -> MH [UserId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> [UserId]
allUserIds
    HashMap TeamId TeamState
ts <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
      [(Seq Channel, Seq ChannelMember)]
pairs <- [TeamId]
-> (TeamId -> IO (Seq Channel, Seq ChannelMember))
-> IO [(Seq Channel, Seq ChannelMember)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) ((TeamId -> IO (Seq Channel, Seq ChannelMember))
 -> IO [(Seq Channel, Seq ChannelMember)])
-> (TeamId -> IO (Seq Channel, Seq ChannelMember))
-> IO [(Seq Channel, Seq ChannelMember)]
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
          Concurrently (Seq Channel, Seq ChannelMember)
-> IO (Seq Channel, Seq ChannelMember)
forall a. Concurrently a -> IO a
runConcurrently (Concurrently (Seq Channel, Seq ChannelMember)
 -> IO (Seq Channel, Seq ChannelMember))
-> Concurrently (Seq Channel, Seq ChannelMember)
-> IO (Seq Channel, Seq ChannelMember)
forall a b. (a -> b) -> a -> b
$ (,)
              (Seq Channel
 -> Seq ChannelMember -> (Seq Channel, Seq ChannelMember))
-> Concurrently (Seq Channel)
-> Concurrently
     (Seq ChannelMember -> (Seq Channel, Seq ChannelMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Seq Channel) -> Concurrently (Seq Channel)
forall a. IO a -> Concurrently a
Concurrently (UserParam -> TeamId -> Session -> IO (Seq Channel)
MM.mmGetChannelsForUser UserParam
UserMe TeamId
tId Session
session)
              Concurrently
  (Seq ChannelMember -> (Seq Channel, Seq ChannelMember))
-> Concurrently (Seq ChannelMember)
-> Concurrently (Seq Channel, Seq ChannelMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Seq ChannelMember) -> Concurrently (Seq ChannelMember)
forall a. IO a -> Concurrently a
Concurrently (UserParam -> TeamId -> Session -> IO (Seq ChannelMember)
MM.mmGetChannelMembersForUser UserParam
UserMe TeamId
tId Session
session)

      let (Seq Channel
chans, Seq ChannelMember
datas) = ([Seq Channel] -> Seq Channel
forall a. Monoid a => [a] -> a
mconcat ([Seq Channel] -> Seq Channel) -> [Seq Channel] -> Seq Channel
forall a b. (a -> b) -> a -> b
$ (Seq Channel, Seq ChannelMember) -> Seq Channel
forall a b. (a, b) -> a
fst ((Seq Channel, Seq ChannelMember) -> Seq Channel)
-> [(Seq Channel, Seq ChannelMember)] -> [Seq Channel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Seq Channel, Seq ChannelMember)]
pairs, [Seq ChannelMember] -> Seq ChannelMember
forall a. Monoid a => [a] -> a
mconcat ([Seq ChannelMember] -> Seq ChannelMember)
-> [Seq ChannelMember] -> Seq ChannelMember
forall a b. (a -> b) -> a -> b
$ (Seq Channel, Seq ChannelMember) -> Seq ChannelMember
forall a b. (a, b) -> b
snd ((Seq Channel, Seq ChannelMember) -> Seq ChannelMember)
-> [(Seq Channel, Seq ChannelMember)] -> [Seq ChannelMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Seq Channel, Seq ChannelMember)]
pairs)

      -- Collect all user IDs associated with DM channels so we can
      -- bulk-fetch their user records.
      let dmUsers :: [UserId]
dmUsers = [Maybe UserId] -> [UserId]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe UserId] -> [UserId]) -> [Maybe UserId] -> [UserId]
forall a b. (a -> b) -> a -> b
$ ((Channel -> Maybe UserId) -> [Channel] -> [Maybe UserId])
-> [Channel] -> (Channel -> Maybe UserId) -> [Maybe UserId]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Channel -> Maybe UserId) -> [Channel] -> [Maybe UserId]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Channel -> [Channel]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Channel
chans) ((Channel -> Maybe UserId) -> [Maybe UserId])
-> (Channel -> Maybe UserId) -> [Maybe UserId]
forall a b. (a -> b) -> a -> b
$ \Channel
chan ->
              case Channel
chanChannel -> Getting Type Channel Type -> Type
forall s a. s -> Getting a s a -> a
^.Getting Type Channel Type
Lens' Channel Type
channelTypeL of
                  Type
Direct -> case UserId -> Text -> Maybe UserId
userIdForDMChannel (User -> UserId
userId User
me) (UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
chan) of
                        Maybe UserId
Nothing -> Maybe UserId
forall a. Maybe a
Nothing
                        Just UserId
otherUserId -> UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
otherUserId
                  Type
_ -> Maybe UserId
forall a. Maybe a
Nothing
          uIdsToFetch :: [UserId]
uIdsToFetch = [UserId] -> [UserId]
forall a. Eq a => [a] -> [a]
nub ([UserId] -> [UserId]) -> [UserId] -> [UserId]
forall a b. (a -> b) -> a -> b
$ User -> UserId
userId User
me UserId -> [UserId] -> [UserId]
forall a. a -> [a] -> [a]
: [UserId]
knownUsers [UserId] -> [UserId] -> [UserId]
forall a. Semigroup a => a -> a -> a
<> [UserId]
dmUsers

          dataMap :: HashMap ChannelId ChannelMember
dataMap = [(ChannelId, ChannelMember)] -> HashMap ChannelId ChannelMember
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(ChannelId, ChannelMember)] -> HashMap ChannelId ChannelMember)
-> [(ChannelId, ChannelMember)] -> HashMap ChannelId ChannelMember
forall a b. (a -> b) -> a -> b
$ Seq (ChannelId, ChannelMember) -> [(ChannelId, ChannelMember)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (ChannelId, ChannelMember) -> [(ChannelId, ChannelMember)])
-> Seq (ChannelId, ChannelMember) -> [(ChannelId, ChannelMember)]
forall a b. (a -> b) -> a -> b
$ (\ChannelMember
d -> (ChannelMember -> ChannelId
channelMemberChannelId ChannelMember
d, ChannelMember
d)) (ChannelMember -> (ChannelId, ChannelMember))
-> Seq ChannelMember -> Seq (ChannelId, ChannelMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq ChannelMember
datas
          mkPair :: Channel -> (Channel, ChannelMember)
mkPair Channel
chan = (Channel
chan, Maybe ChannelMember -> ChannelMember
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ChannelMember -> ChannelMember)
-> Maybe ChannelMember -> ChannelMember
forall a b. (a -> b) -> a -> b
$ ChannelId -> HashMap ChannelId ChannelMember -> Maybe ChannelMember
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Channel -> ChannelId
channelId Channel
chan) HashMap ChannelId ChannelMember
dataMap)
          chansWithData :: Seq (Channel, ChannelMember)
chansWithData = Channel -> (Channel, ChannelMember)
mkPair (Channel -> (Channel, ChannelMember))
-> Seq Channel -> Seq (Channel, ChannelMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Channel
chans

      Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$
          -- Fetch user data associated with DM channels
          Seq UserId -> MH () -> MH ()
handleNewUsers ([UserId] -> Seq UserId
forall a. [a] -> Seq a
Seq.fromList [UserId]
uIdsToFetch) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
              -- Then refresh all loaded channels
              Seq (Channel, ChannelMember)
-> ((Channel, ChannelMember) -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq (Channel, ChannelMember)
chansWithData (((Channel, ChannelMember) -> MH ()) -> MH ())
-> ((Channel, ChannelMember) -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ (Channel -> ChannelMember -> MH ())
-> (Channel, ChannelMember) -> MH ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
SidebarUpdateDeferred)
              Maybe TeamId -> MH ()
updateSidebar Maybe TeamId
forall a. Maybe a
Nothing

-- | Refresh information about a specific channel.  The channel
-- metadata is refreshed, and if this is a loaded channel, the
-- scrollback is updated as well.
--
-- The sidebar update argument indicates whether this refresh should
-- also update the sidebar. Ordinarily you want this, so pass
-- SidebarUpdateImmediate unless you are very sure you know what you are
-- doing, i.e., you are very sure that a call to refreshChannel will
-- be followed immediately by a call to updateSidebar. We provide this
-- control so that channel refreshes can be batched and then a single
-- updateSidebar call can be used instead of the default behavior of
-- calling it once per refreshChannel call, which is the behavior if the
-- immediate setting is passed here.
refreshChannel :: SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel :: SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
upd Channel
chan ChannelMember
member = do
    HashMap TeamId TeamState
ts <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
    let ourTeams :: [TeamId]
ourTeams = HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts
        isOurTeam :: Bool
isOurTeam = case Channel -> Maybe TeamId
channelTeamId Channel
chan of
            Maybe TeamId
Nothing -> Bool
True
            Just TeamId
tId -> TeamId
tId TeamId -> [TeamId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamId]
ourTeams

    case Bool
isOurTeam of
        Bool
False -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Bool
True -> do
            let cId :: ChannelId
cId = Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
chan
            -- If this channel is unknown, register it first.
            Maybe ClientChannel
mChan <- Getting (First ClientChannel) ChatState ClientChannel
-> MH (Maybe ClientChannel)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId))
            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ClientChannel -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ClientChannel
mChan) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
                Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel Bool
False SidebarUpdate
upd Channel
chan ChannelMember
member

            ChannelId -> Channel -> ChannelMember -> MH ()
updateChannelInfo ChannelId
cId Channel
chan ChannelMember
member

handleNewChannel :: Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel :: Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel = Bool -> Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel_ Bool
True

handleNewChannel_ :: Bool
                  -- ^ Whether to permit this call to recursively
                  -- schedule itself for later if it can't locate
                  -- a DM channel user record. This is to prevent
                  -- uncontrolled recursion.
                  -> Bool
                  -- ^ Whether to switch to the new channel once it has
                  -- been installed.
                  -> SidebarUpdate
                  -- ^ Whether to update the sidebar, in case the caller
                  -- wants to batch these before updating it. Pass
                  -- SidebarUpdateImmediate unless you know what
                  -- you are doing, i.e., unless you intend to call
                  -- updateSidebar yourself after calling this.
                  -> Channel
                  -- ^ The channel to install.
                  -> ChannelMember
                  -> MH ()
handleNewChannel_ :: Bool -> Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel_ Bool
permitPostpone Bool
switch SidebarUpdate
sbUpdate Channel
nc ChannelMember
member = do
    -- Only add the channel to the state if it isn't already known.
    User
me <- (ChatState -> User) -> MH User
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
    Maybe ClientChannel
mChan <- Getting (First ClientChannel) ChatState ClientChannel
-> MH (Maybe ClientChannel)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ClientChannel
csChannel(Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
nc))
    case Maybe ClientChannel
mChan of
        Just ClientChannel
_ -> Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
switch (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> MH ()
setFocus (Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
nc)
        Maybe ClientChannel
Nothing -> do
            -- Create a new ClientChannel structure
            ClientChannel
cChannel <- ((ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo ((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> (ChannelInfo -> ChannelInfo) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Channel -> ChannelMember -> ChannelInfo -> ChannelInfo
channelInfoFromChannelWithData Channel
nc ChannelMember
member) (ClientChannel -> ClientChannel)
-> MH ClientChannel -> MH ClientChannel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       UserId -> Channel -> MH ClientChannel
forall (m :: * -> *).
MonadIO m =>
UserId -> Channel -> m ClientChannel
makeClientChannel (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL) Channel
nc

            ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id

            -- Add it to the message map, and to the name map so we
            -- can look it up by name. The name we use for the channel
            -- depends on its type:
            let chType :: Type
chType = Channel
ncChannel -> Getting Type Channel Type -> Type
forall s a. s -> Getting a s a -> a
^.Getting Type Channel Type
Lens' Channel Type
channelTypeL

            -- Get the channel name. If we couldn't, that means we have
            -- async work to do before we can register this channel (in
            -- which case abort because we got rescheduled).
            Bool
register <- case Type
chType of
                Type
Direct -> case UserId -> Text -> Maybe UserId
userIdForDMChannel (ChatState -> UserId
myUserId ChatState
st) (UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
nc) of
                    Maybe UserId
Nothing -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                    Just UserId
otherUserId ->
                        case UserId -> ChatState -> Maybe UserInfo
userById UserId
otherUserId ChatState
st of
                            -- If we found a user ID in the channel
                            -- name string but don't have that user's
                            -- metadata, postpone adding this channel
                            -- until we have fetched the metadata. This
                            -- can happen when we have a channel record
                            -- for a user that is no longer in the
                            -- current team. To avoid recursion due to a
                            -- problem, ensure that the rescheduled new
                            -- channel handler is not permitted to try
                            -- this again.
                            --
                            -- If we're already in a recursive attempt
                            -- to register this channel and still
                            -- couldn't find a username, just bail and
                            -- use the synthetic name (this has the same
                            -- problems as above).
                            Maybe UserInfo
Nothing -> do
                                case Bool
permitPostpone of
                                    Bool
False -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                                    Bool
True -> do
                                        LogCategory -> Text -> MH ()
mhLog LogCategory
LogAPI (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"handleNewChannel_: about to call handleNewUsers for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
otherUserId
                                        Seq UserId -> MH () -> MH ()
handleNewUsers (UserId -> Seq UserId
forall a. a -> Seq a
Seq.singleton UserId
otherUserId) (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$
                                            Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel_ Bool
False Bool
switch SidebarUpdate
sbUpdate Channel
nc ChannelMember
member
                                        Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                            Just UserInfo
_ -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                Type
_ -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
register (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel (Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
nc) ClientChannel
cChannel
                Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SidebarUpdate
sbUpdate SidebarUpdate -> SidebarUpdate -> Bool
forall a. Eq a => a -> a -> Bool
== SidebarUpdate
SidebarUpdateImmediate) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                    -- Note that we only check for whether we should
                    -- switch to this channel when doing a sidebar
                    -- update, since that's the only case where it's
                    -- possible to do so.
                    Maybe TeamId -> MH ()
updateSidebar (ClientChannel
cChannelClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId)

                    -- Finally, set our focus to the newly created
                    -- channel if the caller requested a change of
                    -- channel. Also consider the last join request
                    -- state field in case this is an asynchronous
                    -- channel addition triggered by a /join.
                    Maybe (Maybe (MH ()))
pending1 <- ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange (Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
nc)
                    Bool
pending2 <- case ClientChannel
cChannelClientChannel
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
-> Maybe UserId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> ClientChannel -> Const (Maybe UserId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe UserId) ChannelInfo)
 -> ClientChannel -> Const (Maybe UserId) ClientChannel)
-> ((Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
    -> ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
-> ChannelInfo -> Const (Maybe UserId) ChannelInfo
Lens' ChannelInfo (Maybe UserId)
cdDMUserId of
                        Maybe UserId
Nothing -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        Just UserId
uId -> UserId -> MH Bool
checkPendingChannelChangeByUserId UserId
uId

                    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
switch Bool -> Bool -> Bool
|| Maybe (Maybe (MH ())) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Maybe (MH ()))
pending1 Bool -> Bool -> Bool
|| Bool
pending2) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                        ChannelId -> MH ()
setFocus (Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
nc)
                        case Maybe (Maybe (MH ()))
pending1 of
                            Just (Just MH ()
act) -> MH ()
act
                            Maybe (Maybe (MH ()))
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Check to see whether the specified channel has been queued up to
-- be switched to.  Note that this condition is only cleared by the
-- actual setFocus switch to the channel because there may be multiple
-- operations that must complete before the channel is fully ready for
-- display/use.
--
-- Returns Just if the specified channel has a pending switch. The
-- result is an optional action to invoke after changing to the
-- specified channel.
checkPendingChannelChange :: ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange :: ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange ChannelId
cId = do
    Maybe PendingChannelChange
ch <- Getting
  (Maybe PendingChannelChange) ChatState (Maybe PendingChannelChange)
-> MH (Maybe PendingChannelChange)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe PendingChannelChange) TeamState)
-> ChatState -> Const (Maybe PendingChannelChange) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe PendingChannelChange) TeamState)
 -> ChatState -> Const (Maybe PendingChannelChange) ChatState)
-> ((Maybe PendingChannelChange
     -> Const (Maybe PendingChannelChange) (Maybe PendingChannelChange))
    -> TeamState -> Const (Maybe PendingChannelChange) TeamState)
-> Getting
     (Maybe PendingChannelChange) ChatState (Maybe PendingChannelChange)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Const (Maybe PendingChannelChange) (Maybe PendingChannelChange))
-> TeamState -> Const (Maybe PendingChannelChange) TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange)
    TeamId
curTid <- 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
    Maybe (Maybe (MH ())) -> MH (Maybe (Maybe (MH ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe (MH ())) -> MH (Maybe (Maybe (MH ()))))
-> Maybe (Maybe (MH ())) -> MH (Maybe (Maybe (MH ())))
forall a b. (a -> b) -> a -> b
$ case Maybe PendingChannelChange
ch of
        Just (ChangeByChannelId TeamId
tId ChannelId
i Maybe (MH ())
act) ->
            if ChannelId
i ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId
cId Bool -> Bool -> Bool
&& TeamId
curTid TeamId -> TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== TeamId
tId then Maybe (MH ()) -> Maybe (Maybe (MH ()))
forall a. a -> Maybe a
Just Maybe (MH ())
act else Maybe (Maybe (MH ()))
forall a. Maybe a
Nothing
        Maybe PendingChannelChange
_ -> Maybe (Maybe (MH ()))
forall a. Maybe a
Nothing

-- | Check to see whether the specified channel has been queued up to
-- be switched to.  Note that this condition is only cleared by the
-- actual setFocus switch to the channel because there may be multiple
-- operations that must complete before the channel is fully ready for
-- display/use.
--
-- Returns Just if the specified channel has a pending switch. The
-- result is an optional action to invoke after changing to the
-- specified channel.
checkPendingChannelChangeByUserId :: UserId -> MH Bool
checkPendingChannelChangeByUserId :: UserId -> MH Bool
checkPendingChannelChangeByUserId UserId
uId = do
    Maybe PendingChannelChange
ch <- Getting
  (Maybe PendingChannelChange) ChatState (Maybe PendingChannelChange)
-> MH (Maybe PendingChannelChange)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe PendingChannelChange) TeamState)
-> ChatState -> Const (Maybe PendingChannelChange) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe PendingChannelChange) TeamState)
 -> ChatState -> Const (Maybe PendingChannelChange) ChatState)
-> ((Maybe PendingChannelChange
     -> Const (Maybe PendingChannelChange) (Maybe PendingChannelChange))
    -> TeamState -> Const (Maybe PendingChannelChange) TeamState)
-> Getting
     (Maybe PendingChannelChange) ChatState (Maybe PendingChannelChange)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Const (Maybe PendingChannelChange) (Maybe PendingChannelChange))
-> TeamState -> Const (Maybe PendingChannelChange) TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange)
    Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> MH Bool) -> Bool -> MH Bool
forall a b. (a -> b) -> a -> b
$ case Maybe PendingChannelChange
ch of
        Just (ChangeByUserId UserId
i) ->
            UserId
i UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== UserId
uId
        Maybe PendingChannelChange
_ ->
            Bool
False

-- | Update the indicated Channel entry with the new data retrieved from
-- the Mattermost server. Also update the channel name if it changed.
updateChannelInfo :: ChannelId -> Channel -> ChannelMember -> MH ()
updateChannelInfo :: ChannelId -> Channel -> ChannelMember -> MH ()
updateChannelInfo ChannelId
cid Channel
new ChannelMember
member = do
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Name
ChannelMessages ChannelId
cid
    ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cid)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((ChannelInfo -> Identity ChannelInfo)
    -> ClientChannel -> Identity ClientChannel)
-> (ChannelInfo -> Identity ChannelInfo)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo ((ChannelInfo -> Identity ChannelInfo)
 -> ChatState -> Identity ChatState)
-> (ChannelInfo -> ChannelInfo) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Channel -> ChannelMember -> ChannelInfo -> ChannelInfo
channelInfoFromChannelWithData Channel
new ChannelMember
member
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cid ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
        Maybe TeamId -> MH ()
updateSidebar (ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId)

setFocus :: ChannelId -> MH ()
setFocus :: ChannelId -> MH ()
setFocus ChannelId
cId = do
    ChannelId -> Bool -> MH ()
showChannelInSidebar ChannelId
cId Bool
True
    Bool
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
setFocusWith Bool
True ((ChannelListEntry -> Bool)
-> Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight ((ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId
cId) (ChannelId -> Bool)
-> (ChannelListEntry -> ChannelId) -> ChannelListEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelListEntry -> ChannelId
channelListEntryChannelId)) (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

setFocusWith :: Bool
             -> (Zipper ChannelListGroup ChannelListEntry
             -> Zipper ChannelListGroup ChannelListEntry)
             -> MH ()
             -> MH ()
setFocusWith :: Bool
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
setFocusWith Bool
updatePrev Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
f MH ()
onNoChange = do
    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
    Zipper ChannelListGroup ChannelListEntry
oldZipper <- Getting
  (Zipper ChannelListGroup ChannelListEntry)
  ChatState
  (Zipper ChannelListGroup ChannelListEntry)
-> MH (Zipper ChannelListGroup ChannelListEntry)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState
 -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> ChatState
-> Const (Zipper ChannelListGroup ChannelListEntry) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState
  -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
 -> ChatState
 -> Const (Zipper ChannelListGroup ChannelListEntry) ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Const
          (Zipper ChannelListGroup ChannelListEntry)
          (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState
    -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> Getting
     (Zipper ChannelListGroup ChannelListEntry)
     ChatState
     (Zipper ChannelListGroup ChannelListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Const
      (Zipper ChannelListGroup ChannelListEntry)
      (Zipper ChannelListGroup ChannelListEntry))
-> TeamState
-> Const (Zipper ChannelListGroup ChannelListEntry) TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus)
    let newZipper :: Zipper ChannelListGroup ChannelListEntry
newZipper = Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
f Zipper ChannelListGroup ChannelListEntry
oldZipper
        newFocus :: Maybe ChannelListEntry
newFocus = Zipper ChannelListGroup ChannelListEntry -> Maybe ChannelListEntry
forall a b. Zipper a b -> Maybe b
Z.focus Zipper ChannelListGroup ChannelListEntry
newZipper
        oldFocus :: Maybe ChannelListEntry
oldFocus = Zipper ChannelListGroup ChannelListEntry -> Maybe ChannelListEntry
forall a b. Zipper a b -> Maybe b
Z.focus Zipper ChannelListGroup ChannelListEntry
oldZipper

    -- If we aren't changing anything, skip all the book-keeping because
    -- we'll end up clobbering things like tsRecentChannel.
    if Maybe ChannelListEntry
newFocus Maybe ChannelListEntry -> Maybe ChannelListEntry -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ChannelListEntry
oldFocus
       then do
          EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId
          MH ()
resetAutocomplete
          MH ()
preChangeChannelCommon
          (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Identity (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState -> Identity TeamState)
-> (Zipper ChannelListGroup ChannelListEntry
    -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> TeamState -> Identity TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus ((Zipper ChannelListGroup ChannelListEntry
  -> Identity (Zipper ChannelListGroup ChannelListEntry))
 -> ChatState -> Identity ChatState)
-> Zipper ChannelListGroup ChannelListEntry -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Zipper ChannelListGroup ChannelListEntry
newZipper

          UTCTime
now <- IO UTCTime -> MH UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
          ChannelId
newCid <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
          ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
newCid)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ClientChannel -> Identity ClientChannel)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ChannelInfo -> Identity ChannelInfo)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride ((Maybe UTCTime -> Identity (Maybe UTCTime))
 -> ChatState -> Identity ChatState)
-> Maybe UTCTime -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
now

          Bool -> MH ()
updateViewed Bool
updatePrev
          MH ()
postChangeChannelCommon
       else MH ()
onNoChange

postChangeChannelCommon :: MH ()
postChangeChannelCommon :: MH ()
postChangeChannelCommon = do
    MH ()
resetEditorState
    MH ()
updateChannelListScroll
    MH ()
loadLastEdit
    MH ()
fetchVisibleIfNeeded

loadLastEdit :: MH ()
loadLastEdit :: MH ()
loadLastEdit = do
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)

    Maybe EphemeralEditState
oldEphemeral <- Getting (First EphemeralEditState) ChatState EphemeralEditState
-> MH (Maybe EphemeralEditState)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Const (First EphemeralEditState) ClientChannel)
 -> ChatState -> Const (First EphemeralEditState) ChatState)
-> ((EphemeralEditState
     -> Const (First EphemeralEditState) EphemeralEditState)
    -> ClientChannel -> Const (First EphemeralEditState) ClientChannel)
-> Getting (First EphemeralEditState) ChatState EphemeralEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState
 -> Const (First EphemeralEditState) EphemeralEditState)
-> ClientChannel -> Const (First EphemeralEditState) ClientChannel
Lens' ClientChannel EphemeralEditState
ccEditState)
    case Maybe EphemeralEditState
oldEphemeral of
        Maybe EphemeralEditState
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just EphemeralEditState
e -> (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((EphemeralEditState -> Identity EphemeralEditState)
    -> TeamState -> Identity TeamState)
-> (EphemeralEditState -> Identity EphemeralEditState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((EphemeralEditState -> Identity EphemeralEditState)
    -> ChatEditState -> Identity ChatEditState)
-> (EphemeralEditState -> Identity EphemeralEditState)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Identity EphemeralEditState)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral ((EphemeralEditState -> Identity EphemeralEditState)
 -> ChatState -> Identity ChatState)
-> EphemeralEditState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EphemeralEditState
e

    MH ()
loadLastChannelInput

loadLastChannelInput :: MH ()
loadLastChannelInput :: MH ()
loadLastChannelInput = do
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    Maybe Int
inputHistoryPos <- Getting (Maybe Int) ChatState (Maybe Int) -> MH (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe Int) TeamState)
-> ChatState -> Const (Maybe Int) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe Int) TeamState)
 -> ChatState -> Const (Maybe Int) ChatState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> TeamState -> Const (Maybe Int) TeamState)
-> Getting (Maybe Int) ChatState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe Int) ChatEditState)
-> TeamState -> Const (Maybe Int) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe Int) ChatEditState)
 -> TeamState -> Const (Maybe Int) TeamState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> TeamState
-> Const (Maybe Int) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> ChatEditState -> Const (Maybe Int) ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
 -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ChatEditState
-> Const (Maybe Int) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> EphemeralEditState -> Const (Maybe Int) EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)
    case Maybe Int
inputHistoryPos of
        Just Int
i -> ChannelId -> Int -> MH ()
loadHistoryEntryToEditor ChannelId
cId Int
i
        Maybe Int
Nothing -> do
            (Text
lastEdit, EditMode
lastEditMode) <- Getting (Text, EditMode) ChatState (Text, EditMode)
-> MH (Text, EditMode)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Text, EditMode) TeamState)
-> ChatState -> Const (Text, EditMode) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Text, EditMode) TeamState)
 -> ChatState -> Const (Text, EditMode) ChatState)
-> (((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
    -> TeamState -> Const (Text, EditMode) TeamState)
-> Getting (Text, EditMode) ChatState (Text, EditMode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Text, EditMode) ChatEditState)
-> TeamState -> Const (Text, EditMode) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Text, EditMode) ChatEditState)
 -> TeamState -> Const (Text, EditMode) TeamState)
-> (((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
    -> ChatEditState -> Const (Text, EditMode) ChatEditState)
-> ((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
-> TeamState
-> Const (Text, EditMode) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const (Text, EditMode) EphemeralEditState)
-> ChatEditState -> Const (Text, EditMode) ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const (Text, EditMode) EphemeralEditState)
 -> ChatEditState -> Const (Text, EditMode) ChatEditState)
-> (((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
    -> EphemeralEditState -> Const (Text, EditMode) EphemeralEditState)
-> ((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
-> ChatEditState
-> Const (Text, EditMode) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
-> EphemeralEditState -> Const (Text, EditMode) EphemeralEditState
Lens' EphemeralEditState (Text, EditMode)
eesLastInput)
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> TeamState -> Identity TeamState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> ChatEditState -> Identity ChatEditState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Identity (Editor Text Name))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> ChatState -> Identity ChatState)
-> (Editor Text Name -> Editor Text Name) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit ((TextZipper Text -> TextZipper Text)
 -> Editor Text Name -> Editor Text Name)
-> (TextZipper Text -> TextZipper Text)
-> Editor Text Name
-> Editor Text Name
forall a b. (a -> b) -> a -> b
$ Text -> TextZipper Text -> TextZipper Text
forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany Text
lastEdit (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
clearZipper)
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
    -> TeamState -> Identity TeamState)
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((EditMode -> Identity EditMode)
    -> ChatEditState -> Identity ChatEditState)
-> (EditMode -> Identity EditMode)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EditMode
cedEditMode ((EditMode -> Identity EditMode)
 -> ChatState -> Identity ChatState)
-> EditMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditMode
lastEditMode

updateChannelListScroll :: MH ()
updateChannelListScroll :: MH ()
updateChannelListScroll = do
    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
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
vScrollToBeginning (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelList TeamId
tId)

preChangeChannelCommon :: MH ()
preChangeChannelCommon :: MH ()
preChangeChannelCommon = do
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe ChannelId -> Identity (Maybe ChannelId))
    -> TeamState -> Identity TeamState)
-> (Maybe ChannelId -> Identity (Maybe ChannelId))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Identity (Maybe ChannelId))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe ChannelId)
tsRecentChannel ((Maybe ChannelId -> Identity (Maybe ChannelId))
 -> ChatState -> Identity ChatState)
-> Maybe ChannelId -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId
    MH ()
saveCurrentEdit

resetEditorState :: MH ()
resetEditorState :: MH ()
resetEditorState = do
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
    -> TeamState -> Identity TeamState)
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((EditMode -> Identity EditMode)
    -> ChatEditState -> Identity ChatEditState)
-> (EditMode -> Identity EditMode)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EditMode
cedEditMode ((EditMode -> Identity EditMode)
 -> ChatState -> Identity ChatState)
-> EditMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditMode
NewPost
    MH ()
clearEditor

clearEditor :: MH ()
clearEditor :: MH ()
clearEditor = (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> TeamState -> Identity TeamState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> ChatEditState -> Identity ChatEditState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Identity (Editor Text Name))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> ChatState -> Identity ChatState)
-> (Editor Text Name -> Editor Text Name) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
clearZipper

saveCurrentEdit :: MH ()
saveCurrentEdit :: MH ()
saveCurrentEdit = do
    MH ()
saveCurrentChannelInput

    EphemeralEditState
oldEphemeral <- Getting EphemeralEditState ChatState EphemeralEditState
-> MH EphemeralEditState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const EphemeralEditState TeamState)
-> ChatState -> Const EphemeralEditState ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const EphemeralEditState TeamState)
 -> ChatState -> Const EphemeralEditState ChatState)
-> ((EphemeralEditState
     -> Const EphemeralEditState EphemeralEditState)
    -> TeamState -> Const EphemeralEditState TeamState)
-> Getting EphemeralEditState ChatState EphemeralEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EphemeralEditState ChatEditState)
-> TeamState -> Const EphemeralEditState TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EphemeralEditState ChatEditState)
 -> TeamState -> Const EphemeralEditState TeamState)
-> ((EphemeralEditState
     -> Const EphemeralEditState EphemeralEditState)
    -> ChatEditState -> Const EphemeralEditState ChatEditState)
-> (EphemeralEditState
    -> Const EphemeralEditState EphemeralEditState)
-> TeamState
-> Const EphemeralEditState TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const EphemeralEditState EphemeralEditState)
-> ChatEditState -> Const EphemeralEditState ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral)
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((EphemeralEditState -> Identity EphemeralEditState)
    -> ClientChannel -> Identity ClientChannel)
-> (EphemeralEditState -> Identity EphemeralEditState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Identity EphemeralEditState)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel EphemeralEditState
ccEditState ((EphemeralEditState -> Identity EphemeralEditState)
 -> ChatState -> Identity ChatState)
-> EphemeralEditState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EphemeralEditState
oldEphemeral

saveCurrentChannelInput :: MH ()
saveCurrentChannelInput :: MH ()
saveCurrentChannelInput = do
    Editor Text Name
cmdLine <- Getting (Editor Text Name) ChatState (Editor Text Name)
-> MH (Editor Text Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Editor Text Name) TeamState)
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Editor Text Name) TeamState)
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> TeamState -> Const (Editor Text Name) TeamState)
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Editor Text Name) ChatEditState)
-> TeamState -> Const (Editor Text Name) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Editor Text Name) ChatEditState)
 -> TeamState -> Const (Editor Text Name) TeamState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> ChatEditState -> Const (Editor Text Name) ChatEditState)
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> TeamState
-> Const (Editor Text Name) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> ChatEditState -> Const (Editor Text Name) ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor)
    EditMode
mode <- Getting EditMode ChatState EditMode -> MH EditMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const EditMode TeamState)
-> ChatState -> Const EditMode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const EditMode TeamState)
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> TeamState -> Const EditMode TeamState)
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EditMode ChatEditState)
-> TeamState -> Const EditMode TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EditMode ChatEditState)
 -> TeamState -> Const EditMode TeamState)
-> ((EditMode -> Const EditMode EditMode)
    -> ChatEditState -> Const EditMode ChatEditState)
-> (EditMode -> Const EditMode EditMode)
-> TeamState
-> Const EditMode TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> ChatEditState -> Const EditMode ChatEditState
Lens' ChatEditState EditMode
cedEditMode)

    -- Only save the editor contents if the user is not navigating the
    -- history.
    Maybe Int
inputHistoryPos <- Getting (Maybe Int) ChatState (Maybe Int) -> MH (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe Int) TeamState)
-> ChatState -> Const (Maybe Int) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe Int) TeamState)
 -> ChatState -> Const (Maybe Int) ChatState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> TeamState -> Const (Maybe Int) TeamState)
-> Getting (Maybe Int) ChatState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe Int) ChatEditState)
-> TeamState -> Const (Maybe Int) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe Int) ChatEditState)
 -> TeamState -> Const (Maybe Int) TeamState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> TeamState
-> Const (Maybe Int) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> ChatEditState -> Const (Maybe Int) ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
 -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ChatEditState
-> Const (Maybe Int) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> EphemeralEditState -> Const (Maybe Int) EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)

    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
inputHistoryPos) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
        (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> (((Text, EditMode) -> Identity (Text, EditMode))
    -> TeamState -> Identity TeamState)
-> ((Text, EditMode) -> Identity (Text, EditMode))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> (((Text, EditMode) -> Identity (Text, EditMode))
    -> ChatEditState -> Identity ChatEditState)
-> ((Text, EditMode) -> Identity (Text, EditMode))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Identity EphemeralEditState)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Identity EphemeralEditState)
 -> ChatEditState -> Identity ChatEditState)
-> (((Text, EditMode) -> Identity (Text, EditMode))
    -> EphemeralEditState -> Identity EphemeralEditState)
-> ((Text, EditMode) -> Identity (Text, EditMode))
-> ChatEditState
-> Identity ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Text, EditMode) -> Identity (Text, EditMode))
-> EphemeralEditState -> Identity EphemeralEditState
Lens' EphemeralEditState (Text, EditMode)
eesLastInput (((Text, EditMode) -> Identity (Text, EditMode))
 -> ChatState -> Identity ChatState)
-> (Text, EditMode) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
           (Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents (Editor Text Name -> [Text]) -> Editor Text Name -> [Text]
forall a b. (a -> b) -> a -> b
$ Editor Text Name
cmdLine, EditMode
mode)

applyPreferenceChange :: Preference -> MH ()
applyPreferenceChange :: Preference -> MH ()
applyPreferenceChange Preference
pref = do
    -- always update our user preferences accordingly
    (ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
 -> ChatState -> Identity ChatState)
-> ((UserPreferences -> Identity UserPreferences)
    -> ChatResources -> Identity ChatResources)
-> (UserPreferences -> Identity UserPreferences)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Identity UserPreferences)
-> ChatResources -> Identity ChatResources
Lens' ChatResources UserPreferences
crUserPreferences ((UserPreferences -> Identity UserPreferences)
 -> ChatState -> Identity ChatState)
-> (UserPreferences -> UserPreferences) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Seq Preference -> UserPreferences -> UserPreferences
setUserPreferences (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref)

    -- Invalidate the entire rendering cache since many things depend on
    -- user preferences
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache

    if
      | Just FlaggedPost
f <- Preference -> Maybe FlaggedPost
preferenceToFlaggedPost Preference
pref -> do
          PostId -> Bool -> MH ()
updateMessageFlag (FlaggedPost -> PostId
flaggedPostId FlaggedPost
f) (FlaggedPost -> Bool
flaggedPostStatus FlaggedPost
f)

      | Just [TeamId]
tIds <- Preference -> Maybe [TeamId]
preferenceToTeamOrder Preference
pref ->
          [TeamId] -> MH ()
applyTeamOrder [TeamId]
tIds

      | Just DirectChannelShowStatus
d <- Preference -> Maybe DirectChannelShowStatus
preferenceToDirectChannelShowStatus Preference
pref -> do
          Maybe TeamId -> MH ()
updateSidebar Maybe TeamId
forall a. Maybe a
Nothing

          ClientChannels
cs <- Getting ClientChannels ChatState ClientChannels
-> MH ClientChannels
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels

          -- We need to check on whether this preference was to show a
          -- channel and, if so, whether it was the one we attempted to
          -- switch to (thus triggering the preference change). If so,
          -- we need to switch to it now.
          let Just ChannelId
cId = UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor (DirectChannelShowStatus -> UserId
directChannelShowUserId DirectChannelShowStatus
d) ClientChannels
cs
          case DirectChannelShowStatus -> Bool
directChannelShowValue DirectChannelShowStatus
d of
              Bool
True -> do
                  Maybe (Maybe (MH ()))
pending <- ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange ChannelId
cId
                  case Maybe (Maybe (MH ()))
pending of
                      Just Maybe (MH ())
mAct -> do
                          ChannelId -> MH ()
setFocus ChannelId
cId
                          MH () -> Maybe (MH ()) -> MH ()
forall a. a -> Maybe a -> a
fromMaybe (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
mAct
                      Maybe (Maybe (MH ()))
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Bool
False -> do
                  ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ClientChannel -> Identity ClientChannel)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ChannelInfo -> Identity ChannelInfo)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride ((Maybe UTCTime -> Identity (Maybe UTCTime))
 -> ChatState -> Identity ChatState)
-> Maybe UTCTime -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe UTCTime
forall a. Maybe a
Nothing

      | Just GroupChannelPreference
g <- Preference -> Maybe GroupChannelPreference
preferenceToGroupChannelPreference Preference
pref -> do
          Maybe TeamId -> MH ()
updateSidebar Maybe TeamId
forall a. Maybe a
Nothing

          -- We need to check on whether this preference was to show a
          -- channel and, if so, whether it was the one we attempted to
          -- switch to (thus triggering the preference change). If so,
          -- we need to switch to it now.
          let cId :: ChannelId
cId = GroupChannelPreference -> ChannelId
groupChannelId GroupChannelPreference
g
          case GroupChannelPreference -> Bool
groupChannelShow GroupChannelPreference
g of
              Bool
True -> do
                  Maybe (Maybe (MH ()))
pending <- ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange ChannelId
cId
                  case Maybe (Maybe (MH ()))
pending of
                      Just Maybe (MH ())
mAct -> do
                          ChannelId -> MH ()
setFocus ChannelId
cId
                          MH () -> Maybe (MH ()) -> MH ()
forall a. a -> Maybe a -> a
fromMaybe (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
mAct
                      Maybe (Maybe (MH ()))
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Bool
False -> do
                  ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ClientChannel -> Identity ClientChannel)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ChannelInfo -> Identity ChannelInfo)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride ((Maybe UTCTime -> Identity (Maybe UTCTime))
 -> ChatState -> Identity ChatState)
-> Maybe UTCTime -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe UTCTime
forall a. Maybe a
Nothing

      | Just FavoriteChannelPreference
f <- Preference -> Maybe FavoriteChannelPreference
preferenceToFavoriteChannelPreference Preference
pref -> do
          Maybe TeamId -> MH ()
updateSidebar Maybe TeamId
forall a. Maybe a
Nothing

          -- We need to check on whether this preference was to show a
          -- channel and, if so, whether it was the one we attempted to
          -- switch to (thus triggering the preference change). If so,
          -- we need to switch to it now.
          let cId :: ChannelId
cId = FavoriteChannelPreference -> ChannelId
favoriteChannelId FavoriteChannelPreference
f
          case FavoriteChannelPreference -> Bool
favoriteChannelShow FavoriteChannelPreference
f of
              Bool
True -> do
                  Maybe (Maybe (MH ()))
pending <- ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange ChannelId
cId
                  case Maybe (Maybe (MH ()))
pending of
                      Just Maybe (MH ())
mAct -> do
                          ChannelId -> MH ()
setFocus ChannelId
cId
                          MH () -> Maybe (MH ()) -> MH ()
forall a. a -> Maybe a -> a
fromMaybe (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
mAct
                      Maybe (Maybe (MH ()))
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Bool
False -> do
                  ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ClientChannel -> Identity ClientChannel)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ChannelInfo -> Identity ChannelInfo)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride ((Maybe UTCTime -> Identity (Maybe UTCTime))
 -> ChatState -> Identity ChatState)
-> Maybe UTCTime -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe UTCTime
forall a. Maybe a
Nothing
      | Bool
otherwise -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

refreshChannelById :: ChannelId -> MH ()
refreshChannelById :: ChannelId -> MH ()
refreshChannelById ChannelId
cId = do
    Session
session <- MH Session
getSession
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Channel
cwd <- ChannelId -> Session -> IO Channel
MM.mmGetChannel ChannelId
cId Session
session
        ChannelMember
member <- ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember ChannelId
cId UserParam
UserMe Session
session
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
            SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
SidebarUpdateImmediate Channel
cwd ChannelMember
member

removeChannelFromState :: ChannelId -> MH ()
removeChannelFromState :: ChannelId -> MH ()
removeChannelFromState ChannelId
cId = do
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ ClientChannel
chan -> do
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientChannel
chanClientChannel -> Getting Type ClientChannel Type -> Type
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Getting Type ClientChannel Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
/= Type
Direct) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            case ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
                Maybe TeamId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just TeamId
tId -> do
                    ChannelId
origFocus <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
                    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChannelId
origFocus ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId
cId) MH ()
nextChannelSkipPrevView

            -- Update input history
            (InputHistory -> Identity InputHistory)
-> ChatState -> Identity ChatState
Lens' ChatState InputHistory
csInputHistory ((InputHistory -> Identity InputHistory)
 -> ChatState -> Identity ChatState)
-> (InputHistory -> InputHistory) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId -> InputHistory -> InputHistory
removeChannelHistory ChannelId
cId
            -- Update msgMap
            (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId -> ClientChannels -> ClientChannels
removeChannel ChannelId
cId

            case ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
                Maybe TeamId
Nothing -> do
                    HashMap TeamId TeamState
ts <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
                    [TeamId] -> (TeamId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
                        TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Identity (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState -> Identity TeamState)
-> (Zipper ChannelListGroup ChannelListEntry
    -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> TeamState -> Identity TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus ((Zipper ChannelListGroup ChannelListEntry
  -> Identity (Zipper ChannelListGroup ChannelListEntry))
 -> ChatState -> Identity ChatState)
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ChannelListEntry -> Bool)
-> Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall b a. Eq b => (b -> Bool) -> Zipper a b -> Zipper a b
Z.filterZipper ((ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
/= ChannelId
cId) (ChannelId -> Bool)
-> (ChannelListEntry -> ChannelId) -> ChannelListEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelListEntry -> ChannelId
channelListEntryChannelId)
                Just TeamId
tId -> do
                    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Identity (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState -> Identity TeamState)
-> (Zipper ChannelListGroup ChannelListEntry
    -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> TeamState -> Identity TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus ((Zipper ChannelListGroup ChannelListEntry
  -> Identity (Zipper ChannelListGroup ChannelListEntry))
 -> ChatState -> Identity ChatState)
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ChannelListEntry -> Bool)
-> Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall b a. Eq b => (b -> Bool) -> Zipper a b -> Zipper a b
Z.filterZipper ((ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
/= ChannelId
cId) (ChannelId -> Bool)
-> (ChannelListEntry -> ChannelId) -> ChannelListEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelListEntry -> ChannelId
channelListEntryChannelId)

            Maybe TeamId -> MH ()
updateSidebar (Maybe TeamId -> MH ()) -> Maybe TeamId -> MH ()
forall a b. (a -> b) -> a -> b
$ ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId

nextChannel :: MH ()
nextChannel :: MH ()
nextChannel = do
    MH ()
resetReturnChannel
    Bool
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
setFocusWith Bool
True Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall a b. Zipper a b -> Zipper a b
Z.right (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | This is almost never what you want; we use this when we delete a
-- channel and we don't want to update the deleted channel's view time.
nextChannelSkipPrevView :: MH ()
nextChannelSkipPrevView :: MH ()
nextChannelSkipPrevView = Bool
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
setFocusWith Bool
False Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall a b. Zipper a b -> Zipper a b
Z.right (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

prevChannel :: MH ()
prevChannel :: MH ()
prevChannel = do
    MH ()
resetReturnChannel
    Bool
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
setFocusWith Bool
True Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall a b. Zipper a b -> Zipper a b
Z.left (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

recentChannel :: MH ()
recentChannel :: MH ()
recentChannel = do
  Maybe ChannelId
recent <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsRecentChannel)
  case Maybe ChannelId
recent of
    Maybe ChannelId
Nothing  -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just ChannelId
cId -> do
        Maybe ChannelId
ret <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ChannelId
ret Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId) MH ()
resetReturnChannel
        ChannelId -> MH ()
setFocus ChannelId
cId

resetReturnChannel :: MH ()
resetReturnChannel :: MH ()
resetReturnChannel = do
  Maybe ChannelId
val <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
  case Maybe ChannelId
val of
      Maybe ChannelId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just ChannelId
_ -> do
          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
          EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId
          (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe ChannelId -> Identity (Maybe ChannelId))
    -> TeamState -> Identity TeamState)
-> (Maybe ChannelId -> Identity (Maybe ChannelId))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Identity (Maybe ChannelId))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe ChannelId)
tsReturnChannel ((Maybe ChannelId -> Identity (Maybe ChannelId))
 -> ChatState -> Identity ChatState)
-> Maybe ChannelId -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ChannelId
forall a. Maybe a
Nothing

gotoReturnChannel :: MH ()
gotoReturnChannel :: MH ()
gotoReturnChannel = do
  Maybe ChannelId
ret <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
  case Maybe ChannelId
ret of
    Maybe ChannelId
Nothing  -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just ChannelId
cId -> do
        MH ()
resetReturnChannel
        ChannelId -> MH ()
setFocus ChannelId
cId

setReturnChannel :: MH ()
setReturnChannel :: MH ()
setReturnChannel = do
  Maybe ChannelId
ret <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
  case Maybe ChannelId
ret of
    Maybe ChannelId
Nothing  -> do
        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
        ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
        (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe ChannelId -> Identity (Maybe ChannelId))
    -> TeamState -> Identity TeamState)
-> (Maybe ChannelId -> Identity (Maybe ChannelId))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Identity (Maybe ChannelId))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe ChannelId)
tsReturnChannel ((Maybe ChannelId -> Identity (Maybe ChannelId))
 -> ChatState -> Identity ChatState)
-> Maybe ChannelId -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId
        EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId
    Just ChannelId
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

nextUnreadChannel :: MH ()
nextUnreadChannel :: MH ()
nextUnreadChannel = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    MH ()
setReturnChannel
    Bool
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
setFocusWith Bool
True (ChatState
-> Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall a.
ChatState -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadChannel ChatState
st) MH ()
gotoReturnChannel

nextUnreadUserOrChannel :: MH ()
nextUnreadUserOrChannel :: MH ()
nextUnreadUserOrChannel = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    MH ()
setReturnChannel
    Bool
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
setFocusWith Bool
True (ChatState
-> Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall a.
ChatState -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadUserOrChannel ChatState
st) MH ()
gotoReturnChannel

leaveChannel :: ChannelId -> MH ()
leaveChannel :: ChannelId -> MH ()
leaveChannel ChannelId
cId = ChannelId -> Bool -> MH ()
leaveChannelIfPossible ChannelId
cId Bool
False

leaveChannelIfPossible :: ChannelId -> Bool -> MH ()
leaveChannelIfPossible :: ChannelId -> Bool -> MH ()
leaveChannelIfPossible ChannelId
cId Bool
delete = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    User
me <- (ChatState -> User) -> MH User
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
    let isMe :: User -> Bool
isMe User
u = User
uUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL

    case ChatState
st ChatState
-> Getting (First ChannelInfo) ChatState ChannelInfo
-> Maybe ChannelInfo
forall s a. s -> Getting (First a) s a -> Maybe a
^? ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Const (First ChannelInfo) ClientChannel)
 -> ChatState -> Const (First ChannelInfo) ChatState)
-> ((ChannelInfo -> Const (First ChannelInfo) ChannelInfo)
    -> ClientChannel -> Const (First ChannelInfo) ClientChannel)
-> Getting (First ChannelInfo) ChatState ChannelInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Const (First ChannelInfo) ChannelInfo)
-> ClientChannel -> Const (First ChannelInfo) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo of
        Maybe ChannelInfo
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ChannelInfo
cInfo -> case ChannelInfo -> Bool
canLeaveChannel ChannelInfo
cInfo of
            Bool
False -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Bool
True ->
                -- The server will reject an attempt to leave a private
                -- channel if we're the only member. To check this, we
                -- just ask for the first two members of the channel.
                -- If there is only one, it must be us: hence the "all
                -- isMe" check below. If there are two members, it
                -- doesn't matter who they are, because we just know
                -- that we aren't the only remaining member, so we can't
                -- delete the channel.
                DoAsyncChannelMM [User]
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
                    (\Session
s ChannelId
_ ->
                      let query :: UserQuery
query = UserQuery
MM.defaultUserQuery
                           { userQueryPage :: Maybe Int
MM.userQueryPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
                           , userQueryPerPage :: Maybe Int
MM.userQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
                           , userQueryInChannel :: Maybe ChannelId
MM.userQueryInChannel = ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId
                           }
                      in Seq User -> [User]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq User -> [User]) -> IO (Seq User) -> IO [User]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserQuery -> Session -> IO (Seq User)
MM.mmGetUsers UserQuery
query Session
s)
                    (\ChannelId
_ [User]
members -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                        -- If the channel is private:
                        --  * leave it if we aren't the last member.
                        --  * delete it if we are.
                        --
                        -- Otherwise:
                        --  * leave (or delete) the channel as specified
                        --    by the delete argument.
                        let func :: Session -> ChannelId -> IO ()
func = case ChannelInfo
cInfoChannelInfo
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Type
forall s a. s -> Getting a s a -> a
^.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType of
                                Type
Private -> case (User -> Bool) -> [User] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all User -> Bool
isMe [User]
members of
                                    Bool
True -> (\ Session
s ChannelId
c -> ChannelId -> Session -> IO ()
MM.mmDeleteChannel ChannelId
c Session
s)
                                    Bool
False -> (\ Session
s ChannelId
c -> ChannelId -> UserParam -> Session -> IO ()
MM.mmRemoveUserFromChannel ChannelId
c UserParam
UserMe Session
s)
                                Type
Group ->
                                    \Session
s ChannelId
_ ->
                                        let pref :: Preference
pref = ChannelId -> UserId -> Preference
hideGroupChannelPref ChannelId
cId (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL)
                                        in UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref) Session
s
                                Type
_ -> if Bool
delete
                                     then (\ Session
s ChannelId
c -> ChannelId -> Session -> IO ()
MM.mmDeleteChannel ChannelId
c Session
s)
                                     else (\ Session
s ChannelId
c -> ChannelId -> UserParam -> Session -> IO ()
MM.mmRemoveUserFromChannel ChannelId
c UserParam
UserMe Session
s)

                        DoAsyncChannelMM ()
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId Session -> ChannelId -> IO ()
func ChannelId -> () -> Maybe (MH ())
forall a. ChannelId -> a -> Maybe (MH ())
endAsyncNOP
                    )

getNextUnreadChannel :: ChatState
                     -> (Zipper a ChannelListEntry -> Zipper a ChannelListEntry)
getNextUnreadChannel :: ChatState -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadChannel ChatState
st =
    -- The next channel with unread messages must also be a channel
    -- other than the current one, since the zipper may be on a channel
    -- that has unread messages and will stay that way until we leave
    -- it- so we need to skip that channel when doing the zipper search
    -- for the next candidate channel.
    (ChannelListEntry -> Bool)
-> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight (\ChannelListEntry
e ->
                let cId :: ChannelId
cId = ChannelListEntry -> ChannelId
channelListEntryChannelId ChannelListEntry
e
                in ChannelListEntry -> Bool
channelListEntryUnread ChannelListEntry
e Bool -> Bool -> Bool
&& (ChannelId
cId ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatState
stChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId(ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId)))

getNextUnreadUserOrChannel :: ChatState
                           -> Zipper a ChannelListEntry
                           -> Zipper a ChannelListEntry
getNextUnreadUserOrChannel :: ChatState -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadUserOrChannel ChatState
st Zipper a ChannelListEntry
z =
    -- Find the next unread channel, prefering direct messages
    let cur :: ChannelId
cur = ChatState
stChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId(ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId)
        matches :: ChannelListEntry -> Bool
matches ChannelListEntry
e = ChannelListEntry -> Bool
entryIsDMEntry ChannelListEntry
e Bool -> Bool -> Bool
&& ChannelListEntry -> Bool
isFresh ChannelListEntry
e
        isFresh :: ChannelListEntry -> Bool
isFresh ChannelListEntry
e = ChannelListEntry -> Bool
channelListEntryUnread ChannelListEntry
e Bool -> Bool -> Bool
&& (ChannelListEntry -> ChannelId
channelListEntryChannelId ChannelListEntry
e ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
/= ChannelId
cur)
    in Zipper a ChannelListEntry
-> Maybe (Zipper a ChannelListEntry) -> Zipper a ChannelListEntry
forall a. a -> Maybe a -> a
fromMaybe ((ChannelListEntry -> Bool)
-> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight ChannelListEntry -> Bool
isFresh Zipper a ChannelListEntry
z)
                 ((ChannelListEntry -> Bool)
-> Zipper a ChannelListEntry -> Maybe (Zipper a ChannelListEntry)
forall b a. (b -> Bool) -> Zipper a b -> Maybe (Zipper a b)
Z.maybeFindRight ChannelListEntry -> Bool
matches Zipper a ChannelListEntry
z)

leaveCurrentChannel :: MH ()
leaveCurrentChannel :: MH ()
leaveCurrentChannel = do
    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
    Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId) MH ChannelId -> (ChannelId -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChannelId -> MH ()
leaveChannel

createGroupChannel :: Text -> MH ()
createGroupChannel :: Text -> MH ()
createGroupChannel Text
usernameList = do
    User
me <- (ChatState -> User) -> MH User
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
    Session
session <- MH Session
getSession
    ClientChannels
cs <- Getting ClientChannels ChatState ClientChannels
-> MH ClientChannels
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels

    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        let usernames :: Seq Text
usernames = [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList ([Text] -> Seq Text) -> [Text] -> Seq Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
trimUserSigil ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
usernameList
        Seq User
results <- Seq Text -> Session -> IO (Seq User)
MM.mmGetUsersByUsernames Seq Text
usernames Session
session

        -- If we found all of the users mentioned, then create the group
        -- channel.
        case Seq User -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq User
results Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Text
usernames of
            Bool
True -> do
                Channel
chan <- Seq UserId -> Session -> IO Channel
MM.mmCreateGroupMessageChannel (User -> UserId
userId (User -> UserId) -> Seq User -> Seq UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq User
results) Session
session
                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                    case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById (Channel -> ChannelId
channelId Channel
chan) ClientChannels
cs of
                      Just ClientChannel
_ ->
                          -- If we already know about the channel ID,
                          -- that means the channel already exists so
                          -- we can just switch to it.
                          ChannelId -> MH ()
setFocus (Channel -> ChannelId
channelId Channel
chan)
                      Maybe ClientChannel
Nothing -> do
                          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)
-> ((Maybe PendingChannelChange
     -> Identity (Maybe PendingChannelChange))
    -> TeamState -> Identity TeamState)
-> (Maybe PendingChannelChange
    -> Identity (Maybe PendingChannelChange))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Identity (Maybe PendingChannelChange))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange ((Maybe PendingChannelChange
  -> Identity (Maybe PendingChannelChange))
 -> ChatState -> Identity ChatState)
-> Maybe PendingChannelChange -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
                              (PendingChannelChange -> Maybe PendingChannelChange
forall a. a -> Maybe a
Just (PendingChannelChange -> Maybe PendingChannelChange)
-> PendingChannelChange -> Maybe PendingChannelChange
forall a b. (a -> b) -> a -> b
$ TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId (Channel -> ChannelId
channelId Channel
chan) Maybe (MH ())
forall a. Maybe a
Nothing)
                          let pref :: Preference
pref = ChannelId -> UserId -> Preference
showGroupChannelPref (Channel -> ChannelId
channelId Channel
chan) (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL)
                          AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                            UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
                            Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ Preference -> MH ()
applyPreferenceChange Preference
pref
            Bool
False -> do
                let foundUsernames :: Seq Text
foundUsernames = User -> Text
userUsername (User -> Text) -> Seq User -> Seq Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq User
results
                    missingUsernames :: [Text]
missingUsernames = Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$
                                       Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.difference ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Text
usernames)
                                                    ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Text
foundUsernames)
                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                    [Text] -> (Text -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
missingUsernames (MHError -> MH ()
mhError (MHError -> MH ()) -> (Text -> MHError) -> Text -> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MHError
NoSuchUser)

channelHistoryForward :: MH ()
channelHistoryForward :: MH ()
channelHistoryForward = do
    MH ()
resetAutocomplete

    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    Maybe Int
inputHistoryPos <- Getting (Maybe Int) ChatState (Maybe Int) -> MH (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe Int) TeamState)
-> ChatState -> Const (Maybe Int) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe Int) TeamState)
 -> ChatState -> Const (Maybe Int) ChatState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> TeamState -> Const (Maybe Int) TeamState)
-> Getting (Maybe Int) ChatState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe Int) ChatEditState)
-> TeamState -> Const (Maybe Int) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe Int) ChatEditState)
 -> TeamState -> Const (Maybe Int) TeamState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> TeamState
-> Const (Maybe Int) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> ChatEditState -> Const (Maybe Int) ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
 -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ChatEditState
-> Const (Maybe Int) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> EphemeralEditState -> Const (Maybe Int) EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)
    case Maybe Int
inputHistoryPos of
        Just Int
i
          | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> do
            -- Transition out of history navigation
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> TeamState -> Identity TeamState)
-> (Maybe Int -> Identity (Maybe Int))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> ChatEditState -> Identity ChatEditState)
-> (Maybe Int -> Identity (Maybe Int))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Identity EphemeralEditState)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Identity EphemeralEditState)
 -> ChatEditState -> Identity ChatEditState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> EphemeralEditState -> Identity EphemeralEditState)
-> (Maybe Int -> Identity (Maybe Int))
-> ChatEditState
-> Identity ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Identity (Maybe Int))
-> EphemeralEditState -> Identity EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition ((Maybe Int -> Identity (Maybe Int))
 -> ChatState -> Identity ChatState)
-> Maybe Int -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
forall a. Maybe a
Nothing
            MH ()
loadLastChannelInput
          | Bool
otherwise -> do
            let newI :: Int
newI = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            ChannelId -> Int -> MH ()
loadHistoryEntryToEditor ChannelId
cId Int
newI
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> TeamState -> Identity TeamState)
-> (Maybe Int -> Identity (Maybe Int))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> ChatEditState -> Identity ChatEditState)
-> (Maybe Int -> Identity (Maybe Int))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Identity EphemeralEditState)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Identity EphemeralEditState)
 -> ChatEditState -> Identity ChatEditState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> EphemeralEditState -> Identity EphemeralEditState)
-> (Maybe Int -> Identity (Maybe Int))
-> ChatEditState
-> Identity ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Identity (Maybe Int))
-> EphemeralEditState -> Identity EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition ((Maybe Int -> Identity (Maybe Int))
 -> ChatState -> Identity ChatState)
-> Maybe Int -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newI)
        Maybe Int
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

loadHistoryEntryToEditor :: ChannelId -> Int -> MH ()
loadHistoryEntryToEditor :: ChannelId -> Int -> MH ()
loadHistoryEntryToEditor ChannelId
cId Int
idx = do
    InputHistory
inputHistory <- Getting InputHistory ChatState InputHistory -> MH InputHistory
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting InputHistory ChatState InputHistory
Lens' ChatState InputHistory
csInputHistory
    case ChannelId -> Int -> InputHistory -> Maybe Text
getHistoryEntry ChannelId
cId Int
idx InputHistory
inputHistory of
        Maybe Text
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Text
entry -> do
            let eLines :: [Text]
eLines = Text -> [Text]
T.lines Text
entry
                mv :: TextZipper Text -> TextZipper Text
mv = if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
eLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL else TextZipper Text -> TextZipper Text
forall a. a -> a
id
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((TextZipper Text -> Identity (TextZipper Text))
    -> TeamState -> Identity TeamState)
-> (TextZipper Text -> Identity (TextZipper Text))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((TextZipper Text -> Identity (TextZipper Text))
    -> ChatEditState -> Identity ChatEditState)
-> (TextZipper Text -> Identity (TextZipper Text))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Identity (Editor Text Name))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor((Editor Text Name -> Identity (Editor Text Name))
 -> ChatEditState -> Identity ChatEditState)
-> ((TextZipper Text -> Identity (TextZipper Text))
    -> Editor Text Name -> Identity (Editor Text Name))
-> (TextZipper Text -> Identity (TextZipper Text))
-> ChatEditState
-> Identity ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextZipper Text -> Identity (TextZipper Text))
-> Editor Text Name -> Identity (Editor Text Name)
forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL ((TextZipper Text -> Identity (TextZipper Text))
 -> ChatState -> Identity ChatState)
-> TextZipper Text -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (TextZipper Text -> TextZipper Text
mv (TextZipper Text -> TextZipper Text)
-> TextZipper Text -> TextZipper Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Int -> TextZipper Text
textZipper [Text]
eLines Maybe Int
forall a. Maybe a
Nothing)

channelHistoryBackward :: MH ()
channelHistoryBackward :: MH ()
channelHistoryBackward = do
    MH ()
resetAutocomplete

    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    Maybe Int
inputHistoryPos <- Getting (Maybe Int) ChatState (Maybe Int) -> MH (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe Int) TeamState)
-> ChatState -> Const (Maybe Int) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe Int) TeamState)
 -> ChatState -> Const (Maybe Int) ChatState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> TeamState -> Const (Maybe Int) TeamState)
-> Getting (Maybe Int) ChatState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe Int) ChatEditState)
-> TeamState -> Const (Maybe Int) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe Int) ChatEditState)
 -> TeamState -> Const (Maybe Int) TeamState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> TeamState
-> Const (Maybe Int) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> ChatEditState -> Const (Maybe Int) ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
 -> ChatEditState -> Const (Maybe Int) ChatEditState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ChatEditState
-> Const (Maybe Int) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> EphemeralEditState -> Const (Maybe Int) EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)
    MH ()
saveCurrentChannelInput

    let newI :: Int
newI = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
inputHistoryPos
    ChannelId -> Int -> MH ()
loadHistoryEntryToEditor ChannelId
cId Int
newI
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> TeamState -> Identity TeamState)
-> (Maybe Int -> Identity (Maybe Int))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> ChatEditState -> Identity ChatEditState)
-> (Maybe Int -> Identity (Maybe Int))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Identity EphemeralEditState)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Identity EphemeralEditState)
 -> ChatEditState -> Identity ChatEditState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> EphemeralEditState -> Identity EphemeralEditState)
-> (Maybe Int -> Identity (Maybe Int))
-> ChatEditState
-> Identity ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Identity (Maybe Int))
-> EphemeralEditState -> Identity EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition ((Maybe Int -> Identity (Maybe Int))
 -> ChatState -> Identity ChatState)
-> Maybe Int -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newI)

createOrdinaryChannel :: Bool -> Text -> MH ()
createOrdinaryChannel :: Bool -> Text -> MH ()
createOrdinaryChannel Bool
public Text
name = do
    Session
session <- MH Session
getSession
    TeamId
myTId <- 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
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        -- create a new chat channel
        let slug :: Text
slug = (Char -> Char) -> Text -> Text
T.map (\ Char
c -> if Char -> Bool
isAlphaNum Char
c then Char
c else Char
'-') (Text -> Text
T.toLower Text
name)
            minChannel :: MinChannel
minChannel = MinChannel :: Text
-> Text -> Maybe Text -> Maybe Text -> Type -> TeamId -> MinChannel
MinChannel
              { minChannelName :: Text
minChannelName        = Text
slug
              , minChannelDisplayName :: Text
minChannelDisplayName = Text
name
              , minChannelPurpose :: Maybe Text
minChannelPurpose     = Maybe Text
forall a. Maybe a
Nothing
              , minChannelHeader :: Maybe Text
minChannelHeader      = Maybe Text
forall a. Maybe a
Nothing
              , minChannelType :: Type
minChannelType        = if Bool
public then Type
Ordinary else Type
Private
              , minChannelTeamId :: TeamId
minChannelTeamId      = TeamId
myTId
              }
        IO (Channel, ChannelMember)
-> ((Channel, ChannelMember) -> IO (Maybe (MH ())))
-> IO (Maybe (MH ()))
forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM (do Channel
c <- MinChannel -> Session -> IO Channel
MM.mmCreateChannel MinChannel
minChannel Session
session
                  Channel
chan <- ChannelId -> Session -> IO Channel
MM.mmGetChannel (Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
c) Session
session
                  ChannelMember
member <- ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember (Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
c) UserParam
UserMe Session
session
                  (Channel, ChannelMember) -> IO (Channel, ChannelMember)
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel
chan, ChannelMember
member)
              )
              (Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> ((Channel, ChannelMember) -> Maybe (MH ()))
-> (Channel, ChannelMember)
-> IO (Maybe (MH ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ()))
-> ((Channel, ChannelMember) -> MH ())
-> (Channel, ChannelMember)
-> Maybe (MH ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Channel -> ChannelMember -> MH ())
-> (Channel, ChannelMember) -> MH ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel Bool
True SidebarUpdate
SidebarUpdateImmediate))

-- | When we are added to a channel not locally known about, we need
-- to fetch the channel info for that channel.
handleChannelInvite :: ChannelId -> MH ()
handleChannelInvite :: ChannelId -> MH ()
handleChannelInvite ChannelId
cId = do
    Session
session <- MH Session
getSession
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        ChannelMember
member <- ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember ChannelId
cId UserParam
UserMe Session
session
        IO Channel -> (Channel -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM (ChannelId -> Session -> IO Channel
MM.mmGetChannel ChannelId
cId Session
session)
              (\Channel
cwd -> Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                  Maybe (Maybe (MH ()))
pending <- ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange ChannelId
cId
                  Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel (Maybe (Maybe (MH ())) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Maybe (MH ()))
pending) SidebarUpdate
SidebarUpdateImmediate Channel
cwd ChannelMember
member)

addUserByNameToCurrentChannel :: Text -> MH ()
addUserByNameToCurrentChannel :: Text -> MH ()
addUserByNameToCurrentChannel Text
uname =
    UserFetch -> (UserInfo -> MH ()) -> MH ()
withFetchedUser (Text -> UserFetch
UserFetchByUsername Text
uname) UserInfo -> MH ()
addUserToCurrentChannel

addUserToCurrentChannel :: UserInfo -> MH ()
addUserToCurrentChannel :: UserInfo -> MH ()
addUserToCurrentChannel UserInfo
u = do
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    Session
session <- MH Session
getSession
    let channelMember :: MinChannelMember
channelMember = UserId -> ChannelId -> MinChannelMember
MinChannelMember (UserInfo
uUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId) ChannelId
cId
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        IO () -> (() -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM (IO ChannelMember -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ChannelMember -> IO ()) -> IO ChannelMember -> IO ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> MinChannelMember -> Session -> IO ChannelMember
MM.mmAddUser ChannelId
cId MinChannelMember
channelMember Session
session)
              (IO (Maybe (MH ())) -> () -> IO (Maybe (MH ()))
forall a b. a -> b -> a
const (IO (Maybe (MH ())) -> () -> IO (Maybe (MH ())))
-> IO (Maybe (MH ())) -> () -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing)

removeUserFromCurrentChannel :: Text -> MH ()
removeUserFromCurrentChannel :: Text -> MH ()
removeUserFromCurrentChannel Text
uname =
    UserFetch -> (UserInfo -> MH ()) -> MH ()
withFetchedUser (Text -> UserFetch
UserFetchByUsername Text
uname) ((UserInfo -> MH ()) -> MH ()) -> (UserInfo -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \UserInfo
u -> do
        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
        ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
        Session
session <- MH Session
getSession
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            IO () -> (() -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM (IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> UserParam -> Session -> IO ()
MM.mmRemoveUserFromChannel ChannelId
cId (UserId -> UserParam
UserById (UserId -> UserParam) -> UserId -> UserParam
forall a b. (a -> b) -> a -> b
$ UserInfo
uUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId) Session
session)
                  (IO (Maybe (MH ())) -> () -> IO (Maybe (MH ()))
forall a b. a -> b -> a
const (IO (Maybe (MH ())) -> () -> IO (Maybe (MH ())))
-> IO (Maybe (MH ())) -> () -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing)

startLeaveCurrentChannel :: MH ()
startLeaveCurrentChannel :: MH ()
startLeaveCurrentChannel = do
    ChannelInfo
cInfo <- Getting ChannelInfo ChatState ChannelInfo -> MH ChannelInfo
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ClientChannel -> Const ChannelInfo ClientChannel)
-> ChatState -> Const ChannelInfo ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const ChannelInfo ClientChannel)
 -> ChatState -> Const ChannelInfo ChatState)
-> ((ChannelInfo -> Const ChannelInfo ChannelInfo)
    -> ClientChannel -> Const ChannelInfo ClientChannel)
-> Getting ChannelInfo ChatState ChannelInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Const ChannelInfo ChannelInfo)
-> ClientChannel -> Const ChannelInfo ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo)
    case ChannelInfo
cInfoChannelInfo
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Type
forall s a. s -> Getting a s a -> a
^.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType of
        Type
Direct -> ChannelId -> MH ()
hideDMChannel (ChannelInfo
cInfoChannelInfo -> Getting ChannelId ChannelInfo ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId ChannelInfo ChannelId
Lens' ChannelInfo ChannelId
cdChannelId)
        Type
Group -> ChannelId -> MH ()
hideDMChannel (ChannelInfo
cInfoChannelInfo -> Getting ChannelId ChannelInfo ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId ChannelInfo ChannelId
Lens' ChannelInfo ChannelId
cdChannelId)
        Type
_ -> Mode -> MH ()
setMode Mode
LeaveChannelConfirm

deleteCurrentChannel :: MH ()
deleteCurrentChannel :: MH ()
deleteCurrentChannel = do
    Mode -> MH ()
setMode Mode
Main
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    ChannelId -> Bool -> MH ()
leaveChannelIfPossible ChannelId
cId Bool
True

isCurrentChannel :: ChatState -> ChannelId -> Bool
isCurrentChannel :: ChatState -> ChannelId -> Bool
isCurrentChannel ChatState
st ChannelId
cId = ChatState
stChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId(ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId) ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId
cId

isRecentChannel :: ChatState -> ChannelId -> Bool
isRecentChannel :: ChatState -> ChannelId -> Bool
isRecentChannel ChatState
st ChannelId
cId = ChatState
stChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsRecentChannel Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId

isReturnChannel :: ChatState -> ChannelId -> Bool
isReturnChannel :: ChatState -> ChannelId -> Bool
isReturnChannel ChatState
st ChannelId
cId = ChatState
stChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Maybe ChannelId) TeamState)
-> ChatState -> Const (Maybe ChannelId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe ChannelId) TeamState)
 -> ChatState -> Const (Maybe ChannelId) ChatState)
-> ((Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
    -> TeamState -> Const (Maybe ChannelId) TeamState)
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ChannelId -> Const (Maybe ChannelId) (Maybe ChannelId))
-> TeamState -> Const (Maybe ChannelId) TeamState
Lens' TeamState (Maybe ChannelId)
tsReturnChannel Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId

joinChannelByName :: Text -> MH ()
joinChannelByName :: Text -> MH ()
joinChannelByName Text
rawName = do
    Session
session <- MH Session
getSession
    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
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Either SomeException Channel
result <- IO Channel -> IO (Either SomeException Channel)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Channel -> IO (Either SomeException Channel))
-> IO Channel -> IO (Either SomeException Channel)
forall a b. (a -> b) -> a -> b
$ TeamId -> Text -> Session -> IO Channel
MM.mmGetChannelByName TeamId
tId (Text -> Text
trimChannelSigil Text
rawName) Session
session
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ case Either SomeException Channel
result of
            Left (SomeException
_::SomeException) -> MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchChannel Text
rawName
            Right Channel
chan -> ChannelId -> MH ()
joinChannel (ChannelId -> MH ()) -> ChannelId -> MH ()
forall a b. (a -> b) -> a -> b
$ Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
chan

-- | If the user is not a member of the specified channel, submit a
-- request to join it. Otherwise switch to the channel.
joinChannel :: ChannelId -> MH ()
joinChannel :: ChannelId -> MH ()
joinChannel ChannelId
chanId = ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' ChannelId
chanId Maybe (MH ())
forall a. Maybe a
Nothing

joinChannel' :: ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' :: ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' ChannelId
chanId Maybe (MH ())
act = do
    Mode -> MH ()
setMode Mode
Main
    Maybe ClientChannel
mChan <- Getting (First ClientChannel) ChatState ClientChannel
-> MH (Maybe ClientChannel)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
chanId))
    case Maybe ClientChannel
mChan of
        Just ClientChannel
_ -> do
            ChannelId -> MH ()
setFocus ChannelId
chanId
            MH () -> Maybe (MH ()) -> MH ()
forall a. a -> Maybe a -> a
fromMaybe (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
act
        Maybe ClientChannel
Nothing -> do
            UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
            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
            let member :: MinChannelMember
member = UserId -> ChannelId -> MinChannelMember
MinChannelMember UserId
myId ChannelId
chanId
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe PendingChannelChange
     -> Identity (Maybe PendingChannelChange))
    -> TeamState -> Identity TeamState)
-> (Maybe PendingChannelChange
    -> Identity (Maybe PendingChannelChange))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Identity (Maybe PendingChannelChange))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange ((Maybe PendingChannelChange
  -> Identity (Maybe PendingChannelChange))
 -> ChatState -> Identity ChatState)
-> Maybe PendingChannelChange -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (PendingChannelChange -> Maybe PendingChannelChange
forall a. a -> Maybe a
Just (PendingChannelChange -> Maybe PendingChannelChange)
-> PendingChannelChange -> Maybe PendingChannelChange
forall a b. (a -> b) -> a -> b
$ TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId ChannelId
chanId Maybe (MH ())
act)
            DoAsyncChannelMM ChannelMember
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
chanId (\ Session
s ChannelId
c -> ChannelId -> MinChannelMember -> Session -> IO ChannelMember
MM.mmAddUser ChannelId
c MinChannelMember
member Session
s) ((ChannelMember -> Maybe (MH ()))
-> ChannelId -> ChannelMember -> Maybe (MH ())
forall a b. a -> b -> a
const ((ChannelMember -> Maybe (MH ()))
 -> ChannelId -> ChannelMember -> Maybe (MH ()))
-> (ChannelMember -> Maybe (MH ()))
-> ChannelId
-> ChannelMember
-> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ Maybe (MH ()) -> ChannelMember -> Maybe (MH ())
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
act)

createOrFocusDMChannel :: UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel :: UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel UserInfo
user Maybe (ChannelId -> MH ())
successAct = do
    ClientChannels
cs <- Getting ClientChannels ChatState ClientChannels
-> MH ClientChannels
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels
    case UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor (UserInfo
userUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId) ClientChannels
cs of
        Just ChannelId
cId -> do
            ChannelId -> MH ()
setFocus ChannelId
cId
            case Maybe (ChannelId -> MH ())
successAct of
                Maybe (ChannelId -> MH ())
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just ChannelId -> MH ()
act -> ChannelId -> MH ()
act ChannelId
cId
        Maybe ChannelId
Nothing -> do
            -- We have a user of that name but no channel. Time to make one!
            UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
            Session
session <- MH Session
getSession
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe PendingChannelChange
     -> Identity (Maybe PendingChannelChange))
    -> TeamState -> Identity TeamState)
-> (Maybe PendingChannelChange
    -> Identity (Maybe PendingChannelChange))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Identity (Maybe PendingChannelChange))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange ((Maybe PendingChannelChange
  -> Identity (Maybe PendingChannelChange))
 -> ChatState -> Identity ChatState)
-> Maybe PendingChannelChange -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (PendingChannelChange -> Maybe PendingChannelChange
forall a. a -> Maybe a
Just (PendingChannelChange -> Maybe PendingChannelChange)
-> PendingChannelChange -> Maybe PendingChannelChange
forall a b. (a -> b) -> a -> b
$ UserId -> PendingChannelChange
ChangeByUserId (UserId -> PendingChannelChange) -> UserId -> PendingChannelChange
forall a b. (a -> b) -> a -> b
$ UserInfo
userUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId)
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                -- create a new channel
                Channel
chan <- (UserId, UserId) -> Session -> IO Channel
MM.mmCreateDirectMessageChannel (UserInfo
userUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId, UserId
myId) Session
session
                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ Maybe (ChannelId -> MH ())
successAct Maybe (ChannelId -> MH ()) -> Maybe ChannelId -> Maybe (MH ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChannelId -> Maybe ChannelId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Channel -> ChannelId
channelId Channel
chan)

-- | This switches to the named channel or creates it if it is a missing
-- but valid user channel.
changeChannelByName :: Text -> MH ()
changeChannelByName :: Text -> MH ()
changeChannelByName Text
name = do
    UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    Maybe ChannelId
mCId <- (ChatState -> Maybe ChannelId) -> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Text -> ChatState -> Maybe ChannelId
channelIdByChannelName Text
name)
    Maybe ChannelId
mDMCId <- (ChatState -> Maybe ChannelId) -> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Text -> ChatState -> Maybe ChannelId
channelIdByUsername Text
name)

    UserFetch -> (Maybe UserInfo -> MH ()) -> MH ()
withFetchedUserMaybe (Text -> UserFetch
UserFetchByUsername Text
name) ((Maybe UserInfo -> MH ()) -> MH ())
-> (Maybe UserInfo -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Maybe UserInfo
foundUser -> do
        if (UserInfo -> UserId
_uiId (UserInfo -> UserId) -> Maybe UserInfo -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserInfo
foundUser) Maybe UserId -> Maybe UserId -> Bool
forall a. Eq a => a -> a -> Bool
== UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
myId
        then () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else do
            Mode -> MH ()
setMode Mode
Main
            let err :: MH ()
err = MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
AmbiguousName Text
name
            case (Maybe ChannelId
mCId, Maybe ChannelId
mDMCId) of
              (Maybe ChannelId
Nothing, Maybe ChannelId
Nothing) ->
                  case Maybe UserInfo
foundUser of
                      -- We know about the user but there isn't already a DM
                      -- channel, so create one.
                      Just UserInfo
user -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel UserInfo
user Maybe (ChannelId -> MH ())
forall a. Maybe a
Nothing
                      -- There were no matches of any kind.
                      Maybe UserInfo
Nothing -> MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchChannel Text
name
              (Just ChannelId
cId, Maybe ChannelId
Nothing)
                  -- We matched a channel and there was an explicit sigil, so we
                  -- don't care about the username match.
                  | Text
normalChannelSigil Text -> Text -> Bool
`T.isPrefixOf` Text
name -> ChannelId -> MH ()
setFocus ChannelId
cId
                  -- We matched both a channel and a user, even though there is
                  -- no DM channel.
                  | Just UserInfo
_ <- Maybe UserInfo
foundUser -> MH ()
err
                  -- We matched a channel only.
                  | Bool
otherwise -> ChannelId -> MH ()
setFocus ChannelId
cId
              (Maybe ChannelId
Nothing, Just ChannelId
cId) ->
                  -- We matched a DM channel only.
                  ChannelId -> MH ()
setFocus ChannelId
cId
              (Just ChannelId
_, Just ChannelId
_) ->
                  -- We matched both a channel and a DM channel.
                  MH ()
err

setChannelTopic :: Text -> MH ()
setChannelTopic :: Text -> MH ()
setChannelTopic Text
msg = do
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    let patch :: ChannelPatch
patch = ChannelPatch
defaultChannelPatch { channelPatchHeader :: Maybe Text
channelPatchHeader = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg }
    DoAsyncChannelMM Channel
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
        (\Session
s ChannelId
_ -> ChannelId -> ChannelPatch -> Session -> IO Channel
MM.mmPatchChannel ChannelId
cId ChannelPatch
patch Session
s)
        (\ChannelId
_ Channel
_ -> Maybe (MH ())
forall a. Maybe a
Nothing)

-- | This renames the current channel's url name. It makes a request
-- to the server to change the name, but does not actually change the
-- name in Matterhorn yet; that is handled by a websocket event handled
-- asynchronously.
renameChannelUrl :: Text -> MH ()
renameChannelUrl :: Text -> MH ()
renameChannelUrl Text
name = do
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    Session
s <- MH Session
getSession
    let patch :: ChannelPatch
patch = ChannelPatch
defaultChannelPatch { channelPatchName :: Maybe Text
channelPatchName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name }
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Channel
_ <- ChannelId -> ChannelPatch -> Session -> IO Channel
MM.mmPatchChannel ChannelId
cId ChannelPatch
patch Session
s
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing

getCurrentChannelTopic :: MH Text
getCurrentChannelTopic :: MH Text
getCurrentChannelTopic = do
    ClientChannel
ch <- Getting ClientChannel ChatState ClientChannel -> MH ClientChannel
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannel ChatState ClientChannel
Lens' ChatState ClientChannel
csCurrentChannel
    Text -> MH Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MH Text) -> Text -> MH Text
forall a b. (a -> b) -> a -> b
$ ClientChannel
chClientChannel -> Getting Text ClientChannel Text -> Text
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Text ChannelInfo)
-> ClientChannel -> Const Text ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Text ChannelInfo)
 -> ClientChannel -> Const Text ClientChannel)
-> ((Text -> Const Text Text)
    -> ChannelInfo -> Const Text ChannelInfo)
-> Getting Text ClientChannel Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text) -> ChannelInfo -> Const Text ChannelInfo
Lens' ChannelInfo Text
cdHeader

beginCurrentChannelDeleteConfirm :: MH ()
beginCurrentChannelDeleteConfirm :: MH ()
beginCurrentChannelDeleteConfirm = do
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
        let chType :: Type
chType = ClientChannel
chanClientChannel -> Getting Type ClientChannel Type -> Type
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Getting Type ClientChannel Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType
        if Type
chType Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
/= Type
Direct
            then Mode -> MH ()
setMode Mode
DeleteChannelConfirm
            else MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
"Direct message channels cannot be deleted."

updateChannelNotifyProps :: ChannelId -> ChannelNotifyProps -> MH ()
updateChannelNotifyProps :: ChannelId -> ChannelNotifyProps -> MH ()
updateChannelNotifyProps ChannelId
cId ChannelNotifyProps
notifyProps = do
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
        case ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
            Maybe TeamId
Nothing -> do
                HashMap TeamId TeamState
ts <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
                [TeamId] -> (TeamId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) (EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ())
-> (TeamId -> EventM Name ()) -> TeamId -> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ())
-> (TeamId -> Name) -> TeamId -> EventM Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Name
ChannelSidebar)
            Just TeamId
tId -> EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId

        ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((ChannelNotifyProps -> Identity ChannelNotifyProps)
    -> ClientChannel -> Identity ClientChannel)
-> (ChannelNotifyProps -> Identity ChannelNotifyProps)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((ChannelNotifyProps -> Identity ChannelNotifyProps)
    -> ChannelInfo -> Identity ChannelInfo)
-> (ChannelNotifyProps -> Identity ChannelNotifyProps)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelNotifyProps -> Identity ChannelNotifyProps)
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo ChannelNotifyProps
cdNotifyProps ((ChannelNotifyProps -> Identity ChannelNotifyProps)
 -> ChatState -> Identity ChatState)
-> ChannelNotifyProps -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ChannelNotifyProps
notifyProps

toggleChannelFavoriteStatus :: MH ()
toggleChannelFavoriteStatus :: MH ()
toggleChannelFavoriteStatus = do
    UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    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
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    UserPreferences
userPrefs <- Getting UserPreferences ChatState UserPreferences
-> MH UserPreferences
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const UserPreferences ChatResources)
 -> ChatState -> Const UserPreferences ChatState)
-> ((UserPreferences -> Const UserPreferences UserPreferences)
    -> ChatResources -> Const UserPreferences ChatResources)
-> Getting UserPreferences ChatState UserPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources
Lens' ChatResources UserPreferences
crUserPreferences)
    Session
session <- MH Session
getSession
    let favPref :: Maybe Bool
favPref = UserPreferences -> ChannelId -> Maybe Bool
favoriteChannelPreference UserPreferences
userPrefs ChannelId
cId
        trueVal :: Text
trueVal = Text
"true"
        prefVal :: Text
prefVal =  case Maybe Bool
favPref of
            Just Bool
True -> Text
""
            Just Bool
False -> Text
trueVal
            Maybe Bool
Nothing -> Text
trueVal
        pref :: Preference
pref = Preference :: UserId
-> PreferenceCategory
-> PreferenceName
-> PreferenceValue
-> Preference
Preference
            { preferenceUserId :: UserId
preferenceUserId = UserId
myId
            , preferenceCategory :: PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryFavoriteChannel
            , preferenceName :: PreferenceName
preferenceName = Text -> PreferenceName
PreferenceName (Text -> PreferenceName) -> Text -> PreferenceName
forall a b. (a -> b) -> a -> b
$ ChannelId -> Text
forall x. IsId x => x -> Text
idString ChannelId
cId
            , preferenceValue :: PreferenceValue
preferenceValue = Text -> PreferenceValue
PreferenceValue Text
prefVal
            }
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing