{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where import Control.Monad (when, void) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Control.Monad.IO.Unlift (toIO, liftIO, withRunInIO) import Discord ( def, restCall , runDiscord, sendCommand , DiscordHandler , RunDiscordOpts(..) ) import Discord.Types ( Event(..), PartialApplication(..) , GatewaySendable(..) , UpdateStatusOpts(..) , UpdateStatusType(..) , Activity(..), ActivityType(..) ) import Discord.Interactions ( interactionResponseBasic , Interaction(..) , InteractionDataApplicationCommand(..) ) import qualified Discord.Requests as R import Commands ( edtResponse, edtCommand , pingResponse, pingCommand , remindResponse, remindCommand , groupCommand, groupResponse , helpCommand, helpResponse , Remind(..) ) import Conf ( Config(..), Group(..), readConfig ) import qualified System.Cron.Schedule as Cron 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) import Data.Time (getCurrentTime) 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 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) remindDataExist <- liftIO $ doesFileExist "reminds.data" when remindDataExist $ do remindfile <- liftIO $ readFile "reminds.data" let reminddata :: [Remind] reminddata = map read $ lines remindfile now <- liftIO getCurrentTime liftIO $ removeFile "reminds.data" mapM_ (\r -> do withRunInIO $ \runInIO -> if now > rmdWhen r then void $ 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 ) appendFile "reminds.data" $ show r return () ) else pure () ) reminddata liftIO $ removeFile "reminds.data" 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 ] 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 liftIO $ putStrLn "Started" 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 " `T.append` gn `T.append` " in " `T.append` T.pack (show gc) `T.append` ":\n" `T.append` edt restCall $ R.CreateMessage gc (edt `T.append` "\nAutomatic time table") return () ) glist