1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
-- Enable when GHC7.10 support is not needed
-- where this fails with 'unknown flag'
-- {-# OPTIONS_GHC -Wno-orphans #-}
module Network.IRC.Bot.Parsec where
{-
The parsec part is supposed to make it easy to use Parsec to parse the command arguments.
We would also like to be able to generate a help menu. But the help
menu should not be for only Parsec commands. Or do we? Maybe all interactive commands should be implementing through parsec part.
Some commands like @seen (and @tell) are two part. There is the part that collects
the data. And there is the command itself. How would that integrate
with a parsec command master list?
We would like the parsec commands to be non-blocking.
Each top-level part is run in a separate thread. But if we only have one thread for all the parsecParts, then blocking could occur.
We could run every handler for every message, even though we only expect at most one command to match. That seems bogus. Do we really want to allow to different parts to respond to @foo ?
Seems better to have each part register.
data Part m =
Part { name :: String
, description :: String
, backgroundParts :: [BotPartT m ()]
, command :: Maybe (String, String, BotPartT m ()) -- ^ (name, usage, handler)
}
This is good, unless multiple plugins wanted to depend on some common backgroundParts
-}
import Control.Monad
import Control.Monad.Trans
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C
import Data.Char (digitToInt)
import Data.List (intercalate, nub)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Network.IRC.Bot.Log
import Network.IRC.Bot.BotMonad
import Network.IRC.Bot.Commands
import Text.Parsec
import Text.Parsec.Error (errorMessages, messageString)
import qualified Text.Parsec.Error as P
instance (BotMonad m, Monad m) => BotMonad (ParsecT s u m) where
askBotEnv = lift askBotEnv
askMessage = lift askMessage
askOutChan = lift askOutChan
localMessage f m = mapParsecT (localMessage f) m
sendMessage = lift . sendMessage
logM lvl msg' = lift (logM lvl msg')
whoami = lift whoami
mapParsecT :: (Monad m, Monad n) => (m (Consumed (m (Reply s u a))) -> n (Consumed (n (Reply s u b)))) -> ParsecT s u m a -> ParsecT s u n b
mapParsecT f p = mkPT $ \s -> f (runParsecT p s)
-- | parse a positive integer
nat :: (Monad m) => ParsecT ByteString () m Integer
nat =
do digits <- many1 digit
return $ foldl (\x d -> x * 10 + fromIntegral (digitToInt d)) 0 digits
-- | parser that checks for the 'cmdPrefix' (from the 'BotEnv')
botPrefix :: (BotMonad m) => ParsecT ByteString () m ()
botPrefix =
do recv <- fromMaybe "" <$> askReceiver
pref <- cmdPrefix <$> askBotEnv
if "#" `C.isPrefixOf` recv
then (try $ string pref >> return ()) <|> lift mzero
else (try $ string pref >> return ()) <|> return ()
-- | create a bot part by using Parsec to parse the command
--
-- The argument to 'parsecPart' is a parser function.
--
-- The argument to that parsec function is the 'target' that the response should be sent to.
--
-- The parser will receive the 'msg' from the 'PrivMsg'.
--
-- see 'dicePart' for an example usage.
parsecPart :: (BotMonad m) =>
(ParsecT ByteString () m a)
-> m a
parsecPart p =
do priv <- privMsg
logM Debug $ "I got a message: " <> msg priv <> " sent to " <> (C.intercalate ", " (receivers priv))
ma <- runParserT p () "" (msg priv)
case ma of
(Left e) ->
do logM Debug $ "Parse error: " <> C.pack (show e)
target <- maybeZero =<< replyTo
reportError target e
mzero
(Right a) -> return a
reportError :: (BotMonad m) => ByteString -> ParseError -> m ()
reportError target err =
let errStrs = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages err)
errStr = intercalate "; " errStrs
in sendCommand (PrivMsg Nothing [target] (C.pack errStr))
showErrorMessages ::
String -> String -> String -> String -> String -> [P.Message] -> [String]
showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs'
| null msgs' = [msgUnknown]
| otherwise = clean $
[showSysUnExpect,showUnExpect,showExpect,showMessages]
where
(sysUnExpect,msgs1) = span ((P.SysUnExpect "") ==) msgs'
(unExpect,msgs2) = span ((P.UnExpect "") ==) msgs1
(expect,messages) = span ((P.Expect "") ==) msgs2
showExpect = showMany msgExpecting expect
showUnExpect = showMany msgUnExpected unExpect
showSysUnExpect | not (null unExpect) ||
null sysUnExpect = ""
| null firstMsg = msgUnExpected <> " " <> msgEndOfInput
| otherwise = msgUnExpected <> " " <> firstMsg
where
firstMsg = messageString (head sysUnExpect)
showMessages = showMany "" messages
-- helpers
showMany pre msgs = case clean (map messageString msgs) of
[] -> ""
ms | null pre -> commasOr ms
| otherwise -> pre <> " " <> commasOr ms
commasOr [] = ""
commasOr [m] = m
commasOr ms = commaSep (init ms) <> " " <> msgOr <> " " <> last ms
commaSep = seperate ", " . clean
seperate _ [] = ""
seperate _ [m] = m
seperate sep (m:ms) = m <> sep <> seperate sep ms
clean = nub . filter (not . null)
|
