@@ -0,0 +1,169 @@
3+import Prelude hiding (between)
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)
22+_BOT_USER_ID = "741940687263760475"
24+mentionPrefix1 ∷ String
25+mentionPrefix1 = i "<@!" _BOT_USER_ID ">"
27+_OTHER_BOT_USER_ID ∷ String
28+_OTHER_BOT_USER_ID = "741945029056135179"
30+mentionPrefix2 ∷ String
31+mentionPrefix2 = i "<@&" _OTHER_BOT_USER_ID ">"
33+printErrors :: Message -> Aff Unit -> Aff Unit
34+printErrors msg aff = do
35+ result <- attempt aff
37+ Left e -> log $ "Couldnt' handle message" <> message e <> "\n" <> msg.content
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
47+ messageUpdatedHandler _ msg = printErrors msg do
48+ when (getChannelType msg.channel == TextChannel) $ removeAllReactions msg
49+ msg # react rewindEmoji
52+ messageHandler msg@{ content, channel } = printErrors msg do
53+ when (isMention content) do
54+ case parseCodeBlock content of
56+ sendBasicInstructions msg
58+ res <- compileAndRun yogaToken { code: prepareCode code }
60+ Left cr -> sendCompileProblem msg code cr
61+ Right rr -> case NES.fromString rr.stdout, NES.fromString rr.stderr of
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")
70+sendBasicInstructions :: Message -> Aff Unit
71+sendBasicInstructions msg = do
72+ msg # react thinkingEmoji
73+ dmc <- createDMChannel msg.author
74+ dmc # sendString (NonEmptyString intro)
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. "
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:"
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
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
112+ compilerMessages = intercalate "\n" (prepareOutput <$> (cr.result <#> _.message))
114+prepareOutput ∷ String -> String
116+ if contains (Pattern "\n") s then
117+ "```\n" <> s <> "```\n"
121+prepareCode ∷ String -> String
123+ if startsWith "module" code then
126+ if startsWith "import " code then
129+ if (startsWith "main =" || contains (Pattern "\nmain =")) code then
130+ moduleMain <> importGrimoire <> code
132+ moduleMain <> importGrimoire <> spyMain <> code
134+ moduleMain = "module Main where\n"
136+ importGrimoire = "import Grimoire\n"
138+ spyMain = "main = log $ unsafeCoerce $ "
140+isMention ∷ String -> Boolean
141+isMention = startsWith mentionPrefix1 || startsWith mentionPrefix2
143+parseCodeBlock ∷ String -> Maybe String
147+ <<< drop (length mentionPrefix1)
149+ >=> (lift2 alt (stripPrefix (Pattern "```purescript")) (stripPrefix (Pattern "```")))
150+ >=> stripSuffix (Pattern "```")
156+robotMuscleEmoji ∷ String
157+robotMuscleEmoji = "🦾"
162+thinkingEmoji ∷ String
165+disappointedEmoji ∷ String
166+disappointedEmoji = "😔"