module Matterhorn.State.ChannelList
  ( updateSidebar
  , updateWindowTitle
  , toggleChannelListVisibility
  , showChannelInSidebar
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( getVtyHandle, invalidateCache, invalidateCacheEntry )
import qualified Data.HashMap.Strict as HM
import qualified Data.Sequence as Seq
import           Data.Time.Clock ( getCurrentTime )
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform

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

import {-# SOURCE #-} Matterhorn.State.Messages ( fetchVisibleIfNeeded )
import           Matterhorn.Types
import           Matterhorn.State.Async
import qualified Matterhorn.Zipper as Z


-- | Update the sidebar for the specified team state only, or all team
-- states if not given a specific team ID.
--
-- In either case, schedule user status fetches for all users mentioned
-- in the current team's sidebar. (This should be safe because all
-- sidebars should contain the same user list.)
updateSidebar :: Maybe TeamId -> MH ()
updateSidebar :: Maybe TeamId -> MH ()
updateSidebar Maybe TeamId
mTid = do
    case Maybe TeamId
mTid of
        Maybe TeamId
Nothing -> do
            HashMap TeamId TeamState
ts <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
            [TeamId] -> (TeamId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) TeamId -> MH ()
updateTeamSidebar
        Just TeamId
tId -> do
            TeamId -> MH ()
updateTeamSidebar TeamId
tId

    -- Schedule the current team's sidebar for user status updates at
    -- the end of this MH action. This is okay because all team sidebars
    -- should include the same set of DM channels.
    Zipper ChannelListGroup ChannelListEntry
z <- Getting
  (Zipper ChannelListGroup ChannelListEntry)
  ChatState
  (Zipper ChannelListGroup ChannelListEntry)
-> MH (Zipper ChannelListGroup ChannelListEntry)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState
 -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> ChatState
-> Const (Zipper ChannelListGroup ChannelListEntry) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState
  -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
 -> ChatState
 -> Const (Zipper ChannelListGroup ChannelListEntry) ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Const
          (Zipper ChannelListGroup ChannelListEntry)
          (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState
    -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> Getting
     (Zipper ChannelListGroup ChannelListEntry)
     ChatState
     (Zipper ChannelListGroup ChannelListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Const
      (Zipper ChannelListGroup ChannelListEntry)
      (Zipper ChannelListGroup ChannelListEntry))
-> TeamState
-> Const (Zipper ChannelListGroup ChannelListEntry) TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus)
    UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    [UserId] -> MH ()
scheduleUserStatusFetches ([UserId] -> MH ()) -> [UserId] -> MH ()
forall a b. (a -> b) -> a -> b
$ UserId
myId UserId -> [UserId] -> [UserId]
forall a. a -> [a] -> [a]
: Zipper ChannelListGroup ChannelListEntry -> [UserId]
userIdsFromZipper Zipper ChannelListGroup ChannelListEntry
z

    MH ()
updateWindowTitle

updateWindowTitle :: MH ()
updateWindowTitle :: MH ()
updateWindowTitle = do
    -- Update the window title based on the unread status of the
    -- channels in all teams.
    HashMap TeamId TeamState
ts <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
    [Int]
unreadCounts <- [TeamId] -> (TeamId -> MH Int) -> MH [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) ((TeamId -> MH Int) -> MH [Int]) -> (TeamId -> MH Int) -> MH [Int]
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
        Zipper ChannelListGroup ChannelListEntry
z <- Getting
  (Zipper ChannelListGroup ChannelListEntry)
  ChatState
  (Zipper ChannelListGroup ChannelListEntry)
-> MH (Zipper ChannelListGroup ChannelListEntry)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState
  -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
 -> ChatState
 -> Const (Zipper ChannelListGroup ChannelListEntry) ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Const
          (Zipper ChannelListGroup ChannelListEntry)
          (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState
    -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> Getting
     (Zipper ChannelListGroup ChannelListEntry)
     ChatState
     (Zipper ChannelListGroup ChannelListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Const
      (Zipper ChannelListGroup ChannelListEntry)
      (Zipper ChannelListGroup ChannelListEntry))
-> TeamState
-> Const (Zipper ChannelListGroup ChannelListEntry) TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus)
        Int -> MH Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MH Int) -> Int -> MH Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ChannelListGroup -> Int
