{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}

module Matterhorn.Types.Channels
  ( ClientChannel(..)
  , ChannelInfo(..)
  , ClientChannels -- constructor remains internal
  , chanMap
  , NewMessageIndicator(..)
  -- * Lenses created for accessing ClientChannel fields
  , ccInfo, ccMessageInterface
  -- * Lenses created for accessing ChannelInfo fields
  , cdViewed, cdNewMessageIndicator, cdEditedMessageThreshold, cdUpdated
  , cdName, cdDisplayName, cdHeader, cdPurpose, cdType
  , cdMentionCount, cdDMUserId, cdChannelId
  , cdSidebarShowOverride, cdNotifyProps, cdTeamId, cdFetchPending
  -- * Managing ClientChannel collections
  , noChannels, addChannel, removeChannel, findChannelById, modifyChannelById
  , channelByIdL, maybeChannelByIdL
  , allTeamIds
  , filteredChannelIds
  , filteredChannels
  -- * Creating ChannelInfo objects
  , channelInfoFromChannelWithData
  -- * Channel State management
  , clearNewMessageIndicator
  , clearEditedThreshold
  , adjustUpdated
  , adjustEditedThreshold
  , updateNewMessageIndicator
  -- * Notification settings
  , notifyPreference
  , isMuted
  , channelNotifyPropsMarkUnreadL
  , channelNotifyPropsIgnoreChannelMentionsL
  , channelNotifyPropsDesktopL
  , channelNotifyPropsPushL
  -- * Miscellaneous channel-related operations
  , canLeaveChannel
  , preferredChannelName
  , isTownSquare
  , channelDeleted
  , getDmChannelFor
  , allDmChannelMappings
  , getChannelNameSet
  , emptyChannelMessages
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
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
                                          , TeamId
                                          )

import           Matterhorn.Types.Messages ( Messages, noMessages, addMessage
                                           , clientMessageToMessage )
import           Matterhorn.Types.Posts ( ClientMessageType(UnknownGapBefore)
                                        , newClientMessage )
import           Matterhorn.Types.MessageInterface
import           Matterhorn.Types.Core ( Name )
import           Matterhorn.Types.Common


-- * Channel representations

-- | A 'ClientChannel' contains both the message
--   listing and the metadata about a channel
data ClientChannel = ClientChannel
  { ClientChannel -> ChannelInfo
_ccInfo :: ChannelInfo
    -- ^ The 'ChannelInfo' for the channel
  , ClientChannel -> MessageInterface Name ()
_ccMessageInterface :: MessageInterface Name ()
    -- ^ The channel's message interface
  }

-- Get a channel's name, depending on its type
preferredChannelName :: Channel -> Text
preferredChannelName :: Channel -> Text
preferredChannelName Channel
ch
    | Channel -> Type
channelType Channel
ch forall a. Eq a => a -> a -> Bool
== Type
Group = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelDisplayName Channel
ch
    | Bool
otherwise               = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
ch

data NewMessageIndicator =
    Hide
    | NewPostsAfterServerTime ServerTime
    | NewPostsStartingAt ServerTime
    deriving (NewMessageIndicator -> NewMessageIndicator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewMessageIndicator -> NewMessageIndicator -> Bool
$c/= :: NewMessageIndicator -> NewMessageIndicator -> Bool
== :: NewMessageIndicator -> NewMessageIndicator -> Bool
$c== :: NewMessageIndicator -> NewMessageIndicator -> Bool
Eq, Int -> NewMessageIndicator -> ShowS
[NewMessageIndicator] -> ShowS
NewMessageIndicator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewMessageIndicator] -> ShowS
$cshowList :: [NewMessageIndicator] -> ShowS
show :: NewMessageIndicator -> String
$cshow :: NewMessageIndicator -> String
showsPrec :: Int -> NewMessageIndicator -> ShowS
$cshowsPrec :: Int -> NewMessageIndicator -> ShowS
Show)

