module Matterhorn.State.Reactions ( asyncFetchReactionsForPost , addReactions , removeReaction ) 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 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 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 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