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)


-- | Create a PostListWindow with the given content description and
-- with a specified list of messages.
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 ()

-- | Clear out the state of a PostListWindow
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
      -- n.b. do not use addNewPostedMessage because these messages
      -- are not new, and so no notifications or channel highlighting
      -- or other post-processing should be performed.
      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


-- | Create a PostListWindow with flagged messages from the server.
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

-- | Create a PostListWindow with pinned messages from the server for
-- the current channel.
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

-- | Create a PostListWindow with post search result messages from the
-- server.
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)


-- | Move the selection up in the PostListWindow, which corresponds
-- to finding a chronologically /newer/ message.
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)

-- | Move the selection down in the PostListWindow, which corresponds
-- to finding a chronologically /old/ message.
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)

-- | Unflag the post currently selected in the PostListWindow, if any
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


-- | Jumps to the specified message in the message's main channel
-- display and changes to MessageSelectState.
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