{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module RoleSelfAssign ( reactionAddReceivers, reactionRemReceivers, receivers ) where

import           Control.Monad          ( guard
                                        , unless
                                        , forM_ )
import           UnliftIO               ( liftIO )
import           Data.Aeson             ( decode )
import           Data.Bifunctor         ( first
                                        , bimap
                                        )
import           Data.Char              ( isDigit )
import           Data.Map               ( Map
                                        , toList )
import           Data.Maybe             ( fromJust
                                        , isJust
                                        , isNothing
                                        )
import qualified Data.Text as T
import           Data.Text.Encoding     ( encodeUtf8 )

import           Data.ByteString.Lazy   ( fromStrict )

import           Discord.Types
import           Discord

import           Command
import           Owoifier               ( owoify )
import           Utils                  ( sendMessageDM
                                        , newModCommand
                                        , isEmojiValid
                                        , isRoleInGuild
                                        , sendMessageChan
                                        , addReaction
                                        )
import           CSV                    ( readCSV
                                        , readSingleColCSV
                                        , addToCSV
                                        , writeCSV
                                        )

import           TemplateRE             ( accoladedArgRE
                                        , quotedArgRE
                                        , spaceRE
                                        )

type EmojiRoleMap = [(String, RoleId)]
-- emoji --> snowflake.
-- Note: Only supports default emojis.

type RoleStation = [(String, EmojiRoleMap, String)]
-- Prepended text, role mapping, appended text.

reactionAddReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionAddReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionAddReceivers = [ ReactionInfo -> DiscordHandler ()
attemptRoleAssign ]

reactionRemReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionRemReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionRemReceivers = [ ReactionInfo -> DiscordHandler ()
handleRoleRemove ]

receivers :: [Message -> DiscordHandler ()]
receivers :: [Message -> DiscordHandler ()]
receivers =
    [ Message -> DiscordHandler ()
createAssignStation
    , Message -> DiscordHandler ()
addRoleToStation
    ]

assignFilePath :: FilePath
assignFilePath :: FilePath
assignFilePath = FilePath
"idAssign.csv"

serverID :: GuildId
serverID :: GuildId
serverID = GuildId
755798054455738489
-- the number is the fixed Guild/Server ID.
-- TODO: put the number in a config file.
-- Currently set to the testing server's.

createAssignStationSyntax :: T.Text
createAssignStationSyntax :: Text
createAssignStationSyntax = Text
"Syntax: `:createSelfAssign \"<prependText>\" \"<appendText>\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                            Text
"{\"emoji1\": \"roleText1\", \"emoji2\": \"roleText2\", ...}`"

addRoleToStationSyntax :: T.Text
addRoleToStationSyntax :: Text
addRoleToStationSyntax = Text
"Syntax: `:addRoleToStation \"<prependText>\" \"<appendText>\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                            Text
"\"<stationID>\" \"<channelID>\" \"<emoji>\" \"<roleText>\"`"

-- | Warning: Unsafe, as it does not cover cases where the matrix is not two-dimensional.
twoDimMatrixToMap :: Functor f => f [a] -> f (a, a)
twoDimMatrixToMap :: f [a] -> f (a, a)
twoDimMatrixToMap = ([a] -> (a, a)) -> f [a] -> f (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[a
x, a
y] -> (a
x, a
y))

mapToMatrix :: Functor f => f (a, a) -> f [a]
mapToMatrix :: f (a, a) -> f [a]
mapToMatrix = ((a, a) -> [a]) -> f (a, a) -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
x, a
y) -> [a
x, a
y])

