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 <- Getting (First PostId) ChatState PostId -> MH (Maybe PostId)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)((Maybe ThreadInterface
  -> Const (First PostId) (Maybe ThreadInterface))
 -> ChatState -> Const (First PostId) ChatState)
-> ((PostId -> Const (First PostId) PostId)
    -> Maybe ThreadInterface
    -> Const (First PostId) (Maybe ThreadInterface))
-> Getting (First PostId) ChatState PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ThreadInterface -> Const (First PostId) ThreadInterface)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just((ThreadInterface -> Const (First PostId) ThreadInterface)
 -> Maybe ThreadInterface
 -> Const (First PostId) (Maybe ThreadInterface))
-> ((PostId -> Const (First PostId) PostId)
    -> ThreadInterface -> Const (First PostId) ThreadInterface)
-> (PostId -> Const (First PostId) PostId)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostId -> Const (First PostId) PostId)
-> ThreadInterface -> Const (First PostId) ThreadInterface
forall n i1 i2 (f :: * -> *).
Functor f =>
(i1 -> f i2) -> MessageInterface n i1 -> f (MessageInterface n i2)
miRootPostId)
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Maybe PostId
mPid Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
pId)) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        -- Fetch the entire thread associated with the post.
        AsyncPriority
-> (Session -> IO Posts) -> (Posts -> Maybe (MH ())) -> MH ()
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 = MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                  let numPosts :: Int
numPosts = HashMap PostId Post -> Int
forall k v. HashMap k v -> Int
HM.size (Posts -> HashMap PostId Post
MM.postsPosts Posts
posts)

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

                      (Post -> MH PostProcessMessageAdd) -> [Post] -> MH ()
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 (PostToAdd -> MH PostProcessMessageAdd)
-> (Post -> PostToAdd) -> Post -> MH PostProcessMessageAdd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> PostToAdd
OldPost)
                               [ (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL) HashMap PostId Post -> PostId -> Post
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
p
                               | PostId
p <- Seq PostId -> [PostId]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsPosts -> Getting (Seq PostId) Posts (Seq PostId) -> Seq PostId
forall s a. s -> Getting a s a -> a
^.Getting (Seq PostId) Posts (Seq PostId)
Lens' Posts (Seq PostId)
postsOrderL)
                               ]

                      ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
                      case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId of
                          Just Message
rootMsg | Just Post
rootPost <- Message
rootMsgMessage -> 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 -> do
                              Maybe Aspell
checker <- Getting (Maybe Aspell) ChatState (Maybe Aspell)
-> MH (Maybe Aspell)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (Maybe Aspell) ChatResources)
-> ChatState -> Const (Maybe Aspell) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Aspell) ChatResources)
 -> ChatState -> Const (Maybe Aspell) ChatState)
-> ((Maybe Aspell -> Const (Maybe Aspell) (Maybe Aspell))
    -> ChatResources -> Const (Maybe Aspell) ChatResources)
-> Getting (Maybe Aspell) ChatState (Maybe Aspell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Aspell -> Const (Maybe Aspell) (Maybe Aspell))
-> ChatResources -> Const (Maybe Aspell) ChatResources
Lens' ChatResources (Maybe Aspell)
crSpellChecker)
                              ThreadInterface
ti <- IO ThreadInterface -> MH ThreadInterface
forall a. IO a -> MH a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadInterface -> MH ThreadInterface)
-> IO ThreadInterface -> MH ThreadInterface
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)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
    -> TeamState -> Identity TeamState)
-> (Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface ((Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
 -> ChatState -> Identity ChatState)
-> Maybe ThreadInterface -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ThreadInterface -> Maybe ThreadInterface
forall a. a -> Maybe a
Just ThreadInterface
ti
                              TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageInterfaceFocus -> Identity MessageInterfaceFocus)
    -> TeamState -> Identity TeamState)
-> (MessageInterfaceFocus -> Identity MessageInterfaceFocus)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceFocus -> Identity MessageInterfaceFocus)
-> TeamState -> Identity TeamState
Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus ((MessageInterfaceFocus -> Identity MessageInterfaceFocus)
 -> ChatState -> Identity ChatState)
-> MessageInterfaceFocus -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceFocus
FocusThread
                              Maybe ChannelId
mcId <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
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 -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                          Maybe Message
_ -> [Char] -> MH ()
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)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
    -> TeamState -> Identity TeamState)
-> (Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
-> TeamState -> Identity TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface ((Maybe ThreadInterface -> Identity (Maybe ThreadInterface))
 -> ChatState -> Identity ChatState)
-> Maybe ThreadInterface -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ThreadInterface
forall a. Maybe a
Nothing
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageInterfaceFocus -> Identity MessageInterfaceFocus)
    -> TeamState -> Identity TeamState)
-> (MessageInterfaceFocus -> Identity MessageInterfaceFocus)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceFocus -> Identity MessageInterfaceFocus)
-> TeamState -> Identity TeamState
Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus ((MessageInterfaceFocus -> Identity MessageInterfaceFocus)
 -> ChatState -> Identity ChatState)
-> MessageInterfaceFocus -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceFocus
FocusCurrentChannel
    Maybe ChannelId
mcId <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
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 -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()