-- | Things that are messageable
module Calamity.Types.Tellable (
  ToMessage (..),
  Tellable (..),
  TMention (..),
  tell,
  reply,
  runToMessage,
) where

import Calamity.Client.Types
import Calamity.HTTP.Channel (
  AllowedMentions,
  ChannelRequest (CreateMessage),
  CreateMessageAttachment,
  CreateMessageOptions,
 )
import Calamity.HTTP.Internal.Request (invoke)
import Calamity.HTTP.Internal.Types (RestError)
import Calamity.HTTP.User (UserRequest (CreateDM))
import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild.Member (Member)
import Calamity.Types.Model.Guild.Role (Role)
import Calamity.Types.Model.User
import Calamity.Types.Snowflake
import Data.Default.Class
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import Optics
import qualified Polysemy as P
import qualified Polysemy.Error as P

-- | A wrapper type for allowing mentions
newtype TMention a = TMention (Snowflake a)
  deriving stock (Int -> TMention a -> ShowS
forall a. Int -> TMention a -> ShowS
forall a. [TMention a] -> ShowS
forall a. TMention a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TMention a] -> ShowS
$cshowList :: forall a. [TMention a] -> ShowS
show :: TMention a -> String
$cshow :: forall a. TMention a -> String
showsPrec :: Int -> TMention a -> ShowS
$cshowsPrec :: forall a. Int -> TMention a -> ShowS
Show)

{- | Things that can be used to send a message

 Can be used to compose text, embeds, and files. /e.g./

 @
 'intoMsg' @'L.Text' "A message" '<>' 'intoMsg' @'Embed' ('def' '&' #description '?~' "Embed description")
 @
-}
class ToMessage a where
  -- | Turn @a@ into a 'CreateMessageOptions' builder
  intoMsg :: a -> Endo CreateMessageOptions

-- | Message content, '(<>)' concatenates the content
instance ToMessage L.Text where
  intoMsg :: Text -> Endo CreateMessageOptions
intoMsg Text
t = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "content" a => a
#content forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just (Text -> Text
L.toStrict Text
t)))

-- | Message content, '(<>)' concatenates the content
instance ToMessage T.Text where
  intoMsg :: Text -> Endo CreateMessageOptions
intoMsg Text
t = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "content" a => a
#content forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just Text
t))

-- | Message content, '(<>)' concatenates the content
instance ToMessage String where
  intoMsg :: String -> Endo CreateMessageOptions
intoMsg String
t = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "content" a => a
#content forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just (String -> Text
T.pack String
t)))

-- | Message embed, '(<>)' appends a new embed
instance ToMessage Embed where
  intoMsg :: Embed -> Endo CreateMessageOptions
intoMsg Embed
e = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "embeds" a => a
#embeds forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [Embed
e]))

-- | Message attachments, '(<>)' appends a new file
instance ToMessage CreateMessageAttachment where
  intoMsg :: CreateMessageAttachment -> Endo CreateMessageOptions
intoMsg CreateMessageAttachment
a = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "attachments" a => a
#attachments forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [CreateMessageAttachment
a]))

-- | Allowed mentions, '(<>)' combines allowed mentions
instance ToMessage AllowedMentions where
  intoMsg :: AllowedMentions -> Endo CreateMessageOptions
intoMsg AllowedMentions
m = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "allowedMentions" a => a
#allowedMentions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just AllowedMentions
m))

-- | Add a 'User' id to the list of allowed user mentions
instance ToMessage (TMention User) where
  intoMsg :: TMention User -> Endo CreateMessageOptions
intoMsg (TMention Snowflake User
s) = forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (forall a. Default a => a
def @AllowedMentions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "users" a => a
#users forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> [Snowflake User
s]))

-- | Add a 'Member' id to the list of allowed user mentions
instance ToMessage (TMention Member) where
  intoMsg :: TMention Member -> Endo CreateMessageOptions
intoMsg (TMention Snowflake Member
s) = forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (forall a. Default a => a
def @AllowedMentions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "users" a => a
#users forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> [forall a b. Snowflake a -> Snowflake b
coerceSnowflake Snowflake Member
s]))

-- | Add a 'Role' id to the list of allowed role mentions
instance ToMessage (TMention Role) where
  intoMsg :: TMention Role -> Endo CreateMessageOptions
intoMsg (TMention Snowflake Role
s) = forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (forall a. Default a => a
def @AllowedMentions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "roles" a => a
#roles forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> [Snowflake Role
s]))

fixupActionRow :: Component -> Component
fixupActionRow :: Component -> Component
fixupActionRow r :: Component
r@(ActionRow' [Component]
_) = Component
r
fixupActionRow Component
x = [Component] -> Component
ActionRow' [Component
x]

