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

import           Calamity.Client.Types
import           Calamity.HTTP
import           Calamity.Types.Model.Channel
import           Calamity.Types.Model.Guild
import           Calamity.Types.Model.User
import           Calamity.Types.Snowflake

import           Control.Lens

import           Data.ByteString.Lazy         ( ByteString )
import           Data.Default.Class
import           Data.Monoid
import qualified Data.Text                    as S
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 sending files
newtype TFile = TFile ByteString
  deriving ( Int -> TFile -> ShowS
[TFile] -> ShowS
TFile -> String
(Int -> TFile -> ShowS)
-> (TFile -> String) -> ([TFile] -> ShowS) -> Show TFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TFile] -> ShowS
$cshowList :: [TFile] -> ShowS
show :: TFile -> String
$cshow :: TFile -> String
showsPrec :: Int -> TFile -> ShowS
$cshowsPrec :: Int -> TFile -> ShowS
Show, (forall x. TFile -> Rep TFile x)
-> (forall x. Rep TFile x -> TFile) -> Generic TFile
forall x. Rep TFile x -> TFile
forall x. TFile -> Rep TFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TFile x -> TFile
$cfrom :: forall x. TFile -> Rep TFile 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 t :: 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 S.Text where
  intoMsg :: Text -> Endo CreateMessageOptions
intoMsg t :: 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 t :: 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
S.pack String
t)))

-- | Message embed, '(<>)' merges embeds using '(<>)'
instance ToMessage Embed where
  intoMsg :: Embed -> Endo CreateMessageOptions
intoMsg e :: Embed
e = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "embed"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe Embed)
     (Maybe Embed))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe Embed)
  (Maybe Embed)
#embed 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 file, '(<>)' keeps the last added file
instance ToMessage TFile where
  intoMsg :: TFile -> Endo CreateMessageOptions
intoMsg (TFile f :: ByteString
f) = (CreateMessageOptions -> CreateMessageOptions)
-> Endo CreateMessageOptions
forall a. (a -> a) -> Endo a
Endo (IsLabel
  "file"
  (ASetter
     CreateMessageOptions
     CreateMessageOptions
     (Maybe ByteString)
     (Maybe ByteString))
ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe ByteString)
  (Maybe ByteString)
#file ASetter
  CreateMessageOptions
  CreateMessageOptions
  (Maybe ByteString)
  (Maybe ByteString)
-> (Maybe ByteString -> Maybe ByteString)
-> CreateMessageOptions
-> CreateMessageOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Last ByteString -> Maybe ByteString
forall a. Last a -> Maybe a
getLast (Last ByteString -> Maybe ByteString)
-> (Maybe ByteString -> Last ByteString)
-> Maybe ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Last ByteString -> Last ByteString -> Last ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> Last ByteString
forall a. Maybe a -> Last a
Last (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
f)) (Last ByteString -> Last ByteString)
-> (Maybe ByteString -> Last ByteString)
-> Maybe ByteString
-> Last ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> Last ByteString
forall a. Maybe a -> Last a
Last)

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 target :: 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 Message)
forall a (r :: [(* -> *) -> * -> *]).
(Request a, BotC r, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (ChannelRequest Message
 -> Sem (Error RestError : r) (Either RestError Message))
-> ChannelRequest Message
-> Sem (Error RestError : r) (Either RestError 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

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 DMChannel)
forall a (r :: [(* -> *) -> * -> *]).
(Request a, BotC r, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (UserRequest DMChannel -> Sem r (Either RestError DMChannel))
-> UserRequest DMChannel -> Sem r (Either RestError 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