{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}

-- | Data structures needed for interfacing with the Websocket
--   Gateway
module Discord.Internal.Types.Gateway where

import System.Info

import qualified Data.Text as T
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Aeson
import Data.Aeson.Types
import Data.Maybe (fromMaybe)
import Data.Functor
import Text.Read (readMaybe)

import Discord.Internal.Types.Prelude
import Discord.Internal.Types.Events

-- | Represents data sent and received with Discord servers
data GatewayReceivable
  = Dispatch Event Integer
  | HeartbeatRequest Integer
  | Reconnect
  | InvalidSession Bool
  | Hello Int
  | HeartbeatAck
  | ParseError T.Text
  deriving (Int -> GatewayReceivable -> ShowS
[GatewayReceivable] -> ShowS
GatewayReceivable -> String
(Int -> GatewayReceivable -> ShowS)
-> (GatewayReceivable -> String)
-> ([GatewayReceivable] -> ShowS)
-> Show GatewayReceivable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewayReceivable] -> ShowS
$cshowList :: [GatewayReceivable] -> ShowS
show :: GatewayReceivable -> String
$cshow :: GatewayReceivable -> String
showsPrec :: Int -> GatewayReceivable -> ShowS
$cshowsPrec :: Int -> GatewayReceivable -> ShowS
Show, GatewayReceivable -> GatewayReceivable -> Bool
(GatewayReceivable -> GatewayReceivable -> Bool)
-> (GatewayReceivable -> GatewayReceivable -> Bool)
-> Eq GatewayReceivable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GatewayReceivable -> GatewayReceivable -> Bool
$c/= :: GatewayReceivable -> GatewayReceivable -> Bool
== :: GatewayReceivable -> GatewayReceivable -> Bool
$c== :: GatewayReceivable -> GatewayReceivable -> Bool
Eq)

data GatewaySendable
  = Heartbeat Integer
  | Identify Auth Bool Integer (Int, Int)
  | Resume T.Text T.Text Integer
  | RequestGuildMembers RequestGuildMembersOpts
  | UpdateStatus UpdateStatusOpts
  | UpdateStatusVoice UpdateStatusVoiceOpts
  deriving (Int -> GatewaySendable -> ShowS
[GatewaySendable] -> ShowS
GatewaySendable -> String
(Int -> GatewaySendable -> ShowS)
-> (GatewaySendable -> String)
-> ([GatewaySendable] -> ShowS)
-> Show GatewaySendable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewaySendable] -> ShowS
$cshowList :: [GatewaySendable] -> ShowS
show :: GatewaySendable -> String
$cshow :: GatewaySendable -> String
showsPrec :: Int -> GatewaySendable -> ShowS
$cshowsPrec :: Int -> GatewaySendable -> ShowS
Show, GatewaySendable -> GatewaySendable -> Bool
(GatewaySendable -> GatewaySendable -> Bool)
-> (GatewaySendable -> GatewaySendable -> Bool)
-> Eq GatewaySendable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GatewaySendable -> GatewaySendable -> Bool
$c/= :: GatewaySendable -> GatewaySendable -> Bool
== :: GatewaySendable -> GatewaySendable -> Bool
$c== :: GatewaySendable -> GatewaySendable -> Bool
Eq, Eq GatewaySendable
Eq GatewaySendable
-> (GatewaySendable -> GatewaySendable -> Ordering)
-> (GatewaySendable -> GatewaySendable -> Bool)
-> (GatewaySendable -> GatewaySendable -> Bool)
-> (GatewaySendable -> GatewaySendable -> Bool)
-> (GatewaySendable -> GatewaySendable -> Bool)
-> (GatewaySendable -> GatewaySendable -> GatewaySendable)
-> (GatewaySendable -> GatewaySendable -> GatewaySendable)
-> Ord GatewaySendable
GatewaySendable -> GatewaySendable -> Bool
GatewaySendable -> GatewaySendable -> Ordering
GatewaySendable -> GatewaySendable -> GatewaySendable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GatewaySendable -> GatewaySendable -> GatewaySendable
$cmin :: GatewaySendable -> GatewaySendable -> GatewaySendable
max :: GatewaySendable -> GatewaySendable -> GatewaySendable
$cmax :: GatewaySendable -> GatewaySendable -> GatewaySendable
>= :: GatewaySendable -> GatewaySendable -> Bool
$c>= :: GatewaySendable -> GatewaySendable -> Bool
> :: GatewaySendable -> GatewaySendable -> Bool
$c> :: GatewaySendable -> GatewaySendable -> Bool
<= :: GatewaySendable -> GatewaySendable -> Bool
$c<= :: GatewaySendable -> GatewaySendable -> Bool
< :: GatewaySendable -> GatewaySendable -> Bool
$c< :: GatewaySendable -> GatewaySendable -> Bool
compare :: GatewaySendable -> GatewaySendable -> Ordering
$ccompare :: GatewaySendable -> GatewaySendable -> Ordering
$cp1Ord :: Eq GatewaySendable
Ord)

