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
, User(..)
, GuildMember(..)
, GuildId
, GuildId, UTCTime, Snowflake
)
import Discord.Interactions ( interactionResponseBasic
, 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
-> EventSystem
-> ChannelId
@ -127,7 +134,7 @@ remindResponse (Just (InteractionDataApplicationCommandOptionsValues opts)) evts
MemberOrUser (Right User{userId = uid}) -> uid
_ -> error "Couldnt get user id"
let d = delay'
now <- liftIO $ getCurrentTime
now <- liftIO getCurrentTime
let remindDateTime =
case T.last d of
's' -> addUTCTime ( fromInteger
@ -169,6 +176,7 @@ remindResponse (Just (InteractionDataApplicationCommandOptionsValues opts)) evts
)
return ()
)
liftIO $ appendFile "reminds.data" $ show (Remind remindDateTime message ch userid) ++ "\n"
return
$ interactionResponseBasic
$ "Reminder registered sucessfully for "
@ -239,3 +247,17 @@ groupResponse c
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`)"

6
app/Commands/EDT.hs

@ -37,7 +37,9 @@ getEdt conf@Config{..} opts = do
tz <- DT.getTimeZone
$ DT.UTCTime (head dates)
$ 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"
Right (vcal@IT.VCalendar{IT.vcEvents = evm}:_, _) ->
TS.unlines . map (\d ->
@ -46,7 +48,7 @@ getEdt conf@Config{..} opts = do
`TS.append` TS.pack (show d)
`TS.append` "**\n"
`TS.append` renderEvents tz (ev d)
else ""
else "No classes for the selected dates"
)
$ dates
where

38
app/Main.hs

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

Loading…
Cancel
Save