-- | Things that can be upgraded from snowflakes to their full data
module Calamity.Types.Upgradeable
    ( Upgradeable(..) ) where

import           Calamity.Cache.Eff
import           Calamity.Client.Types
import           Calamity.HTTP                  as H
import           Calamity.Internal.Utils
import qualified Calamity.Internal.SnowflakeMap as SM
import           Calamity.Types.Model.Channel
import           Calamity.Types.Model.Guild
import           Calamity.Types.Model.User
import           Calamity.Types.Snowflake

import           Control.Applicative
import           Control.Lens

import           Data.Generics.Sum.Constructors

import qualified Polysemy                       as P
import qualified Polysemy.Fail                  as P
import qualified Polysemy.NonDet                as P

-- | A typeclass that represents snowflakes that can be upgraded to their
-- complete data, either through the cache or HTTP.
class Upgradeable a ids | a -> ids, ids -> a where
  -- | Upgrade a snowflake to it's complete data.
  --
  -- If it existed in the cache then it is returned from there, otherwise we
  -- fetch from HTTP and update the cache on success.
  upgrade :: BotC r => ids -> P.Sem r (Maybe a)

maybeToAlt :: Alternative f => Maybe a -> f a
maybeToAlt :: Maybe a -> f a
maybeToAlt (Just a
x) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
maybeToAlt Maybe a
Nothing = f a
forall (f :: * -> *) a. Alternative f => f a
empty

instance Upgradeable User (Snowflake User) where
  upgrade :: Snowflake User -> Sem r (Maybe User)
upgrade Snowflake User
uid = Sem (NonDet : r) User -> Sem r (Maybe User)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (NonDet : r) a -> Sem r (Maybe a)
P.runNonDetMaybe ((Snowflake User -> Sem (NonDet : r) (Maybe User)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake User -> Sem r (Maybe User)
getUser Snowflake User
uid Sem (NonDet : r) (Maybe User)
-> (Maybe User -> Sem (NonDet : r) User) -> Sem (NonDet : r) User
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe User -> Sem (NonDet : r) User
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeToAlt) Sem (NonDet : r) User
-> Sem (NonDet : r) User -> Sem (NonDet : r) User
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) User
gethttp)
    where
      gethttp :: Sem (NonDet : r) User
gethttp = Sem (Fail : NonDet : r) User -> Sem (NonDet : r) User
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) User -> Sem (NonDet : r) User)
-> Sem (Fail : NonDet : r) User -> Sem (NonDet : r) User
forall a b. (a -> b) -> a -> b
$ do
        Right User
u <- UserRequest User
-> Sem
     (Fail : NonDet : r) (Either RestError (Result (UserRequest User)))
forall (r :: [(* -> *) -> * -> *]) a.
(BotC r, Request a, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (UserRequest User
 -> Sem
      (Fail : NonDet : r) (Either RestError (Result (UserRequest User))))
-> UserRequest User
-> Sem
     (Fail : NonDet : r) (Either RestError (Result (UserRequest User)))
forall a b. (a -> b) -> a -> b
$ Snowflake User -> UserRequest User
forall u. HasID User u => u -> UserRequest User
H.GetUser Snowflake User
uid
        User -> Sem (Fail : NonDet : r) ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
User -> Sem r ()
setUser User
u
        User -> Sem (Fail : NonDet : r) User
forall (f :: * -> *) a. Applicative f => a -> f a
pure User
u

instance Upgradeable Member (Snowflake Guild, Snowflake Member) where
  upgrade :: (Snowflake Guild, Snowflake Member) -> Sem r (Maybe Member)
upgrade (Snowflake Guild
gid, Snowflake Member
mid) = Sem (NonDet : r) Member -> Sem r (Maybe Member)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (NonDet : r) a -> Sem r (Maybe a)
P.runNonDetMaybe (Sem (NonDet : r) Member
getcache Sem (NonDet : r) Member
-> Sem (NonDet : r) Member -> Sem (NonDet : r) Member
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) Member
gethttp)
    where
      getcache :: Sem (NonDet : r) Member
