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
                                         , 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