{-# 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 :: TeamId -> Message -> MH ()
enterReactionEmojiListWindowMode TeamId
tId Message
msg = do
    EmojiCollection
em <- Getting EmojiCollection ChatState EmojiCollection
-> MH EmojiCollection
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const EmojiCollection ChatResources)
-> ChatState -> Const EmojiCollection ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const EmojiCollection ChatResources)
 -> ChatState -> Const EmojiCollection ChatState)
-> ((EmojiCollection -> Const EmojiCollection EmojiCollection)
    -> ChatResources -> Const EmojiCollection ChatResources)
-> Getting EmojiCollection ChatState EmojiCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EmojiCollection -> Const EmojiCollection EmojiCollection)
-> ChatResources -> Const EmojiCollection ChatResources
Lens' ChatResources EmojiCollection
crEmoji)
    UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    TeamId
-> Lens' ChatState (ListWindowState (Bool, Text) ())
-> Mode
-> ()
-> ((Bool, Text) -> MH Bool)
-> (() -> Session -> Text -> IO (Vector (Bool, Text)))
-> MH ()
forall a b.
TeamId
-> Lens' ChatState (ListWindowState a b)
-> Mode
-> b
-> (a -> MH Bool)
-> (b -> Session -> Text -> IO (Vector a))
-> MH ()
enterListWindowMode TeamId
tId (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListWindowState (Bool, Text) ()
     -> f (ListWindowState (Bool, Text) ()))
    -> TeamState -> f TeamState)
-> (ListWindowState (Bool, Text) ()
    -> f (ListWindowState (Bool, Text) ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState (Bool, Text) ()
 -> f (ListWindowState (Bool, Text) ()))
-> TeamState -> f TeamState
Lens' TeamState (ListWindowState (Bool, Text) ())
tsReactionEmojiListWindow) Mode
ReactionEmojiListWindow
        () (Message -> (Bool, Text) -> MH Bool
enterHandler Message
msg) (UserId
-> Message
-> EmojiCollection
-> ()
-> Session
-> Text
-> IO (Vector (Bool, Text))
fetchResults UserId
myId Message
msg EmojiCollection
em)

enterHandler :: Message -> (Bool, T.Text) -> MH Bool
enterHandler :: Message -> (Bool, Text) -> MH Bool
enterHandler Message
msg (Bool
mine, Text
e) = do
    case Message
msgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost of
        Maybe Post
Nothing -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just Post
p -> do
            PostId -> Text -> Bool -> MH ()
updateReaction (Post -> PostId
postId Post
p) Text
e (Bool -> Bool
not Bool
mine)
            Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: UserId
-> Message
-> EmojiCollection
-> ()
-> Session
-> Text
-> IO (Vector (Bool, Text))
fetchResults UserId
myId Message
msg EmojiCollection
em () Session
session Text
searchString = do
    let currentReactions :: [(Bool, Text)]
currentReactions = [ (UserId
myId UserId -> Set UserId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UserId
uIds, Text
k)
                           | (Text
k, Set UserId
uIds) <- Map Text (Set UserId) -> [(Text, Set UserId)]
forall k a. Map k a -> [(k, a)]
M.toList (Message
msgMessage
-> Getting (Map Text (Set UserId)) Message (Map Text (Set UserId))
-> Map Text (Set UserId)
forall s a. s -> Getting a s a -> a
^.Getting (Map Text (Set UserId)) Message (Map Text (Set UserId))
Lens' Message (Map Text (Set UserId))
mReactions)
                           ]
        matchingCurrentOtherReactions :: [(Bool, Text)]
matchingCurrentOtherReactions = [ (Bool
mine, Text
r) | (Bool
mine, Text
r) <- [(Bool, Text)]
currentReactions
                                        , Text -> Text -> Bool
matchesEmoji Text
searchString Text
r
                                        , Bool -> Bool
not Bool
mine
                                        ]
        matchingCurrentMyReactions :: [(Bool, Text)]
