-- | 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 Control.Lens
import Data.Default.Class
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import GHC.Generics
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
[TMention a] -> ShowS
TMention a -> String
(Int -> TMention a -> ShowS)
-> (TMention a -> String)
-> ([TMention a] -> ShowS)
-> Show (TMention a)
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, (forall x. TMention a -> Rep (TMention a) x)
-> (forall x. Rep (TMention a) x -> TMention a)
-> Generic (TMention a)
forall x. Rep (TMention a) x -> TMention a
forall x. TMention a -> Rep (TMention a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TMention a) x -> TMention a
forall a x. TMention a -> Rep (TMention a) x
$cto :: forall a x. Rep (TMention a) x -> TMention a
$cfrom :: forall a x. TMention a -> Rep (TMention a) x
Generic)

{- | 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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "content"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe Text)
     (Maybe Text))
ASetter
  CreateMessageOptions CreateMessageOptions (Maybe Text) (Maybe Text)
#content ASetter
  CreateMessageOptions CreateMessageOptions (Maybe Text) (Maybe Text)
-> (Maybe Text -> Maybe Text)
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "content"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe Text)
     (Maybe Text))
ASetter
  CreateMessageOptions CreateMessageOptions (Maybe Text) (Maybe Text)
#content ASetter
  CreateMessageOptions CreateMessageOptions (Maybe Text) (Maybe Text)
-> (Maybe Text -> Maybe Text)
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t))

-- | Message content, '(<>)' concatenates the content
instance ToMessage String where
  intoMsg :: String -> Endo CreateMessageOptions
intoMsg String
t = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "content"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe Text)
     (Maybe Text))
ASetter
  CreateMessageOptions CreateMessageOptions (Maybe Text) (Maybe Text)
#content ASetter
  CreateMessageOptions CreateMessageOptions (Maybe Text) (Maybe Text)
-> (Maybe Text -> Maybe Text)
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "embeds"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Embed])
     (Maybe [Embed]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Embed])
  (Maybe [Embed])
#embeds ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Embed])
  (Maybe [Embed])
-> (Maybe [Embed] -> Maybe [Embed])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Embed] -> Maybe [Embed] -> Maybe [Embed]
forall a. Semigroup a => a -> a -> a
<> [Embed] -> Maybe [Embed]
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "attachments"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [CreateMessageAttachment])
     (Maybe [CreateMessageAttachment]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [CreateMessageAttachment])
  (Maybe [CreateMessageAttachment])
#attachments ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [CreateMessageAttachment])
  (Maybe [CreateMessageAttachment])
-> (Maybe [CreateMessageAttachment]
    -> Maybe [CreateMessageAttachment])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [CreateMessageAttachment]
-> Maybe [CreateMessageAttachment]
-> Maybe [CreateMessageAttachment]
forall a. Semigroup a => a -> a -> a
<> [CreateMessageAttachment] -> Maybe [CreateMessageAttachment]
forall a. a -> Maybe a
Just [CreateMessageAttachment
a]))

-- | Allowed mentions, '(<>)' combines allowed mentions
instance ToMessage AllowedMentions where
  intoMsg :: AllowedMentions -> Endo CreateMessageOptions
intoMsg AllowedMentions
m = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "allowedMentions"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe AllowedMentions)
     (Maybe AllowedMentions))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe AllowedMentions)
  (Maybe AllowedMentions)
#allowedMentions ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe AllowedMentions)
  (Maybe AllowedMentions)
