botiut/app/Main.hs

{-# 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
                                         )
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


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
                          , discordOnEnd = liftIO $ putStrLn "Ended"
                          , discordOnEvent = onDiscordEvent conf eventSystem
                          , discordOnLog =
                              \s -> TIO.putStrLn s >> TIO.putStrLn ""
                          }
  TIO.putStrLn err

onDiscordStart :: Config -> DiscordHandler ()
onDiscordStart conf = 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)


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
        ]
  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
        _ -> 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