addRoleToStation :: Message -> DiscordHandler ()
addRoleToStation :: Message -> DiscordHandler ()
addRoleToStation Message
m = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newModCommand Message
m (Text
"addRoleToStation" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE             -- command name
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE             -- prepended text
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE             -- appended text
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE             -- station ID
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE             -- channel ID
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE             -- emoji
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE) (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
captures -> do     -- role
    let [Text
prependT, Text
appendT, Text
stationID, Text
channelID, Text
emoji, Text
role] = [Text]
captures
    Bool
doesEmojiExist <- Text -> GuildId -> DiscordHandler Bool
isEmojiValid Text
emoji GuildId
serverID
    Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doesEmojiExist
        (GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
        Text
"The emoji provided is invalid. Perhaps you used one from another server?")
    Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doesEmojiExist
    -- Emoji's fine!

    Maybe GuildId
roleIDM <- Text -> GuildId -> ReaderT DiscordHandle IO (Maybe GuildId)
forall (m :: * -> *).
MonadDiscord m =>
Text -> GuildId -> m (Maybe GuildId)
isRoleInGuild Text
role GuildId
serverID
    let doesRoleExist :: Bool
doesRoleExist = Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GuildId
roleIDM
    Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doesRoleExist
        (GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
        Text
"The role provided is invalid. Please make sure you use the role's name!")
    Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doesRoleExist
    -- Role's fine!

    let (FilePath
stationIDStr, FilePath
channelIDStr) = (Text -> FilePath
T.unpack Text
stationID, Text -> FilePath
T.unpack Text
channelID)
    let (GuildId
stationIDNum, GuildId
channelIDNum) = (FilePath -> GuildId
forall a. Read a => FilePath -> a
read FilePath
stationIDStr, FilePath -> GuildId
forall a. Read a => FilePath -> a
read FilePath
channelIDStr)
    let Just GuildId
roleID = Maybe GuildId
roleIDM
    let assignFilePath :: FilePath
assignFilePath = FilePath -> FilePath
getAssignFile' FilePath
stationIDStr

    -- The old emote role mapping, read from the CSV.
    [[Text]]
roleEmoteMatrix <- IO [[Text]] -> ReaderT DiscordHandle IO [[Text]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Text]] -> ReaderT DiscordHandle IO [[Text]])
-> IO [[Text]] -> ReaderT DiscordHandle IO [[Text]]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [[Text]]
readCSV FilePath
assignFilePath
    -- The new emote role map! Cons the emoji and role at the front.
    let emojiRoleIDMap :: [(Text, GuildId)]