-> (Maybe AllowedMentions -> Maybe AllowedMentions)
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe AllowedMentions
-> Maybe AllowedMentions -> Maybe AllowedMentions
forall a. Semigroup a => a -> a -> a
<> AllowedMentions -> Maybe AllowedMentions
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) = AllowedMentions -> Endo CreateMessageOptions
forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (Default AllowedMentions => AllowedMentions
forall a. Default a => a
def @AllowedMentions AllowedMentions
-> (AllowedMentions -> AllowedMentions) -> AllowedMentions
forall a b. a -> (a -> b) -> b
& IsLabel
  "users"
  (ASetter
     AllowedMentions AllowedMentions [Snowflake User] [Snowflake User])
ASetter
  AllowedMentions AllowedMentions [Snowflake User] [Snowflake User]
#users ASetter
  AllowedMentions AllowedMentions [Snowflake User] [Snowflake User]
-> [Snowflake User] -> AllowedMentions -> AllowedMentions
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [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) = AllowedMentions -> Endo CreateMessageOptions
forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (Default AllowedMentions => AllowedMentions
forall a. Default a => a
def @AllowedMentions AllowedMentions
-> (AllowedMentions -> AllowedMentions) -> AllowedMentions
forall a b. a -> (a -> b) -> b
& IsLabel
  "users"
  (ASetter
     AllowedMentions AllowedMentions [Snowflake User] [Snowflake User])
ASetter
  AllowedMentions AllowedMentions [Snowflake User] [Snowflake User]
#users ASetter
  AllowedMentions AllowedMentions [Snowflake User] [Snowflake User]
-> [Snowflake User] -> AllowedMentions -> AllowedMentions
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Snowflake Member -> Snowflake User
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) = AllowedMentions -> Endo CreateMessageOptions
forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (Default AllowedMentions => AllowedMentions
forall a. Default a => a
def @AllowedMentions AllowedMentions
-> (AllowedMentions -> AllowedMentions) -> AllowedMentions
forall a b. a -> (a -> b) -> b
& IsLabel
  "roles"
  (ASetter
     AllowedMentions AllowedMentions [Snowflake Role] [Snowflake Role])
ASetter
  AllowedMentions AllowedMentions [Snowflake Role] [Snowflake Role]
#roles ASetter
  AllowedMentions AllowedMentions [Snowflake Role] [Snowflake Role]
-> [Snowflake Role] -> AllowedMentions -> AllowedMentions
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
forall a. a -> Maybe a
Just ((Component -> Component) -> [Component] -> [Component]
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' ([Component] -> Component)
-> ([Button] -> [Component]) -> [Button] -> Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Button -> Component) -> [Button] -> [Component]
forall a b. (a -> b) -> [a] -> [b]
map Button -> Component
Button' ([Button] -> Component) -> [Button] -> Component
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' ([Component] -> Component)
-> ([LinkButton] -> [Component]) -> [LinkButton] -> Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LinkButton -> Component) -> [LinkButton] -> [Component]
forall a b. (a -> b) -> [a] -> [b]
map LinkButton -> Component
LinkButton' ([LinkButton] -> Component) -> [LinkButton] -> Component
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
forall a. a -> Maybe a
Just [[Component] -> Component
ActionRow' ([Component] -> Component)
-> ([Select] -> [Component]) -> [Select] -> Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Select -> Component) -> [Select] -> [Component]
forall a b. (a -> b) -> [a] -> [b]
map Select -> Component
Select' ([Select] -> Component) -> [Select] -> Component
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "components"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe [Component])
     (Maybe [Component]))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
#components ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe [Component])
  (Maybe [Component])
-> (Maybe [Component] -> Maybe [Component])
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe [Component] -> Maybe [Component] -> Maybe [Component]
forall a. Semigroup a => a -> a -> a
<> [Component] -> Maybe [Component]
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 = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "messageReference"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe MessageReference)
     (Maybe MessageReference))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe MessageReference)
  (Maybe MessageReference)
#messageReference ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe MessageReference)
  (Maybe MessageReference)
-> MessageReference -> CreateMessageOptions -> CreateMessageOptions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ MessageReference
ref)

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

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

instance ToMessage CreateMessageOptions where
  intoMsg :: CreateMessageOptions -> Endo CreateMessageOptions
intoMsg = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo ((CreateMessageOptions -> CreateMessageOptions)
 -> Endo CreateMessageOptions)
-> (CreateMessageOptions
    -> CreateMessageOptions -> CreateMessageOptions)
-> CreateMessageOptions
-> Endo CreateMessageOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateMessageOptions
-> CreateMessageOptions -> CreateMessageOptions
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 :: a -> CreateMessageOptions
runToMessage = (Endo CreateMessageOptions
 -> CreateMessageOptions -> CreateMessageOptions)
-> CreateMessageOptions
-> Endo CreateMessageOptions
-> CreateMessageOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo CreateMessageOptions
-> CreateMessageOptions -> CreateMessageOptions
forall a. Endo a -> a -> a
appEndo CreateMessageOptions
forall a. Default a => a
def (Endo CreateMessageOptions -> CreateMessageOptions)
-> (a -> Endo CreateMessageOptions) -> a -> CreateMessageOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Endo CreateMessageOptions
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 :: t -> msg -> Sem r (Either RestError Message)
tell t
target (msg -> CreateMessageOptions
forall a. ToMessage a => a -> CreateMessageOptions
runToMessage -> CreateMessageOptions
msg) = Sem (Error RestError : r) Message
-> Sem r (Either RestError Message)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error RestError : r) Message
 -> Sem r (Either RestError Message))
