module Matterhorn.State.PostListWindow
( enterFlaggedPostListMode
, enterPinnedPostListMode
, enterSearchResultPostListMode
, postListJumpToCurrent
, postListSelectUp
, postListSelectDown
, postListUnflagSelected
, exitPostListMode
)
where
import GHC.Exts ( IsList(..) )
import Prelude ()
import Matterhorn.Prelude
import qualified Data.Foldable as F
import qualified Data.Text as T
import Lens.Micro.Platform ( (.=) )
import Network.Mattermost.Endpoints
import Network.Mattermost.Types
import Matterhorn.State.Messages ( jumpToPost )
import Matterhorn.State.Common
import Matterhorn.State.MessageSelect
import Matterhorn.State.Messages ( addObtainedMessages
, asyncFetchMessagesSurrounding )
import Matterhorn.Types
import Matterhorn.Types.DirectionalSeq (emptyDirSeq)
enterPostListMode :: TeamId -> PostListContents -> Messages -> MH ()
enterPostListMode :: TeamId -> PostListContents -> Messages -> MH ()
enterPostListMode TeamId
tId PostListContents
contents Messages
msgs = do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState Messages
postListPosts forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Messages
msgs
let mlatest :: Maybe Message
mlatest = Messages -> Maybe Message
getLatestPostMsg Messages
msgs
pId :: Maybe PostId
pId = Maybe Message
mlatest forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message -> Maybe PostId
messagePostId
cId :: Maybe ChannelId
cId = Maybe Message
mlatest forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Message
m -> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe ChannelId)
mChannelId
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe PostId
pId
TeamId -> Mode -> MH ()
pushMode TeamId
tId forall a b. (a -> b) -> a -> b
$ PostListContents -> Mode
PostListWindow PostListContents
contents
case (Maybe PostId
pId, Maybe ChannelId
cId) of
(Just PostId
p, Just ChannelId
c) -> ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding ChannelId
c PostId
p
(Maybe PostId, Maybe ChannelId)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
exitPostListMode :: TeamId -> MH ()
exitPostListMode :: TeamId -> MH ()
exitPostListMode TeamId
tId = do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState Messages
postListPosts forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall dir a. DirectionalSeq dir a
emptyDirSeq
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
TeamId -> MH ()
popMode TeamId
tId
createPostList :: TeamId -> PostListContents -> (Session -> IO Posts) -> MH ()
createPostList :: TeamId -> PostListContents -> (Session -> IO Posts) -> MH ()
createPostList TeamId
tId PostListContents
contentsType Session -> IO Posts
fetchOp = do
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
Posts
posts <- Session -> IO Posts
fetchOp Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Messages
messages <- Maybe TeamId -> Posts -> MH Messages
installMessagesFromPosts (forall a. a -> Maybe a
Just TeamId
tId) Posts
posts
let plist :: [Post]
plist = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Posts -> HashMap PostId Post
postsPosts Posts
posts
postsSpec :: Post -> Posts
postsSpec Post
p = Posts { postsPosts :: HashMap PostId Post
postsPosts = forall l. IsList l => [Item l] -> l
fromList [(Post -> PostId
postId Post
p, Post
p)]
, postsOrder :: Seq PostId
postsOrder = forall l. IsList l => [Item l] -> l
fromList [Post -> PostId
postId Post
p]
}
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Post
p -> ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages (Post -> ChannelId
postChannelId Post
p) Int
0 Bool
False forall a b. (a -> b) -> a -> b
$ Post -> Posts
postsSpec Post
p) [Post]
plist
TeamId -> PostListContents -> Messages -> MH ()
enterPostListMode TeamId
tId PostListContents
contentsType Messages
messages
enterFlaggedPostListMode :: TeamId -> MH ()
enterFlaggedPostListMode :: TeamId -> MH ()
enterFlaggedPostListMode TeamId
tId = do
TeamId -> PostListContents -> (Session -> IO Posts) -> MH ()
createPostList TeamId
tId PostListContents
PostListFlagged forall a b. (a -> b) -> a -> b
$
UserParam -> FlaggedPostsQuery -> Session -> IO Posts
mmGetListOfFlaggedPosts UserParam
UserMe FlaggedPostsQuery
defaultFlaggedPostsQuery
enterPinnedPostListMode :: TeamId -> MH ()
enterPinnedPostListMode :: TeamId -> MH ()
enterPinnedPostListMode TeamId
tId =
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
TeamId -> PostListContents -> (Session -> IO Posts) -> MH ()
createPostList TeamId
tId (ChannelId -> PostListContents
PostListPinned ChannelId
cId) forall a b. (a -> b) -> a -> b
$ ChannelId -> Session -> IO Posts
mmGetChannelPinnedPosts ChannelId
cId
enterSearchResultPostListMode :: TeamId -> Text -> MH ()
enterSearchResultPostListMode :: TeamId -> Text -> MH ()
enterSearchResultPostListMode TeamId
tId Text
terms
| Text -> Bool
T.null (Text -> Text
T.strip Text
terms) = Text -> MH ()
postInfoMessage Text
"Search command requires at least one search term."
| Bool
otherwise = do
TeamId -> PostListContents -> Messages -> MH ()
enterPostListMode TeamId
tId (Text -> Bool -> PostListContents
PostListSearch Text
terms Bool
True) Messages
noMessages
TeamId -> PostListContents -> (Session -> IO Posts) -> MH ()
createPostList TeamId
tId (Text -> Bool -> PostListContents
PostListSearch Text
terms Bool
False) forall a b. (a -> b) -> a -> b
$
TeamId -> SearchPosts -> Session -> IO Posts
mmSearchForTeamPosts TeamId
tId (Text -> Bool -> SearchPosts
SearchPosts Text
terms Bool
False)
postListSelectDown :: TeamId -> MH ()
postListSelectDown :: TeamId -> MH ()
postListSelectDown TeamId
tId = do
Maybe PostId
selId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected)
Messages
posts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState Messages
postListPosts)
let nextMsg :: Maybe Message
nextMsg = Maybe MessageId -> Messages -> Maybe Message
getNextMessage (PostId -> MessageId
MessagePostId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PostId
selId) Messages
posts
case Maybe Message
nextMsg of
Maybe Message
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Message
m -> do
let pId :: Maybe PostId
pId = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MessageId -> Maybe PostId
messageIdPostId
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe PostId
pId
case (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe ChannelId)
mChannelId, Maybe PostId
pId) of
(Just ChannelId
c, Just PostId
p) -> ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding ChannelId
c PostId
p
(Maybe ChannelId, Maybe PostId)
o -> LogCategory -> Text -> MH ()
mhLog LogCategory
LogError
(String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"postListSelectDown" forall a. Semigroup a => a -> a -> a
<>
String
" unable to get channel or post ID: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Maybe ChannelId, Maybe PostId)
o)
postListSelectUp :: TeamId -> MH ()
postListSelectUp :: TeamId -> MH ()
postListSelectUp TeamId
tId = do
Maybe PostId
selId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected)
Messages
posts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState Messages
postListPosts)
let prevMsg :: Maybe Message
prevMsg = Maybe MessageId -> Messages -> Maybe Message
getPrevMessage (PostId -> MessageId
MessagePostId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PostId
selId) Messages
posts
case Maybe Message
prevMsg of
Maybe Message
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Message
m -> do
let pId :: Maybe PostId
pId = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MessageId -> Maybe PostId
messageIdPostId
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe PostId
pId
case (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe ChannelId)
mChannelId, Maybe PostId
pId) of
(Just ChannelId
c, Just PostId
p) -> ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding ChannelId
c PostId
p
(Maybe ChannelId, Maybe PostId)
o -> LogCategory -> Text -> MH ()
mhLog LogCategory
LogError
(String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"postListSelectUp" forall a. Semigroup a => a -> a -> a
<>
String
" unable to get channel or post ID: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Maybe ChannelId, Maybe PostId)
o)
postListUnflagSelected :: TeamId -> MH ()
postListUnflagSelected :: TeamId -> MH ()
postListUnflagSelected TeamId
tId = do
Maybe PostId
msgId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected)
case Maybe PostId
msgId of
Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PostId
pId -> PostId -> Bool -> MH ()
flagMessage PostId
pId Bool
False
postListJumpToCurrent :: TeamId -> MH ()
postListJumpToCurrent :: TeamId -> MH ()
postListJumpToCurrent TeamId
tId = do
Maybe PostId
msgId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected)
case Maybe PostId
msgId of
Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PostId
pId -> PostId -> MH ()
jumpToPost PostId
pId