|
|
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}
module Commands where
import Commands.EDT ( getEdt ) import Commands.Reminds ( Remind(..) , registerRemind , scheduleRemind ) import Conf ( Config(..) , Group(..) ) import Control.Event ( EventSystem , addEvent ) import Control.Monad ( when ) import Control.Monad.IO.Class ( liftIO ) import qualified Data.Map.Strict as Map import Data.Maybe ( fromMaybe ) import qualified Data.Text as T import Data.Time ( addUTCTime , getCurrentTime ) import Discord ( DiscordHandler , restCall ) import Discord.Interactions ( ApplicationCommandOptionValue(..) , ApplicationCommandOptions(..) , Choice(..) , CreateApplicationCommand(..) , InteractionDataApplicationCommandOptionValue(..) , InteractionDataApplicationCommandOptions(..) , InteractionResponse , MemberOrUser(..) , createApplicationCommandChatInput , interactionResponseBasic ) import Discord.Requests ( ChannelRequest(..) , GuildRequest(..) ) import Discord.Types ( ChannelId , GuildId , GuildMember(..) , Snowflake , UTCTime , User(..) ) import UnliftIO ( withRunInIO )
groupNames :: Config -> [T.Text] groupNames Config {..} = map fst $ Map.toList configGroups
pingCommand :: Maybe CreateApplicationCommand pingCommand = createApplicationCommandChatInput "ping" "pong"
pingResponse :: Config -> IO InteractionResponse pingResponse _ = return $ interactionResponseBasic "Pong"
edtCommand :: Config -> Maybe CreateApplicationCommand edtCommand c = createApplicationCommandChatInput "edt" "Gets the planning for a group" >>= \cac -> return $ cac { createApplicationCommandOptions = Just $ ApplicationCommandOptionsValues [ ApplicationCommandOptionValueString "group" "The group for which the planning is requested" True (Right $ map (\x -> Choice x x) $ groupNames c) , ApplicationCommandOptionValueString "day" ( "The day(s) for which the planning is requested " `T.append` "(today, tomorrow, week or DD/MM/YYYY)" ) False (Left False) ] }
parseOpt :: InteractionDataApplicationCommandOptionValue -> (T.Text, T.Text) parseOpt InteractionDataApplicationCommandOptionValueString { interactionDataApplicationCommandOptionValueName = name, interactionDataApplicationCommandOptionValueStringValue = Right val, ..} = (name, val) parseOpt _ = ("INVALID Option", "INVALID type")
edtResponse :: Config -> Maybe InteractionDataApplicationCommandOptions -> IO InteractionResponse edtResponse conf@Config {..} (Just (InteractionDataApplicationCommandOptionsValues opts)) = do planning <- getEdt conf parsedOpts return $ interactionResponseBasic planning where parsedOpts :: Map.Map T.Text T.Text parsedOpts = Map.fromList $ map parseOpt opts edtResponse _ _ = return $ interactionResponseBasic "The edt command has mandatory params yet you managed not to give any, WOW"
remindCommand :: Maybe CreateApplicationCommand remindCommand = createApplicationCommandChatInput "remind" "reminds you of something later on" >>= \cac -> return $ cac { createApplicationCommandOptions = Just $ ApplicationCommandOptionsValues [ ApplicationCommandOptionValueString "delay" "delay" True (Left False) , ApplicationCommandOptionValueString "message" "message" True (Left False) ] }
remindResponse :: Maybe InteractionDataApplicationCommandOptions -> EventSystem -> ChannelId -> MemberOrUser -> DiscordHandler InteractionResponse remindResponse (Just (InteractionDataApplicationCommandOptionsValues opts)) evts ch mou = do let userid = case mou of MemberOrUser (Left GuildMember { memberUser = Just User { userId = uid } }) -> uid MemberOrUser (Right User { userId = uid }) -> uid _ -> error "Couldnt get user id" let d = delay' now <- liftIO getCurrentTime let remindDateTime = case T.last d of 's' -> addUTCTime (fromInteger $ read $ init $ T.unpack d) now 'm' -> addUTCTime ((* 60) $ fromInteger $ read $ init $ T.unpack d) now 'h' -> addUTCTime ((* 3600) $ fromInteger $ read $ init $ T.unpack d) now 'd' -> addUTCTime ((* 86400) $ fromInteger $ read $ init $ T.unpack d) now _ -> now if remindDateTime /= now then do let rmd = Remind { rmdUser = userid , rmdChannel = ch , rmdMessage = message , rmdDatetime = remindDateTime } scheduleRemind evts rmd liftIO $ registerRemind rmd return $ interactionResponseBasic $ "Reminder registered sucessfully for " `T.append` T.pack (show remindDateTime) else return $ interactionResponseBasic "couldn't parse your delay :/" where parsedOpts = Map.fromList $ map parseOpt opts delay' = fromMaybe (error "delay must exist wtf") $ Map.lookup "delay" parsedOpts message = fromMaybe (error "message must exist, wtf") $ Map.lookup "message" parsedOpts remindResponse _ _ _ _ = return $ interactionResponseBasic "The remind command has mandatory params, yet you managed not to give any, WOW"
groupCommand :: Config -> Maybe CreateApplicationCommand groupCommand c = createApplicationCommandChatInput "group" "grab your group" >>= \cac -> return $ cac { createApplicationCommandOptions = Just $ ApplicationCommandOptionsValues [ ApplicationCommandOptionValueString "group" "Your group" True (Right $ map (\x -> Choice x x) $ groupNames c) ] }
groupResponse :: Config -> MemberOrUser -> GuildId -> Maybe InteractionDataApplicationCommandOptions -> DiscordHandler InteractionResponse groupResponse c mou gid (Just (InteractionDataApplicationCommandOptionsValues opts)) = do let uid = case mou of MemberOrUser (Left GuildMember { memberUser = Just User { userId = uid } }) -> uid MemberOrUser (Right User { userId = uid }) -> uid _ -> -1 let rid = groupRole $ fromMaybe (error "group must exist") $ Map.lookup group $ configGroups c restCall $ AddGuildMemberRole gid uid rid return $ interactionResponseBasic $ "You are now part of group " `T.append` group where group = fromMaybe (error "required option") $ Map.lookup "group" $ Map.fromList $ map parseOpt opts groupResponse _ _ _ _ = return $ interactionResponseBasic "the group command has mandatory params, yet you managed not to give any, WOW"
helpCommand :: Maybe CreateApplicationCommand helpCommand = createApplicationCommandChatInput "help" "help"
helpResponse :: IO InteractionResponse helpResponse = return . interactionResponseBasic $ "**__Help for Bot IUT__**\n\n" `T.append` "`/help` shows this help message\n" `T.append` "`/group <group>` join a group\n" `T.append` "`/remind <time><s|m|h|d> <message>` reminds you of something in the future\n" `T.append` "`/edt <group> [week|today|tomorrow|dd/mm/yyyy]` get the planning for group `group` on `day` (`day` defaults to `week`)"
|