channelInfoFromChannelWithData :: Channel -> ChannelMember -> ChannelInfo -> ChannelInfo
channelInfoFromChannelWithData :: Channel -> ChannelMember -> ChannelInfo -> ChannelInfo
channelInfoFromChannelWithData Channel
chan ChannelMember
chanMember ChannelInfo
ci =
    let viewed :: ServerTime
viewed   = ChannelMember
chanMember forall s a. s -> Getting a s a -> a
^. forall s a. (s -> a) -> SimpleGetter s a
to ChannelMember -> ServerTime
channelMemberLastViewedAt
        updated :: ServerTime
updated  = Channel
chan forall s a. s -> Getting a s a -> a
^. Lens' Channel ServerTime
channelLastPostAtL
    in ChannelInfo
ci { _cdViewed :: Maybe ServerTime
_cdViewed           = forall a. a -> Maybe a
Just ServerTime
viewed
          , _cdNewMessageIndicator :: NewMessageIndicator
_cdNewMessageIndicator = case ChannelInfo -> NewMessageIndicator
_cdNewMessageIndicator ChannelInfo
ci of
              NewMessageIndicator
Hide -> if ServerTime
updated forall a. Ord a => a -> a -> Bool
> ServerTime
viewed then ServerTime -> NewMessageIndicator
NewPostsAfterServerTime ServerTime
viewed else NewMessageIndicator
Hide
              NewMessageIndicator
v -> NewMessageIndicator
v
          , _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)
          , _cdMentionCount :: Int
_cdMentionCount     = ChannelMember
chanMemberforall s a. s -> Getting a s a -> a
^.forall s a. (s -> a) -> SimpleGetter s a
to ChannelMember -> Int
channelMemberMentionCount
          , _cdNotifyProps :: ChannelNotifyProps
_cdNotifyProps      = ChannelMember
chanMemberforall s a. s -> Getting a s a -> a
^.forall s a. (s -> a) -> SimpleGetter s a
to ChannelMember -> ChannelNotifyProps
channelMemberNotifyProps
          }

-- | An initial empty channel message list. This also contains an
-- UnknownGapBefore, which is a signal that causes actual content
-- fetching. The initial Gap's timestamp is the local client time, but
-- subsequent fetches will synchronize with the server (and eventually
-- eliminate this Gap as well).
emptyChannelMessages :: MonadIO m => m Messages
emptyChannelMessages :: forall (m :: * -> *). MonadIO m => m Messages
emptyChannelMessages = do
  Message
gapMsg <- ClientMessage -> Message
clientMessageToMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
ClientMessageType -> Text -> m ClientMessage
newClientMessage ClientMessageType
UnknownGapBefore Text
"--Fetching messages--"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg Messages
noMessages

------------------------------------------------------------------------

-- | The 'ChannelInfo' record represents metadata
--   about a channel
data ChannelInfo = ChannelInfo
  { ChannelInfo -> ChannelId
_cdChannelId        :: ChannelId
    -- ^ The channel's ID
  , ChannelInfo -> Maybe TeamId
_cdTeamId           :: Maybe TeamId
    -- ^ The channel's team ID
  , ChannelInfo -> Maybe ServerTime
_cdViewed           :: Maybe ServerTime
    -- ^ The last time we looked at a channel
  , ChannelInfo -> NewMessageIndicator
_cdNewMessageIndicator :: NewMessageIndicator
    -- ^ The state of the channel's new message indicator.
  , ChannelInfo -> Maybe ServerTime
_cdEditedMessageThreshold :: Maybe ServerTime
    -- ^ The channel's edited message threshold.
  , ChannelInfo -> Int
_cdMentionCount     :: Int
    -- ^ The current number of unread mentions
  , ChannelInfo -> ServerTime
_cdUpdated          :: ServerTime
    -- ^ The last time a message showed up in the channel
  , ChannelInfo -> Text
_cdName             :: Text
    -- ^ The name of the channel
  , ChannelInfo -> Text
_cdDisplayName      :: Text
    -- ^ The display name of the channel
  , ChannelInfo -> Text
_cdHeader           :: Text
    -- ^ The header text of a channel
  , ChannelInfo -> Text
_cdPurpose          :: Text
    -- ^ The stated purpose of the channel
  , ChannelInfo -> Type
_cdType             :: Type
    -- ^ The type of a channel: public, private, or DM
  , ChannelInfo -> ChannelNotifyProps
_cdNotifyProps      :: ChannelNotifyProps
    -- ^ The user's notification settings for this channel
  , ChannelInfo -> Maybe UserId
_cdDMUserId         :: Maybe UserId
    -- ^ The user associated with this channel, if it is a DM channel
  , ChannelInfo -> Maybe UTCTime
_cdSidebarShowOverride :: Maybe UTCTime
    -- ^ If set, show this channel in the sidebar regardless of other
    -- considerations as long as the specified timestamp meets a cutoff.
    -- Otherwise fall back to other application policy to determine
    -- whether to show the channel.
  , ChannelInfo -> Bool
_cdFetchPending :: Bool
    -- ^ Whether a fetch in this channel is pending
  }

