{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
module Matterhorn.Types.Messages
(
Message(..)
, isDeletable, isReplyable, isReactable, isEditable, isReplyTo, isGap, isFlaggable
, isPinnable, isEmote, isJoinLeave, isTransition, isNewMessagesTransition
, mText, mUser, mDate, mType, mPending, mDeleted, mPinned
, mAttachments, mInReplyToMsg, mMessageId, mReactions, mFlagged
, mOriginalPost, mChannelId, mMarkdownSource
, isBotMessage
, MessageType(..)
, ThreadState(..)
, MentionedUser(..)
, isPostMessage
, messagePostId
, UserRef(..)
, ReplyState(..)
, clientMessageToMessage
, clientPostToMessage
, clientPostReactionUserIds
, newMessageOfType
, Messages
, ChronologicalMessages
, RetrogradeMessages
, MessageOps (..)
, noMessages
, messagesLength
, filterMessages
, reverseMessages
, unreverseMessages
, splitMessages
, splitDirSeqOn
, chronologicalMsgsWithThreadStates
, retrogradeMsgsWithThreadStates
, findMessage
, getRelMessageId
, messagesHead
, messagesDrop
, getNextMessage
, getPrevMessage
, getNextMessageId
, getPrevMessageId
, getNextPostId
, getPrevPostId
, getEarliestPostMsg
, getLatestPostMsg
, getEarliestSelectableMessage
, getLatestSelectableMessage
, findLatestUserMessage
, messagesAfter
, removeMatchesFromSubset
, withFirstMessage
, msgURLs
, LinkChoice(LinkChoice, _linkTarget)
, linkUser
, linkTarget
, linkTime
, linkLabel
)
where
import Prelude ()
import Matterhorn.Prelude
import Control.Monad
import qualified Data.Foldable as F
import qualified Data.Map.Strict as Map
import Data.Sequence as Seq
import qualified Data.Set as S
import Data.Tuple
import Lens.Micro.Platform ( makeLenses )
import Network.Mattermost.Types ( ChannelId, PostId, Post
, ServerTime, UserId
)
import Matterhorn.Types.DirectionalSeq
import Matterhorn.Types.Core
import Matterhorn.Types.Posts
import Matterhorn.Types.RichText
data ThreadState =
NoThread
| InThreadShowParent
| InThread
deriving (Int -> ThreadState -> ShowS
[ThreadState] -> ShowS
ThreadState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadState] -> ShowS
$cshowList :: [ThreadState] -> ShowS
show :: ThreadState -> String
$cshow :: ThreadState -> String
showsPrec :: Int -> ThreadState -> ShowS
$cshowsPrec :: Int -> ThreadState -> ShowS
Show, ThreadState -> ThreadState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadState -> ThreadState -> Bool
$c/= :: ThreadState -> ThreadState -> Bool
== :: ThreadState -> ThreadState -> Bool
$c== :: ThreadState -> ThreadState -> Bool
Eq)
data Message = Message
{ Message -> Blocks
_mText :: Blocks
, Message -> Text
_mMarkdownSource :: Text
, Message -> UserRef
_mUser :: UserRef
, Message -> ServerTime
_mDate :: ServerTime
, Message -> MessageType
_mType :: MessageType
, Message -> Bool
_mPending :: Bool
, Message -> Bool
_mDeleted :: Bool
, Message -> Seq Attachment
_mAttachments :: Seq Attachment
, Message -> ReplyState
_mInReplyToMsg :: ReplyState
, Message -> Maybe MessageId
_mMessageId :: Maybe MessageId
, Message -> Map Text (Set UserId)
_mReactions :: Map.Map Text (S.Set UserId)
, Message -> Maybe Post
_mOriginalPost :: Maybe Post
, Message -> Bool
_mFlagged :: Bool
, Message -> Bool
_mPinned :: Bool
, Message -> Maybe ChannelId
_mChannelId :: Maybe ChannelId
} deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, Message -> Message -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)
isPostMessage :: Message -> Bool
isPostMessage :: Message -> Bool
isPostMessage Message
m =
forall a. Maybe a -> Bool
isJust (Message -> Maybe MessageId
_mMessageId Message
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MessageId -> Maybe PostId
messageIdPostId)
messagePostId :: Message -> Maybe PostId
messagePostId :: Message -> Maybe PostId
messagePostId Message
m = do
MessageId
mId <- Message -> Maybe MessageId
_mMessageId Message
m
MessageId -> Maybe PostId
messageIdPostId MessageId
mId
isDeletable :: Message -> Bool
isDeletable :: Message -> Bool
isDeletable Message
m =
forall a. Maybe a -> Bool
isJust (Message -> Maybe PostId
messagePostId Message
m) Bool -> Bool -> Bool
&&
case Message -> MessageType
_mType Message
m of
CP ClientPostType
NormalPost -> Bool
True
CP ClientPostType
Emote -> Bool
True
MessageType
_ -> Bool
False
isFlaggable :: Message -> Bool
isFlaggable :: Message -> Bool
isFlaggable = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Maybe PostId
messagePostId
isPinnable :: Message -> Bool
isPinnable :: Message -> Bool
isPinnable = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Maybe PostId
messagePostId
isReplyable :: Message -> Bool
isReplyable :: Message -> Bool
isReplyable Message
m =
forall a. Maybe a -> Bool
isJust (Message -> Maybe PostId
messagePostId Message
m) Bool -> Bool -> Bool
&&
case Message -> MessageType
_mType Message
m of
CP ClientPostType
NormalPost -> Bool
True
CP ClientPostType
Emote -> Bool
True
MessageType
_ -> Bool
False
isReactable :: Message -> Bool
isReactable :: Message -> Bool
isReactable Message
m =
forall a. Maybe a -> Bool
isJust (Message -> Maybe PostId
messagePostId Message
m) Bool -> Bool -> Bool
&&
case Message -> MessageType
_mType Message
m of
CP ClientPostType
NormalPost -> Bool
True
CP ClientPostType
Emote -> Bool
True
MessageType
_ -> Bool
False
isEditable :: Message -> Bool
isEditable :: Message -> Bool
isEditable Message
m =
forall a. Maybe a -> Bool
isJust (Message -> Maybe PostId
messagePostId Message
m) Bool -> Bool -> Bool
&&
case Message -> MessageType
_mType Message
m of
CP ClientPostType
NormalPost -> Bool
True
CP ClientPostType
Emote -> Bool
True
MessageType
_ -> Bool
False
isReplyTo :: PostId -> Message -> Bool
isReplyTo :: PostId -> Message -> Bool
isReplyTo PostId
expectedParentId Message
m =
case Message -> ReplyState
_mInReplyToMsg Message
m of
ReplyState
NotAReply -> Bool
False
InReplyTo PostId
actualParentId -> PostId
actualParentId forall a. Eq a => a -> a -> Bool
== PostId
expectedParentId
isGap :: Message -> Bool
isGap :: Message -> Bool
isGap Message
m = case Message -> MessageType
_mType Message
m of
C ClientMessageType
UnknownGapBefore -> Bool
True
C ClientMessageType
UnknownGapAfter -> Bool
True
MessageType
_ -> Bool
False
isTransition :: Message -> Bool
isTransition :: Message -> Bool
isTransition Message
m = case Message -> MessageType
_mType Message
m of
C ClientMessageType
DateTransition -> Bool
True
C ClientMessageType
NewMessagesTransition -> Bool
True
MessageType
_ -> Bool
False
isNewMessagesTransition :: Message -> Bool
isNewMessagesTransition :: Message -> Bool
isNewMessagesTransition Message
m = case Message -> MessageType
_mType Message
m of
C ClientMessageType
NewMessagesTransition -> Bool
True
MessageType
_ -> Bool
False
isEmote :: Message -> Bool
isEmote :: Message -> Bool
isEmote Message
m = case Message -> MessageType
_mType Message
m of
CP ClientPostType
Emote -> Bool
True
MessageType
_ -> Bool
False
isJoinLeave :: Message -> Bool
isJoinLeave :: Message -> Bool
isJoinLeave Message
m = case Message -> MessageType
_mType Message
m of
CP ClientPostType
Join -> Bool
True
CP ClientPostType
Leave -> Bool
True
MessageType
_ -> Bool
False
data MessageType = C ClientMessageType
| CP ClientPostType
deriving (Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageType] -> ShowS
$cshowList :: [MessageType] -> ShowS
show :: MessageType -> String
$cshow :: MessageType -> String
showsPrec :: Int -> MessageType -> ShowS
$cshowsPrec :: Int -> MessageType -> ShowS
Show, MessageType -> MessageType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c== :: MessageType -> MessageType -> Bool
Eq)
data UserRef = NoUser | UserI Bool UserId | UserOverride Bool Text
deriving (UserRef -> UserRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserRef -> UserRef -> Bool
$c/= :: UserRef -> UserRef -> Bool
== :: UserRef -> UserRef -> Bool
$c== :: UserRef -> UserRef -> Bool
Eq, Int -> UserRef -> ShowS
[UserRef] -> ShowS
UserRef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserRef] -> ShowS
$cshowList :: [UserRef] -> ShowS
show :: UserRef -> String
$cshow :: UserRef -> String
showsPrec :: Int -> UserRef -> ShowS
$cshowsPrec :: Int -> UserRef -> ShowS
Show, Eq UserRef
UserRef -> UserRef -> Bool
UserRef -> UserRef -> Ordering
UserRef -> UserRef -> UserRef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UserRef -> UserRef -> UserRef
$cmin :: UserRef -> UserRef -> UserRef
max :: UserRef -> UserRef -> UserRef
$cmax :: UserRef -> UserRef -> UserRef
>= :: UserRef -> UserRef -> Bool
$c>= :: UserRef -> UserRef -> Bool
> :: UserRef -> UserRef -> Bool
$c> :: UserRef -> UserRef -> Bool
<= :: UserRef -> UserRef -> Bool
$c<= :: UserRef -> UserRef -> Bool
< :: UserRef -> UserRef -> Bool
$c< :: UserRef -> UserRef -> Bool
compare :: UserRef -> UserRef -> Ordering
$ccompare :: UserRef -> UserRef -> Ordering
Ord)
isBotMessage :: Message -> Bool
isBotMessage :: Message -> Bool
isBotMessage Message
m =
case Message -> UserRef
_mUser Message
m of
UserI Bool
bot UserId
_ -> Bool
bot
UserOverride Bool
bot Text
_ -> Bool
bot
UserRef
NoUser -> Bool
False
data ReplyState =
NotAReply
| InReplyTo PostId
deriving (Int -> ReplyState -> ShowS
[ReplyState] -> ShowS
ReplyState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyState] -> ShowS
$cshowList :: [ReplyState] -> ShowS
show :: ReplyState -> String
$cshow :: ReplyState -> String
showsPrec :: Int -> ReplyState -> ShowS
$cshowsPrec :: Int -> ReplyState -> ShowS
Show, ReplyState -> ReplyState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplyState -> ReplyState -> Bool
$c/= :: ReplyState -> ReplyState -> Bool
== :: ReplyState -> ReplyState -> Bool
$c== :: ReplyState -> ReplyState -> Bool
Eq)
data LinkChoice =
LinkChoice { LinkChoice -> ServerTime
_linkTime :: ServerTime
, LinkChoice -> UserRef
_linkUser :: UserRef
, LinkChoice -> Maybe Inlines
_linkLabel :: Maybe Inlines
, LinkChoice -> LinkTarget
_linkTarget :: LinkTarget
} deriving (LinkChoice -> LinkChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkChoice -> LinkChoice -> Bool
$c/= :: LinkChoice -> LinkChoice -> Bool
== :: LinkChoice -> LinkChoice -> Bool
$c== :: LinkChoice -> LinkChoice -> Bool
Eq, Int -> LinkChoice -> ShowS
[LinkChoice] -> ShowS
LinkChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkChoice] -> ShowS
$cshowList :: [LinkChoice] -> ShowS
show :: LinkChoice -> String
$cshow :: LinkChoice -> String
showsPrec :: Int -> LinkChoice -> ShowS
$cshowsPrec :: Int -> LinkChoice -> ShowS
Show)
makeLenses ''LinkChoice
clientMessageToMessage :: ClientMessage -> Message
clientMessageToMessage :: ClientMessage -> Message
clientMessageToMessage ClientMessage
cm = Message
{ _mText :: Blocks
_mText = Maybe TeamBaseURL -> Text -> Blocks
parseMarkdown forall a. Maybe a
Nothing (ClientMessage
cmforall s a. s -> Getting a s a -> a
^.Lens' ClientMessage Text
cmText)
, _mMarkdownSource :: Text
_mMarkdownSource = ClientMessage
cmforall s a. s -> Getting a s a -> a
^.Lens' ClientMessage Text
cmText
, _mUser :: UserRef
_mUser = UserRef
NoUser
, _mDate :: ServerTime
_mDate = ClientMessage
cmforall s a. s -> Getting a s a -> a
^.Lens' ClientMessage ServerTime
cmDate
, _mType :: MessageType
_mType = ClientMessageType -> MessageType
C forall a b. (a -> b) -> a -> b
$ ClientMessage
cmforall s a. s -> Getting a s a -> a
^.Lens' ClientMessage ClientMessageType
cmType
, _mPending :: Bool
_mPending = Bool
False
, _mDeleted :: Bool
_mDeleted = Bool
False
, _mAttachments :: Seq Attachment
_mAttachments = forall a. Seq a
Seq.empty
, _mInReplyToMsg :: ReplyState
_mInReplyToMsg = ReplyState
NotAReply
, _mMessageId :: Maybe MessageId
_mMessageId = forall a. Maybe a
Nothing
, _mReactions :: Map Text (Set UserId)
_mReactions = forall k a. Map k a
Map.empty
, _mOriginalPost :: Maybe Post
_mOriginalPost = forall a. Maybe a
Nothing
, _mFlagged :: Bool
_mFlagged = Bool
False
, _mPinned :: Bool
_mPinned = Bool
False
, _mChannelId :: Maybe ChannelId
_mChannelId = forall a. Maybe a
Nothing
}
data MentionedUser =
UsernameMention Text
| UserIdMention UserId
deriving (MentionedUser -> MentionedUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MentionedUser -> MentionedUser -> Bool
$c/= :: MentionedUser -> MentionedUser -> Bool
== :: MentionedUser -> MentionedUser -> Bool
$c== :: MentionedUser -> MentionedUser -> Bool
Eq, Int -> MentionedUser -> ShowS
[MentionedUser] -> ShowS
MentionedUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MentionedUser] -> ShowS
$cshowList :: [MentionedUser] -> ShowS
show :: MentionedUser -> String
$cshow :: MentionedUser -> String
showsPrec :: Int -> MentionedUser -> ShowS
$cshowsPrec :: Int -> MentionedUser -> ShowS
Show, Eq MentionedUser
MentionedUser -> MentionedUser -> Bool
MentionedUser -> MentionedUser -> Ordering
MentionedUser -> MentionedUser -> MentionedUser
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MentionedUser -> MentionedUser -> MentionedUser
$cmin :: MentionedUser -> MentionedUser -> MentionedUser
max :: MentionedUser -> MentionedUser -> MentionedUser
$cmax :: MentionedUser -> MentionedUser -> MentionedUser
>= :: MentionedUser -> MentionedUser -> Bool
$c>= :: MentionedUser -> MentionedUser -> Bool
> :: MentionedUser -> MentionedUser -> Bool
$c> :: MentionedUser -> MentionedUser -> Bool
<= :: MentionedUser -> MentionedUser -> Bool
$c<= :: MentionedUser -> MentionedUser -> Bool
< :: MentionedUser -> MentionedUser -> Bool
$c< :: MentionedUser -> MentionedUser -> Bool
compare :: MentionedUser -> MentionedUser -> Ordering
$ccompare :: MentionedUser -> MentionedUser -> Ordering
Ord)
clientPostReactionUserIds :: ClientPost -> S.Set UserId
clientPostReactionUserIds :: ClientPost -> Set UserId
clientPostReactionUserIds ClientPost
cp =
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Map Text (Set UserId))
cpReactions
clientPostToMessage :: ClientPost -> (Message, S.Set MentionedUser)
clientPostToMessage :: ClientPost -> (Message, Set MentionedUser)
clientPostToMessage ClientPost
cp = (Message
m, Set MentionedUser
mentions)
where
mentions :: Set MentionedUser
mentions =
forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$
(Text -> MentionedUser
UsernameMention forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Blocks -> Set Text
findUsernames forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Blocks
cpText)) forall a. Semigroup a => a -> a -> a
<>
(UserId -> MentionedUser
UserIdMention forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ ClientPost -> Set UserId
clientPostReactionUserIds ClientPost
cp))
m :: Message
m = Message { _mText :: Blocks
_mText = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Blocks
cpText
, _mMarkdownSource :: Text
_mMarkdownSource = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Text
cpMarkdownSource
, _mUser :: UserRef
_mUser =
case ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe Text)
cpUserOverride of
Just Text
n | ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost ClientPostType
cpType forall a. Eq a => a -> a -> Bool
== ClientPostType
NormalPost -> Bool -> Text -> UserRef
UserOverride (ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Bool
cpFromWebhook) Text
n
Maybe Text
_ -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe UserRef
NoUser (Bool -> UserId -> UserRef
UserI (ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Bool
cpFromWebhook)) forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe UserId)
cpUser
, _mDate :: ServerTime
_mDate = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost ServerTime
cpDate
, _mType :: MessageType
_mType = ClientPostType -> MessageType
CP forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost ClientPostType
cpType
, _mPending :: Bool
_mPending = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Bool
cpPending
, _mDeleted :: Bool
_mDeleted = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Bool
cpDeleted
, _mAttachments :: Seq Attachment
_mAttachments = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Seq Attachment)
cpAttachments
, _mInReplyToMsg :: ReplyState
_mInReplyToMsg =
case ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe PostId)
cpInReplyToPost of
Maybe PostId
Nothing -> ReplyState
NotAReply
Just PostId
pId -> PostId -> ReplyState
InReplyTo PostId
pId
, _mMessageId :: Maybe MessageId
_mMessageId = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost PostId
cpPostId
, _mReactions :: Map Text (Set UserId)
_mReactions = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Map Text (Set UserId))
cpReactions
, _mOriginalPost :: Maybe Post
_mOriginalPost = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Post
cpOriginalPost
, _mFlagged :: Bool
_mFlagged = Bool
False
, _mPinned :: Bool
_mPinned = ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost Bool
cpPinned
, _mChannelId :: Maybe ChannelId
_mChannelId = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost ChannelId
cpChannelId
}
newMessageOfType :: Text -> MessageType -> ServerTime -> Message
newMessageOfType :: Text -> MessageType -> ServerTime -> Message
newMessageOfType Text
text MessageType
typ ServerTime
d = Message
{ _mText :: Blocks
_mText = Maybe TeamBaseURL -> Text -> Blocks
parseMarkdown forall a. Maybe a
Nothing Text
text
, _mMarkdownSource :: Text
_mMarkdownSource = Text
text
, _mUser :: UserRef
_mUser = UserRef
NoUser
, _mDate :: ServerTime
_mDate = ServerTime
d
, _mType :: MessageType
_mType = MessageType
typ
, _mPending :: Bool
_mPending = Bool
False
, _mDeleted :: Bool
_mDeleted = Bool
False
, _mAttachments :: Seq Attachment
_mAttachments = forall a. Seq a
Seq.empty
, _mInReplyToMsg :: ReplyState
_mInReplyToMsg = ReplyState
NotAReply
, _mMessageId :: Maybe MessageId
_mMessageId = forall a. Maybe a
Nothing
, _mReactions :: Map Text (Set UserId)
_mReactions = forall k a. Map k a
Map.empty
, _mOriginalPost :: Maybe Post
_mOriginalPost = forall a. Maybe a
Nothing
, _mFlagged :: Bool
_mFlagged = Bool
False
, _mPinned :: Bool
_mPinned = Bool
False
, _mChannelId :: Maybe ChannelId
_mChannelId = forall a. Maybe a
Nothing
}
makeLenses ''Message
type ChronologicalMessages = DirectionalSeq Chronological Message
type Messages = ChronologicalMessages
type RetrogradeMessages = DirectionalSeq Retrograde Message
filterMessages :: SeqDirection seq
=> (a -> Bool)
-> DirectionalSeq seq a
-> DirectionalSeq seq a
filterMessages :: forall seq a.
SeqDirection seq =>
(a -> Bool) -> DirectionalSeq seq a -> DirectionalSeq seq a
filterMessages a -> Bool
f = forall dir a b.
SeqDirection dir =>
(Seq a -> Seq b) -> DirectionalSeq dir a -> DirectionalSeq dir b
onDirectedSeq (forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter a -> Bool
f)
class MessageOps a where
addMessage :: Message -> a -> a
instance MessageOps ChronologicalMessages where
addMessage :: Message -> ChronologicalMessages -> ChronologicalMessages
addMessage Message
m ChronologicalMessages
ml =
case forall a. Seq a -> ViewR a
viewr (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
ml) of
ViewR Message
EmptyR -> forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
singleton Message
m
Seq Message
_ :> Message
l ->
case forall a. Ord a => a -> a -> Ordering
compare (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) (Message
lforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) of
Ordering
GT -> forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall a b. (a -> b) -> a -> b
$ forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
ml forall a. Seq a -> a -> Seq a
|> Message
m
Ordering
EQ -> if Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== Message
lforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
then ChronologicalMessages
ml
else Message -> ChronologicalMessages -> ChronologicalMessages
dirDateInsert Message
m ChronologicalMessages
ml
Ordering
LT -> Message -> ChronologicalMessages -> ChronologicalMessages
dirDateInsert Message
m ChronologicalMessages
ml
dirDateInsert :: Message -> ChronologicalMessages -> ChronologicalMessages
dirDateInsert :: Message -> ChronologicalMessages -> ChronologicalMessages
dirDateInsert Message
m = forall dir a b.
SeqDirection dir =>
(Seq a -> Seq b) -> DirectionalSeq dir a -> DirectionalSeq dir b
onDirectedSeq forall a b. (a -> b) -> a -> b
$ forall {a}. (Maybe a, Seq a) -> Seq a
finalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message
-> (Maybe Message, Seq Message) -> (Maybe Message, Seq Message)
insAfter (Maybe Message, Seq Message)
initial
where initial :: (Maybe Message, Seq Message)
initial = (forall a. a -> Maybe a
Just Message
m, forall a. Monoid a => a
mempty)
insAfter :: Message
-> (Maybe Message, Seq Message) -> (Maybe Message, Seq Message)
insAfter Message
c (Maybe Message
Nothing, Seq Message
l) = (forall a. Maybe a
Nothing, Message
c forall a. a -> Seq a -> Seq a
<| Seq Message
l)
insAfter Message
c (Just Message
n, Seq Message
l) =
case forall a. Ord a => a -> a -> Ordering
compare (Message
nforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) (Message
cforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) of
Ordering
GT -> (forall a. Maybe a
Nothing, Message
c forall a. a -> Seq a -> Seq a
<| (Message
n forall a. a -> Seq a -> Seq a
<| Seq Message
l))
Ordering
EQ -> if Message
nforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== Message
cforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust (Message
cforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
then (forall a. Maybe a
Nothing, Message
c forall a. a -> Seq a -> Seq a
<| Seq Message
l)
else (forall a. a -> Maybe a
Just Message
n, Message
c forall a. a -> Seq a -> Seq a
<| Seq Message
l)
Ordering
LT -> (forall a. a -> Maybe a
Just Message
n, Message
c forall a. a -> Seq a -> Seq a
<| Seq Message
l)
finalize :: (Maybe a, Seq a) -> Seq a
finalize (Just a
n, Seq a
l) = a
n forall a. a -> Seq a -> Seq a
<| Seq a
l
finalize (Maybe a
_, Seq a
l) = Seq a
l
noMessages :: Messages
noMessages :: ChronologicalMessages
noMessages = forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall a. Monoid a => a
mempty
messagesLength :: DirectionalSeq seq a -> Int
messagesLength :: forall seq a. DirectionalSeq seq a -> Int
messagesLength (DSeq Seq a
ms) = forall a. Seq a -> Int
Seq.length Seq a
ms
reverseMessages :: Messages -> RetrogradeMessages
reverseMessages :: ChronologicalMessages -> RetrogradeMessages
reverseMessages = forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq a
Seq.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dir a. DirectionalSeq dir a -> Seq a
dseq
unreverseMessages :: RetrogradeMessages -> Messages
unreverseMessages :: RetrogradeMessages -> ChronologicalMessages
unreverseMessages = forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq a
Seq.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dir a. DirectionalSeq dir a -> Seq a
dseq
splitDirSeqOn :: SeqDirection d
=> (a -> Bool)
-> DirectionalSeq d a
-> (Maybe a, (DirectionalSeq (ReverseDirection d) a,
DirectionalSeq d a))
splitDirSeqOn :: forall d a.
SeqDirection d =>
(a -> Bool)
-> DirectionalSeq d a
-> (Maybe a,
(DirectionalSeq (ReverseDirection d) a, DirectionalSeq d a))
splitDirSeqOn a -> Bool
f DirectionalSeq d a
msgs =
let (DirectionalSeq d a
removed, DirectionalSeq d a
remaining) = forall dir e.
SeqDirection dir =>
(e -> Bool)
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqBreakl a -> Bool
f DirectionalSeq d a
msgs
devomer :: DirectionalSeq dir a
devomer = forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Seq a
Seq.reverse forall a b. (a -> b) -> a -> b
$ forall dir a. DirectionalSeq dir a -> Seq a
dseq DirectionalSeq d a
removed
in (forall dir e r.
SeqDirection dir =>
(e -> r) -> DirectionalSeq dir e -> Maybe r
withDirSeqHead forall a. a -> a
id DirectionalSeq d a
remaining, (forall {dir}. DirectionalSeq dir a
devomer, forall dir a b.
SeqDirection dir =>
(Seq a -> Seq b) -> DirectionalSeq dir a -> DirectionalSeq dir b
onDirectedSeq (forall a. Int -> Seq a -> Seq a
Seq.drop Int
1) DirectionalSeq d a
remaining))
splitMessages :: Maybe MessageId
-> DirectionalSeq Chronological (Message, ThreadState)
-> (Maybe (Message, ThreadState),
( DirectionalSeq Retrograde (Message, ThreadState),
DirectionalSeq Chronological (Message, ThreadState)))
splitMessages :: Maybe MessageId
-> DirectionalSeq Chronological (Message, ThreadState)
-> (Maybe (Message, ThreadState),
(DirectionalSeq Retrograde (Message, ThreadState),
DirectionalSeq Chronological (Message, ThreadState)))
splitMessages Maybe MessageId
mid DirectionalSeq Chronological (Message, ThreadState)
msgs = forall d a.
SeqDirection d =>
(a -> Bool)
-> DirectionalSeq d a
-> (Maybe a,
(DirectionalSeq (ReverseDirection d) a, DirectionalSeq d a))
splitDirSeqOn (\(Message
m, ThreadState
_) -> forall a. Maybe a -> Bool
isJust Maybe MessageId
mid Bool -> Bool -> Bool
&& Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== Maybe MessageId
mid) DirectionalSeq Chronological (Message, ThreadState)
msgs
threadStateFor :: Message
-> Message
-> ThreadState
threadStateFor :: Message -> Message -> ThreadState
threadStateFor Message
msg Message
prev = case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message ReplyState
mInReplyToMsg of
InReplyTo PostId
rootId ->
if | (Message
prevforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
rootId) ->
ThreadState
InThread
| Message
prevforall s a. s -> Getting a s a -> a
^.Lens' Message ReplyState
mInReplyToMsg forall a. Eq a => a -> a -> Bool
== Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message ReplyState
mInReplyToMsg ->
ThreadState
InThread
| Bool
otherwise ->
ThreadState
InThreadShowParent
ReplyState
_ -> ThreadState
NoThread
retrogradeMsgsWithThreadStates :: RetrogradeMessages -> DirectionalSeq Retrograde (Message, ThreadState)
retrogradeMsgsWithThreadStates :: RetrogradeMessages
-> DirectionalSeq Retrograde (Message, ThreadState)
retrogradeMsgsWithThreadStates RetrogradeMessages
msgs = forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall a b. (a -> b) -> a -> b
$ Seq Message -> Seq (Message, ThreadState)
checkAdjacentMessages (forall dir a. DirectionalSeq dir a -> Seq a
dseq RetrogradeMessages
msgs)
where
getMessagePredecessor :: Seq Message -> Maybe Message
getMessagePredecessor Seq Message
ms =
let visiblePredMsg :: Message -> Bool
visiblePredMsg Message
m = Bool -> Bool
not (Message -> Bool
isTransition Message
m Bool -> Bool -> Bool
|| Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mDeleted) in
case forall a. Seq a -> ViewL a
Seq.viewl Seq Message
ms of
Message
prev Seq.:< Seq Message
rest ->
if Message -> Bool
visiblePredMsg Message
prev
then forall a. a -> Maybe a
Just Message
prev
else Seq Message -> Maybe Message
getMessagePredecessor Seq Message
rest
ViewL Message
Seq.EmptyL -> forall a. Maybe a
Nothing
checkAdjacentMessages :: Seq Message -> Seq (Message, ThreadState)
checkAdjacentMessages Seq Message
s = case forall a. Seq a -> ViewL a
Seq.viewl Seq Message
s of
ViewL Message
Seq.EmptyL -> forall a. Monoid a => a
mempty
Message
m Seq.:< Seq Message
t ->
let new_m :: (Message, ThreadState)
new_m = case Seq Message -> Maybe Message
getMessagePredecessor Seq Message
t of
Just Message
prev -> (Message
m, Message -> Message -> ThreadState
threadStateFor Message
m Message
prev)
Maybe Message
Nothing -> case Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message ReplyState
mInReplyToMsg of
InReplyTo PostId
_ -> (Message
m, ThreadState
InThreadShowParent)
ReplyState
_ -> (Message
m, ThreadState
NoThread)
in (Message, ThreadState)
new_m forall a. a -> Seq a -> Seq a
Seq.<| Seq Message -> Seq (Message, ThreadState)
checkAdjacentMessages Seq Message
t
chronologicalMsgsWithThreadStates :: Messages -> DirectionalSeq Chronological (Message, ThreadState)
chronologicalMsgsWithThreadStates :: ChronologicalMessages
-> DirectionalSeq Chronological (Message, ThreadState)
chronologicalMsgsWithThreadStates ChronologicalMessages
msgs = forall dir a. Seq a -> DirectionalSeq dir a
DSeq forall a b. (a -> b) -> a -> b
$ Seq Message -> Seq (Message, ThreadState)
checkAdjacentMessages (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
msgs)
where
getMessagePredecessor :: Seq Message -> Maybe Message
getMessagePredecessor Seq Message
ms =
let visiblePredMsg :: Message -> Bool
visiblePredMsg Message
m = Bool -> Bool
not (Message -> Bool
isTransition Message
m Bool -> Bool -> Bool
|| Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mDeleted) in
case forall a. Seq a -> ViewR a
Seq.viewr Seq Message
ms of
Seq Message
rest Seq.:> Message
prev ->
if Message -> Bool
visiblePredMsg Message
prev
then forall a. a -> Maybe a
Just Message
prev
else Seq Message -> Maybe Message
getMessagePredecessor Seq Message
rest
ViewR Message
Seq.EmptyR -> forall a. Maybe a
Nothing
checkAdjacentMessages :: Seq Message -> Seq (Message, ThreadState)
checkAdjacentMessages Seq Message
s = case forall a. Seq a -> ViewR a
Seq.viewr Seq Message
s of
ViewR Message
Seq.EmptyR -> forall a. Monoid a => a
mempty
Seq Message
t Seq.:> Message
m ->
let new_m :: (Message, ThreadState)
new_m = case Seq Message -> Maybe Message
getMessagePredecessor Seq Message
t of
Just Message
prev -> (Message
m, Message -> Message -> ThreadState
threadStateFor Message
m Message
prev)
Maybe Message
Nothing -> case Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message ReplyState
mInReplyToMsg of
InReplyTo PostId
_ -> (Message
m, ThreadState
InThreadShowParent)
ReplyState
_ -> (Message
m, ThreadState
NoThread)
in Seq Message -> Seq (Message, ThreadState)
checkAdjacentMessages Seq Message
t forall a. Seq a -> a -> Seq a
Seq.|> (Message, ThreadState)
new_m
findMessage :: MessageId -> Messages -> Maybe Message
findMessage :: MessageId -> ChronologicalMessages -> Maybe Message
findMessage MessageId
mid ChronologicalMessages
msgs =
forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexR (\Message
m -> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just MessageId
mid) (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
msgs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Int -> a
Seq.index (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
msgs)
getNextMessage :: Maybe MessageId -> Messages -> Maybe Message
getNextMessage :: Maybe MessageId -> ChronologicalMessages -> Maybe Message
getNextMessage = forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId
getPrevMessage :: Maybe MessageId -> Messages -> Maybe Message
getPrevMessage :: Maybe MessageId -> ChronologicalMessages -> Maybe Message
getPrevMessage Maybe MessageId
mId = forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId Maybe MessageId
mId forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChronologicalMessages -> RetrogradeMessages
reverseMessages
messagesHead :: (SeqDirection seq) => DirectionalSeq seq a -> Maybe a
messagesHead :: forall seq a. SeqDirection seq => DirectionalSeq seq a -> Maybe a
messagesHead = forall dir e r.
SeqDirection dir =>
(e -> r) -> DirectionalSeq dir e -> Maybe r
withDirSeqHead forall a. a -> a
id
messagesDrop :: (SeqDirection seq) => Int -> DirectionalSeq seq a -> DirectionalSeq seq a
messagesDrop :: forall seq a.
SeqDirection seq =>
Int -> DirectionalSeq seq a -> DirectionalSeq seq a
messagesDrop Int
i = forall dir a b.
SeqDirection dir =>
(Seq a -> Seq b) -> DirectionalSeq dir a -> DirectionalSeq dir b
onDirectedSeq (forall a. Int -> Seq a -> Seq a
Seq.drop Int
i)
getNextMessageId :: Maybe MessageId -> Messages -> Maybe MessageId
getNextMessageId :: Maybe MessageId -> ChronologicalMessages -> Maybe MessageId
getNextMessageId Maybe MessageId
mId = Message -> Maybe MessageId
_mMessageId forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe MessageId -> ChronologicalMessages -> Maybe Message
getNextMessage Maybe MessageId
mId
getPrevMessageId :: Maybe MessageId -> Messages -> Maybe MessageId
getPrevMessageId :: Maybe MessageId -> ChronologicalMessages -> Maybe MessageId
getPrevMessageId Maybe MessageId
mId = Message -> Maybe MessageId
_mMessageId forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe MessageId -> ChronologicalMessages -> Maybe Message
getPrevMessage Maybe MessageId
mId
getNextPostId :: Maybe PostId -> Messages -> Maybe PostId
getNextPostId :: Maybe PostId -> ChronologicalMessages -> Maybe PostId
getNextPostId Maybe PostId
pid = Message -> Maybe PostId
messagePostId forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe MessageId -> ChronologicalMessages -> Maybe Message
getNextMessage (PostId -> MessageId
MessagePostId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PostId
pid)
getPrevPostId :: Maybe PostId -> Messages -> Maybe PostId
getPrevPostId :: Maybe PostId -> ChronologicalMessages -> Maybe PostId
getPrevPostId Maybe PostId
pid = Message -> Maybe PostId
messagePostId forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe MessageId -> ChronologicalMessages -> Maybe Message
getPrevMessage (PostId -> MessageId
MessagePostId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PostId
pid)
getRelMessageId :: SeqDirection dir =>
Maybe MessageId
-> DirectionalSeq dir Message
-> Maybe Message
getRelMessageId :: forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId Maybe MessageId
mId =
let isMId :: Maybe (Message -> Bool)
isMId = forall a b. a -> b -> a
const (forall a. Eq a => a -> a -> Bool
(==) Maybe MessageId
mId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Maybe MessageId
_mMessageId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MessageId
mId
in forall dir.
SeqDirection dir =>
Maybe (Message -> Bool)
-> DirectionalSeq dir Message -> Maybe Message
getRelMessage Maybe (Message -> Bool)
isMId
getRelMessage :: SeqDirection dir =>
Maybe (Message -> Bool)
-> DirectionalSeq dir Message
-> Maybe Message
getRelMessage :: forall dir.
SeqDirection dir =>
Maybe (Message -> Bool)
-> DirectionalSeq dir Message -> Maybe Message
getRelMessage Maybe (Message -> Bool)
matcher DirectionalSeq dir Message
msgs =
let after :: DirectionalSeq dir Message
after = case Maybe (Message -> Bool)
matcher of
Just Message -> Bool
matchFun -> case forall d a.
SeqDirection d =>
(a -> Bool)
-> DirectionalSeq d a
-> (Maybe a,
(DirectionalSeq (ReverseDirection d) a, DirectionalSeq d a))
splitDirSeqOn Message -> Bool
matchFun DirectionalSeq dir Message
msgs of
(Maybe Message
_, (DirectionalSeq (ReverseDirection dir) Message
_, DirectionalSeq dir Message
ms)) -> DirectionalSeq dir Message
ms
Maybe (Message -> Bool)
Nothing -> DirectionalSeq dir Message
msgs
in forall dir e r.
SeqDirection dir =>
(e -> r) -> DirectionalSeq dir e -> Maybe r
withDirSeqHead forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall seq a.
SeqDirection seq =>
(a -> Bool) -> DirectionalSeq seq a -> DirectionalSeq seq a
filterMessages Message -> Bool
validSelectableMessage DirectionalSeq dir Message
after
getLatestPostMsg :: Messages -> Maybe Message
getLatestPostMsg :: ChronologicalMessages -> Maybe Message
getLatestPostMsg ChronologicalMessages
msgs =
case forall a. Seq a -> ViewR a
viewr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Bool
validUserMessage) (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
msgs) of
ViewR Message
EmptyR -> forall a. Maybe a
Nothing
Seq Message
_ :> Message
m -> forall a. a -> Maybe a
Just Message
m
getEarliestSelectableMessage :: Messages -> Maybe Message
getEarliestSelectableMessage :: ChronologicalMessages -> Maybe Message
getEarliestSelectableMessage ChronologicalMessages
msgs =
case forall a. Seq a -> ViewL a
viewl forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileL (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Bool
validSelectableMessage) (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
msgs) of
ViewL Message
EmptyL -> forall a. Maybe a
Nothing
Message
m :< Seq Message
_ -> forall a. a -> Maybe a
Just Message
m
getLatestSelectableMessage :: Messages -> Maybe Message
getLatestSelectableMessage :: ChronologicalMessages -> Maybe Message
getLatestSelectableMessage ChronologicalMessages
msgs =
case forall a. Seq a -> ViewR a
viewr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Bool
validSelectableMessage) (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
msgs) of
ViewR Message
EmptyR -> forall a. Maybe a
Nothing
Seq Message
_ :> Message
m -> forall a. a -> Maybe a
Just Message
m
getEarliestPostMsg :: Messages -> Maybe Message
getEarliestPostMsg :: ChronologicalMessages -> Maybe Message
getEarliestPostMsg ChronologicalMessages
msgs =
case forall a. Seq a -> ViewL a
viewl forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileL (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Bool
validUserMessage) (forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
msgs) of
ViewL Message
EmptyL -> forall a. Maybe a
Nothing
Message
m :< Seq Message
_ -> forall a. a -> Maybe a
Just Message
m
findLatestUserMessage :: (Message -> Bool) -> Messages -> Maybe Message
findLatestUserMessage :: (Message -> Bool) -> ChronologicalMessages -> Maybe Message
findLatestUserMessage Message -> Bool
f ChronologicalMessages
ml =
case forall a. Seq a -> ViewR a
viewr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR (\Message
m -> Bool -> Bool
not (Message -> Bool
validUserMessage Message
m Bool -> Bool -> Bool
&& Message -> Bool
f Message
m)) forall a b. (a -> b) -> a -> b
$ forall dir a. DirectionalSeq dir a -> Seq a
dseq ChronologicalMessages
ml of
ViewR Message
EmptyR -> forall a. Maybe a
Nothing
Seq Message
_ :> Message
m -> forall a. a -> Maybe a
Just Message
m
validUserMessage :: Message -> Bool
validUserMessage :: Message -> Bool
validUserMessage Message
m =
Bool -> Bool
not (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mDeleted) Bool -> Bool -> Bool
&& case Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId of
Just (MessagePostId PostId
_) -> Bool
True
Maybe MessageId
_ -> Bool
False
validSelectableMessage :: Message -> Bool
validSelectableMessage :: Message -> Bool
validSelectableMessage Message
m = (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mDeleted) Bool -> Bool -> Bool
&& (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
messagesAfter :: ServerTime -> Messages -> Messages
messagesAfter :: ServerTime -> ChronologicalMessages -> ChronologicalMessages
messagesAfter ServerTime
viewTime = forall dir a b.
SeqDirection dir =>
(Seq a -> Seq b) -> DirectionalSeq dir a -> DirectionalSeq dir b
onDirectedSeq forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
takeWhileR (\Message
m -> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate forall a. Ord a => a -> a -> Bool
> ServerTime
viewTime)
removeMatchesFromSubset :: (Message -> Bool) -> Maybe MessageId -> Maybe MessageId
-> Messages -> (Messages, Messages)
removeMatchesFromSubset :: (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> ChronologicalMessages
-> (ChronologicalMessages, ChronologicalMessages)
removeMatchesFromSubset Message -> Bool
matching Maybe MessageId
firstId Maybe MessageId
lastId ChronologicalMessages
msgs =
let knownIds :: DirectionalSeq Chronological (Maybe MessageId)
knownIds = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId) ChronologicalMessages
msgs
in if forall a. Maybe a -> Bool
isNothing Maybe MessageId
firstId Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe MessageId
lastId
then forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall dir e.
SeqDirection dir =>
(e -> Bool)
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqPartition Message -> Bool
matching ChronologicalMessages
msgs
else if forall a. Maybe a -> Bool
isJust Maybe MessageId
firstId Bool -> Bool -> Bool
&& Maybe MessageId
firstId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DirectionalSeq Chronological (Maybe MessageId)
knownIds
then forall dir e a.
SeqDirection dir =>
(e -> Bool)
-> (e -> Bool)
-> (DirectionalSeq dir e -> (DirectionalSeq dir e, a))
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, a)
onDirSeqSubset
(\Message
m -> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== Maybe MessageId
firstId)
(if forall a. Maybe a -> Bool
isJust Maybe MessageId
lastId then \Message
m -> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== Maybe MessageId
lastId else forall a b. a -> b -> a
const Bool
False)
(forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dir e.
SeqDirection dir =>
(e -> Bool)
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqPartition Message -> Bool
matching) ChronologicalMessages
msgs
else if forall a. Maybe a -> Bool
isJust Maybe MessageId
lastId Bool -> Bool -> Bool
&& Maybe MessageId
lastId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DirectionalSeq Chronological (Maybe MessageId)
knownIds
then forall dir e a.
SeqDirection dir =>
(e -> Bool)
-> (e -> Bool)
-> (DirectionalSeq dir e -> (DirectionalSeq dir e, a))
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, a)
onDirSeqSubset
(forall a b. a -> b -> a
const Bool
True)
(\Message
m -> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== Maybe MessageId
lastId)
(forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dir e.
SeqDirection dir =>
(e -> Bool)
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqPartition Message -> Bool
matching) ChronologicalMessages
msgs
else (ChronologicalMessages
msgs, ChronologicalMessages
noMessages)
withFirstMessage :: SeqDirection dir
=> (Message -> r)
-> DirectionalSeq dir Message
-> Maybe r
withFirstMessage :: forall dir r.
SeqDirection dir =>
(Message -> r) -> DirectionalSeq dir Message -> Maybe r
withFirstMessage = forall dir e r.
SeqDirection dir =>
(e -> r) -> DirectionalSeq dir e -> Maybe r
withDirSeqHead
msgURLs :: Message -> Seq LinkChoice
msgURLs :: Message -> Seq LinkChoice
msgURLs Message
msg =
let uRef :: UserRef
uRef = Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message UserRef
mUser
mkTarget :: Either (TeamURLName, PostId) URL -> LinkTarget
mkTarget (Right URL
url) = URL -> LinkTarget
LinkURL URL
url
mkTarget (Left (TeamURLName
tName, PostId
pId)) = TeamURLName -> PostId -> LinkTarget
LinkPermalink TeamURLName
tName PostId
pId
mkEntry :: (Either (TeamURLName, PostId) URL, Maybe Inlines) -> LinkChoice
mkEntry (Either (TeamURLName, PostId) URL
val, Maybe Inlines
text) = ServerTime -> UserRef -> Maybe Inlines -> LinkTarget -> LinkChoice
LinkChoice (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) UserRef
uRef Maybe Inlines
text (Either (TeamURLName, PostId) URL -> LinkTarget
mkTarget Either (TeamURLName, PostId) URL
val)
msgUrls :: Seq LinkChoice
msgUrls = (Either (TeamURLName, PostId) URL, Maybe Inlines) -> LinkChoice
mkEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Block -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)]
blockGetURLs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ Blocks -> Seq Block
unBlocks forall a b. (a -> b) -> a -> b
$ Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Blocks
mText))
attachmentURLs :: Seq LinkChoice
attachmentURLs = (\ Attachment
a ->
ServerTime -> UserRef -> Maybe Inlines -> LinkTarget -> LinkChoice
LinkChoice
(Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate)
UserRef
uRef
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Attachment -> Inlines
attachmentLabel Attachment
a)
(FileId -> LinkTarget
LinkFileId forall a b. (a -> b) -> a -> b
$ Attachment
aforall s a. s -> Getting a s a -> a
^.Lens' Attachment FileId
attachmentFileId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Seq Attachment)
mAttachments)
attachmentLabel :: Attachment -> Inlines
attachmentLabel Attachment
a =
Seq Inline -> Inlines
Inlines forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList [ Text -> Inline
EText Text
"attachment"
, Inline
ESpace
, Inlines -> Inline
ECode forall a b. (a -> b) -> a -> b
$ Seq Inline -> Inlines
Inlines forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Text -> Inline
EText forall a b. (a -> b) -> a -> b
$ Attachment
aforall s a. s -> Getting a s a -> a
^.Lens' Attachment Text
attachmentName
]
in Seq LinkChoice
msgUrls forall a. Semigroup a => a -> a -> a
<> Seq LinkChoice
attachmentURLs