-> Sem (Error RestError : r) Message
-> Sem r (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ do
  Snowflake Channel
cid <- t -> Sem (Error RestError : r) (Snowflake Channel)
forall a (r :: [(* -> *) -> * -> *]).
(Tellable a, BotC r, Member (Error RestError) r) =>
a -> Sem r (Snowflake Channel)
getChannel t
target
  Either RestError Message
r <- ChannelRequest Message
-> Sem
     (Error RestError : r)
     (Either RestError (Result (ChannelRequest Message)))
forall (r :: [(* -> *) -> * -> *]) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (ChannelRequest Message
 -> Sem
      (Error RestError : r)
      (Either RestError (Result (ChannelRequest Message))))
-> ChannelRequest Message
-> Sem
     (Error RestError : r)
     (Either RestError (Result (ChannelRequest Message)))
forall a b. (a -> b) -> a -> b
$ Snowflake Channel -> CreateMessageOptions -> ChannelRequest Message
forall c.
HasID Channel c =>
c -> CreateMessageOptions -> ChannelRequest Message
CreateMessage Snowflake Channel
cid CreateMessageOptions
msg
  Either RestError Message -> Sem (Error RestError : r) Message
forall e (r :: [(* -> *) -> * -> *]) 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 :: t -> msg -> Sem r (Either RestError Message)
reply t
target msg
msg = Sem (Error RestError : r) Message
-> Sem r (Either RestError Message)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error RestError : r) Message
 -> Sem r (Either RestError Message))
-> Sem (Error RestError : r) Message
-> Sem r (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ do
  let msg' :: CreateMessageOptions
msg' = Endo CreateMessageOptions -> CreateMessageOptions
forall a. ToMessage a => a -> CreateMessageOptions
runToMessage (msg -> Endo CreateMessageOptions
forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg msg
msg Endo CreateMessageOptions
-> Endo CreateMessageOptions -> Endo CreateMessageOptions
forall a. Semigroup a => a -> a -> a
<> MessageReference -> Endo CreateMessageOptions
forall a. ToMessage a => a -> Endo CreateMessageOptions
intoMsg (Maybe (Snowflake Message)
-> Maybe (Snowflake Channel)
-> Maybe (Snowflake Guild)
-> Bool
-> MessageReference
MessageReference (Snowflake Message -> Maybe (Snowflake Message)
forall a. a -> Maybe a
Just (Snowflake Message -> Maybe (Snowflake Message))
-> Snowflake Message -> Maybe (Snowflake Message)
forall a b. (a -> b) -> a -> b
$ t -> Snowflake Message
forall b a. HasID b a => a -> Snowflake b
getID @Message t
target) (Snowflake Channel -> Maybe (Snowflake Channel)
forall a. a -> Maybe a
Just (Snowflake Channel -> Maybe (Snowflake Channel))
-> Snowflake Channel -> Maybe (Snowflake Channel)
forall a b. (a -> b) -> a -> b
$ t -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel t
target) Maybe (Snowflake Guild)
forall a. Maybe a
Nothing Bool
False))
  Either RestError Message
r <- ChannelRequest Message
-> Sem
     (Error RestError : r)
     (Either RestError (Result (ChannelRequest Message)))
forall (r :: [(* -> *) -> * -> *]) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (ChannelRequest Message
 -> Sem
      (Error RestError : r)
      (Either RestError (Result (ChannelRequest Message))))
-> ChannelRequest Message
-> Sem
     (Error RestError : r)
     (Either RestError (Result (ChannelRequest Message)))
forall a b. (a -> b) -> a -> b
$ Snowflake Channel -> CreateMessageOptions -> ChannelRequest Message
forall c.
HasID Channel c =>
c -> CreateMessageOptions -> ChannelRequest Message
CreateMessage (t -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel t
target) CreateMessageOptions
msg'
  Either RestError Message -> Sem (Error RestError : r) Message
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither Either RestError Message
r

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

instance Tellable (Snowflake Channel) where
  getChannel :: Snowflake Channel -> Sem r (Snowflake Channel)
getChannel = Snowflake Channel -> Sem r (Snowflake Channel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

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

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

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

instance Tellable Message where
  getChannel :: Message -> Sem r (Snowflake Channel)
getChannel = Snowflake Channel -> Sem r (Snowflake Channel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snowflake Channel -> Sem r (Snowflake Channel))
-> (Message -> Snowflake Channel)
-> Message
-> Sem r (Snowflake Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Snowflake Channel
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 :: a -> Sem r (Snowflake Channel)
messageUser (forall a. HasID User a => a -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID @User -> Snowflake User
uid) = do
  Either RestError DMChannel
c <- UserRequest DMChannel
-> Sem r (Either RestError (Result (UserRequest DMChannel)))
forall (r :: [(* -> *) -> * -> *]) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (UserRequest DMChannel
 -> Sem r (Either RestError (Result (UserRequest DMChannel))))
-> UserRequest DMChannel
-> Sem r (Either RestError (Result (UserRequest DMChannel)))
forall a b. (a -> b) -> a -> b
$ Snowflake User -> UserRequest DMChannel
forall u. HasID User u => u -> UserRequest DMChannel
CreateDM Snowflake User
uid
  DMChannel -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID (DMChannel -> Snowflake Channel)
-> Sem r DMChannel -> Sem r (Snowflake Channel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RestError DMChannel -> Sem r DMChannel
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither Either RestError DMChannel
c

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

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

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

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