{-# LANGUAGE TupleSections #-} module State.ReactionEmojiListOverlay ( enterReactionEmojiListOverlayMode , reactionEmojiListSelectDown , reactionEmojiListSelectUp , reactionEmojiListPageDown , reactionEmojiListPageUp ) where import Prelude () import Prelude.MH 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 Emoji import State.ListOverlay import State.MessageSelect import State.Async import 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 -- ^ My user ID, so we can see which reactions I haven't -- posted -> Message -- ^ The selected message, so we can include its current -- reactions in the list -> EmojiCollection -- ^ The emoji collection -> () -- ^ The scope to search -> Session -- ^ The connection session -> Text -- ^ The search string -> 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) -- | Move the selection up in the emoji list overlay by one emoji. reactionEmojiListSelectUp :: MH () reactionEmojiListSelectUp = reactionEmojiListMove L.listMoveUp -- | Move the selection down in the emoji list overlay by one emoji. reactionEmojiListSelectDown :: MH () reactionEmojiListSelectDown = reactionEmojiListMove L.listMoveDown -- | Move the selection up in the emoji list overlay by a page of emoji -- (ReactionEmojiListPageSize). reactionEmojiListPageUp :: MH () reactionEmojiListPageUp = reactionEmojiListMove (L.listMoveBy (-1 * reactionEmojiListPageSize)) -- | Move the selection down in the emoji list overlay by a page of emoji -- (ReactionEmojiListPageSize). reactionEmojiListPageDown :: MH () reactionEmojiListPageDown = reactionEmojiListMove (L.listMoveBy reactionEmojiListPageSize) -- | Transform the emoji list results in some way, e.g. by moving the -- cursor, and then check to see whether the modification warrants a -- prefetch of more search results. reactionEmojiListMove :: (L.List Name (Bool, T.Text) -> L.List Name (Bool, T.Text)) -> MH () reactionEmojiListMove = listOverlayMove csReactionEmojiListOverlay -- | The number of emoji in a "page" for cursor movement purposes. reactionEmojiListPageSize :: Int reactionEmojiListPageSize = 10