getcache = Sem (Fail : NonDet : r) Member -> Sem (NonDet : r) Member
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Member -> Sem (NonDet : r) Member)
-> Sem (Fail : NonDet : r) Member -> Sem (NonDet : r) Member
forall a b. (a -> b) -> a -> b
$ do
        Just Guild
g <- Snowflake Guild -> Sem (Fail : NonDet : r) (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
gid
        Just Member
m <- Maybe Member -> Sem (Fail : NonDet : r) (Maybe Member)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Guild
g Guild
-> Getting (Maybe Member) Guild (Maybe Member) -> Maybe Member
forall s a. s -> Getting a s a -> a
^. IsLabel
  "members"
  ((SnowflakeMap Member
    -> Const (Maybe Member) (SnowflakeMap Member))
   -> Guild -> Const (Maybe Member) Guild)
(SnowflakeMap Member -> Const (Maybe Member) (SnowflakeMap Member))
-> Guild -> Const (Maybe Member) Guild
#members ((SnowflakeMap Member
  -> Const (Maybe Member) (SnowflakeMap Member))
 -> Guild -> Const (Maybe Member) Guild)
-> ((Maybe Member -> Const (Maybe Member) (Maybe Member))
    -> SnowflakeMap Member
    -> Const (Maybe Member) (SnowflakeMap Member))
-> Getting (Maybe Member) Guild (Maybe Member)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Member)
-> Lens'
     (SnowflakeMap Member) (Maybe (IxValue (SnowflakeMap Member)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap Member)
Snowflake Member
mid)
        Member -> Sem (Fail : NonDet : r) Member
forall (f :: * -> *) a. Applicative f => a -> f a
pure Member
m
      gethttp :: Sem (NonDet : r) Member
gethttp = Sem (Fail : NonDet : r) Member -> Sem (NonDet : r) Member
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Member -> Sem (NonDet : r) Member)
-> Sem (Fail : NonDet : r) Member -> Sem (NonDet : r) Member
forall a b. (a -> b) -> a -> b
$ do
        Right Member
m <- GuildRequest Member
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (GuildRequest Member)))
forall (r :: [(* -> *) -> * -> *]) a.
(BotC r, Request a, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (GuildRequest Member
 -> Sem
      (Fail : NonDet : r)
      (Either RestError (Result (GuildRequest Member))))
-> GuildRequest Member
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (GuildRequest Member)))
forall a b. (a -> b) -> a -> b
$ Snowflake Guild -> Snowflake User -> GuildRequest Member
forall g u.
(HasID Guild g, HasID User u) =>
g -> u -> GuildRequest Member
H.GetGuildMember Snowflake Guild
gid (Snowflake Member -> Snowflake User
forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @User Snowflake Member
mid)
        -- getcache could have failed becuase the member wasn't cached
        Snowflake Guild -> (Guild -> Guild) -> Sem (Fail : NonDet : r) ()
forall (r :: [(* -> *) -> * -> *]).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
gid (IsLabel
  "members"
  ((SnowflakeMap Member -> Identity (SnowflakeMap Member))
   -> Guild -> Identity Guild)
(SnowflakeMap Member -> Identity (SnowflakeMap Member))
-> Guild -> Identity Guild
#members ((SnowflakeMap Member -> Identity (SnowflakeMap Member))
 -> Guild -> Identity Guild)
-> ((Maybe Member -> Identity (Maybe Member))
    -> SnowflakeMap Member -> Identity (SnowflakeMap Member))
-> (Maybe Member -> Identity (Maybe Member))
-> Guild
-> Identity Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Member)
-> Lens'
     (SnowflakeMap Member) (Maybe (IxValue (SnowflakeMap Member)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap Member)
Snowflake Member
mid ((Maybe Member -> Identity (Maybe Member))
 -> Guild -> Identity Guild)
-> Member -> Guild -> Guild
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Member
m)
        Member -> Sem (Fail : NonDet : r) Member
forall (f :: * -> *) a. Applicative f => a -> f a
pure Member
m