emojiRoleIDMap = (Text
emoji, GuildId
roleID) (Text, GuildId) -> [(Text, GuildId)] -> [(Text, GuildId)]
forall a. a -> [a] -> [a]
: ((Text, Text) -> (Text, GuildId))
-> [(Text, Text)] -> [(Text, GuildId)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> (Text -> FilePath) -> Text -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> GuildId) -> (Text, Text) -> (Text, GuildId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([[Text]] -> [(Text, Text)]
forall (f :: * -> *) a. Functor f => f [a] -> f (a, a)
twoDimMatrixToMap [[Text]]
roleEmoteMatrix)

    -- Edit said message to the new one.
    Text
assignStationT <- Text -> Text -> [(Text, GuildId)] -> DiscordHandler Text
formatAssignStation Text
prependT Text
appendT [(Text, GuildId)]
emojiRoleIDMap
    Message
_ <- (GuildId, GuildId)
-> Text -> Maybe CreateEmbed -> ReaderT DiscordHandle IO Message
forall (m :: * -> *).
MonadDiscord m =>
(GuildId, GuildId) -> Text -> Maybe CreateEmbed -> m Message
editMessage (GuildId
channelIDNum, GuildId
stationIDNum) Text
assignStationT Maybe CreateEmbed
forall a. Maybe a
Nothing

    -- Write the new mapping to the old CSV
    ()
_ <- IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ())
-> ([(Text, Text)] -> IO ()) -> [(Text, Text)] -> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [[Text]] -> IO ()
writeCSV FilePath
assignFilePath ([[Text]] -> IO ())
-> ([(Text, Text)] -> [[Text]]) -> [(Text, Text)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> [[Text]]
forall (f :: * -> *) a. Functor f => f (a, a) -> f [a]
mapToMatrix ([(Text, Text)] -> DiscordHandler ())
-> [(Text, Text)] -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ (GuildId -> Text) -> (Text, GuildId) -> (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Text
T.pack (FilePath -> Text) -> (GuildId -> FilePath) -> GuildId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildId -> FilePath
forall a. Show a => a -> FilePath
show) ((Text, GuildId) -> (Text, Text))
-> [(Text, GuildId)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
emojiRoleIDMap

    -- React!
    GuildId -> GuildId -> Text -> DiscordHandler ()
addReaction GuildId
channelIDNum GuildId
stationIDNum Text
emoji

getAssignFile :: MessageId -> FilePath
getAssignFile :: GuildId -> FilePath
getAssignFile = FilePath -> FilePath
getAssignFile' (FilePath -> FilePath)
-> (GuildId -> FilePath) -> GuildId -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildId -> FilePath
forall a. Show a => a -> FilePath
show

getAssignFile' :: String -> FilePath
getAssignFile' :: FilePath -> FilePath
getAssignFile' FilePath
mid = FilePath
mid FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".selfAssign"

roleIdToRole :: RoleId -> [Role] -> T.Text
roleIdToRole :: GuildId -> [Role] -> Text
roleIdToRole GuildId
rid [Role]
roles = Role -> Text
roleName (Role -> Text) -> ([Role] -> Role) -> [Role] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Role] -> Role
forall a. [a] -> a
head ([Role] -> Text) -> [Role] -> Text
forall a b. (a -> b) -> a -> b
$ (Role -> Bool) -> [Role] -> [Role]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Role
r -> Role -> GuildId
roleId Role
r GuildId -> GuildId -> Bool
forall a. Eq a => a -> a -> Bool
== GuildId
rid) [Role]
roles

formatAssignStation :: T.Text -> T.Text -> [(T.Text, RoleId)] -> DiscordHandler T.Text
formatAssignStation :: Text -> Text -> [(Text, GuildId)] -> DiscordHandler Text
formatAssignStation Text
prependT Text
appendT [(Text, GuildId)]
options = do
    [Role]
roles <- GuildId -> ReaderT DiscordHandle IO [Role]
forall (m :: * -> *). MonadDiscord m => GuildId -> m [Role]
getGuildRoles GuildId
serverID
    let roleTextOptions :: [(Text, Text)]
roleTextOptions = (\(Text
emojiT, GuildId
roleID) -> (Text
emojiT, GuildId -> [Role] -> Text
roleIdToRole GuildId
roleID [Role]
roles)) ((Text, GuildId) -> (Text, Text))
-> [(Text, GuildId)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
options
    let optionsT :: [Text]
optionsT = (\(Text
emoji, Text
roleName) ->
                        Text
"`[`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
emoji Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`]` for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`[`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`]`")
                    ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
roleTextOptions
    Text -> DiscordHandler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DiscordHandler Text) -> Text -> DiscordHandler Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
            Text
prependT,
            Text
"",
            [Text] -> Text
T.unlines [Text]
optionsT,
            Text
appendT
        ]

