Browse Source

Fixed some bugs and added some stuff

master
Antoine COMBET 3 years ago
parent
commit
58ea6945c6
  1. 26
      app/Commands.hs
  2. 6
      app/Commands/EDT.hs
  3. 38
      app/Main.hs

26
app/Commands.hs

@ -7,7 +7,7 @@ import Discord ( restCall, DiscordHandler )
import Discord.Types ( ChannelId import Discord.Types ( ChannelId
, User(..) , User(..)
, GuildMember(..) , GuildMember(..)
, GuildId
, GuildId, UTCTime, Snowflake
) )
import Discord.Interactions ( interactionResponseBasic import Discord.Interactions ( interactionResponseBasic
, createApplicationCommandChatInput , createApplicationCommandChatInput
@ -116,6 +116,13 @@ remindCommand =
] ]
} }
data Remind = Remind { rmdWhen :: UTCTime
, rmdWhat :: T.Text
, rmdWhere :: Snowflake
, rmdWho :: Snowflake
}
deriving (Read, Show, Eq)
remindResponse :: Maybe InteractionDataApplicationCommandOptions remindResponse :: Maybe InteractionDataApplicationCommandOptions
-> EventSystem -> EventSystem
-> ChannelId -> ChannelId
@ -127,7 +134,7 @@ remindResponse (Just (InteractionDataApplicationCommandOptionsValues opts)) evts
MemberOrUser (Right User{userId = uid}) -> uid MemberOrUser (Right User{userId = uid}) -> uid
_ -> error "Couldnt get user id" _ -> error "Couldnt get user id"
let d = delay' let d = delay'
now <- liftIO $ getCurrentTime
now <- liftIO getCurrentTime
let remindDateTime = let remindDateTime =
case T.last d of case T.last d of
's' -> addUTCTime ( fromInteger 's' -> addUTCTime ( fromInteger
@ -169,6 +176,7 @@ remindResponse (Just (InteractionDataApplicationCommandOptionsValues opts)) evts
) )
return () return ()
) )
liftIO $ appendFile "reminds.data" $ show (Remind remindDateTime message ch userid) ++ "\n"
return return
$ interactionResponseBasic $ interactionResponseBasic
$ "Reminder registered sucessfully for " $ "Reminder registered sucessfully for "
@ -239,3 +247,17 @@ groupResponse c
groupResponse _ _ _ _ = groupResponse _ _ _ _ =
return $ interactionResponseBasic return $ interactionResponseBasic
"the group command has mandatory params, yet you managed not to give any, WOW" "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`)"

6
app/Commands/EDT.hs

@ -37,7 +37,9 @@ getEdt conf@Config{..} opts = do
tz <- DT.getTimeZone tz <- DT.getTimeZone
$ DT.UTCTime (head dates) $ DT.UTCTime (head dates)
$ DT.secondsToDiffTime 43200 $ DT.secondsToDiffTime 43200
let message = case cal of
let
message =
case cal of
Left _ -> "I don't know this group, alternatively ADE doesn't work" Left _ -> "I don't know this group, alternatively ADE doesn't work"
Right (vcal@IT.VCalendar{IT.vcEvents = evm}:_, _) -> Right (vcal@IT.VCalendar{IT.vcEvents = evm}:_, _) ->
TS.unlines . map (\d -> TS.unlines . map (\d ->
@ -46,7 +48,7 @@ getEdt conf@Config{..} opts = do
`TS.append` TS.pack (show d) `TS.append` TS.pack (show d)
`TS.append` "**\n" `TS.append` "**\n"
`TS.append` renderEvents tz (ev d) `TS.append` renderEvents tz (ev d)
else ""
else "No classes for the selected dates"
) )
$ dates $ dates
where where

38
app/Main.hs