-- ** Channel-related Lenses

makeLenses ''ChannelInfo
makeLenses ''ClientChannel

isMuted :: ClientChannel -> Bool
isMuted :: ClientChannel -> Bool
isMuted ClientChannel
cc = ClientChannel
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ChannelNotifyProps
cdNotifyPropsforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelNotifyProps (WithDefault NotifyOption)
channelNotifyPropsMarkUnreadL forall a. Eq a => a -> a -> Bool
==
             forall a. a -> WithDefault a
IsValue NotifyOption
NotifyOptionMention

notifyPreference :: User -> ClientChannel -> NotifyOption
notifyPreference :: User -> ClientChannel -> NotifyOption
notifyPreference User
u ClientChannel
cc =
    if ClientChannel -> Bool
isMuted ClientChannel
cc then NotifyOption
NotifyOptionNone
    else case ClientChannel
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ChannelNotifyProps
cdNotifyPropsforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelNotifyProps (WithDefault NotifyOption)
channelNotifyPropsDesktopL of
             IsValue NotifyOption
v -> NotifyOption
v
             WithDefault NotifyOption
Default   -> (User -> UserNotifyProps
userNotifyProps User
u)forall s a. s -> Getting a s a -> a
^.Lens' UserNotifyProps NotifyOption
userNotifyPropsDesktopL

-- ** Miscellaneous channel operations

canLeaveChannel :: ChannelInfo -> Bool
canLeaveChannel :: ChannelInfo -> Bool
canLeaveChannel ChannelInfo
cInfo = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ChannelInfo
cInfoforall s a. s -> Getting a s a -> a
^.Lens' ChannelInfo Type
cdType forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Type
Direct]

-- ** Manage the collection of all Channels

data ClientChannels =
    ClientChannels { ClientChannels -> HashMap ChannelId ClientChannel
_chanMap :: HashMap ChannelId ClientChannel
                   , ClientChannels -> HashMap TeamId (Set Text)
_channelNameSet :: HashMap TeamId (S.Set Text)
                   , ClientChannels -> HashMap UserId ChannelId
_userChannelMap :: HashMap UserId ChannelId
                   }

makeLenses ''ClientChannels

getChannelNameSet :: TeamId -> ClientChannels -> S.Set Text
getChannelNameSet :: TeamId -> ClientChannels -> Set Text
getChannelNameSet TeamId
tId ClientChannels
cs = case ClientChannels
csforall s a. s -> Getting a s a -> a
^.Lens' ClientChannels (HashMap TeamId (Set Text))
channelNameSetforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TeamId
tId of
    Maybe (Set Text)
Nothing -> forall a. Monoid a => a
mempty
    Just Set Text
s -> Set Text
s