jsonTxtToMap :: T.Text -> Maybe (Map String String)
jsonTxtToMap :: Text -> Maybe (Map FilePath FilePath)
jsonTxtToMap = ByteString -> Maybe (Map FilePath FilePath)
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (Map FilePath FilePath))
-> (Text -> ByteString) -> Text -> Maybe (Map FilePath FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

createAssignStation :: Message -> DiscordHandler ()
createAssignStation :: Message -> DiscordHandler ()
createAssignStation Message
m = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newModCommand Message
m (Text
"createSelfAssign" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE                  -- command name
                                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE                  -- prepended text
                                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE                  -- appended text
                                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
accoladedArgRE) (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
captures -> do       -- json
    -- Captures are [arg1, arg2, json]
    let [Text
prependT, Text
appendT, Text
emojiRoleJson] = [Text]
captures
    let emojiRoleMapM :: Maybe (Map FilePath FilePath)
emojiRoleMapM = Text -> Maybe (Map FilePath FilePath)
jsonTxtToMap Text
emojiRoleJson
    case Maybe (Map FilePath FilePath)
emojiRoleMapM of
        Maybe (Map FilePath FilePath)
Nothing           -> do
            GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m) (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$
                Text
"Invalid JSON. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
createAssignStationSyntax
        Just Map FilePath FilePath
emojiRoleMap' -> do
            let emojiRoleMap :: [(Text, Text)]
emojiRoleMap = (FilePath -> Text)
-> (FilePath -> Text) -> (FilePath, FilePath) -> (Text, Text)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FilePath -> Text
T.pack FilePath -> Text
T.pack ((FilePath, FilePath) -> (Text, Text))
-> [(FilePath, FilePath)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
toList Map FilePath FilePath
emojiRoleMap'
            Bool
doEmojisExist <- [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool)
-> ReaderT DiscordHandle IO [Bool] -> DiscordHandler Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DiscordHandler Bool] -> ReaderT DiscordHandle IO [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((\(Text
emoji, Text
_) -> Text -> GuildId -> DiscordHandler Bool
isEmojiValid Text
emoji GuildId
serverID) ((Text, Text) -> DiscordHandler Bool)
-> [(Text, Text)] -> [DiscordHandler Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
emojiRoleMap)
            Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doEmojisExist
                (GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
                Text
"One of the emojis provided is invalid. Perhaps you used one from another server?")
            Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doEmojisExist
            -- Emojis are fine!

            [(Text, Maybe GuildId)]
emojiRoleIDMMap <- [ReaderT DiscordHandle IO (Text, Maybe GuildId)]
-> ReaderT DiscordHandle IO [(Text, Maybe GuildId)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([ReaderT DiscordHandle IO (Text, Maybe GuildId)]
 -> ReaderT DiscordHandle IO [(Text, Maybe GuildId)])
-> [ReaderT DiscordHandle IO (Text, Maybe GuildId)]
-> ReaderT DiscordHandle IO [(Text, Maybe GuildId)]
forall a b. (a -> b) -> a -> b
$ (\(Text
emoji, Text
roleFragment) ->
                                (Text
emoji, ) (Maybe GuildId -> (Text, Maybe GuildId))
-> ReaderT DiscordHandle IO (Maybe GuildId)
-> ReaderT DiscordHandle IO (Text, Maybe GuildId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> GuildId -> ReaderT DiscordHandle IO (Maybe GuildId)
forall (m :: * -> *).
MonadDiscord m =>
Text -> GuildId -> m (Maybe GuildId)
isRoleInGuild Text
roleFragment GuildId
serverID) ((Text, Text) -> ReaderT DiscordHandle IO (Text, Maybe GuildId))
-> [(Text, Text)]
-> [ReaderT DiscordHandle IO (Text, Maybe GuildId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
emojiRoleMap
            let doRolesExist :: Bool
doRolesExist = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((Text, Maybe GuildId) -> Bool) -> [(Text, Maybe GuildId)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Text
_, Maybe GuildId
roleIDM) -> Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GuildId
roleIDM) [(Text, Maybe GuildId)]
emojiRoleIDMMap
            Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doRolesExist
                (GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
                Text
"One of the roles provided is invalid. Please make sure you use the roles' names!")
            Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doRolesExist
            -- Roles are fine!

            -- The map below is sanitised and perfectly safe to use.
            let emojiRoleIDMap :: [(Text, GuildId)]
emojiRoleIDMap = (\(Text
emoji, Just GuildId
roleID) -> (Text
emoji, GuildId
roleID)) ((Text, Maybe GuildId) -> (Text, GuildId))
-> [(Text, Maybe GuildId)] -> [(Text, GuildId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe GuildId)]
emojiRoleIDMMap
            Text -> Text -> Message -> [(Text, GuildId)] -> DiscordHandler ()
handleRoleMapping Text
prependT Text
appendT Message
m [(Text, GuildId)]
emojiRoleIDMap

handleRoleMapping :: T.Text -> T.Text -> Message -> [(T.Text, RoleId)] -> DiscordHandler ()
handleRoleMapping :: Text -> Text -> Message -> [(Text, GuildId)] -> DiscordHandler ()
handleRoleMapping Text
prependT Text
appendT Message
m [(Text, GuildId)]
emojiRoleIDMap = do
    -- Post the assignment station text.
    Text
assignStationT <- Text -> Text -> [(Text, GuildId)] -> DiscordHandler Text
formatAssignStation Text
prependT Text
appendT [(Text, GuildId)]
emojiRoleIDMap
    Message
newMessage <- GuildId -> Text -> ReaderT DiscordHandle IO Message
forall (m :: * -> *).
MonadDiscord m =>
GuildId -> Text -> m Message
createMessage (Message -> GuildId
messageChannel Message
m) Text
assignStationT
    let assignStationID :: GuildId
assignStationID = Message -> GuildId
messageId Message
newMessage

    -- Hence, the map is fine. Write the mapping to the idAssign file :)
    let newFileName :: FilePath
newFileName = GuildId -> FilePath
getAssignFile GuildId
assignStationID
    -- Write the mapping to the newly added CSV
    ()
_ <- IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ())
-> ([[Text]] -> IO ()) -> [[Text]] -> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [[Text]] -> IO ()
writeCSV FilePath
newFileName ([[Text]] -> DiscordHandler ()) -> [[Text]] -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ (\(Text
key, GuildId
value) -> [Text
key, FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ GuildId -> FilePath
forall a. Show a => a -> FilePath
show GuildId
value]) ((Text, GuildId) -> [Text]) -> [(Text, GuildId)] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
emojiRoleIDMap

    -- Make Owen react to the self-assignment station.
    let emojiList :: [Text]
emojiList = (Text, GuildId) -> Text
forall a b. (a, b) -> a
fst ((Text, GuildId) -> Text) -> [(Text, GuildId)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
emojiRoleIDMap
    [Text] -> (Text -> DiscordHandler ()) -> DiscordHandler ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
emojiList (GuildId -> GuildId -> Text -> DiscordHandler ()
addReaction (Message -> GuildId
messageChannel Message
newMessage) GuildId
assignStationID)

    -- Add the new assign file to the CSV
    ()
_ <- IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [[Text]] -> IO ()
addToCSV FilePath
assignFilePath [[FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ GuildId -> FilePath
forall a. Show a => a -> FilePath
show GuildId
assignStationID, FilePath -> Text
T.pack FilePath
newFileName]]
    () -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

isOnAssignMessage :: ReactionInfo -> DiscordHandler Bool
isOnAssignMessage :: ReactionInfo -> DiscordHandler Bool
isOnAssignMessage ReactionInfo
r = do
    [GuildId]
validMessages <- IO [GuildId] -> ReaderT DiscordHandle IO [GuildId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [GuildId]
getAssignMessageIds
    Bool -> DiscordHandler Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> DiscordHandler Bool) -> Bool -> DiscordHandler Bool
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> GuildId
reactionMessageId ReactionInfo
r GuildId -> [GuildId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GuildId]
validMessages
    -- make sure the message being reacted is a role assignment message
    -- (prevents the config from being opened very often / every sent message)

-- | `attemptRoleAssign` handles role assignments.
attemptRoleAssign :: ReactionInfo -> DiscordHandler ()
attemptRoleAssign :: ReactionInfo -> DiscordHandler ()
attemptRoleAssign ReactionInfo
r = do
    Bool
validMsg <- ReactionInfo -> DiscordHandler Bool
isOnAssignMessage ReactionInfo
r
    Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
validMsg

    Maybe Text
assFileName <- IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text))
-> IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> IO (Maybe Text)
getRoleListIndex ReactionInfo
r
    [(Text, GuildId)]
roleMap <- IO [(Text, GuildId)] -> ReaderT DiscordHandle IO [(Text, GuildId)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, GuildId)]
 -> ReaderT DiscordHandle IO [(Text, GuildId)])
-> IO [(Text, GuildId)]
-> ReaderT DiscordHandle IO [(Text, GuildId)]
forall a b. (a -> b) -> a -> b
$ Text -> IO [(Text, GuildId)]
getRoleMap (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
assFileName)
    let desiredRole :: Maybe GuildId
desiredRole = Text -> [(Text, GuildId)] -> Maybe GuildId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toUpper (Text -> Text) -> (Emoji -> Text) -> Emoji -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Emoji -> Text
emojiName (Emoji -> Text) -> Emoji -> Text
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> Emoji
reactionEmoji ReactionInfo
r) [(Text, GuildId)]
roleMap
    Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> DiscordHandler ()) -> Bool -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GuildId
