botiut/app/Commands.hs

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

module Commands where

import Discord              ( restCall, DiscordHandler )
import Discord.Types        ( ChannelId
                            , User(..)
                            , GuildMember(..)
                            , GuildId, UTCTime, Snowflake
                            )
import Discord.Interactions ( interactionResponseBasic
                            , createApplicationCommandChatInput
                            , MemberOrUser(..)
                            , InteractionDataApplicationCommandOptions(..)
                            , InteractionDataApplicationCommandOptionValue(..)
                            , Choice(..)
                            , ApplicationCommandOptionValue(..)
                            , ApplicationCommandOptions(..)
                            , InteractionResponse
                            , CreateApplicationCommand(..)
                            )
import Discord.Requests     ( ChannelRequest(..)
                            , GuildRequest(..)
                            )


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           Data.Time          ( getCurrentTime, addUTCTime )
import qualified Data.Text       as T

import UnliftIO ( withRunInIO )


import Commands.EDT ( getEdt )
import Conf         ( Config(..), Group(..) )

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)
        ]
    }

data Remind = Remind { rmdWhen :: UTCTime
                     , rmdWhat :: T.Text
                     , rmdWhere :: Snowflake
                     , rmdWho :: Snowflake 
                     }
  deriving (Read, Show, Eq)

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
        withRunInIO $ \runInIO ->
          addEvent evts remindDateTime
          ( do
              runInIO ( restCall
                        $ CreateMessage ch
                        $ "<@"
                        `T.append` T.pack (show userid)
                        `T.append` "> **Reminder**\n"
                        `T.append` message
                      )
              return ()
          )
        liftIO $ appendFile "reminds.data" $ show (Remind remindDateTime message ch userid) ++ "\n"
        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`)"