{-# 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 ( OptionValue(..) , Options(..) , Choice(..) , CreateApplicationCommand(..) , OptionDataValue(..) , OptionsData(..) , InteractionResponse , MemberOrUser(..) , LocalizedText(..) , createChatInput , interactionResponseBasic ) import Discord.Requests ( ChannelRequest(..) , GuildRequest(..) ) import Discord.Types ( ChannelId , GuildId , GuildMember(..) , Snowflake , UTCTime , User(..) , RoleId(..) , DiscordId, ) import UnliftIO ( withRunInIO ) groupNames :: Config -> [T.Text] groupNames Config {..} = map fst $ Map.toList configGroups pingCommand :: Maybe CreateApplicationCommand pingCommand = createChatInput "ping" "pong" pingResponse :: Config -> IO InteractionResponse pingResponse _ = return $ interactionResponseBasic "Pong" edtCommand :: Config -> Maybe CreateApplicationCommand edtCommand c = createChatInput "edt" "Gets the planning for a group" >>= \cac -> return $ cac { createOptions = Just $ OptionsValues [ OptionValueString "group" Nothing "The group for which the planning is requested" Nothing True (Right $ map (\x -> Choice x Nothing x) $ groupNames c) Nothing Nothing , OptionValueString "day" Nothing "The day(s) for which the planning is requested (today, tomorrow, week or DD/MM/YYYY)" Nothing False (Left False) Nothing Nothing ] } parseOpt :: OptionDataValue -> (T.Text, T.Text) parseOpt OptionDataValueString { optionDataValueName = name, optionDataValueString = Right val, ..} = (name, val) parseOpt _ = ("INVALID Option", "INVALID type") edtResponse :: Config -> Maybe OptionsData -> IO InteractionResponse edtResponse conf@Config {..} (Just (OptionsDataValues 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 = createChatInput "remind" "reminds you of something later on" >>= \cac -> return $ cac { createOptions = Just $ OptionsValues [ OptionValueString "delay" Nothing "delay" Nothing True (Left False) Nothing Nothing , OptionValueString "message" Nothing "message" Nothing True (Left False) Nothing Nothing ] } remindResponse :: Maybe OptionsData -> EventSystem -> Discord.Types.ChannelId -> MemberOrUser -> DiscordHandler InteractionResponse remindResponse (Just (OptionsDataValues opts)) evts ch mou = do let userid = case mou of MemberOrUser (Left Discord.Types.GuildMember { memberUser = Just Discord.Types.User { userId = uid } }) -> uid MemberOrUser (Right Discord.Types.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 = createChatInput "group" "grab your group" >>= \cac -> return $ cac { createOptions = Just $ OptionsValues [ OptionValueString "group" Nothing "Your group" Nothing True (Right $ map (\x -> Choice x Nothing x) $ groupNames c) Nothing Nothing ] } groupResponse :: Config -> MemberOrUser -> Discord.Types.GuildId -> Maybe OptionsData -> DiscordHandler InteractionResponse groupResponse c mou gid (Just (OptionsDataValues opts)) = do let uid = case mou of MemberOrUser (Left Discord.Types.GuildMember { memberUser = Just Discord.Types.User { userId = uid } }) -> uid MemberOrUser (Right Discord.Types.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 = createChatInput "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 ` join a group\n" `T.append` "`/remind