desiredRole
    -- sanity check the desired role (can't be anything other than those which
    -- are specified in the config; for example, emotePronounMap.csv)
    -- NOTE: make sure the emoji names in the config are uppercase.

    let newRoleId :: GuildId
newRoleId = Maybe GuildId -> GuildId
forall a. HasCallStack => Maybe a -> a
fromJust Maybe GuildId
desiredRole
    GuildId -> GuildId -> GuildId -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
GuildId -> GuildId -> GuildId -> m ()
addGuildMemberRole GuildId
serverID (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r) GuildId
newRoleId

    GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageDM (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r)
        (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Added your desired role! Hurray!"

-- | TODO: remove the repetition in handleRoleAssign/handleRoleRemove by
-- modularizing thingies better (i.e., the sanity check).
handleRoleRemove :: ReactionInfo -> DiscordHandler ()
handleRoleRemove :: ReactionInfo -> DiscordHandler ()
handleRoleRemove ReactionInfo
r = do
    [GuildId]
validMessages <- IO [GuildId] -> ReaderT DiscordHandle IO [GuildId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [GuildId]
getAssignMessageIds
    Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ReactionInfo -> GuildId
reactionMessageId ReactionInfo
r GuildId -> [GuildId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GuildId]
validMessages)
    -- make sure the message being reacted is a role assignment message
    -- (prevents the config from being opened very often / every sent message)

    Maybe Text
assFileName <- IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text))
-> IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> IO (Maybe Text)
getRoleListIndex ReactionInfo
r
    [(Text, GuildId)]
