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