{-# LANGUAGE OverloadedStrings #-}

module Misc (receivers, reactionReceivers, changePronouns) where

import              Control.Monad           ( when
                                            , unless
                                            , forM_ )
import              Data.Char               ( toUpper )
import qualified    Data.Maybe as M
import qualified    Data.Text.IO as TIO
import qualified    Data.Text as T
import              UnliftIO                ( liftIO, UnliftIO (unliftIO) )
import              Text.Regex.TDFA         ( (=~) )
import qualified    System.Process as SP
import              System.Random           ( randomR
                                            , getStdRandom
                                            , randomRIO
                                            )

import qualified    Text.Parsec.Text as T
import              Text.Parsec
import              Discord.Types
import              Discord

import              Command
import              Utils                   ( sendMessageChan
                                            , sendReply
                                            , sendAssetChan
                                            , addReaction
                                            , messageFromReaction
                                            , (=~=)
                                            , assetDir
                                            , isRoleInGuild
                                            )
import              Owoifier                ( owoify )

receivers :: [Message -> DiscordHandler ()]
receivers :: [Message -> DiscordHandler ()]
receivers =
    [ Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
owoifyIfPossible
    , Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
fortune
    , Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
godIsDead
    , Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). MonadDiscord m => Command m
thatcherIsDead
    , Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
thatcherIsAlive
    , Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand Command (ReaderT DiscordHandle IO)
forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m
dadJokeIfPossible
    ]

reactionReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionReceivers =
    [ ReactionInfo -> DiscordHandler ()
forceOwoify ]

-- TODO: put these in config so they can be changed at runtime
owoifyChance, dadJokeChance :: Int
owoifyChance :: Int
owoifyChance  = Int
500
dadJokeChance :: Int
dadJokeChance = Int
1

owoifiedEmoji :: T.Text
owoifiedEmoji :: Text
owoifiedEmoji = Text
"✅"

roll :: Int -> IO Int
roll :: Int -> IO Int
roll Int
n = (StdGen -> (Int, StdGen)) -> IO Int
forall a. (StdGen -> (a, StdGen)) -> IO a
getStdRandom ((StdGen -> (Int, StdGen)) -> IO Int)
-> (StdGen -> (Int, StdGen)) -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
1, Int
n)

