ReactionEmojiListWindow.hs

{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.ReactionEmojiListWindow
  ( enterReactionEmojiListWindowMode

  , 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           Network.Mattermost.Types

import           Matterhorn.Emoji
import           Matterhorn.State.ListWindow
import           Matterhorn.Types
import           Matterhorn.State.Reactions ( updateReaction )


enterReactionEmojiListWindowMode :: TeamId -> Message -> MH ()
enterReactionEmojiListWindowMode tId msg = do
    em <- use (csResources.crEmoji)
    myId <- gets myUserId
    enterListWindowMode tId (csTeam(tId).tsReactionEmojiListWindow) ReactionEmojiListWindow
        () (enterHandler msg) (fetchResults myId msg em)

enterHandler :: Message -> (Bool, T.Text) -> MH Bool
enterHandler msg (mine, e) = do
    case msg^.mOriginalPost of
        Nothing -> return False
        Just p -> do
            updateReaction (postId p) e (not mine)
            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 window by one emoji.
reactionEmojiListSelectUp :: TeamId -> MH ()
reactionEmojiListSelectUp tId = reactionEmojiListMove tId L.listMoveUp

-- | Move the selection down in the emoji list window by one emoji.
reactionEmojiListSelectDown :: TeamId -> MH ()
reactionEmojiListSelectDown tId = reactionEmojiListMove tId L.listMoveDown

-- | Move the selection up in the emoji list window by a page of emoji
-- (ReactionEmojiListPageSize).
reactionEmojiListPageUp :: TeamId -> MH ()
reactionEmojiListPageUp tId = reactionEmojiListMove tId (L.listMoveBy (-1 * reactionEmojiListPageSize))

-- | Move the selection down in the emoji list window by a page of emoji
-- (ReactionEmojiListPageSize).
reactionEmojiListPageDown :: TeamId -> MH ()
reactionEmojiListPageDown tId = reactionEmojiListMove tId (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 :: TeamId -> (L.List Name (Bool, T.Text) -> L.List Name (Bool, T.Text)) -> MH ()
reactionEmojiListMove tId = listWindowMove (csTeam(tId).tsReactionEmojiListWindow)

-- | The number of emoji in a "page" for cursor movement purposes.
reactionEmojiListPageSize :: Int
reactionEmojiListPageSize = 10