{-# LANGUAGE OverloadedStrings #-}

module ModifyEventsChannel (receivers) where

import Discord ( DiscordHandler
               , restCall )
import Discord.Types
    ( Channel(ChannelGuildCategory)
    , Message(messageChannel)
    , ChannelId )

import Discord.Requests as R
    ( ChannelPermissionsOpts(ChannelPermissionsOpts,
                             channelPermissionsOptsAllow, channelPermissionsOptsDeny,
                             channelPermissionsOptsType)
    , ChannelPermissionsOptsType ( ChannelPermissionsOptsRole )
    , ChannelRequest ( EditChannelPermissions, GetChannel ) )
import Utils ( sendMessageChan, newModCommand, moveChannel )
import UnliftIO ( MonadIO(liftIO) )
import Data.Text as T ()

import Owoifier ( owoify )

receivers :: [Message -> DiscordHandler ()]
receivers :: [Message -> DiscordHandler ()]
receivers = [Message -> DiscordHandler ()
moveEventsChannel]

eventsChannelId :: ChannelId
eventsChannelId :: ChannelId
eventsChannelId = ChannelId
837700461192151120

-- | Move a registered events channel to the top of the server.
-- TODO: utilise Either monad
moveEventsChannel :: Message -> DiscordHandler ()
moveEventsChannel :: Message -> DiscordHandler ()
moveEventsChannel Message
m = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newModCommand Message
m Text
"showEvents" (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
_ -> do
    ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
m) (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Moving Events Channel."

    Either RestCallErrorCode Channel
eChannelObj <- ChannelRequest Channel
-> DiscordHandler (Either RestCallErrorCode Channel)
forall a (r :: * -> *).
(FromJSON a, Request (r a)) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall (ChannelRequest Channel
 -> DiscordHandler (Either RestCallErrorCode Channel))
-> ChannelRequest Channel
-> DiscordHandler (Either RestCallErrorCode Channel)
forall a b. (a -> b) -> a -> b
$ ChannelId -> ChannelRequest Channel
R.GetChannel ChannelId
eventsChannelId
    case Either RestCallErrorCode Channel
eChannelObj of
        Left RestCallErrorCode
err -> IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ RestCallErrorCode -> IO ()
forall a. Show a => a -> IO ()
print RestCallErrorCode
err
        Right Channel
channel -> case Channel
channel of
            ChannelGuildCategory ChannelId
_ ChannelId
guild Text
_ Integer
position [Overwrite]
_ -> do
                -- Selects the first value if the category is at the top of the channel.
                let selector :: (a, a) -> a
selector = if Integer
position Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then (a, a) -> a
forall a b. (a, b) -> a
fst else (a, a) -> a
forall a b. (a, b) -> b
snd
                    swapPermOpts :: ChannelPermissionsOpts
swapPermOpts = ChannelPermissionsOpts :: Integer
-> Integer -> ChannelPermissionsOptsType -> ChannelPermissionsOpts
ChannelPermissionsOpts
                        { channelPermissionsOptsAllow :: Integer
channelPermissionsOptsAllow = (Integer, Integer) -> Integer
forall a. (a, a) -> a
selector (Integer
0, Integer
0x000000400)
                        , channelPermissionsOptsDeny :: Integer
channelPermissionsOptsDeny  = (Integer, Integer) -> Integer
forall a. (a, a) -> a
selector (Integer
0x000000400, Integer
0)
                        , channelPermissionsOptsType :: ChannelPermissionsOptsType
channelPermissionsOptsType  = ChannelPermissionsOptsType
ChannelPermissionsOptsRole
                        }

                -- Guild is used in place of role ID as guildID == @everyone role ID
                ChannelRequest () -> DiscordHandler (Either RestCallErrorCode ())
forall a (r :: * -> *).
(FromJSON a, Request (r a)) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall (ChannelRequest () -> DiscordHandler (Either RestCallErrorCode ()))
-> ChannelRequest ()
-> DiscordHandler (Either RestCallErrorCode ())
forall a b. (a -> b) -> a -> b
$ ChannelId
-> ChannelId -> ChannelPermissionsOpts -> ChannelRequest ()
R.EditChannelPermissions ChannelId
eventsChannelId ChannelId
guild ChannelPermissionsOpts
swapPermOpts
                -- Shift to opposite of current location (99 is arbitrarily large to shift to the bottom)
                ChannelId -> ChannelId -> Int -> DiscordHandler ()
moveChannel ChannelId
guild ChannelId
eventsChannelId (Int -> DiscordHandler ()) -> Int -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int
forall a. (a, a) -> a
selector (Int
99,Int
0)

            Channel
_ -> ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
m)
                (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"eventsChannelId is not a valid ChannelCategory"