module Erebos.Conversation (
    Message,
    messageFrom,
    messageTime,
    messageText,
    messageUnread,
    formatMessage,

    Conversation,
    directMessageConversation,
    chatroomConversation,
    chatroomConversationByStateData,
    reloadConversation,
    lookupConversations,

    conversationName,
    conversationPeer,
    conversationHistory,

    sendMessage,
    deleteConversation,
) where

import Control.Monad.Except

import Data.List
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time.Format
import Data.Time.LocalTime

import Erebos.Identity
import Erebos.Chatroom
import Erebos.Message hiding (formatMessage)
import Erebos.State
import Erebos.Storage


data Message = DirectMessageMessage DirectMessage Bool
             | ChatroomMessage ChatMessage Bool

messageFrom :: Message -> ComposedIdentity
messageFrom :: Message -> ComposedIdentity
messageFrom (DirectMessageMessage DirectMessage
msg Bool
_) = DirectMessage -> ComposedIdentity
msgFrom DirectMessage
msg
messageFrom (ChatroomMessage ChatMessage
msg Bool
_) = ChatMessage -> ComposedIdentity
cmsgFrom ChatMessage
msg

messageTime :: Message -> ZonedTime
messageTime :: Message -> ZonedTime
messageTime (DirectMessageMessage DirectMessage
msg Bool
_) = DirectMessage -> ZonedTime
msgTime DirectMessage
msg
messageTime (ChatroomMessage ChatMessage
msg Bool
_) = ChatMessage -> ZonedTime
cmsgTime ChatMessage
msg

messageText :: Message -> Maybe Text
messageText :: Message -> Maybe Text
messageText (DirectMessageMessage DirectMessage
msg Bool
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ DirectMessage -> Text
msgText DirectMessage
msg
messageText (ChatroomMessage ChatMessage
msg Bool
_) = ChatMessage -> Maybe Text
cmsgText ChatMessage
msg

messageUnread :: Message -> Bool
messageUnread :: Message -> Bool
messageUnread (DirectMessageMessage DirectMessage
_ Bool
unread) = Bool
unread
messageUnread (ChatroomMessage ChatMessage
_ Bool
unread) = Bool
unread

formatMessage :: TimeZone -> Message -> String
formatMessage :: TimeZone -> Message -> String
formatMessage TimeZone
tzone Message
msg = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"[%H:%M] " (LocalTime -> String) -> LocalTime -> String
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tzone (UTCTime -> LocalTime) -> UTCTime -> LocalTime
forall a b. (a -> b) -> a -> b
$ ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime) -> ZonedTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Message -> ZonedTime
messageTime Message
msg
    , String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<unnamed>" Text -> String
T.unpack (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$ ComposedIdentity -> Maybe Text
forall (m :: * -> *). Identity m -> Maybe Text
idName (ComposedIdentity -> Maybe Text) -> ComposedIdentity -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Message -> ComposedIdentity
messageFrom Message
msg
    , String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
": "String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$ Message -> Maybe Text
messageText Message
msg
    ]


data Conversation = DirectMessageConversation DirectMessageThread
                  | ChatroomConversation ChatroomState

directMessageConversation :: MonadHead LocalState m => ComposedIdentity -> m Conversation
directMessageConversation :: forall (m :: * -> *).
MonadHead LocalState m =>
ComposedIdentity -> m Conversation
directMessageConversation ComposedIdentity
peer = do
    ((DirectMessageThread -> Bool)
-> [DirectMessageThread] -> Maybe DirectMessageThread
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ComposedIdentity -> ComposedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
sameIdentity ComposedIdentity
peer (ComposedIdentity -> Bool)
-> (DirectMessageThread -> ComposedIdentity)
-> DirectMessageThread
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectMessageThread -> ComposedIdentity
msgPeer) ([DirectMessageThread] -> Maybe DirectMessageThread)
-> (Stored LocalState -> [DirectMessageThread])
-> Stored LocalState
-> Maybe DirectMessageThread
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectMessageThreads -> [DirectMessageThread]
toThreadList (DirectMessageThreads -> [DirectMessageThread])
-> (Stored LocalState -> DirectMessageThreads)
-> Stored LocalState
-> [DirectMessageThread]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored SharedState] -> DirectMessageThreads
forall a. SharedType a => [Stored SharedState] -> a
lookupSharedValue ([Stored SharedState] -> DirectMessageThreads)
-> (Stored LocalState -> [Stored SharedState])
-> Stored LocalState
-> DirectMessageThreads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored (Stored LocalState -> Maybe DirectMessageThread)
-> m (Stored LocalState) -> m (Maybe DirectMessageThread)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stored LocalState)
forall a (m :: * -> *). MonadHead a m => m (Stored a)
getLocalHead) m (Maybe DirectMessageThread)
-> (Maybe DirectMessageThread -> m Conversation) -> m Conversation
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just DirectMessageThread
thread -> Conversation -> m Conversation
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Conversation -> m Conversation) -> Conversation -> m Conversation
forall a b. (a -> b) -> a -> b
$ DirectMessageThread -> Conversation
DirectMessageConversation DirectMessageThread
thread
        Maybe DirectMessageThread