roleMap <- IO [(Text, GuildId)] -> ReaderT DiscordHandle IO [(Text, GuildId)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, GuildId)]
 -> ReaderT DiscordHandle IO [(Text, GuildId)])
-> IO [(Text, GuildId)]
-> ReaderT DiscordHandle IO [(Text, GuildId)]
forall a b. (a -> b) -> a -> b
$ Text -> IO [(Text, GuildId)]
getRoleMap (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
assFileName)
    let desiredRole :: Maybe GuildId
desiredRole = Text -> [(Text, GuildId)] -> Maybe GuildId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toUpper (Text -> Text) -> (Emoji -> Text) -> Emoji -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Emoji -> Text
emojiName (Emoji -> Text) -> Emoji -> Text
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> Emoji
reactionEmoji ReactionInfo
r) [(Text, GuildId)]
roleMap
    Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> DiscordHandler ()) -> Bool -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GuildId
desiredRole
    -- sanity check the desired role (can't be anything other than those which
    -- are specified in the config; for example, emotePronounMap.csv)
    -- NOTE: make sure the emoji names in the config are uppercase.

    let oldRoleId :: GuildId
oldRoleId = Maybe GuildId -> GuildId
forall a. HasCallStack => Maybe a -> a
fromJust Maybe GuildId
desiredRole
    GuildId -> GuildId -> GuildId -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