data RequestGuildMembersOpts = RequestGuildMembersOpts
                             { RequestGuildMembersOpts -> GuildId
requestGuildMembersOptsGuildId :: GuildId
                             , RequestGuildMembersOpts -> Text
requestGuildMembersOptsNamesStartingWith :: T.Text
                             , RequestGuildMembersOpts -> Integer
requestGuildMembersOptsLimit :: Integer }
  deriving (Int -> RequestGuildMembersOpts -> ShowS
[RequestGuildMembersOpts] -> ShowS
RequestGuildMembersOpts -> String
(Int -> RequestGuildMembersOpts -> ShowS)
-> (RequestGuildMembersOpts -> String)
-> ([RequestGuildMembersOpts] -> ShowS)
-> Show RequestGuildMembersOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestGuildMembersOpts] -> ShowS
$cshowList :: [RequestGuildMembersOpts] -> ShowS
show :: RequestGuildMembersOpts -> String
$cshow :: RequestGuildMembersOpts -> String
showsPrec :: Int -> RequestGuildMembersOpts -> ShowS
$cshowsPrec :: Int -> RequestGuildMembersOpts -> ShowS
Show, RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
(RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool)
-> (RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool)
-> Eq RequestGuildMembersOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c/= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
== :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c== :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
Eq, Eq RequestGuildMembersOpts
Eq RequestGuildMembersOpts
-> (RequestGuildMembersOpts -> RequestGuildMembersOpts -> Ordering)
-> (RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool)
-> (RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool)
-> (RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool)
-> (RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool)
-> (RequestGuildMembersOpts
    -> RequestGuildMembersOpts -> RequestGuildMembersOpts)
-> (RequestGuildMembersOpts
    -> RequestGuildMembersOpts -> RequestGuildMembersOpts)
-> Ord RequestGuildMembersOpts
RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
RequestGuildMembersOpts -> RequestGuildMembersOpts -> Ordering
RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
$cmin :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
max :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
$cmax :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
>= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c>= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
> :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c> :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
<= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c<= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
< :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c< :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
compare :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Ordering
$ccompare :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Ordering
$cp1Ord :: Eq RequestGuildMembersOpts
Ord)

