@@ -0,0 +1,169 @@
1+module Royo.Bot where
2+
3+import Prelude hiding (between)
4+
5+import Control.Alt (alt)
6+import Control.Apply (lift2)
7+import Data.Either (Either(..))
8+import Data.Foldable (intercalate)
9+import Data.Interpolate (i)
10+import Data.Maybe (Maybe(..))
11+import Data.String (Pattern(..), contains, drop, length, stripPrefix, stripSuffix, trim)
12+import Data.String.NonEmpty.Internal (NonEmptyString(..))
13+import Data.String.NonEmpty.Internal as NES
14+import Data.String.Utils (startsWith)
15+import Discord.DiscordJS (ChannelType(..), DiscordToken, Message, createDMChannel, getChannelType, login, newClient, onMessage, onMessageUpdate, react, removeAllReactions, sendString)
16+import Effect.Aff (Aff, attempt, launchAff_, message)
17+import Effect.Class (liftEffect)
18+import Effect.Class.Console (log)
19+import Yoga.APIClient (CompileResult, YogaToken, compileAndRun)
20+
21+_BOT_USER_ID ∷ String
22+_BOT_USER_ID = "741940687263760475"
23+
24+mentionPrefix1 ∷ String
25+mentionPrefix1 = i "<@!" _BOT_USER_ID ">"
26+
27+_OTHER_BOT_USER_ID ∷ String
28+_OTHER_BOT_USER_ID = "741945029056135179"
29+
30+mentionPrefix2 ∷ String
31+mentionPrefix2 = i "<@&" _OTHER_BOT_USER_ID ">"
32+
33+printErrors :: Message -> Aff Unit -> Aff Unit
34+printErrors msg aff = do
35+ result <- attempt aff
36+ case result of
37+ Left e -> log $ "Couldnt' handle message" <> message e <> "\n" <> msg.content
38+ Right _ -> pure unit
39+
40+runBot ∷ YogaToken -> DiscordToken -> Aff Unit
41+runBot yogaToken discordToken = do
42+ newClient <- newClient # liftEffect
43+ client <- newClient # login discordToken
44+ client # onMessage (launchAff_ <$> messageHandler) # liftEffect
45+ client # onMessageUpdate (launchAff_ `map map map` messageUpdatedHandler) # liftEffect
46+ where
47+ messageUpdatedHandler _ msg = printErrors msg do
48+ when (getChannelType msg.channel == TextChannel) $ removeAllReactions msg
49+ msg # react rewindEmoji
50+ messageHandler msg
51+
52+ messageHandler msg@{ content, channel } = printErrors msg do
53+ when (isMention content) do
54+ case parseCodeBlock content of
55+ Nothing -> do
56+ sendBasicInstructions msg
57+ Just code -> do
58+ res <- compileAndRun yogaToken { code: prepareCode code }
59+ case res of
60+ Left cr -> sendCompileProblem msg code cr
61+ Right rr -> case NES.fromString rr.stdout, NES.fromString rr.stderr of
62+ Just stdout, _ -> do
63+ msg # react robotMuscleEmoji
64+ channel # sendString (NonEmptyString (prepareOutput rr.stdout))
65+ Nothing, Just stderr -> do
66+ msg # react sirenEmoji
67+ sendRunProblem msg code rr.stderr
68+ _, _ -> channel # sendString (NonEmptyString "Something is weird")
69+
70+sendBasicInstructions :: Message -> Aff Unit
71+sendBasicInstructions msg = do
72+ msg # react thinkingEmoji
73+ dmc <- createDMChannel msg.author
74+ dmc # sendString (NonEmptyString intro)
75+ where
76+ intro =intercalate "\n"
77+ [ "Welcome " <> waveEmoji <> "!"
78+ , "I am here to help you to try out some PureScript code!"
79+ , "I react to messages that start with @royo and are followed by code in in between backticks. "
80+ , "For example:"
81+ , ""
82+ , "@royo"
83+ , "\\`\\`\\`"
84+ , "\"Hello World!\""
85+ , "\\`\\`\\`"
86+ ]
87+
88+sendRunProblem ∷ Message -> String -> String -> Aff Unit
89+sendRunProblem msg code output = do
90+ msg # react sirenEmoji
91+ dmc <- createDMChannel msg.author
92+ let say x = sendString (NonEmptyString x) dmc
93+ say $ "Hey there! I just tried to run your code: \n"
94+ <> prepareOutput code
95+ <> "\nHowever, we can still improve a few things about it."
96+ <> "This is the intel I could gather:"
97+ say $ output
98+ say $ "Don't worry, simply edit your original code and I will try again! The compiler and I are here to help you! We're all in this together " <> robotMuscleEmoji
99+
100+sendCompileProblem ∷ Message -> String -> CompileResult -> Aff Unit
101+sendCompileProblem msg code cr = do
102+ msg # react sirenEmoji
103+ dmc <- createDMChannel msg.author
104+ let say x = sendString (NonEmptyString x) dmc
105+ say $ "Hey there! I just tried to compile your code: \n"
106+ <> prepareOutput code
107+ <> "\nHowever, we can still improve a few things about it."
108+ <> "This is what the compiler says:"
109+ say $ compilerMessages
110+ say $ "Don't worry, simply edit your original code and I will try again! The compiler and I are here to help you! We're all in this together " <> robotMuscleEmoji
111+ where
112+ compilerMessages = intercalate "\n" (prepareOutput <$> (cr.result <#> _.message))
113+
114+prepareOutput ∷ String -> String
115+prepareOutput s =
116+ if contains (Pattern "\n") s then
117+ "```\n" <> s <> "```\n"
118+ else
119+ "`" <> s <> "`"
120+
121+prepareCode ∷ String -> String
122+prepareCode code =
123+ if startsWith "module" code then
124+ code
125+ else
126+ if startsWith "import " code then
127+ moduleMain <> code
128+ else
129+ if (startsWith "main =" || contains (Pattern "\nmain =")) code then
130+ moduleMain <> importGrimoire <> code
131+ else
132+ moduleMain <> importGrimoire <> spyMain <> code
133+ where
134+ moduleMain = "module Main where\n"
135+
136+ importGrimoire = "import Grimoire\n"
137+
138+ spyMain = "main = log $ unsafeCoerce $ "
139+
140+isMention ∷ String -> Boolean
141+isMention = startsWith mentionPrefix1 || startsWith mentionPrefix2
142+
143+parseCodeBlock ∷ String -> Maybe String
144+parseCodeBlock =
145+ pure <<< trim
146+ >=> pure
147+ <<< drop (length mentionPrefix1)
148+ >=> (pure <<< trim)
149+ >=> (lift2 alt (stripPrefix (Pattern "```purescript")) (stripPrefix (Pattern "```")))
150+ >=> stripSuffix (Pattern "```")
151+ >=> (pure <<< trim)
152+
153+rewindEmoji ∷ String
154+rewindEmoji = "⏪"
155+
156+robotMuscleEmoji ∷ String
157+robotMuscleEmoji = "🦾"
158+
159+sirenEmoji ∷ String
160+sirenEmoji = "🚨"
161+
162+thinkingEmoji ∷ String
163+thinkingEmoji = "🤔"
164+
165+disappointedEmoji ∷ String
166+disappointedEmoji = "😔"
167+
168+waveEmoji ∷ String
169+waveEmoji = "👋"