{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.Types.Channels
( ClientChannel(..)
, ChannelContents(..)
, ChannelInfo(..)
, ClientChannels
, NewMessageIndicator(..)
, EphemeralEditState(..)
, EditMode(..)
, eesMultiline, eesInputHistoryPosition, eesLastInput
, defaultEphemeralEditState
, ccContents, ccInfo, ccEditState
, cdViewed, cdNewMessageIndicator, cdEditedMessageThreshold, cdUpdated
, cdName, cdDisplayName, cdHeader, cdPurpose, cdType
, cdMentionCount, cdTypingUsers, cdDMUserId, cdChannelId
, cdSidebarShowOverride, cdNotifyProps
, cdMessages, cdFetchPending
, makeClientChannel
, noChannels, addChannel, removeChannel, findChannelById, modifyChannelById
, channelByIdL, maybeChannelByIdL
, filteredChannelIds
, filteredChannels
, channelInfoFromChannelWithData
, clearNewMessageIndicator
, clearEditedThreshold
, adjustUpdated
, adjustEditedThreshold
, updateNewMessageIndicator
, addChannelTypingUser
, notifyPreference
, isMuted
, channelNotifyPropsMarkUnreadL
, channelNotifyPropsIgnoreChannelMentionsL
, channelNotifyPropsDesktopL
, channelNotifyPropsPushL
, canLeaveChannel
, preferredChannelName
, isTownSquare
, channelDeleted
, getDmChannelFor
, allDmChannelMappings
, getChannelNameSet
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import qualified Data.Text as T
import Lens.Micro.Platform ( (%~), (.~), Traversal', Lens'
, makeLenses, ix, at
, to, non )
import Network.Mattermost.Lenses hiding ( Lens' )
import Network.Mattermost.Types ( Channel(..), UserId, ChannelId
, ChannelMember(..)
, Type(..)
, Post
, User(userNotifyProps)
, ChannelNotifyProps
, NotifyOption(..)
, WithDefault(..)
, ServerTime
, emptyChannelNotifyProps
)
import Matterhorn.Types.Messages ( Messages, noMessages, addMessage
, clientMessageToMessage, Message, MessageType )
import Matterhorn.Types.Posts ( ClientMessageType(UnknownGapBefore)
, newClientMessage )
import Matterhorn.Types.Users ( TypingUsers, noTypingUsers, addTypingUser )
import Matterhorn.Types.Common
data ClientChannel = ClientChannel
{ _ccContents :: ChannelContents
, _ccInfo :: ChannelInfo
, _ccEditState :: EphemeralEditState
}
data EditMode =
NewPost
| Editing Post MessageType
| Replying Message Post
deriving (Show)
data EphemeralEditState =
EphemeralEditState { _eesMultiline :: Bool
, _eesInputHistoryPosition :: Maybe Int
, _eesLastInput :: (T.Text, EditMode)
}
preferredChannelName :: Channel -> Text
preferredChannelName ch
| channelType ch == Group = sanitizeUserText $ channelDisplayName ch
| otherwise = sanitizeUserText $ channelName ch
data NewMessageIndicator =
Hide
| NewPostsAfterServerTime ServerTime
| NewPostsStartingAt ServerTime
deriving (Eq, Show)
initialChannelInfo :: UserId -> Channel -> ChannelInfo
initialChannelInfo myId chan =
let updated = chan ^. channelLastPostAtL
in ChannelInfo { _cdChannelId = chan^.channelIdL
, _cdViewed = Nothing
, _cdNewMessageIndicator = Hide
, _cdEditedMessageThreshold = Nothing
, _cdMentionCount = 0
, _cdUpdated = updated
, _cdName = preferredChannelName chan
, _cdDisplayName = sanitizeUserText $ channelDisplayName chan
, _cdHeader = sanitizeUserText $ chan^.channelHeaderL
, _cdPurpose = sanitizeUserText $ chan^.channelPurposeL
, _cdType = chan^.channelTypeL
, _cdNotifyProps = emptyChannelNotifyProps
, _cdTypingUsers = noTypingUsers
, _cdDMUserId = if chan^.channelTypeL == Direct
then userIdForDMChannel myId $
sanitizeUserText $ channelName chan
else Nothing
, _cdSidebarShowOverride = Nothing
}
channelInfoFromChannelWithData :: Channel -> ChannelMember -> ChannelInfo -> ChannelInfo
channelInfoFromChannelWithData chan chanMember ci =
let viewed = chanMember ^. to channelMemberLastViewedAt
updated = chan ^. channelLastPostAtL
in ci { _cdViewed = Just viewed
, _cdNewMessageIndicator = case _cdNewMessageIndicator ci of
Hide -> if updated > viewed then NewPostsAfterServerTime viewed else Hide
v -> v
, _cdUpdated = updated
, _cdName = preferredChannelName chan
, _cdDisplayName = sanitizeUserText $ channelDisplayName chan
, _cdHeader = (sanitizeUserText $ chan^.channelHeaderL)
, _cdPurpose = (sanitizeUserText $ chan^.channelPurposeL)
, _cdType = (chan^.channelTypeL)
, _cdMentionCount = chanMember^.to channelMemberMentionCount
, _cdNotifyProps = chanMember^.to channelMemberNotifyProps
}
data ChannelContents = ChannelContents
{ _cdMessages :: Messages
, _cdFetchPending :: Bool
}
emptyChannelContents :: MonadIO m => m ChannelContents
emptyChannelContents = do
gapMsg <- clientMessageToMessage <$> newClientMessage UnknownGapBefore "--Fetching messages--"
return $ ChannelContents { _cdMessages = addMessage gapMsg noMessages
, _cdFetchPending = False
}
data ChannelInfo = ChannelInfo
{ _cdChannelId :: ChannelId
, _cdViewed :: Maybe ServerTime
, _cdNewMessageIndicator :: NewMessageIndicator
, _cdEditedMessageThreshold :: Maybe ServerTime
, _cdMentionCount :: Int
, _cdUpdated :: ServerTime
, _cdName :: Text
, _cdDisplayName :: Text
, _cdHeader :: Text
, _cdPurpose :: Text
, _cdType :: Type
, _cdNotifyProps :: ChannelNotifyProps
, _cdTypingUsers :: TypingUsers
, _cdDMUserId :: Maybe UserId
, _cdSidebarShowOverride :: Maybe UTCTime
}
makeLenses ''ChannelContents
makeLenses ''ChannelInfo
makeLenses ''ClientChannel
makeLenses ''EphemeralEditState
isMuted :: ClientChannel -> Bool
isMuted cc = cc^.ccInfo.cdNotifyProps.channelNotifyPropsMarkUnreadL ==
IsValue NotifyOptionMention
notifyPreference :: User -> ClientChannel -> NotifyOption
notifyPreference u cc =
if isMuted cc then NotifyOptionNone
else case cc^.ccInfo.cdNotifyProps.channelNotifyPropsDesktopL of
IsValue v -> v
Default -> (userNotifyProps u)^.userNotifyPropsDesktopL
makeClientChannel :: (MonadIO m) => UserId -> Channel -> m ClientChannel
makeClientChannel myId nc = emptyChannelContents >>= \contents ->
return ClientChannel
{ _ccContents = contents
, _ccInfo = initialChannelInfo myId nc
, _ccEditState = defaultEphemeralEditState
}
defaultEphemeralEditState :: EphemeralEditState
defaultEphemeralEditState =
EphemeralEditState { _eesMultiline = False
, _eesInputHistoryPosition = Nothing
, _eesLastInput = ("", NewPost)
}
canLeaveChannel :: ChannelInfo -> Bool
canLeaveChannel cInfo = not $ cInfo^.cdType `elem` [Direct]
data AllMyChannels a =
AllChannels { _chanMap :: HashMap ChannelId a
, _userChannelMap :: HashMap UserId ChannelId
, _channelNameSet :: S.Set Text
}
deriving (Functor, Foldable, Traversable)
type ClientChannels = AllMyChannels ClientChannel
makeLenses ''AllMyChannels
getChannelNameSet :: ClientChannels -> S.Set Text
getChannelNameSet = _channelNameSet
noChannels :: ClientChannels
noChannels = AllChannels HM.empty HM.empty mempty
addChannel :: ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel cId cinfo =
(chanMap %~ HM.insert cId cinfo) .
(if cinfo^.ccInfo.cdType `notElem` [Direct, Group]
then channelNameSet %~ S.insert (cinfo^.ccInfo.cdName)
else id) .
(case cinfo^.ccInfo.cdDMUserId of
Nothing -> id
Just uId -> userChannelMap %~ HM.insert uId cId
)
removeChannel :: ChannelId -> ClientChannels -> ClientChannels
removeChannel cId cs =
let mChan = findChannelById cId cs
removeChannelName = case mChan of
Nothing -> id
Just ch -> channelNameSet %~ S.delete (ch^.ccInfo.cdName)
in cs & chanMap %~ HM.delete cId
& removeChannelName
& userChannelMap %~ HM.filter (/= cId)
getDmChannelFor :: UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor uId cs = cs^.userChannelMap.at uId
allDmChannelMappings :: ClientChannels -> [(UserId, ChannelId)]
allDmChannelMappings = HM.toList . _userChannelMap
findChannelById :: ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById cId = HM.lookup cId . _chanMap
modifyChannelById :: ChannelId -> (ClientChannel -> ClientChannel)
-> ClientChannels -> ClientChannels
modifyChannelById cId f = chanMap.ix(cId) %~ f
channelByIdL :: ChannelId -> Traversal' ClientChannels ClientChannel
channelByIdL cId = chanMap . ix cId
maybeChannelByIdL :: ChannelId -> Lens' ClientChannels (Maybe ClientChannel)
maybeChannelByIdL cId = chanMap . at cId
filteredChannelIds :: (ClientChannel -> Bool) -> ClientChannels -> [ChannelId]
filteredChannelIds f cc = fst <$> filter (f . snd) (HM.toList (cc^.chanMap))
filteredChannels :: ((ChannelId, ClientChannel) -> Bool)
-> ClientChannels -> [(ChannelId, ClientChannel)]
filteredChannels f cc = filter f $ cc^.chanMap.to HM.toList
addChannelTypingUser :: UserId -> UTCTime -> ClientChannel -> ClientChannel
addChannelTypingUser uId ts = ccInfo.cdTypingUsers %~ (addTypingUser uId ts)
clearNewMessageIndicator :: ClientChannel -> ClientChannel
clearNewMessageIndicator c = c & ccInfo.cdNewMessageIndicator .~ Hide
clearEditedThreshold :: ClientChannel -> ClientChannel
clearEditedThreshold c = c & ccInfo.cdEditedMessageThreshold .~ Nothing
adjustUpdated :: Post -> ClientChannel -> ClientChannel
adjustUpdated m =
ccInfo.cdUpdated %~ max (maxPostTimestamp m)
adjustEditedThreshold :: Post -> ClientChannel -> ClientChannel
adjustEditedThreshold m c =
if m^.postUpdateAtL <= m^.postCreateAtL
then c
else c & ccInfo.cdEditedMessageThreshold %~ (\mt -> case mt of
Just t -> Just $ min (m^.postUpdateAtL) t
Nothing -> Just $ m^.postUpdateAtL
)
maxPostTimestamp :: Post -> ServerTime
maxPostTimestamp m = max (m^.postDeleteAtL . non (m^.postUpdateAtL)) (m^.postCreateAtL)
updateNewMessageIndicator :: Post -> ClientChannel -> ClientChannel
updateNewMessageIndicator m =
ccInfo.cdNewMessageIndicator %~
(\old ->
case old of
Hide ->
NewPostsStartingAt $ m^.postCreateAtL
NewPostsStartingAt ts ->
NewPostsStartingAt $ min (m^.postCreateAtL) ts
NewPostsAfterServerTime ts ->
if m^.postCreateAtL <= ts
then NewPostsStartingAt $ m^.postCreateAtL
else NewPostsAfterServerTime ts
)
isTownSquare :: Channel -> Bool
isTownSquare c = (sanitizeUserText $ c^.channelNameL) == "town-square"
channelDeleted :: Channel -> Bool
channelDeleted c = c^.channelDeleteAtL > c^.channelCreateAtL