module Matterhorn.State.Reactions
( asyncFetchReactionsForPost
, addReactions
, removeReaction
, updateReaction
, toggleReaction
)
where
import Prelude ()
import Matterhorn.Prelude
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
import Matterhorn.Types
asyncFetchReactionsForPost :: ChannelId -> Post -> MH ()
asyncFetchReactionsForPost :: ChannelId -> Post -> MH ()
asyncFetchReactionsForPost ChannelId
cId Post
p
| Bool -> Bool
not (Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post Bool
postHasReactionsL) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Normal ChannelId
cId
(\Session
s ChannelId
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PostId -> Session -> IO (Seq Reaction)
mmGetReactionsForPost (Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Session
s))
(\ChannelId
_ [Reaction]
rs -> forall a. a -> Maybe a
Just 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
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
ChannelId -> Traversal' ChatState Messages
csChannelMessages(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Message
upd
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 (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages TeamId
tId ChannelId
cId (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Message
upd)
let mentions :: Set MentionedUser
mentions = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ UserId -> MentionedUser
UserIdMention forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reaction -> UserId
reactionUserId 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 forall a b. a -> (a -> b) -> b
& Lens' Message (Map Text (Set UserId))
mReactions 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
msgforall s a. s -> Getting a s a -> a
^.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 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (Reaction
rforall s a. s -> Getting a s a -> a
^.Lens' Reaction PostId
reactionPostIdL)) =
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Ord a => Set a -> Set a -> Set a
S.union (Reaction
rforall s a. s -> Getting a s a -> a
^.Lens' Reaction Text
reactionEmojiNameL) (forall a. a -> Set a
S.singleton forall a b. (a -> b) -> a -> b
$ Reaction
rforall s a. s -> Getting a s a -> a
^.Lens' Reaction UserId
reactionUserIdL)
| Bool
otherwise = 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 = 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
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Reaction]
rs forall a b. (a -> b) -> a -> b
$ \Reaction
r ->
PostId -> MH ()
invalidateMessageRenderingCacheByPostId forall a b. (a -> b) -> a -> b
$ Reaction
rforall s a. s -> Getting a s a -> a
^.Lens' Reaction PostId
reactionPostIdL
removeReaction :: Reaction -> ChannelId -> MH ()
removeReaction :: Reaction -> ChannelId -> MH ()
removeReaction Reaction
r ChannelId
cId = do
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
ChannelId -> Traversal' ChatState Messages
csChannelMessages(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Message
upd
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 (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages TeamId
tId ChannelId
cId (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
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Reaction
rforall s a. s -> Getting a s a -> a
^.Lens' Reaction PostId
reactionPostIdL) =
Message
m forall a b. a -> (a -> b) -> b
& Lens' Message (Map Text (Set UserId))
mReactions forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter forall {f :: * -> *}. Functor f => f (Set UserId) -> f (Set UserId)
delReaction (Reaction
rforall s a. s -> Getting a s a -> a
^.Lens' Reaction Text
reactionEmojiNameL))
| Bool
otherwise = Message
m
delReaction :: f (Set UserId) -> f (Set UserId)
delReaction f (Set UserId)
mUs = forall a. Ord a => a -> Set a -> Set a
S.delete (Reaction
rforall s a. s -> Getting a s a -> a
^.Lens' Reaction UserId
reactionUserIdL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Set UserId)
mUs
invalidateRenderCache :: MH ()
invalidateRenderCache =
PostId -> MH ()
invalidateMessageRenderingCacheByPostId forall a b. (a -> b) -> a -> b
$ Reaction
rforall s a. s -> Getting a s a -> a
^.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 <- 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 forall a b. (a -> b) -> a -> b
$ do
PostId -> UserId -> Text -> Session -> IO ()
mmPostReaction PostId
pId UserId
myId Text
text Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
PostId -> UserId -> Text -> Session -> IO ()
mmDeleteReaction PostId
pId UserId
myId Text
text Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
let current :: Bool
current = UserId
myId 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)