channelListGroupUnread (ChannelListGroup -> Int)
-> ((ChannelListGroup, [ChannelListEntry]) -> ChannelListGroup)
-> (ChannelListGroup, [ChannelListEntry])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelListGroup, [ChannelListEntry]) -> ChannelListGroup
forall a b. (a, b) -> a
fst) ((ChannelListGroup, [ChannelListEntry]) -> Int)
-> [(ChannelListGroup, [ChannelListEntry])] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper ChannelListGroup ChannelListEntry
-> [(ChannelListGroup, [ChannelListEntry])]
forall a b. Zipper a b -> [(a, [b])]
Z.toList Zipper ChannelListGroup ChannelListEntry
z

    let title :: String
title = String
"matterhorn" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if Int
unread Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
unread String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")" else String
""
        unread :: Int
unread = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
unreadCounts

    Vty
vty <- EventM Name Vty -> MH Vty
forall a. EventM Name a -> MH a
mh EventM Name Vty
forall n. EventM n Vty
getVtyHandle
    IO () -> MH ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MH ()) -> IO () -> MH ()
forall a b. (a -> b) -> a -> b
$ Vty -> String -> IO ()
Vty.setWindowTitle Vty
vty String
title

updateTeamSidebar :: TeamId -> MH ()
updateTeamSidebar :: TeamId -> MH ()
updateTeamSidebar TeamId
tId = do
    -- Invalidate the cached sidebar rendering since we are about to
    -- change the underlying state
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId

    -- Get the currently-focused channel ID so we can compare after the
    -- zipper is rebuilt
    Maybe ClientConfig
cconfig <- Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
-> MH (Maybe ClientConfig)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
Lens' ChatState (Maybe ClientConfig)
csClientConfig
    ChannelId
oldCid <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)

    -- Update the zipper
    ClientChannels
cs <- Getting ClientChannels ChatState ClientChannels
-> MH ClientChannels
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels
    Users
us <- MH Users
getUsers
    UserPreferences
prefs <- Getting UserPreferences ChatState UserPreferences
-> MH UserPreferences
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const UserPreferences ChatResources)
 -> ChatState -> Const UserPreferences ChatState)
-> ((UserPreferences -> Const UserPreferences UserPreferences)
    -> ChatResources -> Const UserPreferences ChatResources)
-> Getting UserPreferences ChatState UserPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources
Lens' ChatResources UserPreferences
crUserPreferences)
    UTCTime
now <- IO UTCTime -> MH UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    Config
config <- Getting Config ChatState Config -> MH Config
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration)

    let zl :: [(ChannelListGroup, [ChannelListEntry])]
zl = UTCTime
-> Config
-> TeamId
-> Maybe ClientConfig
-> UserPreferences
-> ClientChannels
-> Users
-> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList UTCTime
now Config
config TeamId
tId Maybe ClientConfig
cconfig UserPreferences
prefs ClientChannels
cs Users
us
        compareEntries :: Maybe ChannelListEntry -> ChannelListEntry -> Bool
compareEntries Maybe ChannelListEntry
mOld ChannelListEntry
new = (ChannelListEntry -> ChannelId
channelListEntryChannelId (ChannelListEntry -> ChannelId)
-> Maybe ChannelListEntry -> Maybe ChannelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChannelListEntry
mOld) Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just (ChannelListEntry -> ChannelId
channelListEntryChannelId ChannelListEntry
new)
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Identity (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState -> Identity TeamState)
-> (Zipper ChannelListGroup ChannelListEntry
    -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Identity (Zipper ChannelListGroup ChannelListEntry))
-> TeamState -> Identity TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus ((Zipper ChannelListGroup ChannelListEntry
  -> Identity (Zipper ChannelListGroup ChannelListEntry))
 -> ChatState -> Identity ChatState)
-> (Zipper ChannelListGroup ChannelListEntry
    -> Zipper ChannelListGroup ChannelListEntry)
-> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Maybe ChannelListEntry -> ChannelListEntry -> Bool)
-> [(ChannelListGroup, [ChannelListEntry])]
-> Zipper ChannelListGroup ChannelListEntry
-> Zipper ChannelListGroup ChannelListEntry
forall b a.
Eq b =>
(Maybe b -> b -> Bool) -> [(a, [b])] -> Zipper a b -> Zipper a b
Z.updateListBy Maybe ChannelListEntry -> ChannelListEntry -> Bool
compareEntries [(ChannelListGroup, [ChannelListEntry])]
zl

    -- If the zipper rebuild caused the current channel to change, such
    -- as when the previously-focused channel was removed, we need to
    -- call fetchVisibleIfNeeded on the newly-focused channel to ensure
    -- that it gets loaded.
    ChannelId
newCid <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChannelId
newCid ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
/= ChannelId
oldCid) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
        MH ()
fetchVisibleIfNeeded

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

showChannelInSidebar :: ChannelId -> Bool -> MH ()
showChannelInSidebar :: ChannelId -> Bool -> MH ()
showChannelInSidebar ChannelId
cId Bool
setPending = do
    Maybe ClientChannel
mChan <- Getting (First ClientChannel) ChatState ClientChannel
-> MH (Maybe ClientChannel)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First ClientChannel) ChatState ClientChannel
 -> MH (Maybe ClientChannel))
-> Getting (First ClientChannel) ChatState ClientChannel
-> MH (Maybe ClientChannel)
forall a b. (a -> b) -> a -> b
$ ChannelId -> Traversal' ChatState ClientChannel
csChannel ChannelId
cId
    User
me <- (ChatState -> User) -> MH User
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
    UserPreferences
prefs <- Getting UserPreferences ChatState UserPreferences
-> MH UserPreferences
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const UserPreferences ChatResources)
 -> ChatState -> Const UserPreferences ChatState)
-> ((UserPreferences -> Const UserPreferences UserPreferences)
    -> ChatResources -> Const UserPreferences ChatResources)
-> Getting UserPreferences ChatState UserPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources
Lens' ChatResources UserPreferences
crUserPreferences)
    Session
session <- MH Session
getSession

    case Maybe ClientChannel
mChan of
        Maybe ClientChannel
Nothing ->
          -- The requested channel doesn't actually exist yet, so no
          -- action can be taken.  It's likely that this is a
          -- pendingChannel situation and not all of the operations to
          -- locally define the channel have completed, in which case
          -- this code will be re-entered later and the mChan will be
          -- known.
          () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ClientChannel
ch -> do

            -- Able to successfully switch to a known channel.  This
            -- should clear any pending channel intention.  If the
            -- intention was for this channel, then: done.  If the
            -- intention was for a different channel, reaching this
            -- point means that the pending is still outstanding but
            -- that the user identified a new channel which *was*
            -- displayable, and the UI should always prefer to SATISFY
            -- the user's latest request over any pending/background
            -- task.
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe PendingChannelChange
     -> Identity (Maybe PendingChannelChange))
    -> TeamState -> Identity TeamState)
-> (Maybe PendingChannelChange
    -> Identity (Maybe PendingChannelChange))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Identity (Maybe PendingChannelChange))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange ((Maybe PendingChannelChange
  -> Identity (Maybe PendingChannelChange))
 -> ChatState -> Identity ChatState)
-> Maybe PendingChannelChange -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe PendingChannelChange
forall a. Maybe a
Nothing

            UTCTime
now <- IO UTCTime -> MH UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ClientChannel -> Identity ClientChannel)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Maybe UTCTime -> Identity (Maybe UTCTime))
    -> ChannelInfo -> Identity ChannelInfo)
-> (Maybe UTCTime -> Identity (Maybe UTCTime))
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Identity (Maybe UTCTime))
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride ((Maybe UTCTime -> Identity (Maybe UTCTime))
 -> ChatState -> Identity ChatState)
-> Maybe UTCTime -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
now
            Maybe TeamId -> MH ()
updateSidebar (ClientChannel
chClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId)

            TeamId
curTid <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
            let tId :: TeamId