Nothing -> Conversation -> m Conversation
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Conversation -> m Conversation) -> Conversation -> m Conversation
forall a b. (a -> b) -> a -> b
$ DirectMessageThread -> Conversation
DirectMessageConversation (DirectMessageThread -> Conversation)
-> DirectMessageThread -> Conversation
forall a b. (a -> b) -> a -> b
$ ComposedIdentity
-> [Stored DirectMessage]
-> [Stored DirectMessage]
-> [Stored DirectMessage]
-> DirectMessageThread
DirectMessageThread ComposedIdentity
peer [] [] []

chatroomConversation :: MonadHead LocalState m => ChatroomState -> m (Maybe Conversation)
chatroomConversation :: forall (m :: * -> *).
MonadHead LocalState m =>
ChatroomState -> m (Maybe Conversation)
chatroomConversation ChatroomState
rstate = Stored ChatroomStateData -> m (Maybe Conversation)
forall (m :: * -> *).
MonadHead LocalState m =>
Stored ChatroomStateData -> m (Maybe Conversation)
chatroomConversationByStateData ([Stored ChatroomStateData] -> Stored ChatroomStateData
forall a. HasCallStack => [a] -> a
head ([Stored ChatroomStateData] -> Stored ChatroomStateData)
-> [Stored ChatroomStateData] -> Stored ChatroomStateData
forall a b. (a -> b) -> a -> b
$ ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
rstate)

chatroomConversationByStateData :: MonadHead LocalState m => Stored ChatroomStateData -> m (Maybe Conversation)
chatroomConversationByStateData :: forall (m :: * -> *).
MonadHead LocalState m =>
Stored ChatroomStateData -> m (Maybe Conversation)
chatroomConversationByStateData Stored ChatroomStateData
sdata = (ChatroomState -> Conversation)
-> Maybe ChatroomState -> Maybe Conversation
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChatroomState -> Conversation
ChatroomConversation (Maybe ChatroomState -> Maybe Conversation)
-> m (Maybe ChatroomState) -> m (Maybe Conversation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stored ChatroomStateData -> m (Maybe ChatroomState)
forall (m :: * -> *).
MonadHead LocalState m =>
Stored ChatroomStateData -> m (Maybe ChatroomState)
findChatroomByStateData Stored ChatroomStateData
sdata

reloadConversation :: MonadHead LocalState m => Conversation -> m Conversation
reloadConversation :: forall (m :: * -> *).
MonadHead LocalState m =>
Conversation -> m Conversation
reloadConversation (DirectMessageConversation DirectMessageThread
thread) = ComposedIdentity -> m Conversation
forall (m :: * -> *).
MonadHead LocalState m =>
ComposedIdentity -> m Conversation
directMessageConversation (DirectMessageThread -> ComposedIdentity
msgPeer DirectMessageThread
thread)
reloadConversation cur :: Conversation
cur@(ChatroomConversation ChatroomState
rstate) =
    Conversation -> Maybe Conversation -> Conversation
forall a. a -> Maybe a -> a
fromMaybe Conversation
cur (Maybe Conversation -> Conversation)
-> m (Maybe Conversation) -> m Conversation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomState -> m (Maybe Conversation)
forall (m :: * -> *).
MonadHead LocalState m =>
ChatroomState -> m (Maybe Conversation)
chatroomConversation ChatroomState
rstate

lookupConversations :: MonadHead LocalState m => m [Conversation]
lookupConversations :: forall (m :: * -> *). MonadHead LocalState m => m [Conversation]
lookupConversations = (DirectMessageThread -> Conversation)
-> [DirectMessageThread] -> [Conversation]
forall a b. (a -> b) -> [a] -> [b]
map DirectMessageThread -> Conversation
DirectMessageConversation ([DirectMessageThread] -> [Conversation])
-> (Stored LocalState -> [DirectMessageThread])
-> Stored LocalState
-> [Conversation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectMessageThreads -> [DirectMessageThread]
toThreadList (DirectMessageThreads -> [DirectMessageThread])
-> (Stored LocalState -> DirectMessageThreads)
-> Stored LocalState
-> [DirectMessageThread]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored SharedState] -> DirectMessageThreads
forall a. SharedType a => [Stored SharedState] -> a
lookupSharedValue ([Stored SharedState] -> DirectMessageThreads)
-> (Stored LocalState -> [Stored SharedState])
-> Stored LocalState
-> DirectMessageThreads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored (Stored LocalState -> [Conversation])
-> m (Stored LocalState) -> m [Conversation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stored LocalState)
forall a (m :: * -> *). MonadHead a m => m (Stored a)
getLocalHead


conversationName :: Conversation -> Text
conversationName :: Conversation -> Text
conversationName (DirectMessageConversation DirectMessageThread
thread) = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
T.pack String
"<unnamed>") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ComposedIdentity -> Maybe Text
forall (m :: * -> *). Identity m -> Maybe Text
idName (ComposedIdentity -> Maybe Text) -> ComposedIdentity -> Maybe Text
forall a b. (a -> b) -> a -> b
$ DirectMessageThread -> ComposedIdentity
msgPeer DirectMessageThread
thread
conversationName (ChatroomConversation ChatroomState
rstate) = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
T.pack String
"<unnamed>") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Chatroom -> Maybe Text
roomName (Chatroom -> Maybe Text) -> Maybe Chatroom -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
rstate