-- | Initial collection of Channels with no members
noChannels :: ClientChannels
noChannels :: ClientChannels
noChannels =
    ClientChannels { _chanMap :: HashMap ChannelId ClientChannel
_chanMap = forall k v. HashMap k v
HM.empty
                   , _channelNameSet :: HashMap TeamId (Set Text)
_channelNameSet = forall k v. HashMap k v
HM.empty
                   , _userChannelMap :: HashMap UserId ChannelId
_userChannelMap = forall k v. HashMap k v
HM.empty
                   }

-- | Add a channel to the existing collection.
addChannel :: ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel :: ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel ChannelId
cId ClientChannel
cinfo =
    (Lens' ClientChannels (HashMap ChannelId ClientChannel)
chanMap forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ChannelId
cId ClientChannel
cinfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (if ClientChannel
cinfoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Type
Direct, Type
Group]
     then case ClientChannel
cinfoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
         Maybe TeamId
Nothing -> forall a. a -> a
id
         Just TeamId
tId -> Lens' ClientChannels (HashMap TeamId (Set Text))
channelNameSet forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith forall a. Ord a => Set a -> Set a -> Set a
S.union TeamId
tId (forall a. a -> Set a
S.singleton forall a b. (a -> b) -> a -> b
$ ClientChannel
cinfoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdName)
     else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (case ClientChannel
cinfoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UserId)
cdDMUserId of
         Maybe UserId
Nothing -> forall a. a -> a
id
         Just UserId
uId -> Lens' ClientChannels (HashMap UserId ChannelId)
userChannelMap forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert UserId
uId ChannelId
cId
    )

-- | Remove a channel from the collection.
removeChannel :: ChannelId -> ClientChannels -> ClientChannels
removeChannel :: ChannelId -> ClientChannels -> ClientChannels
removeChannel ChannelId
cId ClientChannels
cs =
    let mChan :: Maybe ClientChannel
mChan = ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId ClientChannels
cs
        removeChannelName :: ClientChannels -> ClientChannels
removeChannelName = case Maybe ClientChannel
mChan of
            Maybe ClientChannel
Nothing -> forall a. a -> a
id
            Just ClientChannel
ch -> case ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
                Maybe TeamId
Nothing -> forall a. a -> a
id
                Just TeamId
tId -> Lens' ClientChannels (HashMap TeamId (Set Text))
channelNameSet forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust (forall a. Ord a => a -> Set a -> Set a
S.delete (ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdName)) TeamId
tId
    in ClientChannels
cs forall a b. a -> (a -> b) -> b
& Lens' ClientChannels (HashMap ChannelId ClientChannel)
chanMap forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete ChannelId
cId
          forall a b. a -> (a -> b) -> b
& ClientChannels -> ClientChannels
removeChannelName
          forall a b. a -> (a -> b) -> b
& Lens' ClientChannels (HashMap UserId ChannelId)
userChannelMap forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (forall a. Eq a => a -> a -> Bool
/= ChannelId
cId)

instance Semigroup ClientChannels where
    ClientChannels
a <> :: ClientChannels -> ClientChannels -> ClientChannels
<> ClientChannels
b =
        let pairs :: [(ChannelId, ClientChannel)]
pairs = forall k v. HashMap k v -> [(k, v)]
HM.toList forall a b. (a -> b) -> a -> b
$ ClientChannels -> HashMap ChannelId ClientChannel
_chanMap ClientChannels
a
        in 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
b [(ChannelId, ClientChannel)]
pairs

instance Monoid ClientChannels where
    mempty :: ClientChannels
mempty = ClientChannels
noChannels
#if !MIN_VERSION_base(4,11,0)
    mappend = (<>)
#endif

getDmChannelFor :: UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor :: UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor UserId
uId ClientChannels
cs = ClientChannels
csforall s a. s -> Getting a s a -> a
^.Lens' ClientChannels (HashMap UserId ChannelId)
userChannelMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at UserId
uId

