1{-# LANGUAGE TupleSections #-} 2module Matterhorn.State.ReactionEmojiListOverlay 3 ( enterReactionEmojiListOverlayMode 4 5 , reactionEmojiListSelectDown 6 , reactionEmojiListSelectUp 7 , reactionEmojiListPageDown 8 , reactionEmojiListPageUp 9 ) 10where 11 12import Prelude () 13import Matterhorn.Prelude 14 15import qualified Brick.Widgets.List as L 16import qualified Data.Vector as Vec 17import qualified Data.Text as T 18import qualified Data.Map as M 19import qualified Data.Set as Set 20import Data.Function ( on ) 21import Data.List ( nubBy ) 22import Lens.Micro.Platform ( to ) 23 24import Network.Mattermost.Types 25 26import Matterhorn.Emoji 27import Matterhorn.State.ListOverlay 28import Matterhorn.State.MessageSelect 29import Matterhorn.Types 30import Matterhorn.State.Reactions ( updateReaction ) 31 32 33enterReactionEmojiListOverlayMode :: MH () 34enterReactionEmojiListOverlayMode = do 35 selectedMessage <- use (to getSelectedMessage) 36 case selectedMessage of 37 Nothing -> return () 38 Just msg -> do 39 tId <- use csCurrentTeamId 40 em <- use (csResources.crEmoji) 41 myId <- gets myUserId 42 enterListOverlayMode (csTeam(tId).tsReactionEmojiListOverlay) ReactionEmojiListOverlay 43 () enterHandler (fetchResults myId msg em) 44 45enterHandler :: (Bool, T.Text) -> MH Bool 46enterHandler (mine, e) = do 47 selectedMessage <- use (to getSelectedMessage) 48 case selectedMessage of 49 Nothing -> return False 50 Just m -> do 51 case m^.mOriginalPost of 52 Nothing -> return False 53 Just p -> do 54 updateReaction (postId p) e (not mine) 55 return True 56 57fetchResults :: UserId 58 -- ^ My user ID, so we can see which reactions I haven't 59 -- posted 60 -> Message 61 -- ^ The selected message, so we can include its current 62 -- reactions in the list 63 -> EmojiCollection 64 -- ^ The emoji collection 65 -> () 66 -- ^ The scope to search 67 -> Session 68 -- ^ The connection session 69 -> Text 70 -- ^ The search string 71 -> IO (Vec.Vector (Bool, T.Text)) 72fetchResults myId msg em () session searchString = do 73 let currentReactions = [ (myId `Set.member` uIds, k) 74 | (k, uIds) <- M.toList (msg^.mReactions) 75 ] 76 matchingCurrentOtherReactions = [ (mine, r) | (mine, r) <- currentReactions 77 , matchesEmoji searchString r 78 , not mine 79 ] 80 matchingCurrentMyReactions = [ (mine, r) | (mine, r) <- currentReactions 81 , matchesEmoji searchString r 82 , mine 83 ] 84 serverMatches <- getMatchingEmoji session em searchString 85 return $ Vec.fromList $ nubBy ((==) `on` snd) $ 86 matchingCurrentOtherReactions <> matchingCurrentMyReactions <> ((False,) <$> serverMatches) 87 88-- | Move the selection up in the emoji list overlay by one emoji. 89reactionEmojiListSelectUp :: MH () 90reactionEmojiListSelectUp = reactionEmojiListMove L.listMoveUp 91 92-- | Move the selection down in the emoji list overlay by one emoji. 93reactionEmojiListSelectDown :: MH () 94reactionEmojiListSelectDown = reactionEmojiListMove L.listMoveDown 95 96-- | Move the selection up in the emoji list overlay by a page of emoji 97-- (ReactionEmojiListPageSize). 98reactionEmojiListPageUp :: MH () 99reactionEmojiListPageUp = reactionEmojiListMove (L.listMoveBy (-1 * reactionEmojiListPageSize)) 100 101-- | Move the selection down in the emoji list overlay by a page of emoji 102-- (ReactionEmojiListPageSize). 103reactionEmojiListPageDown :: MH () 104reactionEmojiListPageDown = reactionEmojiListMove (L.listMoveBy reactionEmojiListPageSize) 105 106-- | Transform the emoji list results in some way, e.g. by moving the 107-- cursor, and then check to see whether the modification warrants a 108-- prefetch of more search results. 109reactionEmojiListMove :: (L.List Name (Bool, T.Text) -> L.List Name (Bool, T.Text)) -> MH () 110reactionEmojiListMove = listOverlayMove (csCurrentTeam.tsReactionEmojiListOverlay) 111 112-- | The number of emoji in a "page" for cursor movement purposes. 113reactionEmojiListPageSize :: Int 114reactionEmojiListPageSize = 10 115