instance Upgradeable Guild (Snowflake Guild) where
  upgrade :: Snowflake Guild -> Sem r (Maybe Guild)
upgrade Snowflake Guild
gid = Sem (NonDet : r) Guild -> Sem r (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (NonDet : r) a -> Sem r (Maybe a)
P.runNonDetMaybe ((Snowflake Guild -> Sem (NonDet : r) (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
gid Sem (NonDet : r) (Maybe Guild)
-> (Maybe Guild -> Sem (NonDet : r) Guild)
-> Sem (NonDet : r) Guild
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Guild -> Sem (NonDet : r) Guild
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeToAlt) Sem (NonDet : r) Guild
-> Sem (NonDet : r) Guild -> Sem (NonDet : r) Guild
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) Guild
gethttp)
    where
      gethttp :: Sem (NonDet : r) Guild
gethttp = Sem (Fail : NonDet : r) Guild -> Sem (NonDet : r) Guild
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Guild -> Sem (NonDet : r) Guild)
-> Sem (Fail : NonDet : r) Guild -> Sem (NonDet : r) Guild
forall a b. (a -> b) -> a -> b
$ do
        Right Guild
g <- GuildRequest Guild
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (GuildRequest Guild)))
forall (r :: [(* -> *) -> * -> *]) a.
(BotC r, Request a, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (GuildRequest Guild
 -> Sem
      (Fail : NonDet : r)
      (Either RestError (Result (GuildRequest Guild))))
-> GuildRequest Guild
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (GuildRequest Guild)))
forall a b. (a -> b) -> a -> b
$ Snowflake Guild -> GuildRequest Guild
forall g. HasID Guild g => g -> GuildRequest Guild
H.GetGuild Snowflake Guild
gid
        Guild -> Sem (Fail : NonDet : r) Guild
forall (f :: * -> *) a. Applicative f => a -> f a
pure Guild
g

insertChannel :: BotC r => Channel -> P.Sem r ()
insertChannel :: Channel -> Sem r ()
insertChannel (DMChannel' DMChannel
dm) = DMChannel -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
DMChannel -> Sem r ()
setDM DMChannel
dm
insertChannel (GuildChannel' GuildChannel
ch) =
  Snowflake Guild -> (Guild -> Guild) -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild (GuildChannel -> Snowflake Guild
forall b a. HasID b a => a -> Snowflake b
getID GuildChannel
ch) (IsLabel
  "channels"
  ((SnowflakeMap GuildChannel
    -> Identity (SnowflakeMap GuildChannel))
   -> Guild -> Identity Guild)
(SnowflakeMap GuildChannel -> Identity (SnowflakeMap GuildChannel))
-> Guild -> Identity Guild
#channels ((SnowflakeMap GuildChannel
  -> Identity (SnowflakeMap GuildChannel))
 -> Guild -> Identity Guild)
-> ((Maybe GuildChannel -> Identity (Maybe GuildChannel))
    -> SnowflakeMap GuildChannel
    -> Identity (SnowflakeMap GuildChannel))
-> (Maybe GuildChannel -> Identity (Maybe GuildChannel))
-> Guild
-> Identity Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap GuildChannel)
-> Lens'
     (SnowflakeMap GuildChannel)
     (Maybe (IxValue (SnowflakeMap GuildChannel)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (GuildChannel -> Snowflake GuildChannel
forall b a. HasID b a => a -> Snowflake b
getID @GuildChannel GuildChannel
ch) ((Maybe GuildChannel -> Identity (Maybe GuildChannel))
 -> Guild -> Identity Guild)
-> GuildChannel -> Guild -> Guild
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ GuildChannel
ch)
insertChannel Channel
_ = () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Upgradeable Channel (Snowflake Channel) where
  upgrade :: Snowflake Channel -> Sem r (Maybe Channel)
upgrade Snowflake Channel
cid = Sem (NonDet : r) Channel -> Sem r (Maybe Channel)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (NonDet : r) a -> Sem r (Maybe a)
P.runNonDetMaybe (Sem (NonDet : r) Channel
getcacheDM Sem (NonDet : r) Channel
-> Sem (NonDet : r) Channel -> Sem (NonDet : r) Channel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) Channel
getcacheGuild Sem (NonDet : r) Channel
-> Sem (NonDet : r) Channel -> Sem (NonDet : r) Channel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) Channel
gethttp)
    where
      getcacheDM :: Sem (NonDet : r) Channel