@ -26,7 +26,10 @@ import Discord.Interactions ( interactionResponseBasic
import qualified Discord.Requests as R import qualified Discord.Requests as R
import Commands ( edtResponse, edtCommand import Commands ( edtResponse, edtCommand
, pingResponse, pingCommand , pingResponse, pingCommand
, remindResponse, remindCommand, groupCommand, groupResponse
, remindResponse, remindCommand
, groupCommand, groupResponse
, helpCommand, helpResponse
, Remind(..)
) )
import Conf ( Config(..), Group(..), readConfig ) import Conf ( Config(..), Group(..), readConfig )
import qualified System.Cron.Schedule as Cron import qualified System.Cron.Schedule as Cron
@ -34,16 +37,17 @@ import qualified Data.Map.Strict as Map
import Commands.EDT (getEdt) import Commands.EDT (getEdt)
import qualified Control.Concurrent import qualified Control.Concurrent
import qualified Control.Event as E import qualified Control.Event as E
import UnliftIO.Directory (doesFileExist, removeFile)
main :: IO () main :: IO ()
main = do main = do
tok <- TIO.readFile "./auth.secret" tok <- TIO.readFile "./auth.secret"
conf <- readConfig "./conf.yaml" conf <- readConfig "./conf.yaml"
eventSystem <- E.initEventSystem eventSystem <- E.initEventSystem
print conf
err <- runDiscord $ def { discordToken = tok err <- runDiscord $ def { discordToken = tok
, discordOnStart = onDiscordStart conf
, discordOnStart = onDiscordStart conf eventSystem
, discordOnEnd = liftIO $ putStrLn "Ended" , discordOnEnd = liftIO $ putStrLn "Ended"
, discordOnEvent = onDiscordEvent conf eventSystem , discordOnEvent = onDiscordEvent conf eventSystem
, discordOnLog = , discordOnLog =
@ -51,8 +55,8 @@ main = do
} }
TIO.putStrLn err TIO.putStrLn err
onDiscordStart :: Config -> DiscordHandler ()
onDiscordStart conf = do
onDiscordStart :: Config -> E.EventSystem -> DiscordHandler ()
onDiscordStart conf eventSystem = do
let let
activity :: Activity activity :: Activity
activity = def { activityName = "Doing stuff" activity = def { activityName = "Doing stuff"
@ -66,6 +70,26 @@ onDiscordStart conf = do
, updateStatusOptsAFK = False , updateStatusOptsAFK = False
} }
sendCommand (UpdateStatus opts) sendCommand (UpdateStatus opts)
remindDataExist <- liftIO $ doesFileExist "reminds.data"
when remindDataExist $ do
remindfile <- liftIO $ readFile "reminds.data"
let reminddata :: [Remind]
reminddata = map read $ lines remindfile
mapM_ (\r -> do
withRunInIO $ \runInIO ->
E.addEvent eventSystem (rmdWhen r)
( do
runInIO ( restCall
$ R.CreateMessage (rmdWhere r)
$ "<@"
`T.append` T.pack (show $rmdWho r)
`T.append` "> **Reminder**\n"
`T.append` rmdWhat r
)
return ()
)
) reminddata
liftIO $ removeFile "reminds.data"
onDiscordEvent :: Config -> E.EventSystem -> Event -> DiscordHandler () onDiscordEvent :: Config -> E.EventSystem -> Event -> DiscordHandler ()
@ -80,6 +104,7 @@ onDiscordEvent conf@Config{..} eventSystem (Ready _ _ _ _ _ _ (PartialApplicatio
, edtCommand conf , edtCommand conf
, remindCommand , remindCommand
, groupCommand conf , groupCommand conf
, helpCommand
] ]
let glist = Map.toList configGroups let glist = Map.toList configGroups
withRunInIO $ \runInIO -> Cron.execSchedule $ do withRunInIO $ \runInIO -> Cron.execSchedule $ do
@ -113,6 +138,7 @@ onDiscordEvent conf@Config{..} eventSystem
"edt" -> liftIO $ edtResponse conf opts "edt" -> liftIO $ edtResponse conf opts
"remind" -> remindResponse opts eventSystem channel user "remind" -> remindResponse opts eventSystem channel user
"group" -> groupResponse conf user guild opts "group" -> groupResponse conf user guild opts
"help" -> liftIO helpResponse
_ -> return $ interactionResponseBasic $ "Unhandled Command: " `T.append` name _ -> return $ interactionResponseBasic $ "Unhandled Command: " `T.append` name
onDiscordEvent _ _ _ = return () onDiscordEvent _ _ _ = return ()

Loading…
Cancel
Save