conversationPeer :: Conversation -> Maybe ComposedIdentity
conversationPeer :: Conversation -> Maybe ComposedIdentity
conversationPeer (DirectMessageConversation DirectMessageThread
thread) = ComposedIdentity -> Maybe ComposedIdentity
forall a. a -> Maybe a
Just (ComposedIdentity -> Maybe ComposedIdentity)
-> ComposedIdentity -> Maybe ComposedIdentity
forall a b. (a -> b) -> a -> b
$ DirectMessageThread -> ComposedIdentity
msgPeer DirectMessageThread
thread
conversationPeer (ChatroomConversation ChatroomState
_) = Maybe ComposedIdentity
forall a. Maybe a
Nothing

conversationHistory :: Conversation -> [Message]
conversationHistory :: Conversation -> [Message]
conversationHistory (DirectMessageConversation DirectMessageThread
thread) = (DirectMessage -> Message) -> [DirectMessage] -> [Message]
forall a b. (a -> b) -> [a] -> [b]
map (\DirectMessage
msg -> DirectMessage -> Bool -> Message
DirectMessageMessage DirectMessage
msg Bool
False) ([DirectMessage] -> [Message]) -> [DirectMessage] -> [Message]
forall a b. (a -> b) -> a -> b
$ DirectMessageThread -> [DirectMessage]
threadToList DirectMessageThread
thread
conversationHistory (ChatroomConversation ChatroomState
rstate) = (ChatMessage -> Message) -> [ChatMessage] -> [Message]
forall a b. (a -> b) -> [a] -> [b]
map (\ChatMessage
msg -> ChatMessage -> Bool -> Message
ChatroomMessage ChatMessage
msg Bool
False) ([ChatMessage] -> [Message]) -> [ChatMessage] -> [Message]
forall a b. (a -> b) -> a -> b
$ ChatroomState -> [ChatMessage]
roomStateMessages ChatroomState
rstate


sendMessage :: (MonadHead LocalState m, MonadError String m) => Conversation -> Text -> m (Maybe Message)
sendMessage :: forall (m :: * -> *).
(MonadHead LocalState m, MonadError String m) =>
Conversation -> Text -> m (Maybe Message)
sendMessage (DirectMessageConversation DirectMessageThread
thread) Text
text = (Message -> Maybe Message) -> m Message -> m (Maybe Message)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Maybe Message
forall a. a -> Maybe a
Just (m Message -> m (Maybe Message)) -> m Message -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ DirectMessage -> Bool -> Message
DirectMessageMessage (DirectMessage -> Bool -> Message)
-> m DirectMessage -> m (Bool -> Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Stored DirectMessage -> DirectMessage
forall a. Stored a -> a
fromStored (Stored DirectMessage -> DirectMessage)
-> m (Stored DirectMessage) -> m DirectMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComposedIdentity -> Text -> m (Stored DirectMessage)
forall (f :: * -> *) (m :: * -> *).
(Foldable f, Applicative f, MonadHead LocalState m,
 MonadError String m) =>
Identity f -> Text -> m (Stored DirectMessage)
sendDirectMessage (DirectMessageThread -> ComposedIdentity
msgPeer DirectMessageThread
thread) Text
text) m (Bool -> Message) -> m Bool -> m Message
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
sendMessage (ChatroomConversation ChatroomState
rstate) Text
text = ChatroomState -> Text -> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
ChatroomState -> Text -> m ()
sendChatroomMessage ChatroomState
rstate Text
text m () -> m (Maybe Message) -> m (Maybe Message)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Message -> m (Maybe Message)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
forall a. Maybe a
Nothing

deleteConversation :: (MonadHead LocalState m, MonadError String m) => Conversation -> m ()
deleteConversation :: forall (m :: * -> *).
(MonadHead LocalState m, MonadError String m) =>
Conversation -> m ()
deleteConversation (DirectMessageConversation DirectMessageThread
_) = String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"deleting direct message conversation is not supported"
deleteConversation (ChatroomConversation ChatroomState
rstate) = Stored ChatroomStateData -> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> m ()
deleteChatroomByStateData ([Stored ChatroomStateData] -> Stored ChatroomStateData
forall a. HasCallStack => [a] -> a
head ([Stored ChatroomStateData] -> Stored ChatroomStateData)
-> [Stored ChatroomStateData] -> Stored ChatroomStateData
forall a b. (a -> b) -> a -> b
$ ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
rstate)