{-# LANGUAGE TupleSections #-}
module Matterhorn.State.ReactionEmojiListOverlay
( enterReactionEmojiListOverlayMode
, reactionEmojiListSelectDown
, reactionEmojiListSelectUp
, reactionEmojiListPageDown
, reactionEmojiListPageUp
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Brick.Widgets.List as L
import qualified Data.Vector as Vec
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Function ( on )
import Data.List ( nubBy )
import Lens.Micro.Platform ( to )
import Network.Mattermost.Types
import Network.Mattermost.Endpoints ( mmPostReaction, mmDeleteReaction )
import Matterhorn.Emoji
import Matterhorn.State.ListOverlay
import Matterhorn.State.MessageSelect
import Matterhorn.State.Async
import Matterhorn.Types
enterReactionEmojiListOverlayMode :: MH ()
enterReactionEmojiListOverlayMode = do
selectedMessage <- use (to getSelectedMessage)
case selectedMessage of
Nothing -> return ()
Just msg -> do
em <- use (csResources.crEmoji)
myId <- gets myUserId
enterListOverlayMode csReactionEmojiListOverlay ReactionEmojiListOverlay
() enterHandler (fetchResults myId msg em)
enterHandler :: (Bool, T.Text) -> MH Bool
enterHandler (mine, e) = do
session <- getSession
myId <- gets myUserId
selectedMessage <- use (to getSelectedMessage)
case selectedMessage of
Nothing -> return False
Just m -> do
case m^.mOriginalPost of
Nothing -> return False
Just p -> do
case mine of
False ->
doAsyncWith Preempt $ do
mmPostReaction (postId p) myId e session
return Nothing
True ->
doAsyncWith Preempt $ do
mmDeleteReaction (postId p) myId e session
return Nothing
return True
fetchResults :: UserId
-> Message
-> EmojiCollection
-> ()
-> Session
-> Text
-> IO (Vec.Vector (Bool, T.Text))
fetchResults myId msg em () session searchString = do
let currentReactions = [ (myId `Set.member` uIds, k)
| (k, uIds) <- M.toList (msg^.mReactions)
]
matchingCurrentOtherReactions = [ (mine, r) | (mine, r) <- currentReactions
, matchesEmoji searchString r
, not mine
]
matchingCurrentMyReactions = [ (mine, r) | (mine, r) <- currentReactions
, matchesEmoji searchString r
, mine
]
serverMatches <- getMatchingEmoji session em searchString
return $ Vec.fromList $ nubBy ((==) `on` snd) $
matchingCurrentOtherReactions <> matchingCurrentMyReactions <> ((False,) <$> serverMatches)
reactionEmojiListSelectUp :: MH ()
reactionEmojiListSelectUp = reactionEmojiListMove L.listMoveUp
reactionEmojiListSelectDown :: MH ()
reactionEmojiListSelectDown = reactionEmojiListMove L.listMoveDown
reactionEmojiListPageUp :: MH ()
reactionEmojiListPageUp = reactionEmojiListMove (L.listMoveBy (-1 * reactionEmojiListPageSize))
reactionEmojiListPageDown :: MH ()
reactionEmojiListPageDown = reactionEmojiListMove (L.listMoveBy reactionEmojiListPageSize)
reactionEmojiListMove :: (L.List Name (Bool, T.Text) -> L.List Name (Bool, T.Text)) -> MH ()
reactionEmojiListMove = listOverlayMove csReactionEmojiListOverlay
reactionEmojiListPageSize :: Int
reactionEmojiListPageSize = 10