{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}

{-|

The 'Message' is a single displayed event in a Channel.  All Messages
have a date/time, and messages that represent posts to the channel
have a (hash) ID, and displayable text, along with other attributes.

All Messages are sorted chronologically.  There is no assumption that
the server date/time is synchronized with the local date/time, so all
of the Message ordering uses the server's date/time.

The mattermost-api retrieves a 'Post' from the server, briefly encodes
the useful portions of that as a 'ClientPost' object and then converts
it to a 'Message' inserting this result it into the collection of
Messages associated with a Channel.  The PostID of the message
uniquely identifies that message and can be used to interact with the
server for subsequent operations relative to that message's 'Post'.
The date/time associated with these messages is generated by the
server.

There are also "messages" generated directly by the Matterhorn client
which can be used to display additional, client-related information to
the user. Examples of these client messages are: date boundaries, the
"new messages" marker, errors from invoking the browser, etc.  These
client-generated messages will have a date/time although it is locally
generated (usually by relation to an associated Post).

Most other Matterhorn operations primarily are concerned with
user-posted messages (@case mMessageId of Just _@ or @case mType of CP
_@), but others will include client-generated messages (@case mMessageId
of Nothing@ or @case mType of C _@).

--}

module Matterhorn.Types.Messages
  ( -- * Message and operations on a single Message
    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
    -- * Message Collections
  , 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
  -- * Operations on any Message type
  , 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


-- | The state of a message's thread context.
data ThreadState =
    NoThread
    -- ^ The message is not in a thread at all.
    | InThreadShowParent
    -- ^ The message is in a thread, and the thread's root message
    -- (parent) should be displayed above this message.
    | InThread
    -- ^ The message is in a thread but the thread's root message should
    -- not be displayed above this message.
    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)

-- ----------------------------------------------------------------------
-- * Messages

-- | A 'Message' is any message we might want to render, either from
--   Mattermost itself or from a client-internal source.
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

-- | A 'Message' is the representation we use for storage and
--   rendering, so it must be able to represent either a
--   post from Mattermost or an internal message. This represents
--   the union of both kinds of post types.
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)

-- | There may be no user (usually an internal message), a reference to
-- a user (by Id), or the server may have supplied a specific username
-- (often associated with bots). The boolean flag indicates whether the
-- user reference is for a message from a bot.
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

-- | The 'ReplyState' of a message represents whether a message
--   is a reply, and if so, to what message
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)

-- | This type represents links to things in the 'open links' view.
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

-- | Convert a 'ClientMessage' to a 'Message'.  A 'ClientMessage' is
-- one that was generated by the Matterhorn client and which the
-- server knows nothing about.  For example, an error message
-- associated with passing a link to the local browser.
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

-- | Builds a message from a ClientPost and also returns the set of
-- usernames mentioned in the text of the message.
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
  }

-- ** 'Message' Lenses

makeLenses ''Message

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

-- * Message Collections

-- | A wrapper for an ordered, unique list of 'Message' values.
--
-- This type has (and promises) the following instances: Show,
-- Functor, Monoid, Foldable, Traversable
type ChronologicalMessages = DirectionalSeq Chronological Message
type Messages = ChronologicalMessages

-- | There are also cases where the list of 'Message' values are kept
-- in reverse order (most recent -> oldest); these cases are
-- represented by the `RetrogradeMessages` type.
type RetrogradeMessages = DirectionalSeq Retrograde Message

-- ** Common operations on Messages

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 inserts a date in proper chronological order, with
    -- the following extra functionality:
    --     * no duplication (by PostId)
    --     * no duplication (adjacent UnknownGap entries)
    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

-- | Reverse the order of the messages
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

-- | Unreverse the order of the messages
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))

-- ----------------------------------------------------------------------
-- * Operations on Posted Messages

-- | Searches for the specified MessageId and returns a tuple where the
-- first element is the Message associated with the MessageId (if it
-- exists), and the second element is another tuple: the first element
-- of the second is all the messages from the beginning of the list to
-- the message just before the MessageId message (or all messages if not
-- found) *in reverse order*, and the second element of the second are
-- all the messages that follow the found message (none if the message
-- was never found) in *forward* order.
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

-- | Given a message and its chronological predecessor, return
-- the thread state of the specified message with respect to its
-- predecessor.
threadStateFor :: Message
               -- ^ The message whose state is to be obtained.
               -> Message
               -- ^ The message's predecessor.
               -> 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 searches for a specific message as identified by the
-- PostId.  The search starts from the most recent messages because
-- that is the most likely place the message will occur.
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)

-- | Look forward for the first Message with an ID that follows the
-- specified Id and return it.  If no input Id supplied, get the
-- latest (most recent chronologically) Message in the input set.
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

-- | Look backward for the first Message with an ID that follows the
-- specified MessageId and return it.  If no input MessageId supplied,
-- get the latest (most recent chronologically) Message in the input
-- set.
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)

-- | Look forward for the first Message with an ID that follows the
-- specified MessageId and return that found Message's ID; if no input
-- MessageId is specified, return the latest (most recent
-- chronologically) MessageId (if any) in the input set.
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

-- | Look backwards for the first Message with an ID that comes before
-- the specified MessageId and return that found Message's ID; if no
-- input MessageId is specified, return the latest (most recent
-- chronologically) MessageId (if any) in the input set.
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

-- | Look forward for the first Message with an ID that follows the
-- specified PostId and return that found Message's PostID; if no
-- input PostId is specified, return the latest (most recent
-- chronologically) PostId (if any) in the input set.
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)

-- | Look backwards for the first Post with an ID that comes before
-- the specified PostId.
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

-- | Internal worker function to return a different user message in
-- relation to either the latest point or a specific message.
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

-- | Find the most recent message that is a Post (as opposed to a
-- local message) (if any).
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

-- | Find the oldest message that is a message with an ID.
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

-- | Find the most recent message that is a message with an ID.
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

-- | Find the earliest message that is a Post (as opposed to a
-- local message) (if any).
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

-- | Find the most recent message that is a message posted by a user
-- that matches the test (if any), skipping local client messages and
-- any user event that is not a message (i.e. find a normal message or
-- an emote).
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)

-- ----------------------------------------------------------------------
-- * Operations on any Message type

-- | Return all messages that were posted after the specified date/time.
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)

-- | Removes any Messages (all types) for which the predicate is true
-- from the specified subset of messages (identified by a starting and
-- ending MessageId, inclusive) and returns the resulting list (from
-- start to finish, irrespective of 'firstId' and 'lastId') and the
-- list of removed items.
--
--    start       | end          |  operates-on              | (test) case
--   --------------------------------------------------------|-------------
--   Nothing      | Nothing      | entire list               |  C1
--   Nothing      | Just found   | start --> found]          |  C2
--   Nothing      | Just missing | nothing [suggest invalid] |  C3
--   Just found   | Nothing      | [found --> end            |  C4
--   Just found   | Just found   | [found --> found]         |  C5
--   Just found   | Just missing | [found --> end            |  C6
--   Just missing | Nothing      | nothing [suggest invalid] |  C7
--   Just missing | Just found   | start --> found]          |  C8
--   Just missing | Just missing | nothing [suggest invalid] |  C9
--
--  @removeMatchesFromSubset matchPred fromId toId msgs = (remaining, removed)@
--
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)

-- | Performs an operation on the first Message, returning just the
-- result of that operation, or Nothing if there were no messages.
-- Note that the message is not necessarily a posted user message.
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