botiut/app/Commands.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Commands where

import           Commands.EDT                   ( getEdt )
import           Commands.Reminds               ( Remind(..)
                                                , registerRemind
                                                , scheduleRemind
                                                )
import           Conf                           ( Config(..)
                                                , Group(..)
                                                )
import           Control.Event                  ( EventSystem
                                                , addEvent
                                                )
import           Control.Monad                  ( when )
import           Control.Monad.IO.Class         ( liftIO )
import qualified Data.Map.Strict               as Map
import           Data.Maybe                     ( fromMaybe )
import qualified Data.Text                     as T
import           Data.Time                      ( addUTCTime
                                                , getCurrentTime
                                                )
import           Discord                        ( DiscordHandler
                                                , restCall
                                                )
import           Discord.Interactions           ( ApplicationCommandOptionValue(..)
                                                , ApplicationCommandOptions(..)
                                                , Choice(..)
                                                , CreateApplicationCommand(..)
                                                , InteractionDataApplicationCommandOptionValue(..)
                                                , InteractionDataApplicationCommandOptions(..)
                                                , InteractionResponse
                                                , MemberOrUser(..)
                                                , createApplicationCommandChatInput
                                                , interactionResponseBasic
                                                )
import           Discord.Requests               ( ChannelRequest(..)
                                                , GuildRequest(..)
                                                )
import           Discord.Types                  ( ChannelId
                                                , GuildId
                                                , GuildMember(..)
                                                , Snowflake
                                                , UTCTime
                                                , User(..)
                                                )
import           UnliftIO                       ( withRunInIO )

groupNames :: Config -> [T.Text]
groupNames Config {..} = map fst $ Map.toList configGroups

pingCommand :: Maybe CreateApplicationCommand
pingCommand = createApplicationCommandChatInput "ping" "pong"

pingResponse :: Config -> IO InteractionResponse
pingResponse _ = return $ interactionResponseBasic "Pong"

edtCommand :: Config -> Maybe CreateApplicationCommand
edtCommand c =
  createApplicationCommandChatInput "edt" "Gets the planning for a group"
    >>= \cac -> return $ cac
          { createApplicationCommandOptions =
            Just $ ApplicationCommandOptionsValues
              [ ApplicationCommandOptionValueString
                "group"
                "The group for which the planning is requested"
                True
                (Right $ map (\x -> Choice x x) $ groupNames c)
              , ApplicationCommandOptionValueString
                "day"
                (          "The day(s) for which the planning is requested "
                `T.append` "(today, tomorrow, week or DD/MM/YYYY)"
                )
                False
                (Left False)
              ]
          }

parseOpt :: InteractionDataApplicationCommandOptionValue -> (T.Text, T.Text)
parseOpt InteractionDataApplicationCommandOptionValueString { interactionDataApplicationCommandOptionValueName = name, interactionDataApplicationCommandOptionValueStringValue = Right val, ..}
  = (name, val)
parseOpt _ = ("INVALID Option", "INVALID type")

edtResponse
  :: Config
  -> Maybe InteractionDataApplicationCommandOptions
  -> IO InteractionResponse
edtResponse conf@Config {..} (Just (InteractionDataApplicationCommandOptionsValues opts))
  = do
    planning <- getEdt conf parsedOpts
    return $ interactionResponseBasic planning
 where
  parsedOpts :: Map.Map T.Text T.Text
  parsedOpts = Map.fromList $ map parseOpt opts
edtResponse _ _ = return $ interactionResponseBasic
  "The edt command has mandatory params yet you managed not to give any, WOW"

remindCommand :: Maybe CreateApplicationCommand
remindCommand =
  createApplicationCommandChatInput "remind" "reminds you of something later on"
    >>= \cac -> return $ cac
          { createApplicationCommandOptions =
            Just $ ApplicationCommandOptionsValues
              [ ApplicationCommandOptionValueString "delay"
                                                    "delay"
                                                    True
                                                    (Left False)
              , ApplicationCommandOptionValueString "message"
                                                    "message"
                                                    True
                                                    (Left False)
              ]
          }