getcacheDM = DMChannel -> Channel
DMChannel' (DMChannel -> Channel)
-> Sem (NonDet : r) (Maybe DMChannel)
-> Sem (NonDet : r) (Maybe Channel)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> Snowflake DMChannel -> Sem (NonDet : r) (Maybe DMChannel)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (Snowflake Channel -> Snowflake DMChannel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake Snowflake Channel
cid) Sem (NonDet : r) (Maybe Channel)
-> (Maybe Channel -> Sem (NonDet : r) Channel)
-> Sem (NonDet : r) Channel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Channel -> Sem (NonDet : r) Channel
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeToAlt
      getcacheGuild :: Sem (NonDet : r) Channel
getcacheGuild = GuildChannel -> Channel
GuildChannel' (GuildChannel -> Channel)
-> Sem (NonDet : r) (Maybe GuildChannel)
-> Sem (NonDet : r) (Maybe Channel)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> Snowflake GuildChannel -> Sem (NonDet : r) (Maybe GuildChannel)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake GuildChannel -> Sem r (Maybe GuildChannel)
getGuildChannel (Snowflake Channel -> Snowflake GuildChannel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake Snowflake Channel
cid) Sem (NonDet : r) (Maybe Channel)
-> (Maybe Channel -> Sem (NonDet : r) Channel)
-> Sem (NonDet : r) Channel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Channel -> Sem (NonDet : r) Channel
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeToAlt
      gethttp :: Sem (NonDet : r) Channel
gethttp = Sem (Fail : NonDet : r) Channel -> Sem (NonDet : r) Channel
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Channel -> Sem (NonDet : r) Channel)
-> Sem (Fail : NonDet : r) Channel -> Sem (NonDet : r) Channel
forall a b. (a -> b) -> a -> b
$ do
        Right Channel
c <- ChannelRequest Channel
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (ChannelRequest Channel)))
forall (r :: [(* -> *) -> * -> *]) a.
(BotC r, Request a, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (ChannelRequest Channel
 -> Sem
      (Fail : NonDet : r)
      (Either RestError (Result (ChannelRequest Channel))))
-> ChannelRequest Channel
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (ChannelRequest Channel)))
forall a b. (a -> b) -> a -> b
$ Snowflake Channel -> ChannelRequest Channel
forall c. HasID Channel c => c -> ChannelRequest Channel
H.GetChannel Snowflake Channel
cid
        Channel -> Sem (Fail : NonDet : r) ()
forall (r :: [(* -> *) -> * -> *]). BotC r => Channel -> Sem r ()
insertChannel Channel
c
        Channel -> Sem (Fail : NonDet : r) Channel
forall (f :: * -> *) a. Applicative f => a -> f a
pure Channel
c

instance Upgradeable GuildChannel (Snowflake GuildChannel) where
  upgrade :: Snowflake GuildChannel -> Sem r (Maybe GuildChannel)
upgrade Snowflake GuildChannel
cid = Sem (NonDet : r) GuildChannel -> Sem r (Maybe GuildChannel)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (NonDet : r) a -> Sem r (Maybe a)
P.runNonDetMaybe (Sem (NonDet : r) GuildChannel
getcache Sem (NonDet : r) GuildChannel
-> Sem (NonDet : r) GuildChannel -> Sem (NonDet : r) GuildChannel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) GuildChannel
gethttp)
    where
      getcache :: Sem (NonDet : r) GuildChannel