GuildId -> GuildId -> GuildId -> m ()
removeGuildMemberRole GuildId
serverID (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r) GuildId
oldRoleId

    GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageDM (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r)
        (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Really sorry you didn't like the role, I went ahead and removed it."

-- | Given a Text @dir@, `getRoleMap` parses the file in "src/config",
-- converting it into a dictionary. One mapping per line. The map is indicated
-- by a comma separating the emoji name (in UPPERCASE) and the corresponding role
-- ID. This has to be wrapped in IO.
getRoleMap :: T.Text -> IO [(T.Text, RoleId)]
getRoleMap :: Text -> IO [(Text, GuildId)]
getRoleMap Text
dir = do
    [[Text]]
contents <- FilePath -> IO [[Text]]
readCSV (FilePath -> IO [[Text]]) -> FilePath -> IO [[Text]]
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
dir
    [(Text, GuildId)] -> IO [(Text, GuildId)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, GuildId)] -> IO [(Text, GuildId)])
-> [(Text, GuildId)] -> IO [(Text, GuildId)]
forall a b. (a -> b) -> a -> b
$ do
        [Text]
line <- [[Text]]
contents
        (Text, GuildId) -> [(Text, GuildId)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Text
forall a. [a] -> a
head [Text]
line, (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> ([Text] -> FilePath) -> [Text] -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> ([Text] -> Text) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
tail) [Text]
line)

-- | Given a reaction @r@, `getRoleListIndex` parses the file "src/config/idAssign".
-- Note: this is a special file that represents a dictionary. Again, one mapping per line,
-- with the map indicated by a comma separating the message ID and the corresponding role
-- config file in "src/config". It returns a Maybe type representing the existence of such
-- a config file for the message that is attached to the given reaction.
getRoleListIndex :: ReactionInfo -> IO (Maybe T.Text)
getRoleListIndex :: ReactionInfo -> IO (Maybe Text)
getRoleListIndex ReactionInfo
r = do
    [[Text]]
contents <- FilePath -> IO [[Text]]
readCSV FilePath
assignFilePath
    Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text))
-> ([(GuildId, Text)] -> Maybe Text)
-> [(GuildId, Text)]
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildId -> [(GuildId, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ReactionInfo -> GuildId
reactionMessageId ReactionInfo
r) ([(GuildId, Text)] -> IO (Maybe Text))
-> [(GuildId, Text)] -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
        [Text]
line <- [[Text]]
contents
        let pair :: (Text, Text)
pair = ([Text] -> Text
forall a. [a] -> a
head [Text]
line, ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
tail) [Text]
line)
        (GuildId, Text) -> [(GuildId, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((GuildId, Text) -> [(GuildId, Text)])
-> (GuildId, Text) -> [(GuildId, Text)]
forall a b. (a -> b) -> a -> b
$ (Text -> GuildId) -> (Text, Text) -> (GuildId, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> (Text -> FilePath) -> Text -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (Text, Text)
pair

-- | `getAssignMessageIds` returns a list of all message Snowflakes for all messages which
-- represent a self assignment station. All such messages are present in "src/config/idAssign",
-- which is also the only file name that mustn't be edited.
getAssignMessageIds :: IO [MessageId]
getAssignMessageIds :: IO [GuildId]
getAssignMessageIds = do
    [[Text]]
lines <- FilePath -> IO [[Text]]
readCSV FilePath
assignFilePath
    [GuildId] -> IO [GuildId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GuildId] -> IO [GuildId]) -> [GuildId] -> IO [GuildId]
forall a b. (a -> b) -> a -> b
$ ([Text] -> GuildId) -> [[Text]] -> [GuildId]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> ([Text] -> FilePath) -> [Text] -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit (FilePath -> FilePath)
-> ([Text] -> FilePath) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> ([Text] -> Text) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. [a] -> a
head) [[Text]]
lines