{- | Add many components to a message.

 Each component will be wrapped in a singleton ActionRow if not already
-}
instance ToMessage [Component] where
  intoMsg :: [Component] -> Endo CreateMessageOptions
intoMsg [Component]
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
map Component -> Component
fixupActionRow [Component]
c)))

-- | Add an row of 'Button's to the message
instance ToMessage [Button] where
  intoMsg :: [Button] -> Endo CreateMessageOptions
intoMsg [Button]
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Button -> Component
Button' forall a b. (a -> b) -> a -> b
$ [Button]
c]))

-- | Add an row of 'LinkButton's to the message
instance ToMessage [LinkButton] where
  intoMsg :: [LinkButton] -> Endo CreateMessageOptions
intoMsg [LinkButton]
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map LinkButton -> Component
LinkButton' forall a b. (a -> b) -> a -> b
$ [LinkButton]
c]))

-- | Add an row of 'Select's to the message
instance ToMessage [Select] where
  intoMsg :: [Select] -> Endo CreateMessageOptions
intoMsg [Select]
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Select -> Component
Select' forall a b. (a -> b) -> a -> b
$ [Select]
c]))

{- | Add a singleton row containing a 'Component' to the message

 If the component is not already an actionrow, it is wrapped in a singleton row
-}
instance ToMessage Component where
  intoMsg :: Component -> Endo CreateMessageOptions
intoMsg Component
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [Component -> Component
fixupActionRow Component
c]))

-- | Add a singleton row containing a 'Button' to the message,
instance ToMessage Button where
  intoMsg :: Button -> Endo CreateMessageOptions
intoMsg Button
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' [Button -> Component
Button' Button
c]]))

-- | Add a singleton row containing a 'LinkButton' to the message,
instance ToMessage LinkButton where
  intoMsg :: LinkButton -> Endo CreateMessageOptions
intoMsg LinkButton
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' [LinkButton -> Component
LinkButton' LinkButton
c]]))

-- | Add a singleton row containing a 'Select' to the message,
instance ToMessage Select where
  intoMsg :: Select -> Endo CreateMessageOptions
intoMsg Select
c = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "components" a => a
#components forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' [Select -> Component
Select' Select
c]]))

-- | Set a 'MessageReference' as the message to reply to
instance ToMessage MessageReference where
  intoMsg :: MessageReference -> Endo CreateMessageOptions
intoMsg MessageReference
ref = forall a. (a -> a) -> Endo a
Endo (forall a. IsLabel "messageReference" a => a
#messageReference forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ MessageReference
ref)

instance ToMessage (Endo CreateMessageOptions) where
  intoMsg :: Endo CreateMessageOptions -> Endo CreateMessageOptions
intoMsg = forall a. a -> a
Prelude.id

instance ToMessage (CreateMessageOptions -> CreateMessageOptions) where
  intoMsg :: (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
intoMsg = forall a. (a -> a) -> Endo a
Endo

instance ToMessage CreateMessageOptions where
  intoMsg :: CreateMessageOptions -> Endo CreateMessageOptions
intoMsg = forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

class Tellable a where
  getChannel :: (BotC r, P.Member (P.Error RestError) r) => a -> P.Sem r (Snowflake Channel)

runToMessage :: ToMessage a => a -> CreateMessageOptions
runToMessage :: forall a. ToMessage a => a -> CreateMessageOptions
runToMessage = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg

{- | Send a message to something that is messageable

 To send a string literal you'll probably want to use @TypeApplication@ to
 specify the type of @msg@

 ==== Examples

 Sending a string:

 @
 'void' $ 'tell' @'Text' m ("Somebody told me to tell you about: " '<>' s)
 @
-}
tell :: forall msg r t. (BotC r, ToMessage msg, Tellable t) => t -> msg -> P.Sem r (Either RestError Message)
tell :: forall msg (r :: EffectRow) t.
(BotC r, ToMessage msg, Tellable t) =>
t -> msg -> Sem r (Either RestError Message)
tell t
target (forall a. ToMessage a => a -> CreateMessageOptions
runToMessage -> CreateMessageOptions
msg) = forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError forall a b. (a -> b) -> a -> b
$ do
  Snowflake Channel
cid <- forall a (r :: EffectRow).
(Tellable a, BotC r, Member (Error RestError) r) =>
a -> Sem r (Snowflake Channel)
getChannel t
target
  Either RestError Message
r <- forall (r :: EffectRow) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke forall a b. (a -> b) -> a -> b
$ forall c.
HasID Channel c =>
c -> CreateMessageOptions -> ChannelRequest Message
CreateMessage Snowflake Channel
cid CreateMessageOptions
msg
  forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither Either RestError Message
r

{- | Create a reply to an existing message in the same channel

 To send a string literal you'll probably want to use @TypeApplication@ to
 specify the type of @msg@

 ==== Examples

 Sending a string:

 @
 'void' $ 'reply' @'Text' msgToReplyTo ("Somebody told me to tell you about: " '<>' s)
 @
-}
reply :: forall msg r t. (BotC r, ToMessage msg, HasID Channel t, HasID Message t) => t -> msg -> P.Sem r (Either RestError Message)
reply :: forall msg (r :: EffectRow) t.
(BotC r, ToMessage msg, HasID Channel t, HasID Message t) =>
t -> msg -> Sem r (Either RestError Message)
reply t
target msg
msg = forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError forall a b. (a -> b) -> a -> b
$ do
  let msg' :: CreateMessageOptions
msg' = forall a. ToMessage a => a -> CreateMessageOptions
runToMessage (forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg msg
msg forall a. Semigroup a => a -> a -> a
<> forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (Maybe (Snowflake Message)
-> Maybe (Snowflake Channel)
-> Maybe (Snowflake Guild)
-> Bool
-> MessageReference
MessageReference (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. HasID b a => a -> Snowflake b
getID @Message t
target) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. HasID b a => a -> Snowflake b
getID @Channel t
target) forall a. Maybe a
Nothing Bool
False))
  Either RestError Message