remindResponse
  :: Maybe InteractionDataApplicationCommandOptions
  -> EventSystem
  -> ChannelId
  -> MemberOrUser
  -> DiscordHandler InteractionResponse
remindResponse (Just (InteractionDataApplicationCommandOptionsValues opts)) evts ch mou
  = do
    let
      userid = case mou of
        MemberOrUser (Left GuildMember { memberUser = Just User { userId = uid } })
          -> uid
        MemberOrUser (Right User { userId = uid }) -> uid
        _ -> error "Couldnt get user id"
    let d = delay'
    now <- liftIO getCurrentTime
    let
      remindDateTime = case T.last d of
        's' -> addUTCTime (fromInteger $ read $ init $ T.unpack d) now
        'm' -> addUTCTime ((* 60) $ fromInteger $ read $ init $ T.unpack d) now
        'h' ->
          addUTCTime ((* 3600) $ fromInteger $ read $ init $ T.unpack d) now
        'd' ->
          addUTCTime ((* 86400) $ fromInteger $ read $ init $ T.unpack d) now
        _ -> now
    if remindDateTime /= now
      then do
        let rmd = Remind { rmdUser     = userid
                         , rmdChannel  = ch
                         , rmdMessage  = message
                         , rmdDatetime = remindDateTime
                         }
        scheduleRemind evts rmd
        liftIO $ registerRemind rmd
        return
          $          interactionResponseBasic
          $          "Reminder registered sucessfully for "
          `T.append` T.pack (show remindDateTime)
      else return $ interactionResponseBasic "couldn't parse your delay :/"
 where
  parsedOpts = Map.fromList $ map parseOpt opts
  delay' =
    fromMaybe (error "delay must exist wtf") $ Map.lookup "delay" parsedOpts
  message = fromMaybe (error "message must exist, wtf")
    $ Map.lookup "message" parsedOpts
remindResponse _ _ _ _ =
  return
    $ interactionResponseBasic
        "The remind command has mandatory params, yet you managed not to give any, WOW"

groupCommand :: Config -> Maybe CreateApplicationCommand
groupCommand c =
  createApplicationCommandChatInput "group" "grab your group" >>= \cac ->
    return $ cac
      { createApplicationCommandOptions = Just $ ApplicationCommandOptionsValues
        [ ApplicationCommandOptionValueString
            "group"
            "Your group"
            True
            (Right $ map (\x -> Choice x x) $ groupNames c)
        ]
      }

groupResponse
  :: Config
  -> MemberOrUser
  -> GuildId
  -> Maybe InteractionDataApplicationCommandOptions
  -> DiscordHandler InteractionResponse
groupResponse c mou gid (Just (InteractionDataApplicationCommandOptionsValues opts))
  = do
    let
      uid = case mou of
        MemberOrUser (Left GuildMember { memberUser = Just User { userId = uid } })
          -> uid
        MemberOrUser (Right User { userId = uid }) -> uid
        _ -> -1
    let rid =
          groupRole
            $ fromMaybe (error "group must exist")
            $ Map.lookup group
            $ configGroups c
    restCall $ AddGuildMemberRole gid uid rid
    return
      $          interactionResponseBasic
      $          "You are now part of group "
      `T.append` group
 where
  group =
    fromMaybe (error "required option")
      $ Map.lookup "group"
      $ Map.fromList
      $ map parseOpt opts
groupResponse _ _ _ _ =
  return
    $ interactionResponseBasic
        "the group command has mandatory params, yet you managed not to give any, WOW"

helpCommand :: Maybe CreateApplicationCommand
helpCommand = createApplicationCommandChatInput "help" "help"

helpResponse :: IO InteractionResponse
helpResponse =
  return
    . interactionResponseBasic
    $ "**__Help for Bot IUT__**\n\n"
    `T.append` "`/help` shows this help message\n"
    `T.append` "`/group <group>` join a group\n"
    `T.append` "`/remind <time><s|m|h|d> <message>` reminds you of something in the future\n"
    `T.append` "`/edt <group> [week|today|tomorrow|dd/mm/yyyy]` get the planning for group `group` on `day` (`day` defaults to `week`)"