module Matterhorn.State.ThreadWindow
  ( openThreadWindow
  , closeThreadWindow
  )
where

import Prelude ()
import Matterhorn.Prelude

import qualified Data.HashMap.Strict as HM
import Lens.Micro.Platform ( (.=), _Just )

import Network.Mattermost.Types (TeamId, PostId, ChannelId)
import qualified Network.Mattermost.Types as MM
import qualified Network.Mattermost.Endpoints as MM
import Network.Mattermost.Lenses

import Matterhorn.Types
import Matterhorn.State.Common
import Matterhorn.State.Teams ( newThreadInterface )
import {-# SOURCE #-} Matterhorn.State.Messages

openThreadWindow :: TeamId -> ChannelId -> PostId -> MH ()
openThreadWindow :: TeamId -> ChannelId -> PostId -> MH ()
openThreadWindow TeamId
tId ChannelId
cId PostId
pId = do
    -- If the thread we're switching to is the one we're already
    -- viewing, do nothing.
    Maybe PostId
mPid <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i1 i2.
Lens (MessageInterface n i1) (MessageInterface n i2) i1 i2
miRootPostId)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Maybe PostId
mPid forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just PostId
pId)) forall a b. (a -> b) -> a -> b
$ do
        -- Fetch the entire thread associated with the post.
        forall a.
AsyncPriority -> (Session -> IO a) -> (a -> Maybe (MH ())) -> MH ()
doAsyncMM AsyncPriority
Preempt Session -> IO Posts
getThread Posts -> Maybe (MH ())
processThread
        where getThread :: Session -> IO Posts
getThread Session
session = PostId -> Session -> IO Posts
MM.mmGetThread PostId
pId Session
session
              processThread :: Posts -> Maybe (MH ())
processThread Posts
posts = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                  let numPosts :: Int
numPosts = forall k v. HashMap k v -> Int
HM.size (Posts -> HashMap PostId Post
MM.postsPosts Posts
posts)

                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numPosts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
                      BChan MHEvent
eventQueue <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (BChan MHEvent)
crEventQueue)
                      Messages
msgs <- Maybe TeamId -> Posts -> MH Messages
installMessagesFromPosts (forall a. a -> Maybe a
Just TeamId
tId) Posts
posts

                      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
False Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> PostToAdd
OldPost)
                               [ (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL) forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
p
                               | PostId
p <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (Seq PostId)
postsOrderL)
                               ]

                      ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
                      case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId of
                          Just Message
rootMsg | Just Post
rootPost <- Message
rootMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost -> do
                              Maybe Aspell
checker <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (Maybe Aspell)
crSpellChecker)
                              ThreadInterface
ti <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Aspell
-> BChan MHEvent
-> TeamId
-> ChannelId
-> Message
-> Post
-> Messages
-> IO ThreadInterface
newThreadInterface Maybe Aspell
checker BChan MHEvent
eventQueue TeamId
tId ChannelId
cId Message
rootMsg Post
rootPost Messages
msgs
                              TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just ThreadInterface
ti
                              TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceFocus
FocusThread
                              Maybe ChannelId
mcId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId))
                              case Maybe ChannelId
mcId of
                                  Just ChannelId
curId -> ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
curId
                                  Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                          Maybe Message
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: openThreadWindow failed to find the root message"

closeThreadWindow :: TeamId -> MH ()
closeThreadWindow :: TeamId -> MH ()
closeThreadWindow TeamId
tId = do
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceFocus
FocusCurrentChannel
    Maybe ChannelId
mcId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId))
    case Maybe ChannelId
mcId of
        Just ChannelId
curId -> ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
curId
        Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()