module Matterhorn.State.Reactions
( asyncFetchReactionsForPost
, addReactions
, removeReaction
, updateReaction
, toggleReaction
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick.Main ( invalidateCacheEntry )
import qualified Data.Map.Strict as Map
import Lens.Micro.Platform
import qualified Data.Set as S
import Network.Mattermost.Endpoints
import Network.Mattermost.Lenses
import Network.Mattermost.Types
import Matterhorn.State.Async
import Matterhorn.State.Common ( fetchMentionedUsers )
import Matterhorn.Types
asyncFetchReactionsForPost :: ChannelId -> Post -> MH ()
asyncFetchReactionsForPost :: ChannelId -> Post -> MH ()
asyncFetchReactionsForPost ChannelId
cId Post
p
| Bool -> Bool
not (Post
pPost -> Getting Bool Post Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Post Bool
Lens' Post Bool
postHasReactionsL) = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = DoAsyncChannelMM [Reaction]
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Normal ChannelId
cId
(\Session
s ChannelId
_ -> (Seq Reaction -> [Reaction]) -> IO (Seq Reaction) -> IO [Reaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Reaction -> [Reaction]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PostId -> Session -> IO (Seq Reaction)
mmGetReactionsForPost (Post
pPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Session
s))
(\ChannelId
_ [Reaction]
rs -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ ChannelId -> [Reaction] -> MH ()
addReactions ChannelId
cId [Reaction]
rs)
addReactions :: ChannelId -> [Reaction] -> MH ()
addReactions :: ChannelId -> [Reaction] -> MH ()
addReactions ChannelId
cId [Reaction]
rs = do
EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Name
ChannelMessages ChannelId
cId
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> (Messages -> Identity Messages)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
-> ChatState -> Identity ChatState)
-> (Messages -> Messages) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Message -> Message) -> Messages -> Messages
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Message
upd
let mentions :: Set MentionedUser
mentions = [MentionedUser] -> Set MentionedUser
forall a. Ord a => [a] -> Set a
S.fromList ([MentionedUser] -> Set MentionedUser)
-> [MentionedUser] -> Set MentionedUser
forall a b. (a -> b) -> a -> b
$ UserId -> MentionedUser
UserIdMention (UserId -> MentionedUser)
-> (Reaction -> UserId) -> Reaction -> MentionedUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reaction -> UserId
reactionUserId (Reaction -> MentionedUser) -> [Reaction] -> [MentionedUser]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Reaction]
rs
Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentions
MH ()
invalidateRenderCache
where upd :: Message -> Message
upd Message
msg = Message
msg Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Map Text (Set UserId) -> Identity (Map Text (Set UserId)))
-> Message -> Identity Message
Lens' Message (Map Text (Set UserId))
mReactions ((Map Text (Set UserId) -> Identity (Map Text (Set UserId)))
-> Message -> Identity Message)
-> (Map Text (Set UserId) -> Map Text (Set UserId))
-> Message
-> Message
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe MessageId -> Map Text (Set UserId) -> Map Text (Set UserId)
insertAll (Message
msgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId)
insert :: Maybe MessageId
-> Reaction -> Map Text (Set UserId) -> Map Text (Set UserId)
insert Maybe MessageId
mId Reaction
r
| Maybe MessageId
mId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (Reaction
rReaction -> Getting PostId Reaction PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Reaction PostId
Lens' Reaction PostId
reactionPostIdL)) =
(Set UserId -> Set UserId -> Set UserId)
-> Text
-> Set UserId
-> Map Text (Set UserId)
-> Map Text (Set UserId)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set UserId -> Set UserId -> Set UserId
forall a. Ord a => Set a -> Set a -> Set a
S.union (Reaction
rReaction -> Getting Text Reaction Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text Reaction Text
Lens' Reaction Text
reactionEmojiNameL) (UserId -> Set UserId
forall a. a -> Set a
S.singleton (UserId -> Set UserId) -> UserId -> Set UserId
forall a b. (a -> b) -> a -> b
$ Reaction
rReaction -> Getting UserId Reaction UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId Reaction UserId
Lens' Reaction UserId
reactionUserIdL)
| Bool
otherwise = Map Text (Set UserId) -> Map Text (Set UserId)
forall a. a -> a
id
insertAll :: Maybe MessageId -> Map Text (Set UserId) -> Map Text (Set UserId)
insertAll Maybe MessageId
mId Map Text (Set UserId)
msg = (Reaction -> Map Text (Set UserId) -> Map Text (Set UserId))
-> Map Text (Set UserId) -> [Reaction] -> Map Text (Set UserId)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe MessageId
-> Reaction -> Map Text (Set UserId) -> Map Text (Set UserId)
insert Maybe MessageId
mId) Map Text (Set UserId)
msg [Reaction]
rs
invalidateRenderCache :: MH ()
invalidateRenderCache = do
let cacheIds :: [Name]
cacheIds = (Reaction -> Name) -> [Reaction] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Reaction -> Name
cacheIdOf [Reaction]
rs
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 ()) -> [Name] -> EventM Name ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry [Name]
cacheIds
cacheIdOf :: Reaction -> Name
cacheIdOf Reaction
r = MessageId -> Name
RenderedMessage (MessageId -> Name) -> MessageId -> Name
forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId (Reaction
rReaction -> Getting PostId Reaction PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Reaction PostId
Lens' Reaction PostId
reactionPostIdL)
removeReaction :: Reaction -> ChannelId -> MH ()
removeReaction :: Reaction -> ChannelId -> MH ()
removeReaction Reaction
r ChannelId
cId = do
EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Name
ChannelMessages ChannelId
cId
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> (Messages -> Identity Messages)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
-> ChatState -> Identity ChatState)
-> (Messages -> Messages) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Message -> Message) -> Messages -> Messages
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Message
upd
MH ()
invalidateRenderCache
where upd :: Message -> Message
upd Message
m | Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (PostId -> MessageId) -> PostId -> MessageId
forall a b. (a -> b) -> a -> b
$ Reaction
rReaction -> Getting PostId Reaction PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Reaction PostId
Lens' Reaction PostId
reactionPostIdL) =
Message
m Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Map Text (Set UserId) -> Identity (Map Text (Set UserId)))
-> Message -> Identity Message
Lens' Message (Map Text (Set UserId))
mReactions ((Map Text (Set UserId) -> Identity (Map Text (Set UserId)))
-> Message -> Identity Message)
-> (Map Text (Set UserId) -> Map Text (Set UserId))
-> Message
-> Message
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Maybe (Set UserId) -> Maybe (Set UserId))
-> Text -> Map Text (Set UserId) -> Map Text (Set UserId)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (Set UserId) -> Maybe (Set UserId)
forall (f :: * -> *). Functor f => f (Set UserId) -> f (Set UserId)
delReaction (Reaction
rReaction -> Getting Text Reaction Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text Reaction Text
Lens' Reaction Text
reactionEmojiNameL))
| Bool
otherwise = Message
m
delReaction :: f (Set UserId) -> f (Set UserId)
delReaction f (Set UserId)
mUs = UserId -> Set UserId -> Set UserId
forall a. Ord a => a -> Set a -> Set a
S.delete (Reaction
rReaction -> Getting UserId Reaction UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId Reaction UserId
Lens' Reaction UserId
reactionUserIdL) (Set UserId -> Set UserId) -> f (Set UserId) -> f (Set UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Set UserId)
mUs
invalidateRenderCache :: MH ()
invalidateRenderCache =
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
$ MessageId -> Name
RenderedMessage (MessageId -> Name) -> MessageId -> Name
forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId (Reaction
rReaction -> Getting PostId Reaction PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Reaction PostId
Lens' Reaction PostId
reactionPostIdL)
updateReaction :: PostId -> Text -> Bool -> MH ()
updateReaction :: PostId -> Text -> Bool -> MH ()
updateReaction PostId
pId Text
text Bool
value = do
Session
session <- MH Session
getSession
UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
if Bool
value
then AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
PostId -> UserId -> Text -> Session -> IO ()
mmPostReaction PostId
pId UserId
myId Text
text Session
session
Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
else AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
PostId -> UserId -> Text -> Session -> IO ()
mmDeleteReaction PostId
pId UserId
myId Text
text Session
session
Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
toggleReaction :: PostId -> Text -> Set UserId -> MH ()
toggleReaction :: PostId -> Text -> Set UserId -> MH ()
toggleReaction PostId
pId Text
text Set UserId
uIds = do
UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
let current :: Bool
current = UserId
myId UserId -> Set UserId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set UserId
uIds
PostId -> Text -> Bool -> MH ()
updateReaction PostId
pId Text
text (Bool -> Bool
not Bool
current)