{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.Teams
( nextTeam
, prevTeam
, handleJoinTeam
, handleLeaveTeam
, handleUpdateTeam
, buildTeamState
, moveCurrentTeamLeft
, moveCurrentTeamRight
, setTeam
, newSaveAttachmentDialog
, newChannelTopicDialog
, newThreadInterface
, makeClientChannel
, cycleTeamMessageInterfaceFocus
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick ( getName )
import qualified Brick.BChan as BCH
import Brick.Main ( invalidateCache, hScrollToBeginning, viewportScroll, makeVisible )
import Brick.Widgets.List ( list )
import Brick.Widgets.Edit ( editor, applyEdit )
import Brick.Focus ( focusRing )
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import Data.Time.Clock ( getCurrentTime )
import qualified Data.Text.Zipper as Z2
import qualified Data.HashMap.Strict as HM
import Lens.Micro.Platform ( (%=), (.=), at )
import Text.Aspell ( Aspell )
import Network.Mattermost.Lenses ( userIdL, channelTypeL, channelPurposeL
, channelHeaderL, channelTeamIdL, channelIdL
, channelLastPostAtL
)
import Network.Mattermost.Types ( TeamId, Team, Channel, User, userId
, getId, channelId, teamId, UserParam(..)
, teamOrderPref, Post, ChannelId, postId
, emptyChannelNotifyProps, UserId
, channelName, Type(..), channelDisplayName
)
import qualified Network.Mattermost.Endpoints as MM
import Matterhorn.Types
import Matterhorn.Types.Common
import Matterhorn.Types.DirectionalSeq ( emptyDirSeq )
import Matterhorn.Types.NonemptyStack
import Matterhorn.LastRunState
import Matterhorn.State.Async
import Matterhorn.State.ChannelList
import Matterhorn.State.Channels
import {-# SOURCE #-} Matterhorn.State.ThreadWindow
import {-# SOURCE #-} Matterhorn.State.Messages
import Matterhorn.State.Setup.Threads ( newSpellCheckTimer )
import qualified Matterhorn.Zipper as Z
nextTeam :: MH ()
nextTeam :: MH ()
nextTeam = (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith forall a b. Zipper a b -> Zipper a b
Z.right
prevTeam :: MH ()
prevTeam :: MH ()
prevTeam = (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith forall a b. Zipper a b -> Zipper a b
Z.left
setTeam :: TeamId -> MH ()
setTeam :: TeamId -> MH ()
setTeam TeamId
tId = (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight (forall a. Eq a => a -> a -> Bool
== TeamId
tId)
setTeamFocusWith :: (Z.Zipper () TeamId -> Z.Zipper () TeamId) -> MH ()
setTeamFocusWith :: (Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith Zipper () TeamId -> Zipper () TeamId
f = do
Bool -> MH ()
updateViewed Bool
True
Lens' ChatState (Zipper () TeamId)
csTeamZipper forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Zipper () TeamId -> Zipper () TeamId
f
(TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
postChangeTeamCommon
postChangeTeamCommon :: TeamId -> MH ()
postChangeTeamCommon :: TeamId -> MH ()
postChangeTeamCommon TeamId
tId = do
Bool -> MH ()
updateViewed Bool
False
TeamId -> MH ()
fetchVisibleIfNeeded TeamId
tId
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ do
forall n. ViewportScroll n -> forall s. EventM n s ()
hScrollToBeginning (forall n. n -> ViewportScroll n
viewportScroll Name
TeamList)
forall n s. Ord n => n -> EventM n s ()
makeVisible forall a b. (a -> b) -> a -> b
$ TeamId -> Name
SelectedChannelListEntry TeamId
tId
handleJoinTeam :: TeamId -> MH ()
handleJoinTeam :: TeamId -> MH ()
handleJoinTeam TeamId
tId = do
Session
session <- MH Session
getSession
ChatResources
cr <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ChatResources
csResources
User
me <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState User
csMe
HashMap TeamId TeamState
curTs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
let myTIds :: [TeamId]
myTIds = forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
curTs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ TeamId
tId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamId]
myTIds) forall a b. (a -> b) -> a -> b
$ do
LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Joining team " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TeamId
tId
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
Team
t <- TeamId -> Session -> IO Team
MM.mmGetTeam TeamId
tId Session
session
(TeamState
ts, ClientChannels
chans) <- ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState ChatResources
cr User
me Team
t
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
TeamState -> ClientChannels -> MH ()
addTeamState TeamState
ts ClientChannels
chans
Maybe TeamId -> MH ()
updateSidebar forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just TeamId
tId
MH ()
updateWindowTitle
MH ()
refreshTeamZipper
handleLeaveTeam :: TeamId -> MH ()
handleLeaveTeam :: TeamId -> MH ()
handleLeaveTeam TeamId
tId =
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ 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
LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Leaving team " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TeamId
tId
TeamId -> MH ()
removeTeam TeamId
tId
MH ()
updateWindowTitle
forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
handleUpdateTeam :: TeamId -> MH ()
handleUpdateTeam :: TeamId -> MH ()
handleUpdateTeam TeamId
tId = do
Session
session <- MH Session
getSession
LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Updating team " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TeamId
tId
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
Team
t <- TeamId -> Session -> IO Team
MM.mmGetTeam TeamId
tId 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
Team -> MH ()
updateTeam Team
t
forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
setTeamOrderWith :: (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith :: (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith TeamId -> [TeamId] -> [TeamId]
transform = do
Session
session <- MH Session
getSession
User
me <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState User
csMe
Maybe TeamId
mtId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
Zipper () TeamId
z <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (Zipper () TeamId)
csTeamZipper
let tIds :: [TeamId]
tIds = Zipper () TeamId -> [TeamId]
teamZipperIds Zipper () TeamId
z
newList :: [TeamId]
newList = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TeamId]
tIds (\TeamId
tId -> TeamId -> [TeamId] -> [TeamId]
transform TeamId
tId [TeamId]
tIds) Maybe TeamId
mtId
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
let pref :: Preference
pref = UserId -> [TeamId] -> Preference
teamOrderPref (User
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL) [TeamId]
newList
UserParam -> Seq Preference -> Session -> IO ()
MM.mmSaveUsersPreferences UserParam
UserMe (forall a. a -> Seq a
Seq.singleton Preference
pref) Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
moveCurrentTeamLeft :: MH ()
moveCurrentTeamLeft :: MH ()
moveCurrentTeamLeft = (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith forall a. Eq a => a -> [a] -> [a]
moveLeft
moveCurrentTeamRight :: MH ()
moveCurrentTeamRight :: MH ()
moveCurrentTeamRight = (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith forall a. Eq a => a -> [a] -> [a]
moveRight
buildTeamState :: ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState :: ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState ChatResources
cr User
me Team
team = do
let tId :: TeamId
tId = Team -> TeamId
teamId Team
team
session :: Session
session = ChatResources -> Session
getResourceSession ChatResources
cr
config :: Config
config = ChatResources
crforall s a. s -> Getting a s a -> a
^.Lens' ChatResources Config
crConfiguration
eventQueue :: BChan MHEvent
eventQueue = ChatResources
crforall s a. s -> Getting a s a -> a
^.Lens' ChatResources (BChan MHEvent)
crEventQueue
Either String LastRunState
lrsResult <- TeamId -> IO (Either String LastRunState)
readLastRunState TeamId
tId
let mLrs :: Maybe LastRunState
mLrs = case Either String LastRunState
lrsResult of
Right LastRunState
lrs | ChatResources -> User -> LastRunState -> Bool
isValidLastRunState ChatResources
cr User
me LastRunState
lrs -> forall a. a -> Maybe a
Just LastRunState
lrs
Either String LastRunState
_ -> forall a. Maybe a
Nothing
isLastSelectedChannel :: Channel -> Bool
isLastSelectedChannel = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Channel -> Bool
isTownSquare (\LastRunState
lrs Channel
c -> forall a. a -> Maybe a
Just (Channel -> ChannelId
channelId Channel
c) forall a. Eq a => a -> a -> Bool
== LastRunState
lrsforall s a. s -> Getting a s a -> a
^.Lens' LastRunState (Maybe ChannelId)
lrsSelectedChannelId) Maybe LastRunState
mLrs
Seq Channel
userChans <- UserParam -> TeamId -> Session -> IO (Seq Channel)
MM.mmGetChannelsForUser UserParam
UserMe TeamId
tId Session
session
let lastSelectedChans :: Seq Channel
lastSelectedChans = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter Channel -> Bool
isLastSelectedChannel Seq Channel
userChans
chans :: Seq Channel
chans = if forall a. Seq a -> Bool
Seq.null Seq Channel
lastSelectedChans
then forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter Channel -> Bool
isTownSquare Seq Channel
userChans
else Seq Channel
lastSelectedChans
[(ChannelId, ClientChannel)]
chanPairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Channel
chans) forall a b. (a -> b) -> a -> b
$ \Channel
c -> do
ClientChannel
cChannel <- forall (m :: * -> *).
MonadIO m =>
BChan MHEvent
-> Maybe Aspell
-> UserId
-> Maybe TeamId
-> Channel
-> m ClientChannel
makeClientChannel BChan MHEvent
eventQueue (ChatResources
crforall s a. s -> Getting a s a -> a
^.Lens' ChatResources (Maybe Aspell)
crSpellChecker) (User -> UserId
userId User
me) (forall a. a -> Maybe a
Just TeamId
tId) Channel
c
forall (m :: * -> *) a. Monad m => a -> m a
return (forall x y. HasId x y => x -> y
getId Channel
c, ClientChannel
cChannel)
UTCTime
now <- IO UTCTime
getCurrentTime
let chanIds :: [(ChannelListGroup, [ChannelListEntry])]
chanIds = ChannelListSorting
-> UTCTime
-> Config
-> TeamId
-> Maybe ClientConfig
-> UserPreferences
-> HashMap TeamId (Set ChannelListGroupLabel)
-> ClientChannels
-> Users
-> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList (Config
configforall s a. s -> Getting a s a -> a
^.Lens' Config ChannelListSorting
configChannelListSortingL) UTCTime
now Config
config TeamId
tId
forall a. Maybe a
Nothing (ChatResources
crforall s a. s -> Getting a s a -> a
^.Lens' ChatResources UserPreferences
crUserPreferences)
forall a. Monoid a => a
mempty ClientChannels
clientChans Users
noUsers
chanZip :: Zipper ChannelListGroup ChannelListEntry
chanZip = forall b a. Eq b => [(a, [b])] -> Zipper a b
Z.fromList [(ChannelListGroup, [ChannelListEntry])]
chanIds
clientChans :: ClientChannels
clientChans = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel) ClientChannels
noChannels [(ChannelId, ClientChannel)]
chanPairs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configShowLastOpenThread Config
config) forall a b. (a -> b) -> a -> b
$ do
let maybeOpenThread :: Maybe (IO ())
maybeOpenThread = do
LastRunState
lrs <- Maybe LastRunState
mLrs
(ChannelId
cId, PostId
pId) <- LastRunState
lrsforall s a. s -> Getting a s a -> a
^.Lens' LastRunState (Maybe (ChannelId, PostId))
lrsOpenThread
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ChatResources -> MH () -> IO ()
scheduleMH ChatResources
cr (TeamId -> ChannelId -> PostId -> MH ()
openThreadWindow TeamId
tId ChannelId
cId PostId
pId)
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (IO ())
maybeOpenThread
let ts :: TeamState
ts = Config
-> Team -> Zipper ChannelListGroup ChannelListEntry -> TeamState
newTeamState Config
config Team
team Zipper ChannelListGroup ChannelListEntry
chanZip
forall (m :: * -> *) a. Monad m => a -> m a
return (TeamState
ts, ClientChannels
clientChans)
addTeamState :: TeamState -> ClientChannels -> MH ()
addTeamState :: TeamState -> ClientChannels -> MH ()
addTeamState TeamState
ts ClientChannels
chans = do
let tId :: TeamId
tId = Team -> TeamId
teamId forall a b. (a -> b) -> a -> b
$ TeamState -> Team
_tsTeam TeamState
ts
Lens' ChatState (HashMap TeamId TeamState)
csTeamsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TeamId
tId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just TeamState
ts
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ClientChannels
chans forall a. Semigroup a => a -> a -> a
<>)
updateTeam :: Team -> MH ()
updateTeam :: Team -> MH ()
updateTeam Team
t = do
let tId :: TeamId
tId = Team -> TeamId
teamId Team
t
HashMap TeamId TeamState
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamId
tId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) forall a b. (a -> b) -> a -> b
$ do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState Team
tsTeam forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Team
t
removeTeam :: TeamId -> MH ()
removeTeam :: TeamId -> MH ()
removeTeam TeamId
tId = do
Lens' ChatState (HashMap TeamId TeamState)
csTeamsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TeamId
tId forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
(Zipper () TeamId -> Zipper () TeamId) -> MH ()
setTeamFocusWith forall a b. (a -> b) -> a -> b
$ forall b a. Eq b => (b -> Bool) -> Zipper a b -> Zipper a b
Z.filterZipper (forall a. Eq a => a -> a -> Bool
/= TeamId
tId)
cycleTeamMessageInterfaceFocus :: TeamId -> MH ()
cycleTeamMessageInterfaceFocus :: TeamId -> MH ()
cycleTeamMessageInterfaceFocus TeamId
tId =
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= TeamState -> TeamState
messageInterfaceFocusNext
emptyEditStateForChannel :: Maybe Aspell -> BCH.BChan MHEvent -> Maybe TeamId -> ChannelId -> IO (EditState Name)
emptyEditStateForChannel :: Maybe Aspell
-> BChan MHEvent
-> Maybe TeamId
-> ChannelId
-> IO (EditState Name)
emptyEditStateForChannel Maybe Aspell
checker BChan MHEvent
eventQueue Maybe TeamId
tId ChannelId
cId = do
Maybe (IO ())
reset <- case Maybe Aspell
checker of
Maybe Aspell
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Aspell
as -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Aspell -> BChan MHEvent -> MessageInterfaceTarget -> IO (IO ())
newSpellCheckTimer Aspell
as BChan MHEvent
eventQueue forall a b. (a -> b) -> a -> b
$ ChannelId -> MessageInterfaceTarget
MIChannel ChannelId
cId)
let editorName :: Name
editorName = ChannelId -> Name
MessageInput ChannelId
cId
attachmentListName :: Name
attachmentListName = ChannelId -> Name
AttachmentList ChannelId
cId
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n.
n
-> n
-> Maybe TeamId
-> ChannelId
-> EditMode
-> Bool
-> Maybe (IO ())
-> EditState n
newEditState Name
editorName Name
attachmentListName Maybe TeamId
tId ChannelId
cId EditMode
NewPost Bool
True Maybe (IO ())
reset
emptyEditStateForThread :: Maybe Aspell -> BCH.BChan MHEvent -> TeamId -> ChannelId -> EditMode -> IO (EditState Name)
emptyEditStateForThread :: Maybe Aspell
-> BChan MHEvent
-> TeamId
-> ChannelId
-> EditMode
-> IO (EditState Name)
emptyEditStateForThread Maybe Aspell
checker BChan MHEvent
eventQueue TeamId
tId ChannelId
cId EditMode
initialEditMode = do
Maybe (IO ())
reset <- case Maybe Aspell
checker of
Maybe Aspell
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Aspell
as -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Aspell -> BChan MHEvent -> MessageInterfaceTarget -> IO (IO ())
newSpellCheckTimer Aspell
as BChan MHEvent
eventQueue forall a b. (a -> b) -> a -> b
$ TeamId -> MessageInterfaceTarget
MITeamThread TeamId
tId)
let editorName :: Name
editorName = ChannelId -> Name
ThreadMessageInput ChannelId
cId
attachmentListName :: Name
attachmentListName = ChannelId -> Name
ThreadEditorAttachmentList ChannelId
cId
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n.
n
-> n
-> Maybe TeamId
-> ChannelId
-> EditMode
-> Bool
-> Maybe (IO ())
-> EditState n
newEditState Name
editorName Name
attachmentListName (forall a. a -> Maybe a
Just TeamId
tId) ChannelId
cId EditMode
initialEditMode Bool
False Maybe (IO ())
reset
newThreadInterface :: Maybe Aspell
-> BCH.BChan MHEvent
-> TeamId
-> ChannelId
-> Message
-> Post
-> Messages
-> IO ThreadInterface
newThreadInterface :: 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 = do
EditState Name
es <- Maybe Aspell
-> BChan MHEvent
-> TeamId
-> ChannelId
-> EditMode
-> IO (EditState Name)
emptyEditStateForThread Maybe Aspell
checker BChan MHEvent
eventQueue TeamId
tId ChannelId
cId (Message -> Post -> EditMode
Replying Message
rootMsg Post
rootPost)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i.
ChannelId
-> i
-> Messages
-> EditState Name
-> MessageInterfaceTarget
-> URLListSource
-> MessageInterface Name i
newMessageInterface ChannelId
cId (Post -> PostId
postId Post
rootPost) Messages
msgs EditState Name
es (TeamId -> MessageInterfaceTarget
MITeamThread TeamId
tId) (ChannelId -> URLListSource
FromThreadIn ChannelId
cId)
newChannelMessageInterface :: Maybe Aspell
-> BCH.BChan MHEvent
-> Maybe TeamId
-> ChannelId
-> Messages
-> IO ChannelMessageInterface
newChannelMessageInterface :: Maybe Aspell
-> BChan MHEvent
-> Maybe TeamId
-> ChannelId
-> Messages
-> IO ChannelMessageInterface
newChannelMessageInterface Maybe Aspell
checker BChan MHEvent
eventQueue Maybe TeamId
tId ChannelId
cId Messages
msgs = do
EditState Name
es <- Maybe Aspell
-> BChan MHEvent
-> Maybe TeamId
-> ChannelId
-> IO (EditState Name)
emptyEditStateForChannel Maybe Aspell
checker BChan MHEvent
eventQueue Maybe TeamId
tId ChannelId
cId
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i.
ChannelId
-> i
-> Messages
-> EditState Name
-> MessageInterfaceTarget
-> URLListSource
-> MessageInterface Name i
newMessageInterface ChannelId
cId () Messages
msgs EditState Name
es (ChannelId -> MessageInterfaceTarget
MIChannel ChannelId
cId) (ChannelId -> URLListSource
FromChannel ChannelId
cId)
newMessageInterface :: ChannelId
-> i
-> Messages
-> EditState Name
-> MessageInterfaceTarget
-> URLListSource
-> MessageInterface Name i
newMessageInterface :: forall i.
ChannelId
-> i
-> Messages
-> EditState Name
-> MessageInterfaceTarget
-> URLListSource
-> MessageInterface Name i
newMessageInterface ChannelId
cId i
pId Messages
msgs EditState Name
es MessageInterfaceTarget
target URLListSource
src =
let urlListName :: Name
urlListName = Name -> Name
UrlList Name
eName
eName :: Name
eName = forall a n. Named a n => a -> n
getName forall a b. (a -> b) -> a -> b
$ EditState Name
esforall s a. s -> Getting a s a -> a
^.forall n. Lens' (EditState n) (Editor Text n)
esEditor
in MessageInterface { _miMessages :: Messages
_miMessages = Messages
msgs
, _miRootPostId :: i
_miRootPostId = i
pId
, _miChannelId :: ChannelId
_miChannelId = ChannelId
cId
, _miMessageSelect :: MessageSelectState
_miMessageSelect = Maybe MessageId -> MessageSelectState
MessageSelectState forall a. Maybe a
Nothing
, _miMode :: MessageInterfaceMode
_miMode = MessageInterfaceMode
Compose
, _miEditor :: EditState Name
_miEditor = EditState Name
es
, _miTarget :: MessageInterfaceTarget
_miTarget = MessageInterfaceTarget
target
, _miUrlListSource :: URLListSource
_miUrlListSource = URLListSource
src
, _miUrlList :: URLList Name
_miUrlList = URLList { _ulList :: List Name (Int, LinkChoice)
_ulList = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
urlListName forall a. Monoid a => a
mempty Int
2
, _ulSource :: Maybe URLListSource
_ulSource = forall a. Maybe a
Nothing
}
, _miSaveAttachmentDialog :: SaveAttachmentDialogState Name
_miSaveAttachmentDialog = Name -> Text -> SaveAttachmentDialogState Name
newSaveAttachmentDialog Name
eName Text
"(unused)"
}
newTeamState :: Config
-> Team
-> Z.Zipper ChannelListGroup ChannelListEntry
-> TeamState
newTeamState :: Config
-> Team -> Zipper ChannelListGroup ChannelListEntry -> TeamState
newTeamState Config
config Team
team Zipper ChannelListGroup ChannelListEntry
chanList =
let tId :: TeamId
tId = Team -> TeamId
teamId Team
team
in TeamState { _tsModeStack :: NonemptyStack Mode
_tsModeStack = forall a. a -> NonemptyStack a
newStack Mode
Main
, _tsFocus :: Zipper ChannelListGroup ChannelListEntry
_tsFocus = Zipper ChannelListGroup ChannelListEntry
chanList
, _tsTeam :: Team
_tsTeam = Team
team
, _tsPostListWindow :: PostListWindowState
_tsPostListWindow = Messages -> Maybe PostId -> PostListWindowState
PostListWindowState forall dir a. DirectionalSeq dir a
emptyDirSeq forall a. Maybe a
Nothing
, _tsUserListWindow :: ListWindowState UserInfo UserSearchScope
_tsUserListWindow = TeamId -> ListWindowState UserInfo UserSearchScope
nullUserListWindowState TeamId
tId
, _tsChannelListWindow :: ListWindowState Channel ChannelSearchScope
_tsChannelListWindow = TeamId -> ListWindowState Channel ChannelSearchScope
nullChannelListWindowState TeamId
tId
, _tsChannelSelectState :: ChannelSelectState
_tsChannelSelectState = TeamId -> ChannelSelectState
emptyChannelSelectState TeamId
tId
, _tsChannelTopicDialog :: ChannelTopicDialogState
_tsChannelTopicDialog = TeamId -> Text -> ChannelTopicDialogState
newChannelTopicDialog TeamId
tId Text
""
, _tsNotifyPrefs :: Maybe (Form ChannelNotifyProps MHEvent Name)
_tsNotifyPrefs = forall a. Maybe a
Nothing
, _tsPendingChannelChange :: Maybe PendingChannelChange
_tsPendingChannelChange = forall a. Maybe a
Nothing
, _tsRecentChannel :: Maybe ChannelId
_tsRecentChannel = forall a. Maybe a
Nothing
, _tsReturnChannel :: Maybe ChannelId
_tsReturnChannel = forall a. Maybe a
Nothing
, _tsViewedMessage :: Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
_tsViewedMessage = forall a. Maybe a
Nothing
, _tsThemeListWindow :: ListWindowState InternalTheme ()
_tsThemeListWindow = TeamId -> ListWindowState InternalTheme ()
nullThemeListWindowState TeamId
tId
, _tsReactionEmojiListWindow :: ListWindowState (Bool, Text) ()
_tsReactionEmojiListWindow = TeamId -> ListWindowState (Bool, Text) ()
nullEmojiListWindowState TeamId
tId
, _tsChannelListSorting :: ChannelListSorting
_tsChannelListSorting = Config -> ChannelListSorting
configChannelListSorting Config
config
, _tsThreadInterface :: Maybe ThreadInterface
_tsThreadInterface = forall a. Maybe a
Nothing
, _tsMessageInterfaceFocus :: MessageInterfaceFocus
_tsMessageInterfaceFocus = MessageInterfaceFocus
FocusCurrentChannel
}
nullChannelListWindowState :: TeamId -> ListWindowState Channel ChannelSearchScope
nullChannelListWindowState :: TeamId -> ListWindowState Channel ChannelSearchScope
nullChannelListWindowState TeamId
tId =
let newList :: t e -> GenericList Name t e
newList t e
rs = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
JoinChannelList TeamId
tId) t e
rs Int
2
in ListWindowState { _listWindowSearchResults :: List Name Channel
_listWindowSearchResults = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList forall a. Monoid a => a
mempty
, _listWindowSearchInput :: Editor Text Name
_listWindowSearchInput = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
JoinChannelListSearchInput TeamId
tId) (forall a. a -> Maybe a
Just Int
1) Text
""
, _listWindowSearchScope :: ChannelSearchScope
_listWindowSearchScope = ChannelSearchScope
AllChannels
, _listWindowSearching :: Bool
_listWindowSearching = Bool
False
, _listWindowEnterHandler :: Channel -> MH Bool
_listWindowEnterHandler = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
, _listWindowNewList :: Vector Channel -> List Name Channel
_listWindowNewList = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList
, _listWindowFetchResults :: ChannelSearchScope -> Session -> Text -> IO (Vector Channel)
_listWindowFetchResults = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
, _listWindowRecordCount :: Maybe Int
_listWindowRecordCount = forall a. Maybe a
Nothing
}
nullThemeListWindowState :: TeamId -> ListWindowState InternalTheme ()
nullThemeListWindowState :: TeamId -> ListWindowState InternalTheme ()
nullThemeListWindowState TeamId
tId =
let newList :: t e -> GenericList Name t e
newList t e
rs = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
ThemeListSearchResults TeamId
tId) t e
rs Int
3
in ListWindowState { _listWindowSearchResults :: List Name InternalTheme
_listWindowSearchResults = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList forall a. Monoid a => a
mempty
, _listWindowSearchInput :: Editor Text Name
_listWindowSearchInput = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
ThemeListSearchInput TeamId
tId) (forall a. a -> Maybe a
Just Int
1) Text
""
, _listWindowSearchScope :: ()
_listWindowSearchScope = ()
, _listWindowSearching :: Bool
_listWindowSearching = Bool
False
, _listWindowEnterHandler :: InternalTheme -> MH Bool
_listWindowEnterHandler = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
, _listWindowNewList :: Vector InternalTheme -> List Name InternalTheme
_listWindowNewList = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList
, _listWindowFetchResults :: () -> Session -> Text -> IO (Vector InternalTheme)
_listWindowFetchResults = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
, _listWindowRecordCount :: Maybe Int
_listWindowRecordCount = forall a. Maybe a
Nothing
}
nullUserListWindowState :: TeamId -> ListWindowState UserInfo UserSearchScope
nullUserListWindowState :: TeamId -> ListWindowState UserInfo UserSearchScope
nullUserListWindowState TeamId
tId =
let newList :: t e -> GenericList Name t e
newList t e
rs = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
UserListSearchResults TeamId
tId) t e
rs Int
1
in ListWindowState { _listWindowSearchResults :: List Name UserInfo
_listWindowSearchResults = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList forall a. Monoid a => a
mempty
, _listWindowSearchInput :: Editor Text Name
_listWindowSearchInput = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
UserListSearchInput TeamId
tId) (forall a. a -> Maybe a
Just Int
1) Text
""
, _listWindowSearchScope :: UserSearchScope
_listWindowSearchScope = Maybe TeamId -> UserSearchScope
AllUsers forall a. Maybe a
Nothing
, _listWindowSearching :: Bool
_listWindowSearching = Bool
False
, _listWindowEnterHandler :: UserInfo -> MH Bool
_listWindowEnterHandler = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
, _listWindowNewList :: Vector UserInfo -> List Name UserInfo
_listWindowNewList = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList
, _listWindowFetchResults :: UserSearchScope -> Session -> Text -> IO (Vector UserInfo)
_listWindowFetchResults = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
, _listWindowRecordCount :: Maybe Int
_listWindowRecordCount = forall a. Maybe a
Nothing
}
nullEmojiListWindowState :: TeamId -> ListWindowState (Bool, T.Text) ()
nullEmojiListWindowState :: TeamId -> ListWindowState (Bool, Text) ()
nullEmojiListWindowState TeamId
tId =
let newList :: t e -> GenericList Name t e
newList t e
rs = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
ReactionEmojiList TeamId
tId) t e
rs Int
1
in ListWindowState { _listWindowSearchResults :: List Name (Bool, Text)
_listWindowSearchResults = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList forall a. Monoid a => a
mempty
, _listWindowSearchInput :: Editor Text Name
_listWindowSearchInput = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
ReactionEmojiListInput TeamId
tId) (forall a. a -> Maybe a
Just Int
1) Text
""
, _listWindowSearchScope :: ()
_listWindowSearchScope = ()
, _listWindowSearching :: Bool
_listWindowSearching = Bool
False
, _listWindowEnterHandler :: (Bool, Text) -> MH Bool
_listWindowEnterHandler = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
, _listWindowNewList :: Vector (Bool, Text) -> List Name (Bool, Text)
_listWindowNewList = forall {t :: * -> *} {e}. Foldable t => t e -> GenericList Name t e
newList
, _listWindowFetchResults :: () -> Session -> Text -> IO (Vector (Bool, Text))
_listWindowFetchResults = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
, _listWindowRecordCount :: Maybe Int
_listWindowRecordCount = forall a. Maybe a
Nothing
}
newChannelTopicDialog :: TeamId -> T.Text -> ChannelTopicDialogState
newChannelTopicDialog :: TeamId -> Text -> ChannelTopicDialogState
newChannelTopicDialog TeamId
tId Text
t =
ChannelTopicDialogState { _channelTopicDialogEditor :: Editor Text Name
_channelTopicDialogEditor = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
ChannelTopicEditor TeamId
tId) forall a. Maybe a
Nothing Text
t
, _channelTopicDialogFocus :: FocusRing Name
_channelTopicDialogFocus = forall n. [n] -> FocusRing n
focusRing [ TeamId -> Name
ChannelTopicEditor TeamId
tId
, TeamId -> Name
ChannelTopicSaveButton TeamId
tId
, TeamId -> Name
ChannelTopicCancelButton TeamId
tId
]
}
newSaveAttachmentDialog :: Name -> T.Text -> SaveAttachmentDialogState Name
newSaveAttachmentDialog :: Name -> Text -> SaveAttachmentDialogState Name
newSaveAttachmentDialog Name
n Text
t =
SaveAttachmentDialogState { _attachmentPathEditor :: Editor Text Name
_attachmentPathEditor = forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
Z2.gotoEOL forall a b. (a -> b) -> a -> b
$
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (Name -> Name
AttachmentPathEditor Name
n) (forall a. a -> Maybe a
Just Int
1) Text
t
, _attachmentPathDialogFocus :: FocusRing Name
_attachmentPathDialogFocus = forall n. [n] -> FocusRing n
focusRing [ Name -> Name
AttachmentPathEditor Name
n
, Name -> Name
AttachmentPathSaveButton Name
n
, Name -> Name
AttachmentPathCancelButton Name
n
]
}
makeClientChannel :: (MonadIO m)
=> BCH.BChan MHEvent
-> Maybe Aspell
-> UserId
-> Maybe TeamId
-> Channel
-> m ClientChannel
makeClientChannel :: forall (m :: * -> *).
MonadIO m =>
BChan MHEvent
-> Maybe Aspell
-> UserId
-> Maybe TeamId
-> Channel
-> m ClientChannel
makeClientChannel BChan MHEvent
eventQueue Maybe Aspell
spellChecker UserId
myId Maybe TeamId
tId Channel
nc = do
Messages
msgs <- forall (m :: * -> *). MonadIO m => m Messages
emptyChannelMessages
ChannelMessageInterface
mi <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Aspell
-> BChan MHEvent
-> Maybe TeamId
-> ChannelId
-> Messages
-> IO ChannelMessageInterface
newChannelMessageInterface Maybe Aspell
spellChecker BChan MHEvent
eventQueue Maybe TeamId
tId (forall x y. HasId x y => x -> y
getId Channel
nc) Messages
msgs
forall (m :: * -> *) a. Monad m => a -> m a
return ClientChannel { _ccInfo :: ChannelInfo
_ccInfo = UserId -> Channel -> ChannelInfo
initialChannelInfo UserId
myId Channel
nc
, _ccMessageInterface :: ChannelMessageInterface
_ccMessageInterface = ChannelMessageInterface
mi
}
initialChannelInfo :: UserId -> Channel -> ChannelInfo
initialChannelInfo :: UserId -> Channel -> ChannelInfo
initialChannelInfo UserId
myId Channel
chan =
let updated :: ServerTime
updated = Channel
chan forall s a. s -> Getting a s a -> a
^. Lens' Channel ServerTime
channelLastPostAtL
in ChannelInfo { _cdChannelId :: ChannelId
_cdChannelId = Channel
chanforall s a. s -> Getting a s a -> a
^.Lens' Channel ChannelId
channelIdL
, _cdTeamId :: Maybe TeamId
_cdTeamId = Channel
chanforall s a. s -> Getting a s a -> a
^.Lens' Channel (Maybe TeamId)
channelTeamIdL
, _cdViewed :: Maybe ServerTime
_cdViewed = forall a. Maybe a
Nothing
, _cdNewMessageIndicator :: NewMessageIndicator
_cdNewMessageIndicator = NewMessageIndicator
Hide
, _cdEditedMessageThreshold :: Maybe ServerTime
_cdEditedMessageThreshold = forall a. Maybe a
Nothing
, _cdMentionCount :: Int
_cdMentionCount = Int
0
, _cdUpdated :: ServerTime
_cdUpdated = ServerTime
updated
, _cdName :: Text
_cdName = Channel -> Text
preferredChannelName Channel
chan
, _cdDisplayName :: Text
_cdDisplayName = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelDisplayName Channel
chan
, _cdHeader :: Text
_cdHeader = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel
chanforall s a. s -> Getting a s a -> a
^.Lens' Channel UserText
channelHeaderL
, _cdPurpose :: Text
_cdPurpose = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel
chanforall s a. s -> Getting a s a -> a
^.Lens' Channel UserText
channelPurposeL
, _cdType :: Type
_cdType = Channel
chanforall s a. s -> Getting a s a -> a
^.Lens' Channel Type
channelTypeL
, _cdNotifyProps :: ChannelNotifyProps
_cdNotifyProps = ChannelNotifyProps
emptyChannelNotifyProps
, _cdDMUserId :: Maybe UserId
_cdDMUserId = if Channel
chanforall s a. s -> Getting a s a -> a
^.Lens' Channel Type
channelTypeL forall a. Eq a => a -> a -> Bool
== Type
Direct
then UserId -> Text -> Maybe UserId
userIdForDMChannel UserId
myId forall a b. (a -> b) -> a -> b
$
UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
chan
else forall a. Maybe a
Nothing
, _cdSidebarShowOverride :: Maybe UTCTime
_cdSidebarShowOverride = forall a. Maybe a
Nothing
, _cdFetchPending :: Bool
_cdFetchPending = Bool
False
}