data UpdateStatusVoiceOpts = UpdateStatusVoiceOpts
                           { UpdateStatusVoiceOpts -> GuildId
updateStatusVoiceOptsGuildId :: GuildId
                           , UpdateStatusVoiceOpts -> Maybe GuildId
updateStatusVoiceOptsChannelId :: Maybe ChannelId
                           , UpdateStatusVoiceOpts -> Bool
updateStatusVoiceOptsIsMuted :: Bool
                           , UpdateStatusVoiceOpts -> Bool
updateStatusVoiceOptsIsDeaf :: Bool
                           }
  deriving (Int -> UpdateStatusVoiceOpts -> ShowS
[UpdateStatusVoiceOpts] -> ShowS
UpdateStatusVoiceOpts -> String
(Int -> UpdateStatusVoiceOpts -> ShowS)
-> (UpdateStatusVoiceOpts -> String)
-> ([UpdateStatusVoiceOpts] -> ShowS)
-> Show UpdateStatusVoiceOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStatusVoiceOpts] -> ShowS
$cshowList :: [UpdateStatusVoiceOpts] -> ShowS
show :: UpdateStatusVoiceOpts -> String
$cshow :: UpdateStatusVoiceOpts -> String
showsPrec :: Int -> UpdateStatusVoiceOpts -> ShowS
$cshowsPrec :: Int -> UpdateStatusVoiceOpts -> ShowS
Show, UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
(UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool)
-> (UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool)
-> Eq UpdateStatusVoiceOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c/= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
== :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c== :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
Eq, Eq UpdateStatusVoiceOpts
Eq UpdateStatusVoiceOpts
-> (UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Ordering)
-> (UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool)
-> (UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool)
-> (UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool)
-> (UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool)
-> (UpdateStatusVoiceOpts
    -> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts)
-> (UpdateStatusVoiceOpts
    -> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts)
-> Ord UpdateStatusVoiceOpts
UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Ordering
UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
$cmin :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
max :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
$cmax :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
>= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c>= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
> :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c> :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
<= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c<= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
< :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c< :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
compare :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Ordering
$ccompare :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Ordering
$cp1Ord :: Eq UpdateStatusVoiceOpts
Ord)

data UpdateStatusOpts = UpdateStatusOpts
                      { UpdateStatusOpts -> Maybe UTCTime
updateStatusOptsSince :: Maybe UTCTime
                      , UpdateStatusOpts -> Maybe Activity
updateStatusOptsGame :: Maybe Activity
                      , UpdateStatusOpts -> UpdateStatusType
updateStatusOptsNewStatus :: UpdateStatusType
                      , UpdateStatusOpts -> Bool
updateStatusOptsAFK :: Bool
                      }
  deriving (Int -> UpdateStatusOpts -> ShowS
[UpdateStatusOpts] -> ShowS
UpdateStatusOpts -> String
(Int -> UpdateStatusOpts -> ShowS)
-> (UpdateStatusOpts -> String)
-> ([UpdateStatusOpts] -> ShowS)
-> Show UpdateStatusOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStatusOpts] -> ShowS
$cshowList :: [UpdateStatusOpts] -> ShowS
show :: UpdateStatusOpts -> String
$cshow :: UpdateStatusOpts -> String
showsPrec :: Int -> UpdateStatusOpts -> ShowS
$cshowsPrec :: Int -> UpdateStatusOpts -> ShowS
Show, UpdateStatusOpts -> UpdateStatusOpts -> Bool
(UpdateStatusOpts -> UpdateStatusOpts -> Bool)
-> (UpdateStatusOpts -> UpdateStatusOpts -> Bool)
-> Eq UpdateStatusOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c/= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
== :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c== :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
Eq, Eq UpdateStatusOpts
Eq UpdateStatusOpts
-> (UpdateStatusOpts -> UpdateStatusOpts -> Ordering)
-> (UpdateStatusOpts -> UpdateStatusOpts -> Bool)
-> (UpdateStatusOpts -> UpdateStatusOpts -> Bool)
-> (UpdateStatusOpts -> UpdateStatusOpts -> Bool)
-> (UpdateStatusOpts -> UpdateStatusOpts -> Bool)
-> (UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts)
-> (UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts)
-> Ord UpdateStatusOpts
UpdateStatusOpts -> UpdateStatusOpts -> Bool
UpdateStatusOpts -> UpdateStatusOpts -> Ordering
UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
$cmin :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
max :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
$cmax :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
>= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c>= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
> :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c> :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
<= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c<= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
< :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c< :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
compare :: UpdateStatusOpts -> UpdateStatusOpts -> Ordering
$ccompare :: UpdateStatusOpts -> UpdateStatusOpts -> Ordering
$cp1Ord :: Eq UpdateStatusOpts
Ord)

