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           ( OptionValue(..)
                                                , Options(..)
                                                , Choice(..)
                                                , CreateApplicationCommand(..)
                                                , OptionDataValue(..)
                                                , OptionsData(..)
                                                , InteractionResponse
                                                , MemberOrUser(..)
                                                , LocalizedText(..)
                                                , createChatInput
                                                , interactionResponseBasic
                                                )
import           Discord.Requests               ( ChannelRequest(..)
                                                , GuildRequest(..)
                                                )
import           Discord.Types                  ( ChannelId
                                                , GuildId
                                                , GuildMember(..)
                                                , Snowflake
                                                , UTCTime
                                                , User(..)
                                                , RoleId(..)
                                                , DiscordId,
                                                )
import           UnliftIO                       ( withRunInIO )

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

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

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

edtCommand :: Config -> Maybe CreateApplicationCommand
edtCommand c =
  createChatInput "edt" "Affiche l'emploi du temps"
    >>= \cac -> return $ cac
          { createOptions =
            Just $ OptionsValues
              [ OptionValueString
                "group"
                Nothing
                "Le groupe pour lequel afficher l'emploi du temps"
                Nothing
                True
                (Right $ map (\x -> Choice x Nothing x) $ groupNames c)
                Nothing Nothing
              , OptionValueString
                "day"
                Nothing
                "Le(s) jour(s) pour le(s)quel(s) afficher l'emploi du temps (today (aujourd'hui), tomorrow (demain), week (semaine) or JJ/MM/AAAA)"
                Nothing
                False
                (Left False)
                Nothing Nothing
              ]
          }

parseOpt :: OptionDataValue -> (T.Text, T.Text)
parseOpt OptionDataValueString { optionDataValueName = name, optionDataValueString = Right val, ..}
  = (name, val)
parseOpt _ = ("INVALID Option", "INVALID type")

edtResponse
  :: Config
  -> Maybe OptionsData
  -> IO InteractionResponse
edtResponse conf@Config {..} (Just (OptionsDataValues 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 =
  createChatInput "remind" "Crée un rapel pour plus tard"
    >>= \cac -> return $ cac
          { createOptions =
            Just $ OptionsValues
            [ OptionValueString "delay" Nothing "délai" Nothing True (Left False) Nothing Nothing
            , OptionValueString "message" Nothing "message" Nothing True (Left False) Nothing Nothing
            ]
          }

remindResponse
  :: Maybe OptionsData
  -> EventSystem
  -> Discord.Types.ChannelId
  -> MemberOrUser
  -> DiscordHandler InteractionResponse
remindResponse (Just (OptionsDataValues opts)) evts ch mou
  = do
    let
      userid = case mou of
        MemberOrUser (Left Discord.Types.GuildMember { memberUser = Just Discord.Types.User { userId = uid } })
          -> uid
        MemberOrUser (Right Discord.Types.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
          $          "Rappel enregistré avec succes pour le "
          `T.append` T.pack (show remindDateTime)
      else return $ interactionResponseBasic "Le délai n'a pas pu être interprété"
 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 =
  createChatInput "group" "grab your group" >>= \cac ->
    return $ cac
      { createOptions = Just $ OptionsValues
        [ OptionValueString
            "group" Nothing
            "Your group" Nothing
            True
            (Right $ map (\x -> Choice x Nothing x) $ groupNames c)
            Nothing Nothing
        ]
      }

groupResponse
  :: Config
  -> MemberOrUser
  -> Discord.Types.GuildId
  -> Maybe OptionsData
  -> DiscordHandler InteractionResponse
groupResponse c mou gid (Just (OptionsDataValues opts))
  = do
    let
      uid = case mou of
        MemberOrUser (Left Discord.Types.GuildMember { memberUser = Just Discord.Types.User { userId = uid } })
          -> uid
        MemberOrUser (Right Discord.Types.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
      $          "Vous faîtes désormait partie du groupe "
      `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 = createChatInput "help" "help"

helpResponse :: IO InteractionResponse
helpResponse =
  return
    . interactionResponseBasic
    $ "**__Aide pour Bot IUT__**\n\n"
    `T.append` "`/help` afficher ce message d'aide\n"
    `T.append` "`/group <group>` rejoindre un groupe\n"
    `T.append` "`/remind <time><s|m|h|d> <message>` Créer un rappel pour plus tard\n"
    `T.append` "`/edt <group> [week|today|tomorrow|jj/mm/aaaa]` Affiche l'emploi du temps pour le groupe `group` pour le jour `day` (`day` est `week` par défaut)"