{-# LANGUAGE TupleSections #-}
module Matterhorn.State.ReactionEmojiListOverlay
( enterReactionEmojiListOverlayMode
, 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 Lens.Micro.Platform ( to )
import Network.Mattermost.Types
import Network.Mattermost.Endpoints ( mmPostReaction, mmDeleteReaction )
import Matterhorn.Emoji
import Matterhorn.State.ListOverlay
import Matterhorn.State.MessageSelect
import Matterhorn.State.Async
import Matterhorn.Types
enterReactionEmojiListOverlayMode :: MH ()
enterReactionEmojiListOverlayMode :: MH ()
enterReactionEmojiListOverlayMode = do
Maybe Message
selectedMessage <- Getting (Maybe Message) ChatState (Maybe Message)
-> MH (Maybe Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatState -> Maybe Message)
-> SimpleGetter ChatState (Maybe Message)
forall s a. (s -> a) -> SimpleGetter s a
to ChatState -> Maybe Message
getSelectedMessage)
case Maybe Message
selectedMessage of
Maybe Message
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Message
msg -> do
TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
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
Lens' ChatState (ListOverlayState (Bool, Text) ())
-> Mode
-> ()
-> ((Bool, Text) -> MH Bool)
-> (() -> Session -> Text -> IO (Vector (Bool, Text)))
-> MH ()
forall a b.
Lens' ChatState (ListOverlayState a b)
-> Mode
-> b
-> (a -> MH Bool)
-> (b -> Session -> Text -> IO (Vector a))
-> MH ()
enterListOverlayMode (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState (Bool, Text) ()
-> f (ListOverlayState (Bool, Text) ()))
-> TeamState -> f TeamState)
-> (ListOverlayState (Bool, Text) ()
-> f (ListOverlayState (Bool, Text) ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState (Bool, Text) ()
-> f (ListOverlayState (Bool, Text) ()))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState (Bool, Text) ())
tsReactionEmojiListOverlay) Mode
ReactionEmojiListOverlay
() (Bool, Text) -> MH Bool
enterHandler (UserId
-> Message
-> EmojiCollection
-> ()
-> Session
-> Text
-> IO (Vector (Bool, Text))
fetchResults UserId
myId Message
msg EmojiCollection
em)
enterHandler :: (Bool, T.Text) -> MH Bool
enterHandler :: (Bool, Text) -> MH Bool
enterHandler (Bool
mine, Text
e) = do
Session
session <- MH Session
getSession
UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
Maybe Message
selectedMessage <- Getting (Maybe Message) ChatState (Maybe Message)
-> MH (Maybe Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatState -> Maybe Message)
-> SimpleGetter ChatState (Maybe Message)
forall s a. (s -> a) -> SimpleGetter s a
to ChatState -> Maybe Message
getSelectedMessage)
case Maybe Message
selectedMessage of
Maybe Message
Nothing -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Message
m -> do
case Message
mMessage -> 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
case Bool
mine of
Bool
False ->
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
PostId -> UserId -> Text -> Session -> IO ()
mmPostReaction (Post -> PostId
postId Post
p) UserId
myId Text
e Session
session
Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
Bool
True ->
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
PostId -> UserId -> Text -> Session -> IO ()
mmDeleteReaction (Post -> PostId
postId Post
p) UserId
myId Text
e Session
session
Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
fetchResults :: UserId
-> Message
-> EmojiCollection
-> ()
-> Session
-> Text
-> 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)
reactionEmojiListSelectUp :: MH ()
reactionEmojiListSelectUp :: MH ()
reactionEmojiListSelectUp = (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove 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
reactionEmojiListSelectDown :: MH ()
reactionEmojiListSelectDown :: MH ()
reactionEmojiListSelectDown = (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove 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
reactionEmojiListPageUp :: MH ()
reactionEmojiListPageUp :: MH ()
reactionEmojiListPageUp = (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove (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))
reactionEmojiListPageDown :: MH ()
reactionEmojiListPageDown :: MH ()
reactionEmojiListPageDown = (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove (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)
reactionEmojiListMove :: (L.List Name (Bool, T.Text) -> L.List Name (Bool, T.Text)) -> MH ()
reactionEmojiListMove :: (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
reactionEmojiListMove = Lens' ChatState (ListOverlayState (Bool, Text) ())
-> (List Name (Bool, Text) -> List Name (Bool, Text)) -> MH ()
forall a b.
Lens' ChatState (ListOverlayState a b)
-> (List Name a -> List Name a) -> MH ()
listOverlayMove ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState (Bool, Text) ()
-> f (ListOverlayState (Bool, Text) ()))
-> TeamState -> f TeamState)
-> (ListOverlayState (Bool, Text) ()
-> f (ListOverlayState (Bool, Text) ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState (Bool, Text) ()
-> f (ListOverlayState (Bool, Text) ()))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState (Bool, Text) ())
tsReactionEmojiListOverlay)
reactionEmojiListPageSize :: Int
reactionEmojiListPageSize :: Int
reactionEmojiListPageSize = Int
10