PostListOverlay.hs

module State.PostListOverlay
  ( enterFlaggedPostListMode
  , enterSearchResultPostListMode
  , postListJumpToCurrent
  , postListSelectUp
  , postListSelectDown
  , postListUnflagSelected
  , exitPostListMode
  )
where

import           GHC.Exts ( IsList(..) )
import           Prelude ()
import           Prelude.MH

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           State.Channels
import           State.Common
import           State.MessageSelect
import           State.Messages ( addObtainedMessages
                                , asyncFetchMessagesSurrounding )
import           Types
import           Types.DirectionalSeq (emptyDirSeq)


-- | Create a PostListOverlay with the given content description and
-- with a specified list of messages.
enterPostListMode ::  PostListContents -> Messages -> MH ()
enterPostListMode contents msgs = do
  csPostListOverlay.postListPosts .= msgs
  let mlatest = getLatestPostMsg msgs
      pId = mlatest >>= messagePostId
      cId = mlatest >>= \m -> m^.mChannelId
  csPostListOverlay.postListSelected .= pId
  setMode $ PostListOverlay contents
  case (pId, cId) of
    (Just p, Just c) -> asyncFetchMessagesSurrounding c p
    _ -> return ()

-- | Clear out the state of a PostListOverlay
exitPostListMode :: MH ()
exitPostListMode = do
  csPostListOverlay.postListPosts .= emptyDirSeq
  csPostListOverlay.postListSelected .= Nothing
  setMode Main


createPostList :: PostListContents -> (Session -> IO Posts) -> MH ()
createPostList contentsType fetchOp = do
  session <- getSession
  doAsyncWith Preempt $ do
    posts <- fetchOp session
    return $ Just $ do
      messages <- installMessagesFromPosts 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 = F.toList $ postsPosts posts
          postsSpec p = Posts { postsPosts = fromList [(postId p, p)]
                              , postsOrder = fromList [postId p]
                              }
      mapM_ (\p -> addObtainedMessages (postChannelId p) 0 False $ postsSpec p) plist
      enterPostListMode contentsType messages


-- | Create a PostListOverlay with flagged messages from the server.
enterFlaggedPostListMode :: MH ()
enterFlaggedPostListMode = createPostList PostListFlagged $
                           mmGetListOfFlaggedPosts UserMe defaultFlaggedPostsQuery


-- | Create a PostListOverlay with post search result messages from the
-- server.
enterSearchResultPostListMode :: Text -> MH ()
enterSearchResultPostListMode terms
  | T.null (T.strip terms) = postInfoMessage "Search command requires at least one search term."
  | otherwise = do
      enterPostListMode (PostListSearch terms True) noMessages
      tId <- gets myTeamId
      createPostList (PostListSearch terms False) $
        mmSearchForTeamPosts tId (SearchPosts terms False)


-- | Move the selection up in the PostListOverlay, which corresponds
-- to finding a chronologically /newer/ message.
postListSelectUp :: MH ()
postListSelectUp = do
  selId <- use (csPostListOverlay.postListSelected)
  posts <- use (csPostListOverlay.postListPosts)
  let nextMsg = getNextMessage (MessagePostId <$> selId) posts
  case nextMsg of
    Nothing -> return ()
    Just m -> do
      let pId = m^.mMessageId >>= messageIdPostId
      csPostListOverlay.postListSelected .= pId
      case (m^.mChannelId, pId) of
        (Just c, Just p) -> asyncFetchMessagesSurrounding c p
        o -> mhLog LogError
             (T.pack $ "postListSelectUp" <>
              " unable to get channel or post ID: " <> show o)

-- | Move the selection down in the PostListOverlay, which corresponds
-- to finding a chronologically /old/ message.
postListSelectDown :: MH ()
postListSelectDown = do
  selId <- use (csPostListOverlay.postListSelected)
  posts <- use (csPostListOverlay.postListPosts)
  let prevMsg = getPrevMessage (MessagePostId <$> selId) posts
  case prevMsg of
    Nothing -> return ()
    Just m -> do
      let pId = m^.mMessageId >>= messageIdPostId
      csPostListOverlay.postListSelected .= pId
      case (m^.mChannelId, pId) of
        (Just c, Just p) -> asyncFetchMessagesSurrounding c p
        o -> mhLog LogError
             (T.pack $ "postListSelectDown" <>
              " unable to get channel or post ID: " <> show o)

-- | Unflag the post currently selected in the PostListOverlay, if any
postListUnflagSelected :: MH ()
postListUnflagSelected = do
  msgId <- use (csPostListOverlay.postListSelected)
  case msgId of
    Nothing  -> return ()
    Just pId -> flagMessage pId False


-- | Jumps to the specified message in the message's main channel
-- display and changes to MessageSelectState.
postListJumpToCurrent :: MH ()
postListJumpToCurrent = do
  msgId <- use (csPostListOverlay.postListSelected)
  st <- use id
  case msgId of
    Nothing  -> return ()
    Just pId ->
      case getMessageForPostId st pId of
        Just msg ->
          case msg ^. mChannelId of
            Just cId -> do
              setFocus cId
              setMode MessageSelect
              csMessageSelect .= MessageSelectState (msg^.mMessageId)
            Nothing ->
              error "INTERNAL: selected Post ID not associated with a channel"
        Nothing ->
          error "INTERNAL: selected Post ID not added to global state!"