data Activity = Activity
              { Activity -> Text
activityName :: T.Text
              , Activity -> ActivityType
activityType :: ActivityType
              , Activity -> Maybe Text
activityUrl :: Maybe T.Text
              }
  deriving (Int -> Activity -> ShowS
[Activity] -> ShowS
Activity -> String
(Int -> Activity -> ShowS)
-> (Activity -> String) -> ([Activity] -> ShowS) -> Show Activity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Activity] -> ShowS
$cshowList :: [Activity] -> ShowS
show :: Activity -> String
$cshow :: Activity -> String
showsPrec :: Int -> Activity -> ShowS
$cshowsPrec :: Int -> Activity -> ShowS
Show, Activity -> Activity -> Bool
(Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool) -> Eq Activity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Activity -> Activity -> Bool
$c/= :: Activity -> Activity -> Bool
== :: Activity -> Activity -> Bool
$c== :: Activity -> Activity -> Bool
Eq, Eq Activity
Eq Activity
-> (Activity -> Activity -> Ordering)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Activity)
-> (Activity -> Activity -> Activity)
-> Ord Activity
Activity -> Activity -> Bool
Activity -> Activity -> Ordering
Activity -> Activity -> Activity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Activity -> Activity -> Activity
$cmin :: Activity -> Activity -> Activity
max :: Activity -> Activity -> Activity
$cmax :: Activity -> Activity -> Activity
>= :: Activity -> Activity -> Bool
$c>= :: Activity -> Activity -> Bool
> :: Activity -> Activity -> Bool
$c> :: Activity -> Activity -> Bool
<= :: Activity -> Activity -> Bool
$c<= :: Activity -> Activity -> Bool
< :: Activity -> Activity -> Bool
$c< :: Activity -> Activity -> Bool
compare :: Activity -> Activity -> Ordering
$ccompare :: Activity -> Activity -> Ordering
$cp1Ord :: Eq Activity
Ord)

data ActivityType = ActivityTypeGame
                  | ActivityTypeStreaming
                  | ActivityTypeListening
                  | ActivityTypeCompeting
  deriving (Int -> ActivityType -> ShowS
[ActivityType] -> ShowS
ActivityType -> String
(Int -> ActivityType -> ShowS)
-> (ActivityType -> String)
-> ([ActivityType] -> ShowS)
-> Show ActivityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityType] -> ShowS
$cshowList :: [ActivityType] -> ShowS
show :: ActivityType -> String
$cshow :: ActivityType -> String
showsPrec :: Int -> ActivityType -> ShowS
$cshowsPrec :: Int -> ActivityType -> ShowS
Show, ActivityType -> ActivityType -> Bool
(ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool) -> Eq ActivityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityType -> ActivityType -> Bool
$c/= :: ActivityType -> ActivityType -> Bool
== :: ActivityType -> ActivityType -> Bool
$c== :: ActivityType -> ActivityType -> Bool
Eq, Eq ActivityType
Eq ActivityType
-> (ActivityType -> ActivityType -> Ordering)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> ActivityType)
-> (ActivityType -> ActivityType -> ActivityType)
-> Ord ActivityType
ActivityType -> ActivityType -> Bool
ActivityType -> ActivityType -> Ordering
ActivityType -> ActivityType -> ActivityType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActivityType -> ActivityType -> ActivityType
$cmin :: ActivityType -> ActivityType -> ActivityType
max :: ActivityType -> ActivityType -> ActivityType
$cmax :: ActivityType -> ActivityType -> ActivityType
>= :: ActivityType -> ActivityType -> Bool
$c>= :: ActivityType -> ActivityType -> Bool
> :: ActivityType -> ActivityType -> Bool
$c> :: ActivityType -> ActivityType -> Bool
<= :: ActivityType -> ActivityType -> Bool
$c<= :: ActivityType -> ActivityType -> Bool
< :: ActivityType -> ActivityType -> Bool
$c< :: ActivityType -> ActivityType -> Bool
compare :: ActivityType -> ActivityType -> Ordering
$ccompare :: ActivityType -> ActivityType -> Ordering
$cp1Ord :: Eq ActivityType
Ord)

