1
1
{-# LANGUAGE OverloadedStrings #-}
2
- {-# LANGUAGE QuasiQuotes #-}
2
+ {-# LANGUAGE QuasiQuotes #-}
3
3
4
4
module Bot.CustomCommand
5
5
( addCustomCommand
@@ -10,28 +10,28 @@ module Bot.CustomCommand
10
10
, timesCustomCommand
11
11
) where
12
12
13
- import Bot.CustomCommandType
14
- import Bot.Expr
15
- import Bot.Flip
16
- import Bot.Help
17
- import Bot.Replies
18
- import Command
19
- import Control.Monad
20
- import Control.Monad.Trans.Maybe
21
- import Data.Functor.Compose
22
- import qualified Data.Map as M
23
- import Data.Maybe
24
- import Data.Proxy
25
- import qualified Data.Text as T
26
- import Data.Time
27
- import Effect
28
- import Entity
29
- import HyperNerd.Parser
30
- import qualified Network.URI.Encode as URI
31
- import Property
32
- import Reaction
33
- import Text.InterpolatedString.QM
34
- import Transport
13
+ import Bot.CustomCommandType
14
+ import Bot.Expr
15
+ import Bot.Flip
16
+ import Bot.Help
17
+ import Bot.Replies
18
+ import Command
19
+ import Control.Monad
20
+ import Control.Monad.Trans.Maybe
21
+ import Data.Functor.Compose
22
+ import qualified Data.Map as M
23
+ import Data.Maybe
24
+ import Data.Proxy
25
+ import qualified Data.Text as T
26
+ import Data.Time
27
+ import Effect
28
+ import Entity
29
+ import HyperNerd.Parser
30
+ import qualified Network.URI.Encode as URI
31
+ import Property
32
+ import Reaction
33
+ import Text.InterpolatedString.QM
34
+ import Transport
35
35
36
36
customCommandByName :: T. Text -> MaybeT Effect (Entity CustomCommand )
37
37
customCommandByName name =
@@ -42,10 +42,8 @@ customCommandByName name =
42
42
addCustomCommand :: CommandTable -> Reaction Message (T. Text , T. Text )
43
43
addCustomCommand builtinCommands =
44
44
Reaction $ \ mesg@ Message {messageSender = sender, messageContent = (name, message)} -> do
45
- runReaction refreshHelpGistId mesg
46
- customCommand <- runMaybeT $ customCommandByName name
47
- let builtinCommand = M. lookup name builtinCommands
48
- case (customCommand, builtinCommand) of
45
+ res <- refreshHelpAndUnpack builtinCommands (fst <$> mesg)
46
+ case res of
49
47
(Just _, Nothing ) ->
50
48
replyToSender sender [qms |Command '{name}' already exists|]
51
49
(Nothing , Just _) ->
@@ -65,13 +63,18 @@ addCustomCommand builtinCommands =
65
63
}
66
64
replyToSender sender [qms |Added command '{name}'|]
67
65
68
- deleteCustomCommand :: CommandTable -> Reaction Message T. Text
69
- deleteCustomCommand builtinCommands =
70
- Reaction $ \ mesg@ Message {messageSender = sender, messageContent = name} -> do
66
+ refreshHelpAndUnpack :: CommandTable -> Message T. Text -> Effect (Maybe (Entity CustomCommand ), Maybe BuiltinCommand )
67
+ refreshHelpAndUnpack builtinCommands mesg @ Message {messageContent = name} = do
71
68
runReaction refreshHelpGistId mesg
72
69
customCommand <- runMaybeT $ customCommandByName name
73
70
let builtinCommand = M. lookup name builtinCommands
74
- case (customCommand, builtinCommand) of
71
+ pure (customCommand, builtinCommand)
72
+
73
+ deleteCustomCommand :: CommandTable -> Reaction Message T. Text
74
+ deleteCustomCommand builtinCommands =
75
+ Reaction $ \ mesg@ Message {messageSender = sender, messageContent = name} -> do
76
+ res <- refreshHelpAndUnpack builtinCommands mesg
77
+ case res of
75
78
(Just _, Nothing ) -> do
76
79
void $
77
80
deleteEntities (Proxy :: Proxy CustomCommand ) $
@@ -139,10 +142,8 @@ timesCustomCommand builtinCommands =
139
142
updateCustomCommand :: CommandTable -> Reaction Message (T. Text , T. Text )
140
143
updateCustomCommand builtinCommands =
141
144
Reaction $ \ mesg@ Message {messageSender = sender, messageContent = (name, message)} -> do
142
- runReaction refreshHelpGistId mesg
143
- customCommand <- runMaybeT $ customCommandByName name
144
- let builtinCommand = M. lookup name builtinCommands
145
- case (customCommand, builtinCommand) of
145
+ res <- refreshHelpAndUnpack builtinCommands (fst <$> mesg)
146
+ case res of
146
147
(Just cmd, Nothing ) -> do
147
148
void $ updateEntityById (replaceCustomCommandMessage message <$> cmd)
148
149
replyToSender sender [qms |Command '{name}' has been updated|]
0 commit comments