matchingCurrentMyReactions = [ (Bool
mine, Text
r) | (Bool
mine, Text
r) <- [(Bool, Text)]
currentReactions
                                     , Text -> Text -> Bool
matchesEmoji Text
searchString Text
r
                                     , Bool
mine
                                     ]
    [Text]
serverMatches <- Session -> EmojiCollection -> Text -> IO [Text]
getMatchingEmoji Session
session EmojiCollection
em Text
searchString
    Vector (Bool, Text) -> IO (Vector (Bool, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector (Bool, Text) -> IO (Vector (Bool, Text)))
-> Vector (Bool, Text) -> IO (Vector (Bool, Text))
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> Vector (Bool, Text)
forall a. [a] -> Vector a
Vec.fromList ([(Bool, Text)] -> Vector (Bool, Text))
-> [(Bool, Text)] -> Vector (Bool, Text)
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> (Bool, Text) -> Bool)
-> [(Bool, Text)] -> [(Bool, Text)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> ((Bool, Text) -> Text) -> (Bool, Text) -> (Bool, Text) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Bool, Text) -> Text
forall a b. (a, b) -> b
snd) ([(Bool, Text)] -> [(Bool, Text)])
-> [(Bool, Text)] -> [(Bool, Text)]
forall a b. (a -> b) -> a -> b
$
        [(Bool, Text)]
matchingCurrentOtherReactions [(Bool, Text)] -> [(Bool, Text)] -> [(Bool, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Bool, Text)]
matchingCurrentMyReactions [(Bool, Text)] -> [(Bool, Text)] -> [(Bool, Text)]
forall a. Semigroup a => a -> a -> a
<> ((Bool
False,) (Text -> (Bool, Text)) -> [Text] -> [(Bool, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
serverMatches)

-- | Move the selection up in the emoji list window by one emoji.
reactionEmojiListSelectUp :: TeamId -> MH ()
reactionEmojiListSelectUp :: TeamId -> MH ()
reactionEmojiListSelectUp TeamId
tId = TeamId
-> (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove TeamId
tId List Name (Bool, Text) -> List Name (Bool, Text)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveUp

-- | Move the selection down in the emoji list window by one emoji.
reactionEmojiListSelectDown :: TeamId -> MH ()
reactionEmojiListSelectDown :: TeamId -> MH ()
reactionEmojiListSelectDown TeamId
tId = TeamId
-> (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove TeamId
tId List Name (Bool, Text) -> List Name (Bool, Text)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveDown

-- | Move the selection up in the emoji list window by a page of emoji
-- (ReactionEmojiListPageSize).
reactionEmojiListPageUp :: TeamId -> MH ()
reactionEmojiListPageUp :: TeamId -> MH ()
reactionEmojiListPageUp TeamId
tId = TeamId
-> (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove TeamId
tId (Int -> List Name (Bool, Text) -> List Name (Bool, Text)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
reactionEmojiListPageSize))

-- | Move the selection down in the emoji list window by a page of emoji
-- (ReactionEmojiListPageSize).
reactionEmojiListPageDown :: TeamId -> MH ()
reactionEmojiListPageDown :: TeamId -> MH ()
reactionEmojiListPageDown TeamId
tId = TeamId
-> (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove TeamId
tId (Int -> List Name (Bool, Text) -> List Name (Bool, Text)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy Int
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 :: TeamId
-> (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove TeamId
tId = Lens' ChatState (ListWindowState (Bool, Text) ())
-> (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
forall a b.
Lens' ChatState (ListWindowState a b)
-> (List Name a -> List Name a) -> MH ()
listWindowMove (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListWindowState (Bool, Text) ()
     -> f (ListWindowState (Bool, Text) ()))
    -> TeamState -> f TeamState)
-> (ListWindowState (Bool, Text) ()
    -> f (ListWindowState (Bool, Text) ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState (Bool, Text) ()
 -> f (ListWindowState (Bool, Text) ()))
-> TeamState -> f TeamState
Lens' TeamState (ListWindowState (Bool, Text) ())
tsReactionEmojiListWindow)

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