activityTypeId :: ActivityType -> Int
activityTypeId :: ActivityType -> Int
activityTypeId ActivityType
a = case ActivityType
a of ActivityType
ActivityTypeGame -> Int
0
                             ActivityType
ActivityTypeStreaming -> Int
1
                             ActivityType
ActivityTypeListening -> Int
2
                             ActivityType
ActivityTypeCompeting -> Int
5

data UpdateStatusType = UpdateStatusOnline
                      | UpdateStatusDoNotDisturb
                      | UpdateStatusAwayFromKeyboard
                      | UpdateStatusInvisibleOffline
                      | UpdateStatusOffline
  deriving (Int -> UpdateStatusType -> ShowS
[UpdateStatusType] -> ShowS
UpdateStatusType -> String
(Int -> UpdateStatusType -> ShowS)
-> (UpdateStatusType -> String)
-> ([UpdateStatusType] -> ShowS)
-> Show UpdateStatusType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStatusType] -> ShowS
$cshowList :: [UpdateStatusType] -> ShowS
show :: UpdateStatusType -> String
$cshow :: UpdateStatusType -> String
showsPrec :: Int -> UpdateStatusType -> ShowS
$cshowsPrec :: Int -> UpdateStatusType -> ShowS
Show, UpdateStatusType -> UpdateStatusType -> Bool
(UpdateStatusType -> UpdateStatusType -> Bool)
-> (UpdateStatusType -> UpdateStatusType -> Bool)
-> Eq UpdateStatusType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStatusType -> UpdateStatusType -> Bool
$c/= :: UpdateStatusType -> UpdateStatusType -> Bool
== :: UpdateStatusType -> UpdateStatusType -> Bool
$c== :: UpdateStatusType -> UpdateStatusType -> Bool
Eq, Eq UpdateStatusType
Eq UpdateStatusType
-> (UpdateStatusType -> UpdateStatusType -> Ordering)
-> (UpdateStatusType -> UpdateStatusType -> Bool)
-> (UpdateStatusType -> UpdateStatusType -> Bool)
-> (UpdateStatusType -> UpdateStatusType -> Bool)
-> (UpdateStatusType -> UpdateStatusType -> Bool)
-> (UpdateStatusType -> UpdateStatusType -> UpdateStatusType)
-> (UpdateStatusType -> UpdateStatusType -> UpdateStatusType)
-> Ord UpdateStatusType
UpdateStatusType -> UpdateStatusType -> Bool
UpdateStatusType -> UpdateStatusType -> Ordering
UpdateStatusType -> UpdateStatusType -> UpdateStatusType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
$cmin :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
max :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
$cmax :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
>= :: UpdateStatusType -> UpdateStatusType -> Bool
$c>= :: UpdateStatusType -> UpdateStatusType -> Bool
> :: UpdateStatusType -> UpdateStatusType -> Bool
$c> :: UpdateStatusType -> UpdateStatusType -> Bool
<= :: UpdateStatusType -> UpdateStatusType -> Bool
$c<= :: UpdateStatusType -> UpdateStatusType -> Bool
< :: UpdateStatusType -> UpdateStatusType -> Bool
$c< :: UpdateStatusType -> UpdateStatusType -> Bool
compare :: UpdateStatusType -> UpdateStatusType -> Ordering
$ccompare :: UpdateStatusType -> UpdateStatusType -> Ordering
$cp1Ord :: Eq UpdateStatusType
Ord, Int -> UpdateStatusType
UpdateStatusType -> Int
UpdateStatusType -> [UpdateStatusType]
UpdateStatusType -> UpdateStatusType
UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
UpdateStatusType
-> UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
(UpdateStatusType -> UpdateStatusType)
-> (UpdateStatusType -> UpdateStatusType)
-> (Int -> UpdateStatusType)
-> (UpdateStatusType -> Int)
-> (UpdateStatusType -> [UpdateStatusType])
-> (UpdateStatusType -> UpdateStatusType -> [UpdateStatusType])
-> (UpdateStatusType -> UpdateStatusType -> [UpdateStatusType])
-> (UpdateStatusType
    -> UpdateStatusType -> UpdateStatusType -> [UpdateStatusType])