allDmChannelMappings :: ClientChannels -> [(UserId, ChannelId)]
allDmChannelMappings :: ClientChannels -> [(UserId, ChannelId)]
allDmChannelMappings = forall k v. HashMap k v -> [(k, v)]
HM.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientChannels -> HashMap UserId ChannelId
_userChannelMap

-- | Get the ChannelInfo information given the ChannelId
findChannelById :: ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById :: ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ChannelId
cId forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientChannels -> HashMap ChannelId ClientChannel
_chanMap

-- | Transform the specified channel in place with provided function.
modifyChannelById :: ChannelId -> (ClientChannel -> ClientChannel)
                  -> ClientChannels -> ClientChannels
modifyChannelById :: ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId ClientChannel -> ClientChannel
f = Lens' ClientChannels (HashMap ChannelId ClientChannel)
chanMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(ChannelId
cId) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ClientChannel -> ClientChannel
f

-- | A 'Traversal' that will give us the 'ClientChannel' in a
-- 'ClientChannels' structure if it exists
channelByIdL :: ChannelId -> Traversal' ClientChannels ClientChannel
channelByIdL :: ChannelId -> Traversal' ClientChannels ClientChannel
channelByIdL ChannelId
cId = Lens' ClientChannels (HashMap ChannelId ClientChannel)
chanMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix ChannelId
cId

-- | A 'Lens' that will give us the 'ClientChannel' in a
-- 'ClientChannels' wrapped in a 'Maybe'
maybeChannelByIdL :: ChannelId -> Lens' ClientChannels (Maybe ClientChannel)
maybeChannelByIdL :: ChannelId -> Lens' ClientChannels (Maybe ClientChannel)
maybeChannelByIdL ChannelId
cId = Lens' ClientChannels (HashMap ChannelId ClientChannel)
chanMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at ChannelId
cId

-- | Apply a filter to each ClientChannel and return a list of the
-- ChannelId values for which the filter matched.
filteredChannelIds :: (ClientChannel -> Bool) -> ClientChannels -> [ChannelId]
filteredChannelIds :: (ClientChannel -> Bool) -> ClientChannels -> [ChannelId]
filteredChannelIds ClientChannel -> Bool
f ClientChannels
cc = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (ClientChannel -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k v. HashMap k v -> [(k, v)]
HM.toList (ClientChannels
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannels (HashMap ChannelId ClientChannel)
chanMap))

-- | Get all the team IDs in the channel collection.
allTeamIds :: ClientChannels -> [TeamId]
allTeamIds :: ClientChannels -> [TeamId]
allTeamIds ClientChannels
cc = forall k v. HashMap k v -> [k]
HM.keys forall a b. (a -> b) -> a -> b
$ ClientChannels
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannels (HashMap TeamId (Set Text))
channelNameSet

-- | Filter the ClientChannel collection, keeping only those for which
-- the provided filter test function returns True.
filteredChannels :: ((ChannelId, ClientChannel) -> Bool)
                 -> ClientChannels -> [(ChannelId, ClientChannel)]
filteredChannels :: ((ChannelId, ClientChannel) -> Bool)
-> ClientChannels -> [(ChannelId, ClientChannel)]
filteredChannels (ChannelId, ClientChannel) -> Bool
f ClientChannels
cc = forall a. (a -> Bool) -> [a] -> [a]
filter (ChannelId, ClientChannel) -> Bool
f forall a b. (a -> b) -> a -> b
$ ClientChannels
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannels (HashMap ChannelId ClientChannel)
chanMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall k v. HashMap k v -> [(k, v)]
HM.toList

------------------------------------------------------------------------

-- * Channel State management


-- | Clear the new message indicator for the specified channel
clearNewMessageIndicator :: ClientChannel -> ClientChannel
clearNewMessageIndicator :: ClientChannel -> ClientChannel
clearNewMessageIndicator ClientChannel
c = ClientChannel
c forall a b. a -> (a -> b) -> b
& Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo NewMessageIndicator
cdNewMessageIndicator forall s t a b. ASetter s t a b -> b -> s -> t
.~ NewMessageIndicator
Hide

