{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
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
, inputHistoryForward
, inputHistoryBackward
, handleNewChannel
, createOrdinaryChannel
, handleChannelInvite
, addUserByNameToCurrentChannel
, addUserToCurrentChannel
, removeUserFromCurrentChannel
, removeChannelFromState
, isRecentChannel
, isReturnChannel
, isCurrentChannel
, deleteCurrentChannel
, startLeaveCurrentChannel
, joinChannel
, joinChannel'
, joinChannelByName
, changeChannelByName
, setChannelTopic
, getCurrentChannelTopic
, beginCurrentChannelDeleteConfirm
, toggleExpandedChannelTopics
, updateChannelNotifyProps
, renameChannelUrl
, toggleChannelFavoriteStatus
, toggleChannelListGroupVisibility
, toggleCurrentChannelChannelListGroup
, toggleCurrentChannelChannelListGroupByName
, cycleChannelListSortingMode
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick.Main ( invalidateCache, invalidateCacheEntry
, makeVisible, vScrollToBeginning
, viewportScroll
)
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 hiding ( Lens' )
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 {-# SOURCE #-} Matterhorn.State.Teams
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
(TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Int
cdMentionCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
Bool -> ChannelId -> MH ()
updateViewedChan Bool
updatePrev ChannelId
cId
updateViewedChan :: Bool -> ChannelId -> MH ()
updateViewedChan :: Bool -> ChannelId -> MH ()
updateViewedChan Bool
updatePrev ChannelId
cId = forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ConnectionStatus
csConnectionStatus forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ConnectionStatus
Connected -> do
ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
Maybe ChannelId
pId <- if Bool
updatePrev
then do
case ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
Just TeamId
tId -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsRecentChannel)
Maybe TeamId
Nothing -> do
Maybe TeamId
mtId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
case Maybe TeamId
mtId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just TeamId
tId -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsRecentChannel)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
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 () -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe ChannelId -> ChannelId -> MH ()
setLastViewedFor Maybe ChannelId
pId ChannelId
c)
ConnectionStatus
Disconnected ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
toggleExpandedChannelTopics :: MH ()
toggleExpandedChannelTopics :: MH ()
toggleExpandedChannelTopics = do
forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config Bool
configShowExpandedChannelTopicsL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
hideDMChannel :: ChannelId -> MH ()
hideDMChannel :: ChannelId -> MH ()
hideDMChannel ChannelId
cId = do
User
me <- 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 forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
case ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType of
Type
Direct -> do
let pref :: Preference
pref = UserId -> UserId -> Bool -> Preference
showDirectChannelPref (User
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL) UserId
uId Bool
False
uId :: UserId
uId = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UserId)
cdDMUserId
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Type
Group -> do
let pref :: Preference
pref = ChannelId -> UserId -> Preference
hideGroupChannelPref ChannelId
cId (User
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL)
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Type
_ -> do
MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
"Cannot hide this channel. Consider using /leave instead."
setLastViewedFor :: Maybe ChannelId -> ChannelId -> MH ()
setLastViewedFor :: Maybe ChannelId -> ChannelId -> MH ()
setLastViewedFor Maybe ChannelId
prevId ChannelId
cId = do
Maybe ClientChannel
chan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ClientChannels
csChannelsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId))
case Maybe ClientChannel
chan of
Maybe ClientChannel
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ClientChannel
_ ->
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId (\ Session
s ChannelId
_ ->
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChannelId -> Session -> IO Channel
MM.mmGetChannel ChannelId
cId Session
s
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) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
pcid)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfo 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)
case Maybe ChannelId
prevId of
Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
p -> ChannelId -> MH ()
clearChannelUnreadStatus ChannelId
p
refreshChannelsAndUsers :: MH ()
refreshChannelsAndUsers :: MH ()
refreshChannelsAndUsers = do
Session
session <- MH Session
getSession
User
me <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
[UserId]
knownUsers <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> [UserId]
allUserIds
HashMap TeamId TeamState
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
[(Seq Channel, Seq ChannelMember)]
pairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
forall a. Concurrently a -> IO a
runConcurrently forall a b. (a -> b) -> a -> b
$ (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> Concurrently a
Concurrently (UserParam -> TeamId -> Session -> IO (Seq Channel)
MM.mmGetChannelsForUser UserParam
UserMe TeamId
tId Session
session)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Seq Channel, Seq ChannelMember)]
pairs, forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Seq Channel, Seq ChannelMember)]
pairs)
let dmUsers :: [UserId]
dmUsers = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Channel
chans) forall a b. (a -> b) -> a -> b
$ \Channel
chan ->
case Channel
chanforall s a. s -> Getting a s a -> a
^.Lens' Channel Type
channelTypeL of
Type
Direct -> case UserId -> Text -> Maybe UserId
userIdForDMChannel (User -> UserId
userId User
me) (UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
chan) of
Maybe UserId
Nothing -> forall a. Maybe a
Nothing
Just UserId
otherUserId -> forall a. a -> Maybe a
Just UserId
otherUserId
Type
_ -> forall a. Maybe a
Nothing
uIdsToFetch :: [UserId]
uIdsToFetch = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ User -> UserId
userId User
me forall a. a -> [a] -> [a]
: [UserId]
knownUsers forall a. Semigroup a => a -> a -> a
<> [UserId]
dmUsers
dataMap :: HashMap ChannelId ChannelMember
dataMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ (\ChannelMember
d -> (ChannelMember -> ChannelId
channelMemberChannelId ChannelMember
d, ChannelMember
d)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq ChannelMember
datas
mkPair :: Channel -> (Channel, ChannelMember)
mkPair Channel
chan = (Channel
chan, forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Channel
chans
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
Seq UserId -> MH () -> MH ()
handleNewUsers (forall a. [a] -> Seq a
Seq.fromList [UserId]
uIdsToFetch) forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq (Channel, ChannelMember)
chansWithData forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
SidebarUpdateDeferred)
Maybe TeamId -> MH ()
updateSidebar forall a. Maybe a
Nothing
refreshChannel :: SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel :: SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
upd Channel
chan ChannelMember
member = do
HashMap TeamId TeamState
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
let ourTeams :: [TeamId]
ourTeams = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamId]
ourTeams
case Bool
isOurTeam of
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
True -> do
let cId :: ChannelId
cId = forall x y. HasId x y => x -> y
getId Channel
chan
Maybe ClientChannel
mChan <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe ClientChannel
mChan) 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
-> Bool
-> SidebarUpdate
-> Channel
-> ChannelMember
-> MH ()
handleNewChannel_ :: Bool -> Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel_ Bool
permitPostpone Bool
switch SidebarUpdate
sbUpdate Channel
nc ChannelMember
member = do
User
me <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
Maybe ClientChannel
mChan <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ClientChannel
csChannel(forall x y. HasId x y => x -> y
getId Channel
nc))
case Maybe ClientChannel
mChan of
Just ClientChannel
ch -> do
Maybe TeamId
mtId <- case ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
Just TeamId
i -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just TeamId
i
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
switch forall a b. (a -> b) -> a -> b
$ case Maybe TeamId
mtId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> TeamId -> ChannelId -> MH ()
setFocus TeamId
tId (forall x y. HasId x y => x -> y
getId Channel
nc)
Maybe ClientChannel
Nothing -> do
BChan MHEvent
eventQueue <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (BChan MHEvent)
crEventQueue)
Maybe Aspell
spellChecker <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (Maybe Aspell)
crSpellChecker)
ClientChannel
cChannel <- (Lens' ClientChannel ChannelInfo
ccInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Channel -> ChannelMember -> ChannelInfo -> ChannelInfo
channelInfoFromChannelWithData Channel
nc ChannelMember
member) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *).
MonadIO m =>
BChan MHEvent
-> Maybe Aspell
-> UserId
-> Maybe TeamId
-> Channel
-> m ClientChannel
makeClientChannel BChan MHEvent
eventQueue Maybe Aspell
spellChecker (User
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL) (Channel -> Maybe TeamId
channelTeamId Channel
nc) Channel
nc
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
let chType :: Type
chType = Channel
ncforall s a. s -> Getting a s a -> a
^.Lens' Channel Type
channelTypeL
Bool
register <- case Type
chType of
Type
Direct -> case UserId -> Text -> Maybe UserId
userIdForDMChannel (ChatState -> UserId
myUserId ChatState
st) (UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
nc) of
Maybe UserId
Nothing -> 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
Maybe UserInfo
Nothing -> do
case Bool
permitPostpone of
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
True -> do
LogCategory -> Text -> MH ()
mhLog LogCategory
LogAPI forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"handleNewChannel_: about to call handleNewUsers for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show UserId
otherUserId
Seq UserId -> MH () -> MH ()
handleNewUsers (forall a. a -> Seq a
Seq.singleton UserId
otherUserId) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel_ Bool
False Bool
switch SidebarUpdate
sbUpdate Channel
nc ChannelMember
member
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just UserInfo
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Type
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
register forall a b. (a -> b) -> a -> b
$ do
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel (forall x y. HasId x y => x -> y
getId Channel
nc) ClientChannel
cChannel
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SidebarUpdate
sbUpdate forall a. Eq a => a -> a -> Bool
== SidebarUpdate
SidebarUpdateImmediate) forall a b. (a -> b) -> a -> b
$ do
Maybe TeamId -> MH ()
updateSidebar (ClientChannel
cChannelforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId)
Maybe TeamId
chanTeam <- case ClientChannel
cChannelforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
Just TeamId
i -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just TeamId
i
case Maybe TeamId
chanTeam of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> do
Maybe (Maybe (MH ()))
pending1 <- TeamId -> ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange TeamId
tId (forall x y. HasId x y => x -> y
getId Channel
nc)
Bool
pending2 <- case ClientChannel
cChannelforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UserId)
cdDMUserId of
Maybe UserId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just UserId
uId -> TeamId -> UserId -> MH Bool
checkPendingChannelChangeByUserId TeamId
tId UserId
uId
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
switch Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (Maybe (MH ()))
pending1 Bool -> Bool -> Bool
|| Bool
pending2) forall a b. (a -> b) -> a -> b
$ do
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId (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 ()))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPendingChannelChange :: TeamId -> ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange :: TeamId -> ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange TeamId
curTid ChannelId
cId = do
Maybe PendingChannelChange
ch <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
curTid)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe PendingChannelChange
ch of
Just (ChangeByChannelId TeamId
tId ChannelId
i Maybe (MH ())
act) ->
if ChannelId
i forall a. Eq a => a -> a -> Bool
== ChannelId
cId Bool -> Bool -> Bool
&& TeamId
curTid forall a. Eq a => a -> a -> Bool
== TeamId
tId then forall a. a -> Maybe a
Just Maybe (MH ())
act else forall a. Maybe a
Nothing
Maybe PendingChannelChange
_ -> forall a. Maybe a
Nothing
checkPendingChannelChangeByUserId :: TeamId -> UserId -> MH Bool
checkPendingChannelChangeByUserId :: TeamId -> UserId -> MH Bool
checkPendingChannelChangeByUserId TeamId
tId UserId
uId = do
Maybe PendingChannelChange
ch <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe PendingChannelChange
ch of
Just (ChangeByUserId UserId
i) ->
UserId
i forall a. Eq a => a -> a -> Bool
== UserId
uId
Maybe PendingChannelChange
_ ->
Bool
False
updateChannelInfo :: ChannelId -> Channel -> ChannelMember -> MH ()
updateChannelInfo :: ChannelId -> Channel -> ChannelMember -> MH ()
updateChannelInfo ChannelId
cid Channel
new ChannelMember
member = do
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cid
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cid)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfo 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 forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
Maybe TeamId -> MH ()
updateSidebar (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId)
setFocus :: TeamId -> ChannelId -> MH ()
setFocus :: TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId = do
ChannelId -> Bool -> MH ()
showChannelInSidebar ChannelId
cId Bool
True
TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith TeamId
tId Bool
True (forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight ((forall a. Eq a => a -> a -> Bool
== ChannelId
cId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelListEntry -> ChannelId
channelListEntryChannelId)) (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
setFocusWith :: TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith :: TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith TeamId
tId Bool
updatePrev Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
f MH ()
onChange MH ()
onNoChange = do
Zipper ChannelListGroup ChannelListEntry
oldZipper <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus)
Maybe ChannelId
mOldCid <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId)
let newZipper :: Zipper ChannelListGroup ChannelListEntry
newZipper = Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
f Zipper ChannelListGroup ChannelListEntry
oldZipper
newFocus :: Maybe ChannelListEntry
newFocus = forall a b. Zipper a b -> Maybe b
Z.focus Zipper ChannelListGroup ChannelListEntry
newZipper
oldFocus :: Maybe ChannelListEntry
oldFocus = forall a b. Zipper a b -> Maybe b
Z.focus Zipper ChannelListGroup ChannelListEntry
oldZipper
if Maybe ChannelListEntry
newFocus forall a. Eq a => a -> a -> Bool
/= Maybe ChannelListEntry
oldFocus
then do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId
case Maybe ChannelId
mOldCid of
Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
cId -> forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete (ChannelId -> Lens' ChatState (EditState Name)
channelEditor(ChannelId
cId))
TeamId -> MH ()
preChangeChannelCommon TeamId
tId
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Zipper ChannelListGroup ChannelListEntry
newZipper
UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
Maybe ChannelId
mNewCid <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId)
case Maybe ChannelId
mNewCid of
Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
newCid -> do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
newCid)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just UTCTime
now
Bool -> MH ()
updateViewed Bool
updatePrev
TeamId -> MH ()
postChangeChannelCommon TeamId
tId
case Maybe ChannelListEntry
newFocus of
Maybe ChannelListEntry
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelListEntry
_ -> forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
makeVisible forall a b. (a -> b) -> a -> b
$ TeamId -> Name
SelectedChannelListEntry TeamId
tId
MH ()
onChange
else MH ()
onNoChange
postChangeChannelCommon :: TeamId -> MH ()
postChangeChannelCommon :: TeamId -> MH ()
postChangeChannelCommon TeamId
tId = do
TeamId -> MH ()
fetchVisibleIfNeeded TeamId
tId
loadLastChannelInput :: Lens' ChatState (MessageInterface n i) -> MH ()
loadLastChannelInput :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
loadLastChannelInput Lens' ChatState (MessageInterface n i)
which = do
Maybe Int
inputHistoryPos <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)
case Maybe Int
inputHistoryPos of
Just Int
i -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall n i.
Lens' ChatState (MessageInterface n i) -> Int -> MH Bool
loadHistoryEntryToEditor Lens' ChatState (MessageInterface n i)
which Int
i
Maybe Int
Nothing -> do
(Text
lastEdit, EditMode
lastEditMode) <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Text, EditMode)
eesLastInput)
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany Text
lastEdit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => TextZipper a -> TextZipper a
clearZipper)
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditMode
lastEditMode
preChangeChannelCommon :: TeamId -> MH ()
preChangeChannelCommon :: TeamId -> MH ()
preChangeChannelCommon TeamId
tId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsRecentChannel forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just ChannelId
cId
saveEditorInput :: Lens' ChatState (MessageInterface n i) -> MH ()
saveEditorInput :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
saveEditorInput Lens' ChatState (MessageInterface n i)
which = do
Editor Text n
cmdLine <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor)
EditMode
mode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode)
Maybe Int
inputHistoryPos <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe Int
inputHistoryPos) forall a b. (a -> b) -> a -> b
$
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Text, EditMode)
eesLastInput forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
(Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents forall a b. (a -> b) -> a -> b
$ Editor Text n
cmdLine, EditMode
mode)
applyPreferenceChange :: Preference -> MH ()
applyPreferenceChange :: Preference -> MH ()
applyPreferenceChange Preference
pref = do
Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferences forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Seq Preference -> UserPreferences -> UserPreferences
setUserPreferences (forall a. a -> Seq a
Seq.singleton Preference
pref)
forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
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 forall a. Maybe a
Nothing
ClientChannels
cs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ClientChannels
csChannels
let cId :: ChannelId
cId = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor (DirectChannelShowStatus -> UserId
directChannelShowUserId DirectChannelShowStatus
d) ClientChannels
cs
case DirectChannelShowStatus -> Bool
directChannelShowValue DirectChannelShowStatus
d of
Bool
True -> do
(TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
Maybe (Maybe (MH ()))
pending <- TeamId -> ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange TeamId
tId ChannelId
cId
case Maybe (Maybe (MH ()))
pending of
Just Maybe (MH ())
mAct -> do
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
mAct
Maybe (Maybe (MH ()))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
| Just GroupChannelPreference
g <- Preference -> Maybe GroupChannelPreference
preferenceToGroupChannelPreference Preference
pref -> do
Maybe TeamId -> MH ()
updateSidebar forall a. Maybe a
Nothing
let cId :: ChannelId
cId = GroupChannelPreference -> ChannelId
groupChannelId GroupChannelPreference
g
case GroupChannelPreference -> Bool
groupChannelShow GroupChannelPreference
g of
Bool
True -> do
(TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
Maybe (Maybe (MH ()))
pending <- TeamId -> ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange TeamId
tId ChannelId
cId
case Maybe (Maybe (MH ()))
pending of
Just Maybe (MH ())
mAct -> do
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
mAct
Maybe (Maybe (MH ()))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
| Just FavoriteChannelPreference
f <- Preference -> Maybe FavoriteChannelPreference
preferenceToFavoriteChannelPreference Preference
pref -> do
Maybe TeamId -> MH ()
updateSidebar forall a. Maybe a
Nothing
let cId :: ChannelId
cId = FavoriteChannelPreference -> ChannelId
favoriteChannelId FavoriteChannelPreference
f
case FavoriteChannelPreference -> Bool
favoriteChannelShow FavoriteChannelPreference
f of
Bool
True -> do
(TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
Maybe (Maybe (MH ()))
pending <- TeamId -> ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange TeamId
tId ChannelId
cId
case Maybe (Maybe (MH ()))
pending of
Just Maybe (MH ())
mAct -> do
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
mAct
Maybe (Maybe (MH ()))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
| Bool
otherwise -> 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 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just 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 forall a b. (a -> b) -> a -> b
$ \ ClientChannel
chan -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType forall a. Eq a => a -> a -> Bool
/= Type
Direct) forall a b. (a -> b) -> a -> b
$ do
case ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> do
Maybe ChannelId
origFocus <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ChannelId
origFocus forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ChannelId
cId) (TeamId -> MH ()
nextChannelSkipPrevView TeamId
tId)
Lens' ChatState InputHistory
csInputHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId -> InputHistory -> InputHistory
removeChannelHistory ChannelId
cId
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId -> ClientChannels -> ClientChannels
removeChannel ChannelId
cId
case ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> do
HashMap TeamId TeamState
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall b a. Eq b => (b -> Bool) -> Zipper a b -> Zipper a b
Z.filterZipper ((forall a. Eq a => a -> a -> Bool
/= ChannelId
cId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelListEntry -> ChannelId
channelListEntryChannelId)
Just TeamId
tId -> do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall b a. Eq b => (b -> Bool) -> Zipper a b -> Zipper a b
Z.filterZipper ((forall a. Eq a => a -> a -> Bool
/= ChannelId
cId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelListEntry -> ChannelId
channelListEntryChannelId)
Maybe TeamId -> MH ()
updateSidebar forall a b. (a -> b) -> a -> b
$ ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
nextChannel :: TeamId -> MH ()
nextChannel :: TeamId -> MH ()
nextChannel TeamId
tId = do
TeamId -> MH ()
resetReturnChannel TeamId
tId
let checkForFirst :: MH ()
checkForFirst = do
Zipper ChannelListGroup ChannelListEntry
z <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus)
case forall a b. Zipper a b -> Maybe b
Z.focus Zipper ChannelListGroup ChannelListEntry
z of
Maybe ChannelListEntry
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelListEntry
entry -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChannelListEntry
entry forall a. Eq a => a -> a -> Bool
== (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Zipper a b -> [(a, [b])]
Z.toList Zipper ChannelListGroup ChannelListEntry
z)) forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning forall a b. (a -> b) -> a -> b
$ forall n. n -> ViewportScroll n
viewportScroll (TeamId -> Name
ChannelListViewport TeamId
tId)
TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith TeamId
tId Bool
True forall a b. Zipper a b -> Zipper a b
Z.right MH ()
checkForFirst (forall (m :: * -> *) a. Monad m => a -> m a
return ())
nextChannelSkipPrevView :: TeamId -> MH ()
nextChannelSkipPrevView :: TeamId -> MH ()
nextChannelSkipPrevView TeamId
tId = TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith TeamId
tId Bool
False forall a b. Zipper a b -> Zipper a b
Z.right (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
prevChannel :: TeamId -> MH ()
prevChannel :: TeamId -> MH ()
prevChannel TeamId
tId = do
TeamId -> MH ()
resetReturnChannel TeamId
tId
TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith TeamId
tId Bool
True forall a b. Zipper a b -> Zipper a b
Z.left (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
recentChannel :: TeamId -> MH ()
recentChannel :: TeamId -> MH ()
recentChannel TeamId
tId = do
Maybe ChannelId
recent <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsRecentChannel)
case Maybe ChannelId
recent of
Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
cId -> do
Maybe ChannelId
ret <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ChannelId
ret forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ChannelId
cId) (TeamId -> MH ()
resetReturnChannel TeamId
tId)
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
resetReturnChannel :: TeamId -> MH ()
resetReturnChannel :: TeamId -> MH ()
resetReturnChannel TeamId
tId = do
Maybe ChannelId
val <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
case Maybe ChannelId
val of
Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
_ -> do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsReturnChannel forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
gotoReturnChannel :: TeamId -> MH ()
gotoReturnChannel :: TeamId -> MH ()
gotoReturnChannel TeamId
tId = do
Maybe ChannelId
ret <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
case Maybe ChannelId
ret of
Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
cId -> do
TeamId -> MH ()
resetReturnChannel TeamId
tId
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
setReturnChannel :: TeamId -> MH ()
setReturnChannel :: TeamId -> MH ()
setReturnChannel TeamId
tId = do
Maybe ChannelId
ret <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsReturnChannel)
case Maybe ChannelId
ret of
Maybe ChannelId
Nothing -> do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsReturnChannel forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just ChannelId
cId
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId
Just ChannelId
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
nextUnreadChannel :: TeamId -> MH ()
nextUnreadChannel :: TeamId -> MH ()
nextUnreadChannel TeamId
tId = do
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
TeamId -> MH ()
setReturnChannel TeamId
tId
TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith TeamId
tId Bool
True (forall a.
ChatState
-> TeamId -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadChannel ChatState
st TeamId
tId) (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (TeamId -> MH ()
gotoReturnChannel TeamId
tId)
nextUnreadUserOrChannel :: TeamId -> MH ()
nextUnreadUserOrChannel :: TeamId -> MH ()
nextUnreadUserOrChannel TeamId
tId = do
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
TeamId -> MH ()
setReturnChannel TeamId
tId
TeamId
-> Bool
-> (Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
-> MH ()
-> MH ()
setFocusWith TeamId
tId Bool
True (forall a.
ChatState
-> TeamId -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadUserOrChannel ChatState
st TeamId
tId) (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (TeamId -> MH ()
gotoReturnChannel TeamId
tId)
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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
User
me <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
let isMe :: User -> Bool
isMe User
u = User
uforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL forall a. Eq a => a -> a -> Bool
== User
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL
case ChatState
st forall s a. s -> Getting (First a) s a -> Maybe a
^? ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfo of
Maybe ChannelInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelInfo
cInfo -> case ChannelInfo -> Bool
canLeaveChannel ChannelInfo
cInfo of
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
True ->
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
(\Session
s ChannelId
_ ->
let query :: UserQuery
query = UserQuery
MM.defaultUserQuery
{ userQueryPage :: Maybe Int
MM.userQueryPage = forall a. a -> Maybe a
Just Int
0
, userQueryPerPage :: Maybe Int
MM.userQueryPerPage = forall a. a -> Maybe a
Just Int
2
, userQueryInChannel :: Maybe ChannelId
MM.userQueryInChannel = forall a. a -> Maybe a
Just ChannelId
cId
}
in forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
let func :: Session -> ChannelId -> IO ()
func = case ChannelInfo
cInfoforall s a. s -> Getting a s a -> a
^.Lens' ChannelInfo Type
cdType of
Type
Private -> case 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
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL)
in UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (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)
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId Session -> ChannelId -> IO ()
func forall a. ChannelId -> a -> Maybe (MH ())
endAsyncNOP
)
getNextUnreadChannel :: ChatState
-> TeamId
-> (Zipper a ChannelListEntry -> Zipper a ChannelListEntry)
getNextUnreadChannel :: forall a.
ChatState
-> TeamId -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadChannel ChatState
st TeamId
tId =
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
&& (forall a. a -> Maybe a
Just ChannelId
cId forall a. Eq a => a -> a -> Bool
/= ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)))
getNextUnreadUserOrChannel :: ChatState
-> TeamId
-> Zipper a ChannelListEntry
-> Zipper a ChannelListEntry
getNextUnreadUserOrChannel :: forall a.
ChatState
-> TeamId -> Zipper a ChannelListEntry -> Zipper a ChannelListEntry
getNextUnreadUserOrChannel ChatState
st TeamId
tId Zipper a ChannelListEntry
z =
let cur :: Maybe ChannelId
cur = ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
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
&& (forall a. a -> Maybe a
Just (ChannelListEntry -> ChannelId
channelListEntryChannelId ChannelListEntry
e) forall a. Eq a => a -> a -> Bool
/= Maybe ChannelId
cur)
in forall a. a -> Maybe a -> a
fromMaybe (forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight ChannelListEntry -> Bool
isFresh Zipper a ChannelListEntry
z)
(forall b a. (b -> Bool) -> Zipper a b -> Maybe (Zipper a b)
Z.maybeFindRight ChannelListEntry -> Bool
matches Zipper a ChannelListEntry
z)
leaveCurrentChannel :: TeamId -> MH ()
leaveCurrentChannel :: TeamId -> MH ()
leaveCurrentChannel TeamId
tId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
ChannelId -> MH ()
leaveChannel ChannelId
cId
createGroupChannel :: TeamId -> Text -> MH ()
createGroupChannel :: TeamId -> Text -> MH ()
createGroupChannel TeamId
tId Text
usernameList = do
User
me <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
Session
session <- MH Session
getSession
ClientChannels
cs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ClientChannels
csChannels
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
let usernames :: Seq Text
usernames = forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
trimUserSigil 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
case forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq User
results forall a. Eq a => a -> a -> Bool
== 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq User
results) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById (Channel -> ChannelId
channelId Channel
chan) ClientChannels
cs of
Just ClientChannel
_ ->
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId (Channel -> ChannelId
channelId Channel
chan)
Maybe ClientChannel
Nothing -> do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId (Channel -> ChannelId
channelId Channel
chan) forall a. Maybe a
Nothing)
let pref :: Preference
pref = ChannelId -> UserId -> Preference
showGroupChannelPref (Channel -> ChannelId
channelId Channel
chan) (User
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL)
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Preference -> MH ()
applyPreferenceChange Preference
pref
Bool
False -> do
let foundUsernames :: Seq Text
foundUsernames = User -> Text
userUsername forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq User
results
missingUsernames :: [Text]
missingUsernames = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$
forall a. Ord a => Set a -> Set a -> Set a
S.difference (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Text
usernames)
(forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Text
foundUsernames)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
missingUsernames (MHError -> MH ()
mhError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MHError
NoSuchUser)
inputHistoryForward :: Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryForward :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryForward Lens' ChatState (MessageInterface n i)
which = do
forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor)
Maybe Int
inputHistoryPos <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)
case Maybe Int
inputHistoryPos of
Just Int
i
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 -> do
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
loadLastChannelInput Lens' ChatState (MessageInterface n i)
which
| Bool
otherwise -> do
let newI :: Int
newI = Int
i forall a. Num a => a -> a -> a
- Int
1
Bool
loaded <- forall n i.
Lens' ChatState (MessageInterface n i) -> Int -> MH Bool
loadHistoryEntryToEditor Lens' ChatState (MessageInterface n i)
which Int
newI
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
loaded forall a b. (a -> b) -> a -> b
$
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (forall a. a -> Maybe a
Just Int
newI)
Maybe Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
loadHistoryEntryToEditor :: Lens' ChatState (MessageInterface n i) -> Int -> MH Bool
loadHistoryEntryToEditor :: forall n i.
Lens' ChatState (MessageInterface n i) -> Int -> MH Bool
loadHistoryEntryToEditor Lens' ChatState (MessageInterface n i)
which Int
idx = do
ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId)
InputHistory
inputHistory <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState InputHistory
csInputHistory
case ChannelId -> Int -> InputHistory -> Maybe Text
getHistoryEntry ChannelId
cId Int
idx InputHistory
inputHistory of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Text
entry -> do
let eLines :: [Text]
eLines = Text -> [Text]
T.lines Text
entry
mv :: TextZipper Text -> TextZipper Text
mv = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
eLines forall a. Eq a => a -> a -> Bool
== Int
1 then forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL else forall a. a -> a
id
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (TextZipper Text -> TextZipper Text
mv forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Int -> TextZipper Text
textZipper [Text]
eLines forall a. Maybe a
Nothing)
Config
cfg <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configShowMessagePreview Config
cfg) forall a b. (a -> b) -> a -> b
$
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
inputHistoryBackward :: Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryBackward :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryBackward Lens' ChatState (MessageInterface n i)
which = do
forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor)
Maybe Int
inputHistoryPos <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition)
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
saveEditorInput Lens' ChatState (MessageInterface n i)
which
let newI :: Int
newI = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
inputHistoryPos
Bool
loaded <- forall n i.
Lens' ChatState (MessageInterface n i) -> Int -> MH Bool
loadHistoryEntryToEditor Lens' ChatState (MessageInterface n i)
which Int
newI
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
loaded forall a b. (a -> b) -> a -> b
$
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (forall a. a -> Maybe a
Just Int
newI)
createOrdinaryChannel :: TeamId -> Bool -> Text -> MH ()
createOrdinaryChannel :: TeamId -> Bool -> Text -> MH ()
createOrdinaryChannel TeamId
myTId Bool
public Text
name = do
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
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
{ minChannelName :: Text
minChannelName = Text
slug
, minChannelDisplayName :: Text
minChannelDisplayName = Text
name
, minChannelPurpose :: Maybe Text
minChannelPurpose = forall a. Maybe a
Nothing
, minChannelHeader :: Maybe Text
minChannelHeader = forall a. Maybe a
Nothing
, minChannelType :: Type
minChannelType = if Bool
public then Type
Ordinary else Type
Private
, minChannelTeamId :: TeamId
minChannelTeamId = TeamId
myTId
}
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 (forall x y. HasId x y => x -> y
getId Channel
c) Session
session
ChannelMember
member <- ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember (forall x y. HasId x y => x -> y
getId Channel
c) UserParam
UserMe Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel
chan, ChannelMember
member)
)
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel Bool
True SidebarUpdate
SidebarUpdateImmediate))
handleChannelInvite :: ChannelId -> MH ()
handleChannelInvite :: ChannelId -> MH ()
handleChannelInvite ChannelId
cId = do
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
ChannelMember
member <- ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember ChannelId
cId UserParam
UserMe Session
session
forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM (ChannelId -> Session -> IO Channel
MM.mmGetChannel ChannelId
cId Session
session)
(\Channel
cwd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Maybe TeamId
mtId <- case Channel -> Maybe TeamId
channelTeamId Channel
cwd of
Maybe TeamId
Nothing -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
Just TeamId
i -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just TeamId
i
Maybe (Maybe (MH ()))
pending <- case Maybe TeamId
mtId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just TeamId
tId -> TeamId -> ChannelId -> MH (Maybe (Maybe (MH ())))
checkPendingChannelChange TeamId
tId ChannelId
cId
Bool -> SidebarUpdate -> Channel -> ChannelMember -> MH ()
handleNewChannel (forall a. Maybe a -> Bool
isJust Maybe (Maybe (MH ()))
pending) SidebarUpdate
SidebarUpdateImmediate Channel
cwd ChannelMember
member)
addUserByNameToCurrentChannel :: TeamId -> Text -> MH ()
addUserByNameToCurrentChannel :: TeamId -> Text -> MH ()
addUserByNameToCurrentChannel TeamId
tId Text
uname =
UserFetch -> (UserInfo -> MH ()) -> MH ()
withFetchedUser (Text -> UserFetch
UserFetchByUsername Text
uname) (TeamId -> UserInfo -> MH ()
addUserToCurrentChannel TeamId
tId)
addUserToCurrentChannel :: TeamId -> UserInfo -> MH ()
addUserToCurrentChannel :: TeamId -> UserInfo -> MH ()
addUserToCurrentChannel TeamId
tId UserInfo
u = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
Session
session <- MH Session
getSession
let channelMember :: MinChannelMember
channelMember = UserId -> ChannelId -> MinChannelMember
MinChannelMember (UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId) ChannelId
cId
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ChannelId -> MinChannelMember -> Session -> IO ChannelMember
MM.mmAddUser ChannelId
cId MinChannelMember
channelMember Session
session)
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
removeUserFromCurrentChannel :: TeamId -> Text -> MH ()
removeUserFromCurrentChannel :: TeamId -> Text -> MH ()
removeUserFromCurrentChannel TeamId
tId Text
uname =
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
UserFetch -> (UserInfo -> MH ()) -> MH ()
withFetchedUser (Text -> UserFetch
UserFetchByUsername Text
uname) forall a b. (a -> b) -> a -> b
$ \UserInfo
u -> do
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
forall a. IO a -> (a -> IO (Maybe (MH ()))) -> IO (Maybe (MH ()))
tryMM (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ChannelId -> UserParam -> Session -> IO ()
MM.mmRemoveUserFromChannel ChannelId
cId (UserId -> UserParam
UserById forall a b. (a -> b) -> a -> b
$ UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId) Session
session)
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
startLeaveCurrentChannel :: TeamId -> MH ()
startLeaveCurrentChannel :: TeamId -> MH ()
startLeaveCurrentChannel TeamId
tId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
_ ClientChannel
ch -> do
case ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType of
Type
Direct -> ChannelId -> MH ()
hideDMChannel (ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ChannelId
cdChannelId)
Type
Group -> ChannelId -> MH ()
hideDMChannel (ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ChannelId
cdChannelId)
Type
_ -> TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
LeaveChannelConfirm
deleteCurrentChannel :: TeamId -> MH ()
deleteCurrentChannel :: TeamId -> MH ()
deleteCurrentChannel TeamId
tId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
ChannelId -> Bool -> MH ()
leaveChannelIfPossible ChannelId
cId Bool
True
isCurrentChannel :: ChatState -> TeamId -> ChannelId -> Bool
isCurrentChannel :: ChatState -> TeamId -> ChannelId -> Bool
isCurrentChannel ChatState
st TeamId
tId ChannelId
cId = ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ChannelId
cId
isRecentChannel :: ChatState -> TeamId -> ChannelId -> Bool
isRecentChannel :: ChatState -> TeamId -> ChannelId -> Bool
isRecentChannel ChatState
st TeamId
tId ChannelId
cId = ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsRecentChannel forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ChannelId
cId
isReturnChannel :: ChatState -> TeamId -> ChannelId -> Bool
isReturnChannel :: ChatState -> TeamId -> ChannelId -> Bool
isReturnChannel ChatState
st TeamId
tId ChannelId
cId = ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ChannelId)
tsReturnChannel forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ChannelId
cId
joinChannelByName :: TeamId -> Text -> MH ()
joinChannelByName :: TeamId -> Text -> MH ()
joinChannelByName TeamId
tId Text
rawName = do
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
Either SomeException Channel
result <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ TeamId -> Text -> Session -> IO Channel
MM.mmGetChannelByName TeamId
tId (Text -> Text
trimChannelSigil Text
rawName) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Either SomeException Channel
result of
Left (SomeException
_::SomeException) -> MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchChannel Text
rawName
Right Channel
chan -> TeamId -> ChannelId -> MH ()
joinChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ forall x y. HasId x y => x -> y
getId Channel
chan
joinChannel :: TeamId -> ChannelId -> MH ()
joinChannel :: TeamId -> ChannelId -> MH ()
joinChannel TeamId
tId ChannelId
chanId = TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId ChannelId
chanId forall a. Maybe a
Nothing
joinChannel' :: TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' :: TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId ChannelId
chanId Maybe (MH ())
act = do
Maybe ClientChannel
mChan <- 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
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
chanId
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (MH ())
act
Maybe ClientChannel
Nothing -> do
UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
let member :: MinChannelMember
member = UserId -> ChannelId -> MinChannelMember
MinChannelMember UserId
myId ChannelId
chanId
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId ChannelId
chanId Maybe (MH ())
act)
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) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
act)
createOrFocusDMChannel :: TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel :: TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel TeamId
tId UserInfo
user Maybe (ChannelId -> MH ())
successAct = do
ClientChannels
cs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ClientChannels
csChannels
case UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor (UserInfo
userforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId) ClientChannels
cs of
Just ChannelId
cId -> do
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
case Maybe (ChannelId -> MH ())
successAct of
Maybe (ChannelId -> MH ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId -> MH ()
act -> ChannelId -> MH ()
act ChannelId
cId
Maybe ChannelId
Nothing -> do
UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
Session
session <- MH Session
getSession
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UserId -> PendingChannelChange
ChangeByUserId forall a b. (a -> b) -> a -> b
$ UserInfo
userforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId)
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
Channel
chan <- (UserId, UserId) -> Session -> IO Channel
MM.mmCreateDirectMessageChannel (UserInfo
userforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId, UserId
myId) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe (ChannelId -> MH ())
successAct forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Channel -> ChannelId
channelId Channel
chan)
changeChannelByName :: TeamId -> Text -> MH ()
changeChannelByName :: TeamId -> Text -> MH ()
changeChannelByName TeamId
tId Text
name = do
UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
Maybe ChannelId
mCId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (TeamId -> Text -> ChatState -> Maybe ChannelId
channelIdByChannelName TeamId
tId Text
name)
Maybe ChannelId
mDMCId <- 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) forall a b. (a -> b) -> a -> b
$ \Maybe UserInfo
foundUser -> do
if (UserInfo -> UserId
_uiId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserInfo
foundUser) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just UserId
myId
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let err :: MH ()
err = MHError -> MH ()
mhError 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
Just UserInfo
user -> TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel TeamId
tId UserInfo
user forall a. Maybe a
Nothing
Maybe UserInfo
Nothing -> MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchChannel Text
name
(Just ChannelId
cId, Maybe ChannelId
Nothing)
| Text
normalChannelSigil Text -> Text -> Bool
`T.isPrefixOf` Text
name -> TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
| Just UserInfo
_ <- Maybe UserInfo
foundUser -> MH ()
err
| Bool
otherwise -> TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
(Maybe ChannelId
Nothing, Just ChannelId
cId) ->
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
(Just ChannelId
_, Just ChannelId
_) ->
MH ()
err
setChannelTopic :: TeamId -> Text -> MH ()
setChannelTopic :: TeamId -> Text -> MH ()
setChannelTopic TeamId
tId Text
msg = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
let patch :: ChannelPatch
patch = ChannelPatch
defaultChannelPatch { channelPatchHeader :: Maybe Text
channelPatchHeader = forall a. a -> Maybe a
Just Text
msg }
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
_ -> forall a. Maybe a
Nothing)
renameChannelUrl :: TeamId -> Text -> MH ()
renameChannelUrl :: TeamId -> Text -> MH ()
renameChannelUrl TeamId
tId Text
name = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
Session
s <- MH Session
getSession
let patch :: ChannelPatch
patch = ChannelPatch
defaultChannelPatch { channelPatchName :: Maybe Text
channelPatchName = forall a. a -> Maybe a
Just Text
name }
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
Channel
_ <- ChannelId -> ChannelPatch -> Session -> IO Channel
MM.mmPatchChannel ChannelId
cId ChannelPatch
patch Session
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getCurrentChannelTopic :: TeamId -> MH (Maybe Text)
getCurrentChannelTopic :: TeamId -> MH (Maybe Text)
getCurrentChannelTopic TeamId
tId =
forall a.
TeamId
-> (ChannelId -> ClientChannel -> MH (Maybe a)) -> MH (Maybe a)
withCurrentChannel' TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
_ ClientChannel
c -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdHeader
beginCurrentChannelDeleteConfirm :: TeamId -> MH ()
beginCurrentChannelDeleteConfirm :: TeamId -> MH ()
beginCurrentChannelDeleteConfirm TeamId
tId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
_ ClientChannel
chan -> do
let chType :: Type
chType = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType
if Type
chType forall a. Eq a => a -> a -> Bool
/= Type
Direct
then TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
DeleteChannelConfirm
else MHError -> MH ()
mhError 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 forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ChannelNotifyProps
cdNotifyProps forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ChannelNotifyProps
notifyProps
Maybe TeamId -> MH ()
updateSidebar (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId)
toggleChannelFavoriteStatus :: TeamId -> MH ()
toggleChannelFavoriteStatus :: TeamId -> MH ()
toggleChannelFavoriteStatus TeamId
tId = do
UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
UserPreferences
userPrefs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.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
{ preferenceUserId :: UserId
preferenceUserId = UserId
myId
, preferenceCategory :: PreferenceCategory
preferenceCategory = PreferenceCategory
PreferenceCategoryFavoriteChannel
, preferenceName :: PreferenceName
preferenceName = Text -> PreferenceName
PreferenceName forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ do
UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
toggleChannelListGroupVisibility :: ChannelListGroupLabel -> MH ()
toggleChannelListGroupVisibility :: ChannelListGroupLabel -> MH ()
toggleChannelListGroupVisibility ChannelListGroupLabel
label = do
(TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
Lens' ChatState (HashMap TeamId (Set ChannelListGroupLabel))
csHiddenChannelGroups forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \HashMap TeamId (Set ChannelListGroupLabel)
hidden ->
let s' :: Set ChannelListGroupLabel
s' = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup TeamId
tId HashMap TeamId (Set ChannelListGroupLabel)
hidden of
Maybe (Set ChannelListGroupLabel)
Nothing -> forall a. a -> Set a
S.singleton ChannelListGroupLabel
label
Just Set ChannelListGroupLabel
s ->
if forall a. Ord a => a -> Set a -> Bool
S.member ChannelListGroupLabel
label Set ChannelListGroupLabel
s
then forall a. Ord a => a -> Set a -> Set a
S.delete ChannelListGroupLabel
label Set ChannelListGroupLabel
s
else forall a. Ord a => a -> Set a -> Set a
S.insert ChannelListGroupLabel
label Set ChannelListGroupLabel
s
in forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert TeamId
tId Set ChannelListGroupLabel
s' HashMap TeamId (Set ChannelListGroupLabel)
hidden
Maybe TeamId -> MH ()
updateSidebar forall a. Maybe a
Nothing
toggleCurrentChannelChannelListGroup :: TeamId -> MH ()
toggleCurrentChannelChannelListGroup :: TeamId -> MH ()
toggleCurrentChannelChannelListGroup TeamId
tId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
_ ClientChannel
_ -> do
Zipper ChannelListGroup ChannelListEntry
z <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus)
case forall b a. Eq b => Zipper a b -> Maybe a
Z.focusHeading Zipper ChannelListGroup ChannelListEntry
z of
Maybe ChannelListGroup
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelListGroup
grp -> ChannelListGroupLabel -> MH ()
toggleChannelListGroupVisibility forall a b. (a -> b) -> a -> b
$ ChannelListGroup -> ChannelListGroupLabel
channelListGroupLabel ChannelListGroup
grp
toggleCurrentChannelChannelListGroupByName :: T.Text -> TeamId -> MH ()
toggleCurrentChannelChannelListGroupByName :: Text -> TeamId -> MH ()
toggleCurrentChannelChannelListGroupByName Text
name TeamId
tId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
_ ClientChannel
_ -> do
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
name) [(Text, ChannelListGroupLabel)]
channelListGroupNames of
Maybe ChannelListGroupLabel
Nothing -> Text -> MH ()
postErrorMessage' forall a b. (a -> b) -> a -> b
$ Text
"Invalid group name: " forall a. Semigroup a => a -> a -> a
<> Text
name
Just ChannelListGroupLabel
l -> ChannelListGroupLabel -> MH ()
toggleChannelListGroupVisibility ChannelListGroupLabel
l
channelListSortingModes :: [(ChannelListSorting, T.Text)]
channelListSortingModes :: [(ChannelListSorting, Text)]
channelListSortingModes =
[ (ChannelListSorting
ChannelListSortDefault, Text
"alphabetic")
, (ChannelListSorting
ChannelListSortUnreadFirst, Text
"alphabetic with unread channels first")
]
cycleChannelListSortingMode :: TeamId -> MH ()
cycleChannelListSortingMode :: TeamId -> MH ()
cycleChannelListSortingMode TeamId
tId = do
ChannelListSorting
curMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelListSorting
tsChannelListSorting)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChannelListSorting
curMode forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ChannelListSorting, Text)]
channelListSortingModes)) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: active channel list sorting mode unknown (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show ChannelListSorting
curMode forall a. Semigroup a => a -> a -> a
<> [Char]
")"
let (ChannelListSorting
newMode, Text
newModeDesc) = ChannelListSorting -> (ChannelListSorting, Text)
sortingModeAfter ChannelListSorting
curMode
sortingModeAfter :: ChannelListSorting -> (ChannelListSorting, Text)
sortingModeAfter ChannelListSorting
m = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Eq a => a -> a -> Bool
/= ChannelListSorting
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
cycle [(ChannelListSorting, Text)]
channelListSortingModes
Text -> MH ()
postInfoMessage forall a b. (a -> b) -> a -> b
$ Text
"Sorting channel list: " forall a. Semigroup a => a -> a -> a
<> Text
newModeDesc
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelListSorting
tsChannelListSorting forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ChannelListSorting
newMode
Maybe TeamId -> MH ()
updateSidebar forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just TeamId
tId