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 Data.Maybe ( fromJust )
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
updateSidebar :: Maybe TeamId -> MH ()
Maybe TeamId
mTid = do
case Maybe TeamId
mTid 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) TeamId -> MH ()
updateTeamSidebar
Just TeamId
tId -> do
TeamId -> MH ()
updateTeamSidebar TeamId
tId
(TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> 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)
UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
[UserId] -> MH ()
scheduleUserStatusFetches forall a b. (a -> b) -> a -> b
$ UserId
myId forall a. a -> [a] -> [a]
: Zipper ChannelListGroup ChannelListEntry -> [UserId]
userIdsFromZipper Zipper ChannelListGroup ChannelListEntry
z
MH ()
updateWindowTitle
MH ()
refreshTeamZipper
updateWindowTitle :: MH ()
updateWindowTitle :: MH ()
updateWindowTitle = 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
[Int]
unreadCounts <- 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
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)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ (ChannelListGroup -> Int
channelListGroupUnread forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) 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
let title :: String
title = String
"matterhorn" forall a. Semigroup a => a -> a -> a
<> if Int
unread forall a. Ord a => a -> a -> Bool
> Int
0 then String
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
unread forall a. Semigroup a => a -> a -> a
<> String
")" else String
""
unread :: Int
unread = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
unreadCounts
Vty
vty <- forall a. EventM Name ChatState a -> MH a
mh forall n s. EventM n s Vty
getVtyHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Vty -> String -> IO ()
Vty.setWindowTitle Vty
vty String
title
updateTeamSidebar :: TeamId -> MH ()
TeamId
tId = 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
Maybe ClientConfig
cconfig <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (Maybe ClientConfig)
csClientConfig
Maybe ChannelId
oldCid <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId)
ClientChannels
cs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ClientChannels
csChannels
ChannelListSorting
sorting <- 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)
Users
us <- MH Users
getUsers
UserPreferences
prefs <- 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)
HashMap TeamId (Set ChannelListGroupLabel)
hidden <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId (Set ChannelListGroupLabel))
csHiddenChannelGroups
UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
Config
config <- 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)
let zl :: [(ChannelListGroup, [ChannelListEntry])]
zl = ChannelListSorting
-> UTCTime
-> Config
-> TeamId
-> Maybe ClientConfig
-> UserPreferences
-> HashMap TeamId (Set ChannelListGroupLabel)
-> ClientChannels
-> Users
-> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList ChannelListSorting
sorting UTCTime
now Config
config TeamId
tId Maybe ClientConfig
cconfig UserPreferences
prefs HashMap TeamId (Set ChannelListGroupLabel)
hidden ClientChannels
cs Users
us
compareEntries :: Maybe ChannelListEntry -> ChannelListEntry -> Bool
compareEntries Maybe ChannelListEntry
mOld ChannelListEntry
new = (ChannelListEntry -> ChannelId
channelListEntryChannelId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChannelListEntry
mOld) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (ChannelListEntry -> ChannelId
channelListEntryChannelId ChannelListEntry
new)
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 =>
(Maybe b -> b -> Bool) -> [(a, [b])] -> Zipper a b -> Zipper a b
Z.updateListBy Maybe ChannelListEntry -> ChannelListEntry -> Bool
compareEntries [(ChannelListGroup, [ChannelListEntry])]
zl
Maybe ChannelId
newCid <- 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
newCid forall a. Eq a => a -> a -> Bool
/= Maybe ChannelId
oldCid) forall a b. (a -> b) -> a -> b
$
TeamId -> MH ()
fetchVisibleIfNeeded TeamId
tId
toggleChannelListVisibility :: MH ()
toggleChannelListVisibility :: MH ()
toggleChannelListVisibility = 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
configShowChannelListL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
showChannelInSidebar :: ChannelId -> Bool -> MH ()
ChannelId
cId Bool
setPending = do
Maybe ClientChannel
mChan <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ ChannelId -> Traversal' ChatState ClientChannel
csChannel ChannelId
cId
User
me <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> User
myUser
UserPreferences
prefs <- 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
case Maybe ClientChannel
mChan of
Maybe ClientChannel
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ClientChannel
ch -> do
UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
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. a -> Maybe a
Just UTCTime
now
Maybe TeamId -> MH ()
updateSidebar (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)
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 -> do
let uId :: UserId
uId = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ 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 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
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL) UserId
uId Bool
True
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
setPending forall a b. (a -> b) -> a -> b
$
(TeamId -> MH ()) -> MH ()
withCurrentTeam 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 (Maybe PendingChannelChange)
tsPendingChannelChange forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
forall a. a -> Maybe a
Just (TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId (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) 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
Maybe Bool
_ -> 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
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
setPending forall a b. (a -> b) -> a -> b
$
(TeamId -> MH ()) -> MH ()
withCurrentTeam 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 (Maybe PendingChannelChange)
tsPendingChannelChange forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
forall a. a -> Maybe a
Just (TeamId -> ChannelId -> Maybe (MH ()) -> PendingChannelChange
ChangeByChannelId TeamId
tId (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) 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
Maybe Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Type
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()