getcache = Snowflake GuildChannel -> Sem (NonDet : r) (Maybe GuildChannel)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake GuildChannel -> Sem r (Maybe GuildChannel)
getGuildChannel (Snowflake GuildChannel -> Snowflake GuildChannel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake Snowflake GuildChannel
cid) Sem (NonDet : r) (Maybe GuildChannel)
-> (Maybe GuildChannel -> Sem (NonDet : r) GuildChannel)
-> Sem (NonDet : r) GuildChannel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe GuildChannel -> Sem (NonDet : r) GuildChannel
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeToAlt
      gethttp :: Sem (NonDet : r) GuildChannel
gethttp = Sem (Fail : NonDet : r) GuildChannel
-> Sem (NonDet : r) GuildChannel
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) GuildChannel
 -> Sem (NonDet : r) GuildChannel)
-> Sem (Fail : NonDet : r) GuildChannel
-> Sem (NonDet : r) GuildChannel
forall a b. (a -> b) -> a -> b
$ do
        Right Channel
c <- ChannelRequest Channel
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (ChannelRequest Channel)))
forall (r :: [(* -> *) -> * -> *]) a.
(BotC r, Request a, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (ChannelRequest Channel
 -> Sem
      (Fail : NonDet : r)
      (Either RestError (Result (ChannelRequest Channel))))
-> ChannelRequest Channel
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (ChannelRequest Channel)))
forall a b. (a -> b) -> a -> b
$ Snowflake Channel -> ChannelRequest Channel
forall c. HasID Channel c => c -> ChannelRequest Channel
H.GetChannel (Snowflake GuildChannel -> Snowflake Channel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @Channel Snowflake GuildChannel
cid)
        Channel -> Sem (Fail : NonDet : r) ()
forall (r :: [(* -> *) -> * -> *]). BotC r => Channel -> Sem r ()
insertChannel Channel
c
        Maybe GuildChannel -> Sem (Fail : NonDet : r) GuildChannel
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeToAlt (Channel
c Channel
-> Getting (First GuildChannel) Channel GuildChannel
-> Maybe GuildChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b.
AsConstructor "GuildChannel'" s t a b =>
Prism s t a b
forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"GuildChannel'")

instance Upgradeable VoiceChannel (Snowflake VoiceChannel) where
    upgrade :: Snowflake VoiceChannel -> Sem r (Maybe VoiceChannel)
upgrade Snowflake VoiceChannel
s = Snowflake Channel -> Sem r (Maybe Channel)
forall a ids (r :: [(* -> *) -> * -> *]).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (Snowflake VoiceChannel -> Snowflake Channel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @Channel Snowflake VoiceChannel
s) Sem r (Maybe Channel)
-> (Maybe Channel -> Maybe VoiceChannel)
-> Sem r (Maybe VoiceChannel)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Just (GuildChannel' (GuildVoiceChannel VoiceChannel
vc)) -> VoiceChannel -> Maybe VoiceChannel
forall a. a -> Maybe a
Just VoiceChannel
vc
            Maybe Channel
_ -> Maybe VoiceChannel
forall a. Maybe a
Nothing

instance Upgradeable DMChannel (Snowflake DMChannel) where
    upgrade :: Snowflake DMChannel -> Sem r (Maybe DMChannel)
upgrade Snowflake DMChannel
s = Snowflake Channel -> Sem r (Maybe Channel)
forall a ids (r :: [(* -> *) -> * -> *]).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (Snowflake DMChannel -> Snowflake Channel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @Channel Snowflake DMChannel
s) Sem r (Maybe Channel)
-> (Maybe Channel -> Maybe DMChannel) -> Sem r (Maybe DMChannel)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Just (DMChannel' DMChannel
dc) -> DMChannel -> Maybe DMChannel
forall a. a -> Maybe a
Just DMChannel
dc
            Maybe Channel
_ -> Maybe DMChannel
forall a. Maybe a
Nothing

instance Upgradeable GroupChannel (Snowflake GroupChannel) where
    upgrade :: Snowflake GroupChannel -> Sem r (Maybe GroupChannel)