owoifyIfPossible :: (MonadDiscord m, MonadIO m) => Command m
owoifyIfPossible :: Command m
owoifyIfPossible
    = (Message -> m (Maybe Text)) -> Command m -> Command m
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires (\Message
m -> do
        Int
r <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> IO Int
roll Int
owoifyChance
        Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
        )
    (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text -> (Message -> [Text] -> m ()) -> Command m
forall (m :: * -> *).
MonadDiscord m =>
Text -> (Message -> [Text] -> m ()) -> Command m
regexCommand Text
"[lLrR]|[nNmM][oO]"
    ((Message -> [Text] -> m ()) -> Command m)
-> (Message -> [Text] -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m [Text]
_ -> Message -> Bool -> Text -> m ()
forall (m :: * -> *).
MonadDiscord m =>
Message -> Bool -> Text -> m ()
sendReply Message
m Bool
True (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify (Message -> Text
messageText Message
m)

-- | Emote names for which to trigger force owoify on. Use All Caps.
forceOwoifyEmotes :: [T.Text]
forceOwoifyEmotes :: [Text]
forceOwoifyEmotes =
    [ Text
"BEGONEBISH" ]

-- | Forces the owofication of a message upon a reaction of forceOwoifyEmotes.
-- Marks it as done with a green check, and checks for its existence to prevent
-- duplicates.
forceOwoify :: ReactionInfo -> DiscordHandler ()
forceOwoify :: ReactionInfo -> DiscordHandler ()
forceOwoify ReactionInfo
r = do
    Message
mess <- ReactionInfo -> ReaderT DiscordHandle IO Message
forall (m :: * -> *). MonadDiscord m => ReactionInfo -> m Message
messageFromReaction ReactionInfo
r
    -- Get all reactions for the associated message
    let reactions :: [MessageReaction]
reactions = Message -> [MessageReaction]
messageReactions Message
mess
    -- Define conditions that stops execution
    let blockCond :: MessageReaction -> Bool
blockCond = \MessageReaction
x ->
            MessageReaction -> Bool
messageReactionMeIncluded MessageReaction
x
            Bool -> Bool -> Bool
&& Emoji -> Text
emojiName (MessageReaction -> Emoji
messageReactionEmoji MessageReaction
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
owoifiedEmoji
    -- Conditions that say go!
    let fulfillCond :: MessageReaction -> Bool
fulfillCond = \MessageReaction
x ->
            Text -> Text
T.toUpper (Emoji -> Text
emojiName (Emoji -> Text) -> Emoji -> Text
forall a b. (a -> b) -> a -> b
$ MessageReaction -> Emoji
messageReactionEmoji MessageReaction
x) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
forceOwoifyEmotes
    -- If all goes good, add a checkmark and send an owoification reply
    Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((MessageReaction -> Bool) -> [MessageReaction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any MessageReaction -> Bool
blockCond [MessageReaction]
reactions Bool -> Bool -> Bool
|| Bool -> Bool
not ((MessageReaction -> Bool) -> [MessageReaction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any MessageReaction -> Bool
fulfillCond [MessageReaction]
reactions)) (DiscordHandler () -> DiscordHandler ())
-> DiscordHandler () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ do
        ChannelId -> ChannelId -> Text -> DiscordHandler ()
addReaction (ReactionInfo -> ChannelId
reactionChannelId ReactionInfo
r) (ReactionInfo -> ChannelId
reactionMessageId ReactionInfo
r) Text
owoifiedEmoji
        -- Send reply without pinging (this isn't as ping-worthy as random trigger)
        Message -> Bool -> Text -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Message -> Bool -> Text -> m ()
sendReply Message
mess Bool
False (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify (Message -> Text
messageText Message
mess)

godIsDead :: (MonadDiscord m, MonadIO m) => Command m
godIsDead :: Command m
godIsDead = Text -> (Message -> [Text] -> m ()) -> Command m
forall (m :: * -> *).
MonadDiscord m =>
Text -> (Message -> [Text] -> m ()) -> Command m
regexCommand Text
"[gG]od *[iI]s *[dD]ead" ((Message -> [Text] -> m ()) -> Command m)
-> (Message -> [Text] -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m [Text]
_ -> do
    FilePath
base <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
assetDir
    Text
contents <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
TIO.readFile (FilePath -> IO Text) -> FilePath -> IO Text
forall a b. (a -> b) -> a -> b
$ FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"nietzsche.txt")
    ChannelId -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
m) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
contents

thatcherRE :: T.Text
thatcherRE :: Text
thatcherRE = Text
"thatcher('s *| *[Ii]s) *"

thatcherIsDead :: (MonadDiscord m) => Command m
thatcherIsDead :: Command m
thatcherIsDead = Text -> (Message -> [Text] -> m ()) -> Command m
forall (m :: * -> *).
MonadDiscord m =>
Text -> (Message -> [Text] -> m ()) -> Command m
regexCommand (Text
thatcherRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[Dd]ead") ((Message -> [Text] -> m ()) -> Command m)
-> (Message -> [Text] -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m [Text]
_ ->
    Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"https://www.youtube.com/watch?v=ILvd5buCEnU"

thatcherIsAlive :: (MonadDiscord m, MonadIO m) => Command m
thatcherIsAlive :: Command m
thatcherIsAlive = Text -> (Message -> [Text] -> m ()) -> Command m
forall (m :: * -> *).
MonadDiscord m =>
Text -> (Message -> [Text] -> m ()) -> Command m
regexCommand (Text
thatcherRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[Aa]live") ((Message -> [Text] -> m ()) -> Command m)
-> (Message -> [Text] -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m [Text]
_ ->
    ChannelId -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
ChannelId -> Text -> FilePath -> m ()
sendAssetChan (Message -> ChannelId
messageChannel Message
m) Text
"god_help_us_all.mp4" FilePath
"god_help_us_all.mp4"

dadJokeIfPossible :: (MonadDiscord m, MonadIO m) => Command m
dadJokeIfPossible :: Command m
dadJokeIfPossible =
    (Message -> m (Maybe Text)) -> Command m -> Command m
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires (\Message
m -> do
        Int
r <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> IO Int
roll Int
dadJokeChance
        Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
        )
    (Command m -> Command m) -> Command m -> Command m
forall a b. (a -> b) -> a -> b
$ Text -> (Message -> [Text] -> m ()) -> Command m
forall (m :: * -> *).
MonadDiscord m =>
Text -> (Message -> [Text] -> m ()) -> Command m
regexCommand Text
"^[iI] ?[aA]?'?[mM] +([a-zA-Z'*]+)([!;:.,?~-]+| *$)"
    ((Message -> [Text] -> m ()) -> Command m)
-> (Message -> [Text] -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m (Text
name:[Text]
_) ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Int
T.length Text
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify (Text
"hello " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", i'm owen")

fortune :: (MonadDiscord m, MonadIO m) => Command m
fortune :: Command m
fortune = Text -> (Message -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"fortune" ((Message -> m ()) -> Command m) -> (Message -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
    FilePath
cowText <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
fortuneCow
    Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
cowText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"```"

fortuneProc :: IO String
fortuneProc :: IO FilePath
fortuneProc = FilePath -> [FilePath] -> FilePath -> IO FilePath
SP.readProcess FilePath
"fortune" [] []

fortuneCowFiles :: [String]
fortuneCowFiles :: [FilePath]
fortuneCowFiles =
    [ FilePath
"default"
    , FilePath
"milk"
    , FilePath
"moose"
    , FilePath
"moofasa"
    , FilePath
"three-eyes"
    , FilePath
"www"
    ]

fortuneCow :: IO String
fortuneCow :: IO FilePath
fortuneCow = do
    FilePath
base <- IO FilePath
assetDir
    Text
f <- FilePath -> Text
T.pack (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
fortuneProc
    Int
roll <- Int -> IO Int
roll (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
fortuneCowFiles
    let file :: FilePath
file = if Int
roll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        then FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"freddy.cow"
        else [FilePath]
fortuneCowFiles [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
roll
    FilePath -> [FilePath] -> FilePath -> IO FilePath
SP.readProcess FilePath
"cowsay" [FilePath
"-f", FilePath
file] (FilePath -> IO FilePath)
-> (Text -> FilePath) -> Text -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> IO FilePath) -> Text -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
f

-- | "Joke" function to change owen's pronouns randomly in servers on startup, cause owen is our favourite genderfluid icon
changePronouns :: (MonadDiscord m, MonadIO m) => m ()
changePronouns :: m ()
changePronouns = do
    User
u <- m User
forall (m :: * -> *). MonadDiscord m => m User
getCurrentUser
    -- get partial guilds, don't contain full information, so getId is defined below
    [PartialGuild]
pGuilds <- m [PartialGuild]
forall (m :: * -> *). MonadDiscord m => m [PartialGuild]
getCurrentUserGuilds
    let guilds :: [ChannelId]
guilds = PartialGuild -> ChannelId
partialGuildId (PartialGuild -> ChannelId) -> [PartialGuild] -> [ChannelId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PartialGuild]
pGuilds
    let pronouns :: [Text]
pronouns = [Text
"she/her", Text
"he/him", Text
"they/them"]

    [(ChannelId, [ChannelId])]
guildPronounMapUnfiltered <- [m (ChannelId, [ChannelId])] -> m [(ChannelId, [ChannelId])]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m (ChannelId, [ChannelId])] -> m [(ChannelId, [ChannelId])])
-> [m (ChannelId, [ChannelId])] -> m [(ChannelId, [ChannelId])]
forall a b. (a -> b) -> a -> b
$ do
        ChannelId
g <- [ChannelId]
guilds
        m (ChannelId, [ChannelId]) -> [m (ChannelId, [ChannelId])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (ChannelId, [ChannelId]) -> [m (ChannelId, [ChannelId])])
-> m (ChannelId, [ChannelId]) -> [m (ChannelId, [ChannelId])]
forall a b. (a -> b) -> a -> b
$ do
            [Maybe ChannelId]
pronounRoles <- [m (Maybe ChannelId)] -> m [Maybe ChannelId]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m (Maybe ChannelId)] -> m [Maybe ChannelId])
-> [m (Maybe ChannelId)] -> m [Maybe ChannelId]
forall a b. (a -> b) -> a -> b
$ (Text -> ChannelId -> m (Maybe ChannelId)
forall (m :: * -> *).
MonadDiscord m =>
Text -> ChannelId -> m (Maybe ChannelId)
`isRoleInGuild` ChannelId
g) (Text -> m (Maybe ChannelId)) -> [Text] -> [m (Maybe ChannelId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
pronouns
            let matchingRoles :: [ChannelId]
matchingRoles = [Maybe ChannelId] -> [ChannelId]
forall a. [Maybe a] -> [a]
M.catMaybes [Maybe ChannelId]
pronounRoles
            (ChannelId, [ChannelId]) -> m (ChannelId, [ChannelId])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChannelId
g, [ChannelId]
matchingRoles)

    -- remove guilds without pronoun roles
    let guildPronounMap :: [(ChannelId, [ChannelId])]
guildPronounMap = ((ChannelId, [ChannelId]) -> Bool)
-> [(ChannelId, [ChannelId])] -> [(ChannelId, [ChannelId])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ChannelId, [ChannelId]) -> Bool)
-> (ChannelId, [ChannelId])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChannelId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ChannelId] -> Bool)
-> ((ChannelId, [ChannelId]) -> [ChannelId])
-> (ChannelId, [ChannelId])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelId, [ChannelId]) -> [ChannelId]
forall a b. (a, b) -> b
snd) [(ChannelId, [ChannelId])]
guildPronounMapUnfiltered

    -- remove current pronoun roles
    let simplifiedMap :: [(ChannelId, ChannelId)]
simplifiedMap = [[(ChannelId, ChannelId)]] -> [(ChannelId, ChannelId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ChannelId, ChannelId)]] -> [(ChannelId, ChannelId)])
-> [[(ChannelId, ChannelId)]] -> [(ChannelId, ChannelId)]
forall a b. (a -> b) -> a -> b
$ (ChannelId, [ChannelId]) -> [(ChannelId, ChannelId)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((ChannelId, [ChannelId]) -> [(ChannelId, ChannelId)])
-> [(ChannelId, [ChannelId])] -> [[(ChannelId, ChannelId)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ChannelId, [ChannelId])]
guildPronounMap
    [(ChannelId, ChannelId)]
-> ((ChannelId, ChannelId) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ChannelId, ChannelId)]
simplifiedMap (\(ChannelId
g, ChannelId
r) -> ChannelId -> ChannelId -> ChannelId -> m ()
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> ChannelId -> ChannelId -> m ()
removeGuildMemberRole ChannelId
g (User -> ChannelId
userId User
u) ChannelId
r)

    [(ChannelId, ChannelId)]
chosenPronouns <- [m (ChannelId, ChannelId)] -> m [(ChannelId, ChannelId)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m (ChannelId, ChannelId)] -> m [(ChannelId, ChannelId)])
-> [m (ChannelId, ChannelId)] -> m [(ChannelId, ChannelId)]
forall a b. (a -> b) -> a -> b
$ do
        (ChannelId
gid, [ChannelId]
roles) <- [(ChannelId, [ChannelId])]
guildPronounMap
        m (ChannelId, ChannelId) -> [m (ChannelId, ChannelId)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (ChannelId, ChannelId) -> [m (ChannelId, ChannelId)])
-> m (ChannelId, ChannelId) -> [m (ChannelId, ChannelId)]
forall a b. (a -> b) -> a -> b
$ do
            Just ChannelId
role <- IO (Maybe ChannelId) -> m (Maybe ChannelId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ChannelId) -> m (Maybe ChannelId))
-> IO (Maybe ChannelId) -> m (Maybe ChannelId)
forall a b. (a -> b) -> a -> b
$ [ChannelId] -> IO (Maybe ChannelId)
forall a. [a] -> IO (Maybe a)
randomChoice [ChannelId]
roles
            (ChannelId, ChannelId) -> m (ChannelId, ChannelId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChannelId
gid, ChannelId
role)

    [(ChannelId, ChannelId)]
-> ((ChannelId, ChannelId) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ChannelId, ChannelId)]
chosenPronouns (\(ChannelId
g, ChannelId
r) -> ChannelId -> ChannelId -> ChannelId -> m ()
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> ChannelId -> ChannelId -> m ()
addGuildMemberRole ChannelId
g (User -> ChannelId
userId User
u) ChannelId
r)

    where
        randomChoice :: [a] -> IO (Maybe a)
        randomChoice :: [a] -> IO (Maybe a)
randomChoice [] = Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        randomChoice [a]
l = Maybe (IO a) -> IO (Maybe a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe (IO a) -> IO (Maybe a)) -> Maybe (IO a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ IO a -> Maybe (IO a)
forall a. a -> Maybe a
Just (IO a -> Maybe (IO a)) -> IO a -> Maybe (IO a)
forall a b. (a -> b) -> a -> b
$ ([a]
l [a] -> Int -> a
forall a. [a] -> Int -> a
!!) (Int -> a) -> IO Int -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a. Random a => (a, a) -> IO a
randomRIO (Int
0, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)