You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
165 lines
6.8 KiB
165 lines
6.8 KiB
{-# 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
|
|
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
|
|
)
|
|
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
|
|
|