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