{-# 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 ]
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)
forceOwoifyEmotes :: [T.Text]
forceOwoifyEmotes :: [Text]
forceOwoifyEmotes =
[ Text
"BEGONEBISH" ]
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
let reactions :: [MessageReaction]
reactions = Message -> [MessageReaction]
messageReactions Message
mess
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
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
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
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
changePronouns :: (MonadDiscord m, MonadIO m) => m ()
changePronouns :: m ()
changePronouns = do
User
u <- m User
forall (m :: * -> *). MonadDiscord m => m User
getCurrentUser
[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)
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
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)