upgrade Snowflake GroupChannel
s = Snowflake Channel -> Sem r (Maybe Channel)
forall a ids (r :: [(* -> *) -> * -> *]).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (Snowflake GroupChannel -> Snowflake Channel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @Channel Snowflake GroupChannel
s) Sem r (Maybe Channel)
-> (Maybe Channel -> Maybe GroupChannel)
-> Sem r (Maybe GroupChannel)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Just (GroupChannel' GroupChannel
gc) -> GroupChannel -> Maybe GroupChannel
forall a. a -> Maybe a
Just GroupChannel
gc
            Maybe Channel
_ -> Maybe GroupChannel
forall a. Maybe a
Nothing

instance Upgradeable TextChannel (Snowflake TextChannel) where
    upgrade :: Snowflake TextChannel -> Sem r (Maybe TextChannel)
upgrade Snowflake TextChannel
s = Snowflake Channel -> Sem r (Maybe Channel)
forall a ids (r :: [(* -> *) -> * -> *]).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (Snowflake TextChannel -> Snowflake Channel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @Channel Snowflake TextChannel
s) Sem r (Maybe Channel)
-> (Maybe Channel -> Maybe TextChannel)
-> Sem r (Maybe TextChannel)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Just (GuildChannel' (GuildTextChannel TextChannel
tc)) -> TextChannel -> Maybe TextChannel
forall a. a -> Maybe a
Just TextChannel
tc
            Maybe Channel
_ -> Maybe TextChannel
forall a. Maybe a
Nothing

instance Upgradeable Category (Snowflake Category) where
    upgrade :: Snowflake Category -> Sem r (Maybe Category)
upgrade Snowflake Category
s = Snowflake Channel -> Sem r (Maybe Channel)
forall a ids (r :: [(* -> *) -> * -> *]).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (Snowflake Category -> Snowflake Channel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake @_ @Channel Snowflake Category
s) Sem r (Maybe Channel)
-> (Maybe Channel -> Maybe Category) -> Sem r (Maybe Category)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Just (GuildChannel' (GuildCategory Category
c)) -> Category -> Maybe Category
forall a. a -> Maybe a
Just Category
c
            Maybe Channel
_ -> Maybe Category
forall a. Maybe a
Nothing


instance Upgradeable Emoji (Snowflake Guild, Snowflake Emoji) where
  upgrade :: (Snowflake Guild, Snowflake Emoji) -> Sem r (Maybe Emoji)
upgrade (Snowflake Guild
gid, Snowflake Emoji
eid) = Sem (NonDet : r) Emoji -> Sem r (Maybe Emoji)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (NonDet : r) a -> Sem r (Maybe a)
P.runNonDetMaybe (Sem (NonDet : r) Emoji
getcache Sem (NonDet : r) Emoji
-> Sem (NonDet : r) Emoji -> Sem (NonDet : r) Emoji
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) Emoji
gethttp)
    where
      getcache :: Sem (NonDet : r) Emoji
getcache = Sem (Fail : NonDet : r) Emoji -> Sem (NonDet : r) Emoji
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Emoji -> Sem (NonDet : r) Emoji)
-> Sem (Fail : NonDet : r) Emoji -> Sem (NonDet : r) Emoji
forall a b. (a -> b) -> a -> b
$ do
        Just Guild
g <- Snowflake Guild -> Sem (Fail : NonDet : r) (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
gid
        Just Emoji
m <- Maybe Emoji -> Sem (Fail : NonDet : r) (Maybe Emoji)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Guild
g Guild -> Getting (Maybe Emoji) Guild (Maybe Emoji) -> Maybe Emoji
forall s a. s -> Getting a s a -> a
^. IsLabel
  "emojis"
  ((SnowflakeMap Emoji -> Const (Maybe Emoji) (SnowflakeMap Emoji))
   -> Guild -> Const (Maybe Emoji) Guild)
(SnowflakeMap Emoji -> Const (Maybe Emoji) (SnowflakeMap Emoji))
-> Guild -> Const (Maybe Emoji) Guild
#emojis ((SnowflakeMap Emoji -> Const (Maybe Emoji) (SnowflakeMap Emoji))
 -> Guild -> Const (Maybe Emoji) Guild)
