{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where import Commands ( edtCommand , edtResponse , groupCommand , groupResponse , helpCommand , helpResponse , pingCommand , pingResponse , remindCommand , remindResponse ) import Commands.EDT ( getEdt ) import Commands.Reminds ( Remind(..) , scheduleRemind , setupRemindDb ) import Conf ( Config(..) , Group(..) , readConfig ) import qualified Control.Concurrent import qualified Control.Event as E import Control.Monad ( void , when ) import Control.Monad.IO.Unlift ( liftIO , toIO , withRunInIO ) import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Time ( getCurrentTime ) import qualified Database.HDBC as DB import qualified Database.HDBC.Sqlite3 as DB.SQ3 import Discord ( DiscordHandler , RunDiscordOpts(..) , def , restCall , runDiscord , sendCommand ) import Discord.Interactions ( Interaction(..) , InteractionDataApplicationCommand(..) , interactionResponseBasic ) import qualified Discord.Requests as R import Discord.Types ( Activity(..) , ActivityType(..) , Event(..) , GatewaySendable(..) , PartialApplication(..) , Snowflake(Snowflake) , UpdateStatusOpts(..) , UpdateStatusType(..) ) import qualified System.Cron.Schedule as Cron import UnliftIO.Directory ( doesFileExist , removeFile ) main :: IO () main = do tok <- TIO.readFile "./auth.secret" conf <- readConfig "./conf.yaml" eventSystem <- E.initEventSystem err <- runDiscord $ def { discordToken = tok , discordOnStart = onDiscordStart conf eventSystem , discordOnEnd = liftIO $ putStrLn "Ended" , discordOnEvent = onDiscordEvent conf eventSystem , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn "" } TIO.putStrLn err onDiscordStart :: Config -> E.EventSystem -> DiscordHandler () onDiscordStart conf@Config {..} eventSystem = do let activity :: Activity activity = def { activityName = "Doing stuff" , activityType = ActivityTypeGame , activityUrl = Nothing } opts :: UpdateStatusOpts opts = UpdateStatusOpts { updateStatusOptsSince = Nothing , updateStatusOptsGame = Just activity , updateStatusOptsNewStatus = UpdateStatusOnline , updateStatusOptsAFK = False } sendCommand (UpdateStatus opts) let glist = Map.toList configGroups withRunInIO $ \runInIO -> Cron.execSchedule $ do Cron.addJob (runInIO $ pushgroupedt conf "tomorrow" glist) configAutoEDTCronDay Cron.addJob (runInIO $ pushgroupedt conf "week" glist) configAutoEDTCronWeek -- Ensure the database is setup liftIO setupRemindDb -- Get the reminders out of the database conn <- liftIO $ DB.SQ3.connectSqlite3 "db.sqlite3" query <- liftIO $ DB.prepare conn "SELECT user, channel, message, dt \ \FROM reminds \ \WHERE (datetime(dt) > datetime('now'));" liftIO $ DB.execute query [] reminds <- liftIO $ DB.fetchAllRows' query mapM_ (\[u, c, m, d] -> do liftIO $ print [u, c, m, d] scheduleRemind eventSystem Remind { rmdUser = Snowflake $ DB.fromSql u , rmdChannel = Snowflake $ DB.fromSql c , rmdMessage = DB.fromSql m , rmdDatetime = DB.fromSql d } ) reminds liftIO $ putStrLn "Started" onDiscordEvent :: Config -> E.EventSystem -> Event -> DiscordHandler () onDiscordEvent conf@Config {..} eventSystem (Ready _ _ _ _ _ _ (PartialApplication i _)) = do mapM_ (maybe (return ()) (void . restCall . R.CreateGuildApplicationCommand i configServer) ) [ pingCommand , edtCommand conf , remindCommand , groupCommand conf , helpCommand ] onDiscordEvent conf@Config {..} eventSystem (InteractionCreate InteractionApplicationCommand { interactionDataApplicationCommand = InteractionDataApplicationCommandChatInput { interactionDataApplicationCommandName = name, interactionDataApplicationCommandOptions = opts, ..}, interactionChannelId = Just channel, interactionGuildId = Just guild, interactionUser = user, ..}) = do response <- responseIO void $ restCall (R.CreateInteractionResponse interactionId interactionToken response) where responseIO = case name of "ping" -> liftIO $ pingResponse conf "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 () pushgroupedt :: Config -> T.Text -> [(T.Text, Group)] -> DiscordHandler () pushgroupedt conf@Config {..} day glist = do mapM_ (\(gn, Group { groupChannel = gc }) -> do edt <- liftIO $ getEdt conf $ Map.fromList [("group", gn), ("day", day)] liftIO $ TIO.putStrLn $ "Putting out time table for group " <> gn <> " in " <> T.pack (show gc) <> ":\n" <> edt restCall $ R.CreateMessage gc edt return () ) glist