module Matterhorn.State.Teams
  ( nextTeam
  , prevTeam
  , handleJoinTeam
  , handleLeaveTeam
  , handleUpdateTeam
  , buildTeamState
  , moveCurrentTeamLeft
  , moveCurrentTeamRight
  , setTeam
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( invalidateCache, hScrollToBeginning, viewportScroll )
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import           Data.Time.Clock ( getCurrentTime )
import qualified Data.HashMap.Strict as HM
import           Lens.Micro.Platform ( (%=), (.=), at )

import           Network.Mattermost.Lenses ( userIdL )
import           Network.Mattermost.Types ( TeamId, Team, User, userId
                                          , getId, channelId, teamId, UserParam(..)
                                          , teamOrderPref
                                          )
import qualified Network.Mattermost.Endpoints as MM

import           Matterhorn.Types
import           Matterhorn.LastRunState
import           Matterhorn.State.Async
import           Matterhorn.State.ChannelList
import           Matterhorn.State.Channels
import           Matterhorn.State.Messages
import           Matterhorn.State.Setup.Threads ( maybeStartSpellChecker )
import qualified Matterhorn.Zipper as Z


-- | Move right in the channel list to select the next team.
nextTeam :: MH ()
nextTeam :: MH ()
nextTeam = (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith Zipper () TeamId -> Zipper () TeamId
forall a b. Zipper a b -> Zipper a b
Z.right

-- | Move left in the channel list to select the previous team.
prevTeam :: MH ()
prevTeam :: MH ()
prevTeam = (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith Zipper () TeamId -> Zipper () TeamId
forall a b. Zipper a b -> Zipper a b
Z.left

-- | Set the current team directly
setTeam :: TeamId -> MH ()
setTeam :: TeamId -> MH ()
setTeam TeamId
tId = (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith ((Zipper () TeamId -> Zipper () TeamId) -> MH ())
-> (Zipper () TeamId -> Zipper () TeamId) -> MH ()
forall a b. (a -> b) -> a -> b
$ (TeamId -> Bool) -> Zipper () TeamId -> Zipper () TeamId
forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight (TeamId -> TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== TeamId
tId)

-- | Change the selected team with the specified team zipper
-- transformation. This function also takes care of book-keeping
-- necessary during team switching.
setTeamFocusWith :: (Z.Zipper () TeamId -> Z.Zipper () TeamId) -> MH ()
setTeamFocusWith :: (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith Zipper () TeamId -> Zipper () TeamId
f = do
    -- Before we leave this team to view another one, indicate that
    -- we've viewed the current team's currently-selected channel so
    -- that this team doesn't get left with an unread indicator once we
    -- are looking at the other team. We do this when switching channels
    -- within a team in the same way.
    Bool -> MH ()
updateViewed Bool
True

    (Zipper () TeamId -> Identity (Zipper () TeamId))
-> ChatState -> Identity ChatState
Lens' ChatState (Zipper () TeamId)
csTeamZipper ((Zipper () TeamId -> Identity (Zipper () TeamId))
 -> ChatState -> Identity ChatState)
-> (Zipper () TeamId -> Zipper () TeamId) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Zipper () TeamId -> Zipper () TeamId
f
    MH ()
postChangeTeamCommon

-- | Book-keeping common to all team selection changes.
postChangeTeamCommon :: MH ()
postChangeTeamCommon :: MH ()
postChangeTeamCommon = do
    Bool -> MH ()
updateViewed Bool
False
    MH ()
fetchVisibleIfNeeded
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
hScrollToBeginning (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
TeamList)

-- | Fetch the specified team and add it to the application state.
--
-- This is called in response to a server event indicating that the
-- current user was added to the team.
handleJoinTeam :: TeamId -> MH ()
handleJoinTeam :: TeamId -> MH ()
handleJoinTeam TeamId
tId = do
    Session
session <- MH Session
getSession
    ChatResources
cr <- Getting ChatResources ChatState ChatResources -> MH ChatResources
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatResources ChatState ChatResources
Lens' ChatState ChatResources
csResources
    User
me <- Getting User ChatState User -> MH User
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting User ChatState User
Lens' ChatState User
csMe

    LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Joining team " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TeamId -> String
forall a. Show a => a -> String
show TeamId
tId
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Team
t <- TeamId -> Session -> IO Team
MM.mmGetTeam TeamId
tId Session
session
        (TeamState
ts, ClientChannels
chans) <- ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState ChatResources
cr User
me Team
t
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
            HashMap TeamId TeamState
curTs <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
            let myTIds :: [TeamId]
myTIds = HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
curTs
            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TeamId
tId TeamId -> [TeamId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamId]
myTIds) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                TeamState -> ClientChannels -> MH ()
addTeamState TeamState
ts ClientChannels
chans
                Maybe TeamId -> MH ()
updateSidebar (Maybe TeamId -> MH ()) -> Maybe TeamId -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
tId
                MH ()
updateWindowTitle
                MH ()
refreshTeamZipper

-- | Remove the specified team to the application state.
--
-- This is called in response to a server event indicating that the
-- current user was removed from the team.
handleLeaveTeam :: TeamId -> MH ()
handleLeaveTeam :: TeamId -> MH ()
handleLeaveTeam TeamId
tId =
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
        LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Leaving team " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TeamId -> String
forall a. Show a => a -> String
show TeamId
tId
        TeamId -> MH ()
removeTeam TeamId
tId
        MH ()
updateWindowTitle
        -- Invalidating the cache here expunges any cached message
        -- renderings from the team we are leaving.
        EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache

-- | Fetch the specified team's metadata and update it in the
-- application state.
--
-- This is called in response to a server event indicating that the
-- specified team was updated in some way.
handleUpdateTeam :: TeamId -> MH ()
handleUpdateTeam :: TeamId -> MH ()
handleUpdateTeam TeamId
tId = do
    Session
session <- MH Session
getSession
    LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Updating team " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TeamId -> String
forall a. Show a => a -> String
show TeamId
tId
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Team
t <- TeamId -> Session -> IO Team
MM.mmGetTeam TeamId
tId Session
session
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
            Team -> MH ()
updateTeam Team
t
            -- Invalidate the cache since we happen to know that the
            -- team name is in the cached sidebar.
            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache

-- | Set the team zipper ordering with the specified transformation,
-- which is expected to be either 'moveLeft' or 'moveRight'.
setTeamOrderWith :: (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith :: (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith TeamId -> [TeamId] -> [TeamId]
sortFunc = do
    Session
session <- MH Session
getSession
    User
me <- Getting User ChatState User -> MH User
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting User ChatState User
Lens' ChatState User
csMe

    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    Zipper () TeamId
z <- Getting (Zipper () TeamId) ChatState (Zipper () TeamId)
-> MH (Zipper () TeamId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Zipper () TeamId) ChatState (Zipper () TeamId)
Lens' ChatState (Zipper () TeamId)
csTeamZipper
    let tIds :: [TeamId]
tIds = Zipper () TeamId -> [TeamId]
teamZipperIds Zipper () TeamId
z
        newList :: [TeamId]
newList = TeamId -> [TeamId] -> [TeamId]
sortFunc TeamId
tId [TeamId]
tIds

    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        let pref :: Preference
pref = UserId -> [TeamId] -> Preference
teamOrderPref (User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL) [TeamId]
newList
        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

-- | Move the selected team left in the team list.
moveCurrentTeamLeft :: MH ()
moveCurrentTeamLeft :: MH ()
moveCurrentTeamLeft = (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith TeamId -> [TeamId] -> [TeamId]
forall a. Eq a => a -> [a] -> [a]
moveLeft

-- | Move the selected team right in the team list.
moveCurrentTeamRight :: MH ()
moveCurrentTeamRight :: MH ()
moveCurrentTeamRight = (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith TeamId -> [TeamId] -> [TeamId]
forall a. Eq a => a -> [a] -> [a]
moveRight

-- | Build a new 'TeamState' for the specified team.
--
-- This function starts a new spell checker thread for the team's
-- message editor, loads the last-run state for the team (to ensure that
-- the initially-selected channel is honored), and fetches the channel
-- metadata for the team.
--
-- This returns the resulting team state as well as the channels
-- associated with the team. The caller is responsible for adding the
-- channels and the team state to the application state.
buildTeamState :: ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState :: ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState ChatResources
cr User
me Team
team = do
    let tId :: TeamId
tId = Team -> TeamId
teamId Team
team
        session :: Session
session = ChatResources -> Session
getResourceSession ChatResources
cr

    -- Create a predicate to find the last selected channel by reading
    -- the run state file. If unable to read or decode or validate the
    -- file, this predicate is just `isTownSquare`.
    Channel -> Bool
isLastSelectedChannel <- do
        Either String LastRunState
result <- TeamId -> IO (Either String LastRunState)
readLastRunState TeamId
tId
        case Either String LastRunState
result of
            Right LastRunState
lrs | ChatResources -> User -> LastRunState -> Bool
isValidLastRunState ChatResources
cr User
me LastRunState
lrs -> (Channel -> Bool) -> IO (Channel -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Channel -> Bool) -> IO (Channel -> Bool))
-> (Channel -> Bool) -> IO (Channel -> Bool)
forall a b. (a -> b) -> a -> b
$ \Channel
c ->
                 Channel -> ChannelId
channelId Channel
c ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== LastRunState
lrsLastRunState
-> Getting ChannelId LastRunState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId LastRunState ChannelId
Lens' LastRunState ChannelId
lrsSelectedChannelId
            Either String LastRunState
_ -> (Channel -> Bool) -> IO (Channel -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Channel -> Bool
isTownSquare

    -- Get all channels, but filter down to just the one we want
    -- to start in. We get all, rather than requesting by name or
    -- ID, because we don't know whether the server will give us a
    -- last-viewed preference. We first try to find a channel matching
    -- with the last selected channel ID, failing which we look for the
    -- Town Square channel by name.
    Seq Channel
userChans <- UserParam -> TeamId -> Session -> IO (Seq Channel)
MM.mmGetChannelsForUser UserParam
UserMe TeamId
tId Session
session
    let lastSelectedChans :: Seq Channel
lastSelectedChans = (Channel -> Bool) -> Seq Channel -> Seq Channel
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter Channel -> Bool
isLastSelectedChannel Seq Channel
userChans
        chans :: Seq Channel
chans = if Seq Channel -> Bool
forall a. Seq a -> Bool
Seq.null Seq Channel
lastSelectedChans
                  then (Channel -> Bool) -> Seq Channel -> Seq Channel
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter Channel -> Bool
isTownSquare Seq Channel
userChans
                  else Seq Channel
lastSelectedChans

    -- Since the only channel we are dealing with is by construction the
    -- last channel, we don't have to consider other cases here:
    [(ChannelId, ClientChannel)]
chanPairs <- [Channel]
-> (Channel -> IO (ChannelId, ClientChannel))
-> IO [(ChannelId, ClientChannel)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Seq Channel -> [Channel]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Channel
chans) ((Channel -> IO (ChannelId, ClientChannel))
 -> IO [(ChannelId, ClientChannel)])
-> (Channel -> IO (ChannelId, ClientChannel))
-> IO [(ChannelId, ClientChannel)]
forall a b. (a -> b) -> a -> b
$ \Channel
c -> do
        ClientChannel
cChannel <- UserId -> Channel -> IO ClientChannel
forall (m :: * -> *).
MonadIO m =>
UserId -> Channel -> m ClientChannel
makeClientChannel (User -> UserId
userId User
me) Channel
c
        (ChannelId, ClientChannel) -> IO (ChannelId, ClientChannel)
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel -> ChannelId
forall x y. HasId x y => x -> y
getId Channel
c, ClientChannel
cChannel)

    -- Start the spell checker and spell check timer, if configured
    Maybe (Aspell, IO ())
spResult <- Config -> BChan MHEvent -> IO (Maybe (Aspell, IO ()))
maybeStartSpellChecker (ChatResources
crChatResources -> Getting Config ChatResources Config -> Config
forall s a. s -> Getting a s a -> a
^.Getting Config ChatResources Config
Lens' ChatResources Config
crConfiguration) (ChatResources
crChatResources
-> Getting (BChan MHEvent) ChatResources (BChan MHEvent)
-> BChan MHEvent
forall s a. s -> Getting a s a -> a
^.Getting (BChan MHEvent) ChatResources (BChan MHEvent)
Lens' ChatResources (BChan MHEvent)
crEventQueue)

    UTCTime
now <- IO UTCTime
getCurrentTime
    let chanIds :: [(ChannelListGroup, [ChannelListEntry])]
chanIds = UTCTime
-> Config
-> TeamId
-> Maybe ClientConfig
-> UserPreferences
-> ClientChannels
-> Users
-> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList UTCTime
now (ChatResources
crChatResources -> Getting Config ChatResources Config -> Config
forall s a. s -> Getting a s a -> a
^.Getting Config ChatResources Config
Lens' ChatResources Config
crConfiguration) TeamId
tId
                                          Maybe ClientConfig
forall a. Maybe a
Nothing (ChatResources
crChatResources
-> Getting UserPreferences ChatResources UserPreferences
-> UserPreferences
forall s a. s -> Getting a s a -> a
^.Getting UserPreferences ChatResources UserPreferences
Lens' ChatResources UserPreferences
crUserPreferences)
                                          ClientChannels
clientChans Users
noUsers
        chanZip :: Zipper ChannelListGroup ChannelListEntry
chanZip = [(ChannelListGroup, [ChannelListEntry])]
-> Zipper ChannelListGroup ChannelListEntry
forall b a. Eq b => [(a, [b])] -> Zipper a b
Z.fromList [(ChannelListGroup, [ChannelListEntry])]
chanIds
        clientChans :: ClientChannels
clientChans = ((ChannelId, ClientChannel) -> ClientChannels -> ClientChannels)
-> ClientChannels -> [(ChannelId, ClientChannel)] -> ClientChannels
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ChannelId -> ClientChannel -> ClientChannels -> ClientChannels)
-> (ChannelId, ClientChannel) -> ClientChannels -> ClientChannels
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel) ClientChannels
noChannels [(ChannelId, ClientChannel)]
chanPairs

    (TeamState, ClientChannels) -> IO (TeamState, ClientChannels)
forall (m :: * -> *) a. Monad m => a -> m a
return (Team
-> Zipper ChannelListGroup ChannelListEntry
-> Maybe (Aspell, IO ())
-> TeamState
newTeamState Team
team Zipper ChannelListGroup ChannelListEntry
chanZip Maybe (Aspell, IO ())
spResult, ClientChannels
clientChans)

-- | Add a new 'TeamState' and corresponding channels to the application
-- state.
addTeamState :: TeamState -> ClientChannels -> MH ()
addTeamState :: TeamState -> ClientChannels -> MH ()
addTeamState TeamState
ts ClientChannels
chans = do
    let tId :: TeamId
tId = Team -> TeamId
teamId (Team -> TeamId) -> Team -> TeamId
forall a b. (a -> b) -> a -> b
$ TeamState -> Team
_tsTeam TeamState
ts
    (HashMap TeamId TeamState -> Identity (HashMap TeamId TeamState))
-> ChatState -> Identity ChatState
Lens' ChatState (HashMap TeamId TeamState)
csTeams((HashMap TeamId TeamState -> Identity (HashMap TeamId TeamState))
 -> ChatState -> Identity ChatState)
-> ((Maybe TeamState -> Identity (Maybe TeamState))
    -> HashMap TeamId TeamState -> Identity (HashMap TeamId TeamState))
-> (Maybe TeamState -> Identity (Maybe TeamState))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap TeamId TeamState)
-> Lens'
     (HashMap TeamId TeamState)
     (Maybe (IxValue (HashMap TeamId TeamState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TeamId
Index (HashMap TeamId TeamState)
tId ((Maybe TeamState -> Identity (Maybe TeamState))
 -> ChatState -> Identity ChatState)
-> Maybe TeamState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TeamState -> Maybe TeamState
forall a. a -> Maybe a
Just TeamState
ts
    (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ClientChannels
chans ClientChannels -> ClientChannels -> ClientChannels
forall a. Semigroup a => a -> a -> a
<>)

-- | Update the specified team metadata in the application state (only
-- if we are already a member of that team).
updateTeam :: Team -> MH ()
updateTeam :: Team -> MH ()
updateTeam Team
t = do
    let tId :: TeamId
tId = Team -> TeamId
teamId Team
t
    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
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamId
tId TeamId -> [TeamId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Team -> Identity Team) -> TeamState -> Identity TeamState)
-> (Team -> Identity Team)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Team -> Identity Team) -> TeamState -> Identity TeamState
Lens' TeamState Team
tsTeam ((Team -> Identity Team) -> ChatState -> Identity ChatState)
-> Team -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Team
t

-- | Remove the specified team from the application state.
removeTeam :: TeamId -> MH ()
removeTeam :: TeamId -> MH ()
removeTeam TeamId
tId = do
    (HashMap TeamId TeamState -> Identity (HashMap TeamId TeamState))
-> ChatState -> Identity ChatState
Lens' ChatState (HashMap TeamId TeamState)
csTeams((HashMap TeamId TeamState -> Identity (HashMap TeamId TeamState))
 -> ChatState -> Identity ChatState)
-> ((Maybe TeamState -> Identity (Maybe TeamState))
    -> HashMap TeamId TeamState -> Identity (HashMap TeamId TeamState))
-> (Maybe TeamState -> Identity (Maybe TeamState))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap TeamId TeamState)
-> Lens'
     (HashMap TeamId TeamState)
     (Maybe (IxValue (HashMap TeamId TeamState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TeamId
Index (HashMap TeamId TeamState)
tId ((Maybe TeamState -> Identity (Maybe TeamState))
 -> ChatState -> Identity ChatState)
-> Maybe TeamState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe TeamState
forall a. Maybe a
Nothing
    (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith ((Zipper () TeamId -> Zipper () TeamId) -> MH ())
-> (Zipper () TeamId -> Zipper () TeamId) -> MH ()
forall a b. (a -> b) -> a -> b
$ (TeamId -> Bool) -> Zipper () TeamId -> Zipper () TeamId
forall b a. Eq b => (b -> Bool) -> Zipper a b -> Zipper a b
Z.filterZipper (TeamId -> TeamId -> Bool
forall a. Eq a => a -> a -> Bool
/= TeamId
tId)