-> ((Maybe Emoji -> Const (Maybe Emoji) (Maybe Emoji))
    -> SnowflakeMap Emoji -> Const (Maybe Emoji) (SnowflakeMap Emoji))
-> Getting (Maybe Emoji) Guild (Maybe Emoji)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Emoji)
-> Lens'
     (SnowflakeMap Emoji) (Maybe (IxValue (SnowflakeMap Emoji)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap Emoji)
Snowflake Emoji
eid)
        Emoji -> Sem (Fail : NonDet : r) Emoji
forall (f :: * -> *) a. Applicative f => a -> f a
pure Emoji
m
      gethttp :: Sem (NonDet : r) Emoji
gethttp = Sem (Fail : NonDet : r) Emoji -> Sem (NonDet : r) Emoji
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Emoji -> Sem (NonDet : r) Emoji)
-> Sem (Fail : NonDet : r) Emoji -> Sem (NonDet : r) Emoji
forall a b. (a -> b) -> a -> b
$ do
        Right Emoji
e <- EmojiRequest Emoji
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (EmojiRequest Emoji)))
forall (r :: [(* -> *) -> * -> *]) a.
(BotC r, Request a, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (EmojiRequest Emoji
 -> Sem
      (Fail : NonDet : r)
      (Either RestError (Result (EmojiRequest Emoji))))
-> EmojiRequest Emoji
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (EmojiRequest Emoji)))
forall a b. (a -> b) -> a -> b
$ Snowflake Guild -> Snowflake Emoji -> EmojiRequest Emoji
forall g e.
(HasID Guild g, HasID Emoji e) =>
g -> e -> EmojiRequest Emoji
H.GetGuildEmoji Snowflake Guild
gid Snowflake Emoji
eid
        Snowflake Guild -> (Guild -> Guild) -> Sem (Fail : NonDet : r) ()
forall (r :: [(* -> *) -> * -> *]).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
gid (IsLabel
  "emojis"
  ((SnowflakeMap Emoji -> Identity (SnowflakeMap Emoji))
   -> Guild -> Identity Guild)
(SnowflakeMap Emoji -> Identity (SnowflakeMap Emoji))
-> Guild -> Identity Guild
#emojis ((SnowflakeMap Emoji -> Identity (SnowflakeMap Emoji))
 -> Guild -> Identity Guild)
-> ((Maybe Emoji -> Identity (Maybe Emoji))
    -> SnowflakeMap Emoji -> Identity (SnowflakeMap Emoji))
-> (Maybe Emoji -> Identity (Maybe Emoji))
-> Guild
-> Identity Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Emoji)
-> Lens'
     (SnowflakeMap Emoji) (Maybe (IxValue (SnowflakeMap Emoji)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap Emoji)
Snowflake Emoji
eid ((Maybe Emoji -> Identity (Maybe Emoji))
 -> Guild -> Identity Guild)
-> Emoji -> Guild -> Guild
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Emoji
e)
        Emoji -> Sem (Fail : NonDet : r) Emoji
forall (f :: * -> *) a. Applicative f => a -> f a
pure Emoji
e

instance Upgradeable Role (Snowflake Guild, Snowflake Role) where
  upgrade :: (Snowflake Guild, Snowflake Role) -> Sem r (Maybe Role)
upgrade (Snowflake Guild
gid, Snowflake Role
rid) = Sem (NonDet : r) Role -> Sem r (Maybe Role)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (NonDet : r) a -> Sem r (Maybe a)
P.runNonDetMaybe (Sem (NonDet : r) Role
getcache Sem (NonDet : r) Role
-> Sem (NonDet : r) Role -> Sem (NonDet : r) Role
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sem (NonDet : r) Role
gethttp)
    where
      getcache :: Sem (NonDet : r) Role
getcache = Sem (Fail : NonDet : r) Role -> Sem (NonDet : r) Role
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Role -> Sem (NonDet : r) Role)
-> Sem (Fail : NonDet : r) Role -> Sem (NonDet : r) Role
forall a b. (a -> b) -> a -> b
$ do
        Just Guild