tId = TeamId -> Maybe TeamId -> TeamId
forall a. a -> Maybe a -> a
fromMaybe TeamId
curTid (ClientChannel
chClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId)

            case ClientChannel
chClientChannel -> Getting Type ClientChannel Type -> Type
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Getting Type ClientChannel Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType of
                Type
Direct -> do
                    let Just UserId
uId = ClientChannel
chClientChannel
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
-> Maybe UserId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> ClientChannel -> Const (Maybe UserId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe UserId) ChannelInfo)
 -> ClientChannel -> Const (Maybe UserId) ClientChannel)
-> ((Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
    -> ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
-> ChannelInfo -> Const (Maybe UserId) ChannelInfo
Lens' ChannelInfo (Maybe UserId)
cdDMUserId
                    case UserPreferences -> UserId -> Maybe Bool
dmChannelShowPreference UserPreferences
prefs UserId
uId of
                        Just Bool
False -> do
                            let pref :: Preference
pref = UserId -> UserId -> Bool -> Preference
showDirectChannelPref (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL) UserId
uId Bool
True
                            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
setPending (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
                                (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe PendingChannelChange
     -> Identity (Maybe PendingChannelChange))
    -> TeamState -> Identity TeamState)
-> (Maybe PendingChannelChange
    -> Identity (Maybe PendingChannelChange))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Identity (Maybe PendingChannelChange))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange ((Maybe PendingChannelChange
  -> Identity (Maybe PendingChannelChange))
 -> ChatState -> Identity ChatState)
-> Maybe PendingChannelChange -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
                                    PendingChannelChange -> Maybe PendingChannelChange
forall a. a -> Maybe a
Just (TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId (ClientChannel
chClientChannel
-> Getting ChannelId ClientChannel ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const ChannelId ChannelInfo)
-> ClientChannel -> Const ChannelId ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const ChannelId ChannelInfo)
 -> ClientChannel -> Const ChannelId ClientChannel)
-> ((ChannelId -> Const ChannelId ChannelId)
    -> ChannelInfo -> Const ChannelId ChannelInfo)
-> Getting ChannelId ClientChannel ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> ChannelInfo -> Const ChannelId ChannelInfo
Lens' ChannelInfo ChannelId
cdChannelId) Maybe (MH ())
forall a. Maybe a
Nothing)
                            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                                UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
                                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
                        Maybe Bool
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                Type
Group ->
                    case UserPreferences -> ChannelId -> Maybe Bool
groupChannelShowPreference UserPreferences
prefs ChannelId
cId of
                        Just Bool
False -> do
                            let pref :: Preference
pref = ChannelId -> UserId -> Preference
showGroupChannelPref ChannelId
cId (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL)
                            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
setPending (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
                                (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe PendingChannelChange
     -> Identity (Maybe PendingChannelChange))
    -> TeamState -> Identity TeamState)
-> (Maybe PendingChannelChange
    -> Identity (Maybe PendingChannelChange))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PendingChannelChange
 -> Identity (Maybe PendingChannelChange))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe PendingChannelChange)
tsPendingChannelChange ((Maybe PendingChannelChange
  -> Identity (Maybe PendingChannelChange))
 -> ChatState -> Identity ChatState)
-> Maybe PendingChannelChange -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
                                    PendingChannelChange -> Maybe PendingChannelChange
forall a. a -> Maybe a
Just (TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId (ClientChannel
chClientChannel
-> Getting ChannelId ClientChannel ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const ChannelId ChannelInfo)
-> ClientChannel -> Const ChannelId ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const ChannelId ChannelInfo)
 -> ClientChannel -> Const ChannelId ClientChannel)
-> ((ChannelId -> Const ChannelId ChannelId)
    -> ChannelInfo -> Const ChannelId ChannelInfo)
-> Getting ChannelId ClientChannel ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> ChannelInfo -> Const ChannelId ChannelInfo
Lens' ChannelInfo ChannelId
cdChannelId) Maybe (MH ())
forall a. Maybe a
Nothing)
                            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                                UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (Preference -> Seq Preference
forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
                                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
                        Maybe Bool
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                Type
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()