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

    Conversation,
    directMessageConversation,
    reloadConversation,
    lookupConversations,

    conversationName,
    conversationPeer,
    conversationHistory,

    sendMessage,
) where

import Control.Monad.Except

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

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


data Message = DirectMessageMessage DirectMessage Bool

messageFrom :: Message -> ComposedIdentity
messageFrom :: Message -> ComposedIdentity
messageFrom (DirectMessageMessage DirectMessage
msg Bool
_) = DirectMessage -> ComposedIdentity
msgFrom DirectMessage
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

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

formatMessage :: TimeZone -> Message -> String
formatMessage :: TimeZone -> Message -> String
formatMessage TimeZone
tzone (DirectMessageMessage DirectMessage
msg Bool
_) = TimeZone -> DirectMessage -> String
formatDirectMessage TimeZone
tzone DirectMessage
msg


data Conversation = DirectMessageConversation DirectMessageThread

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 [] [] []

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)

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

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

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


sendMessage :: (MonadHead LocalState m, MonadError String m) => Conversation -> Text -> m Message
sendMessage :: forall (m :: * -> *).
(MonadHead LocalState m, MonadError String m) =>
Conversation -> Text -> m Message
sendMessage (DirectMessageConversation DirectMessageThread
thread) Text
text = 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