-- | Clear the edit threshold for the specified channel
clearEditedThreshold :: ClientChannel -> ClientChannel
clearEditedThreshold :: ClientChannel -> ClientChannel
clearEditedThreshold ClientChannel
c = ClientChannel
c forall a b. a -> (a -> b) -> b
& Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe ServerTime)
cdEditedMessageThreshold forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing

-- | Adjust updated time based on a message, ensuring that the updated
-- time does not move backward.
adjustUpdated :: Post -> ClientChannel -> ClientChannel
adjustUpdated :: Post -> ClientChannel -> ClientChannel
adjustUpdated Post
m =
    Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ServerTime
cdUpdated forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => a -> a -> a
max (Post -> ServerTime
maxPostTimestamp Post
m)

adjustEditedThreshold :: Post -> ClientChannel -> ClientChannel
adjustEditedThreshold :: Post -> ClientChannel -> ClientChannel
adjustEditedThreshold Post
m ClientChannel
c =
    if Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postUpdateAtL forall a. Ord a => a -> a -> Bool
<= Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postCreateAtL
    then ClientChannel
c
    else ClientChannel
c forall a b. a -> (a -> b) -> b
& Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe ServerTime)
cdEditedMessageThreshold forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Maybe ServerTime
mt -> case Maybe ServerTime
mt of
        Just ServerTime
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postUpdateAtL) ServerTime
t
        Maybe ServerTime
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postUpdateAtL
        )

maxPostTimestamp :: Post -> ServerTime
maxPostTimestamp :: Post -> ServerTime
maxPostTimestamp Post
m = forall a. Ord a => a -> a -> a
max (Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post (Maybe ServerTime)
postDeleteAtL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Lens' (Maybe a) a
non (Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postUpdateAtL)) (Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postCreateAtL)

updateNewMessageIndicator :: Post -> ClientChannel -> ClientChannel
updateNewMessageIndicator :: Post -> ClientChannel -> ClientChannel
updateNewMessageIndicator Post
m =
    Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo NewMessageIndicator
cdNewMessageIndicator forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
        (\NewMessageIndicator
old ->
          case NewMessageIndicator
old of
              NewMessageIndicator
Hide ->
                  ServerTime -> NewMessageIndicator
NewPostsStartingAt forall a b. (a -> b) -> a -> b
$ Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postCreateAtL
              NewPostsStartingAt ServerTime
ts ->
                  ServerTime -> NewMessageIndicator
NewPostsStartingAt forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postCreateAtL) ServerTime
ts
              NewPostsAfterServerTime ServerTime
ts ->
                  if Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postCreateAtL forall a. Ord a => a -> a -> Bool
<= ServerTime
ts
                  then ServerTime -> NewMessageIndicator
NewPostsStartingAt forall a b. (a -> b) -> a -> b
$ Post
mforall s a. s -> Getting a s a -> a
^.Lens' Post ServerTime
postCreateAtL
                  else ServerTime -> NewMessageIndicator
NewPostsAfterServerTime ServerTime
ts
              )

-- | Town Square is special in that its non-display name cannot be
-- changed and is a hard-coded constant server-side according to the
-- developers (as of 8/2/17). So this is a reliable way to check for
-- whether a channel is in fact that channel, even if the user has
-- changed its display name.
isTownSquare :: Channel -> Bool
isTownSquare :: Channel -> Bool
isTownSquare Channel
c = (UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel
cforall s a. s -> Getting a s a -> a
^.Lens' Channel UserText
channelNameL) forall a. Eq a => a -> a -> Bool
== Text
"town-square"

channelDeleted :: Channel -> Bool
channelDeleted :: Channel -> Bool
channelDeleted Channel
c = Channel
cforall s a. s -> Getting a s a -> a
^.Lens' Channel ServerTime
channelDeleteAtL forall a. Ord a => a -> a -> Bool
> Channel
cforall s a. s -> Getting a s a -> a
^.Lens' Channel ServerTime
channelCreateAtL