r <- forall (r :: EffectRow) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke forall a b. (a -> b) -> a -> b
$ forall c.
HasID Channel c =>
c -> CreateMessageOptions -> ChannelRequest Message
CreateMessage (forall b a. HasID b a => a -> Snowflake b
getID @Channel t
target) CreateMessageOptions
msg'
  forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither Either RestError Message
r

instance Tellable DMChannel where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
DMChannel -> Sem r (Snowflake Channel)
getChannel = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. HasID b a => a -> Snowflake b
getID

instance Tellable (Snowflake Channel) where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Snowflake Channel -> Sem r (Snowflake Channel)
getChannel = forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Tellable Channel where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Channel -> Sem r (Snowflake Channel)
getChannel = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. HasID b a => a -> Snowflake b
getID

instance Tellable (Snowflake DMChannel) where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Snowflake DMChannel -> Sem r (Snowflake Channel)
getChannel = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Snowflake a -> Snowflake b
coerceSnowflake

instance Tellable TextChannel where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
TextChannel -> Sem r (Snowflake Channel)
getChannel = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. HasID b a => a -> Snowflake b
getID

instance Tellable (Snowflake TextChannel) where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Snowflake TextChannel -> Sem r (Snowflake Channel)
getChannel = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Snowflake a -> Snowflake b
coerceSnowflake

instance Tellable Message where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Message -> Sem r (Snowflake Channel)
getChannel = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. HasID b a => a -> Snowflake b
getID

messageUser :: (BotC r, P.Member (P.Error RestError) r, HasID User a) => a -> P.Sem r (Snowflake Channel)
messageUser :: forall (r :: EffectRow) a.
(BotC r, Member (Error RestError) r, HasID User a) =>
a -> Sem r (Snowflake Channel)
messageUser (forall b a. HasID b a => a -> Snowflake b
getID @User -> Snowflake User
uid) = do
  Either RestError DMChannel
c <- forall (r :: EffectRow) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke forall a b. (a -> b) -> a -> b
$ forall u. HasID User u => u -> UserRequest DMChannel
CreateDM Snowflake User
uid
  forall b a. HasID b a => a -> Snowflake b
getID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither Either RestError DMChannel
c

instance Tellable (Snowflake Member) where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Snowflake Member -> Sem r (Snowflake Channel)
getChannel = forall (r :: EffectRow) a.
(BotC r, Member (Error RestError) r, HasID User a) =>
a -> Sem r (Snowflake Channel)
messageUser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @User

instance Tellable Member where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Member -> Sem r (Snowflake Channel)
getChannel = forall (r :: EffectRow) a.
(BotC r, Member (Error RestError) r, HasID User a) =>
a -> Sem r (Snowflake Channel)
messageUser

instance Tellable User where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
User -> Sem r (Snowflake Channel)
getChannel = forall (r :: EffectRow) a.
(BotC r, Member (Error RestError) r, HasID User a) =>
a -> Sem r (Snowflake Channel)
messageUser

instance Tellable (Snowflake User) where
  getChannel :: forall (r :: EffectRow).
(BotC r, Member (Error RestError) r) =>
Snowflake User -> Sem r (Snowflake Channel)
getChannel = forall (r :: EffectRow) a.
(BotC r, Member (Error RestError) r, HasID User a) =>
a -> Sem r (Snowflake Channel)
messageUser