-> Enum UpdateStatusType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UpdateStatusType
-> UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
$cenumFromThenTo :: UpdateStatusType
-> UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
enumFromTo :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
$cenumFromTo :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
enumFromThen :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
$cenumFromThen :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
enumFrom :: UpdateStatusType -> [UpdateStatusType]
$cenumFrom :: UpdateStatusType -> [UpdateStatusType]
fromEnum :: UpdateStatusType -> Int
$cfromEnum :: UpdateStatusType -> Int
toEnum :: Int -> UpdateStatusType
$ctoEnum :: Int -> UpdateStatusType
pred :: UpdateStatusType -> UpdateStatusType
$cpred :: UpdateStatusType -> UpdateStatusType
succ :: UpdateStatusType -> UpdateStatusType
$csucc :: UpdateStatusType -> UpdateStatusType
Enum)

statusString :: UpdateStatusType -> T.Text
statusString :: UpdateStatusType -> Text
statusString UpdateStatusType
s = case UpdateStatusType
s of
  UpdateStatusType
UpdateStatusOnline -> Text
"online"
  UpdateStatusType
UpdateStatusDoNotDisturb -> Text
"dnd"
  UpdateStatusType
UpdateStatusAwayFromKeyboard -> Text
"idle"
  UpdateStatusType
UpdateStatusInvisibleOffline -> Text
"invisible"
  UpdateStatusType
UpdateStatusOffline -> Text
"offline"

instance FromJSON GatewayReceivable where
  parseJSON :: Value -> Parser GatewayReceivable
parseJSON = String
-> (Object -> Parser GatewayReceivable)
-> Value
-> Parser GatewayReceivable
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"payload" ((Object -> Parser GatewayReceivable)
 -> Value -> Parser GatewayReceivable)
-> (Object -> Parser GatewayReceivable)
-> Value
-> Parser GatewayReceivable
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
op <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"op" :: Parser Int
    case Int
op of
      Int
0  -> do Text
etype <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"t"
               Value
ejson <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
               case Value
ejson of
                 Object Object
hm -> Event -> Integer -> GatewayReceivable
Dispatch (Event -> Integer -> GatewayReceivable)
-> Parser Event -> Parser (Integer -> GatewayReceivable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Object -> Parser Event
eventParse Text
etype Object
hm Parser (Integer -> GatewayReceivable)
-> Parser Integer -> Parser GatewayReceivable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"s"
                 Value
_other -> Event -> Integer -> GatewayReceivable
Dispatch (Text -> Object -> Event
UnknownEvent (Text
"Dispatch payload wasn't an object") Object
o)
                                  (Integer -> GatewayReceivable)
-> Parser Integer -> Parser GatewayReceivable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"s"
      Int
1  -> Integer -> GatewayReceivable
HeartbeatRequest (Integer -> GatewayReceivable)
-> (String -> Integer) -> String -> GatewayReceivable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer)
-> (String -> Maybe Integer) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> GatewayReceivable)
-> Parser String -> Parser GatewayReceivable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
      Int
7  -> GatewayReceivable -> Parser GatewayReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure GatewayReceivable
Reconnect
      Int
9  -> Bool -> GatewayReceivable
InvalidSession (Bool -> GatewayReceivable)
-> Parser Bool -> Parser GatewayReceivable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
      Int
10 -> do Object
od <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
               Int
int <- Object
od Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"heartbeat_interval"
               GatewayReceivable -> Parser GatewayReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> GatewayReceivable
Hello Int
int)
      Int