g <- Snowflake Guild -> Sem (Fail : NonDet : r) (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild Snowflake Guild
gid
        Just Role
r <- Maybe Role -> Sem (Fail : NonDet : r) (Maybe Role)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Guild
g Guild -> Getting (Maybe Role) Guild (Maybe Role) -> Maybe Role
forall s a. s -> Getting a s a -> a
^. IsLabel
  "roles"
  ((SnowflakeMap Role -> Const (Maybe Role) (SnowflakeMap Role))
   -> Guild -> Const (Maybe Role) Guild)
(SnowflakeMap Role -> Const (Maybe Role) (SnowflakeMap Role))
-> Guild -> Const (Maybe Role) Guild
#roles ((SnowflakeMap Role -> Const (Maybe Role) (SnowflakeMap Role))
 -> Guild -> Const (Maybe Role) Guild)
-> ((Maybe Role -> Const (Maybe Role) (Maybe Role))
    -> SnowflakeMap Role -> Const (Maybe Role) (SnowflakeMap Role))
-> Getting (Maybe Role) Guild (Maybe Role)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Role)
-> Lens' (SnowflakeMap Role) (Maybe (IxValue (SnowflakeMap Role)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap Role)
Snowflake Role
rid)
        Role -> Sem (Fail : NonDet : r) Role
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
r
      gethttp :: Sem (NonDet : r) Role
gethttp = Sem (Fail : NonDet : r) Role -> Sem (NonDet : r) Role
forall (r :: [(* -> *) -> * -> *]) a.
Member NonDet r =>
Sem (Fail : r) a -> Sem r a
P.failToNonDet (Sem (Fail : NonDet : r) Role -> Sem (NonDet : r) Role)
-> Sem (Fail : NonDet : r) Role -> Sem (NonDet : r) Role
forall a b. (a -> b) -> a -> b
$ do
        Right [Role]
rs <- GuildRequest [Role]
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (GuildRequest [Role])))
forall (r :: [(* -> *) -> * -> *]) a.
(BotC r, Request a, FromJSON (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (GuildRequest [Role]
 -> Sem
      (Fail : NonDet : r)
      (Either RestError (Result (GuildRequest [Role]))))
-> GuildRequest [Role]
-> Sem
     (Fail : NonDet : r)
     (Either RestError (Result (GuildRequest [Role])))
forall a b. (a -> b) -> a -> b
$ Snowflake Guild -> GuildRequest [Role]
forall g. HasID Guild g => g -> GuildRequest [Role]
H.GetGuildRoles Snowflake Guild
gid
        let sm :: SnowflakeMap Role
sm = [Role] -> SnowflakeMap Role
forall a. HasID' a => [a] -> SnowflakeMap a
SM.fromList [Role]
rs
        Snowflake Guild -> (Guild -> Guild) -> Sem (Fail : NonDet : r) ()
forall (r :: [(* -> *) -> * -> *]).
Member CacheEff r =>
Snowflake Guild -> (Guild -> Guild) -> Sem r ()
updateGuild Snowflake Guild
gid (IsLabel
  "roles"
  (ASetter Guild Guild (SnowflakeMap Role) (SnowflakeMap Role))
ASetter Guild Guild (SnowflakeMap Role) (SnowflakeMap Role)
#roles ASetter Guild Guild (SnowflakeMap Role) (SnowflakeMap Role)
-> SnowflakeMap Role -> Guild -> Guild
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ SnowflakeMap Role
sm)
        Just Role
r <- Maybe Role -> Sem (Fail : NonDet : r) (Maybe Role)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnowflakeMap Role
sm SnowflakeMap Role
-> ((Maybe Role -> Const (Maybe Role) (Maybe Role))
    -> SnowflakeMap Role -> Const (Maybe Role) (SnowflakeMap Role))
-> Maybe Role
forall s a. s -> Getting a s a -> a
^. Index (SnowflakeMap Role)
-> Lens' (SnowflakeMap Role) (Maybe (IxValue (SnowflakeMap Role)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap Role)
Snowflake Role
rid)
        Role -> Sem (Fail : NonDet : r) Role
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
r