11 -> GatewayReceivable -> Parser GatewayReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure GatewayReceivable
HeartbeatAck
      Int
_  -> String -> Parser GatewayReceivable
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown Receivable payload ID:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
op)

-- instance FromJSON GatewaySendable where
--   parseJSON = withObject "payload" $ \o -> do
--     op <- o .: "op" :: Parser Int
--     case op of
--       1  -> Heartbeat . fromMaybe 0 . readMaybe <$> o .: "d"
--       2  -> do od <- o .: "d"
--                tok <- od .: "token"
--                compress <- od .:? "compress" .!= False
--
--       _  -> fail ("Unknown Sendable payload ID:" <> show op)

instance ToJSON GatewaySendable where
  toJSON :: GatewaySendable -> Value
toJSON (Heartbeat Integer
i) = [Pair] -> Value
object [ Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
1 :: Int), Text
"d" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 then String
"null" else Integer -> String
forall a. Show a => a -> String
show Integer
i ]
  toJSON (Identify Auth
token Bool
compress Integer
large (Int, Int)
shard) = [Pair] -> Value
object [
      Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
2 :: Int)
    , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [
        Text
"token" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Auth -> Text
authToken Auth
token
      , Text
"properties" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [
          Text
"$os"                Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
os
        , Text
"$browser"           Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"discord-haskell" :: T.Text)
        , Text
"$device"            Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"discord-haskell" :: T.Text)
        , Text
"$referrer"          Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
""                :: T.Text)
        , Text
"$referring_domain"  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
""                :: T.Text)
        ]
      , Text
"compress" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
compress
      , Text
"large_threshold" Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
large
      , Text
"shard" Text -> (Int, Int) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int, Int)
shard
      ]
    ]
  toJSON (UpdateStatus (UpdateStatusOpts Maybe UTCTime
since Maybe Activity
game UpdateStatusType
status Bool
afk)) = [Pair] -> Value
object [
      Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
3 :: Int)
    , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [
        Text
"since" Text -> Maybe POSIXTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Maybe UTCTime
since Maybe UTCTime -> (UTCTime -> POSIXTime) -> Maybe POSIXTime
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \UTCTime
s -> POSIXTime
1000 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
s) -- takes UTCTime and returns unix time (in milliseconds)
      , Text
"afk" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
afk
      , Text
"status" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UpdateStatusType -> Text
statusString UpdateStatusType
status
      , Text
"game" Text -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Maybe Activity
game Maybe Activity -> (Activity -> Value) -> Maybe Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Activity
a -> [Pair] -> Value
object [
                                Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Activity -> Text
activityName Activity
a
                              , Text
"type" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ActivityType -> Int
activityTypeId (Activity -> ActivityType
activityType Activity
a)
                              , Text
"url" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Activity -> Maybe Text
activityUrl Activity
a
                              ])
      ]
    ]
  toJSON (UpdateStatusVoice (UpdateStatusVoiceOpts GuildId
guild Maybe GuildId
channel Bool
mute Bool
deaf)) =
    [Pair] -> Value
object [
      Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
4 :: Int)
    , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [
        Text
"guild_id"   Text -> GuildId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GuildId
guild
      , Text
"channel_id" Text -> Maybe GuildId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe GuildId
channel
      , Text
"self_mute"  Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
mute
      , Text
"self_deaf"  Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
deaf
      ]
    ]
  toJSON (Resume Text
token Text
session Integer
seqId) = [Pair] -> Value
object [
      Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
6 :: Int)
    , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [
        Text
"token"      Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
token
      , Text
"session_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
session
      , Text
"seq"        Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
seqId
      ]
    ]
  toJSON (RequestGuildMembers (RequestGuildMembersOpts GuildId
guild Text
query Integer
limit)) =
    [Pair] -> Value
object [
      Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
8 :: Int)
    , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [
        Text
"guild_id" Text -> GuildId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GuildId
guild
      , Text
"query"    Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
query
      , Text
"limit"    Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
limit
      ]
    ]