blob: e92a9d08b90ca08c18ff8cb61246dcdeb93f0d4a (
plain)
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
|
module Hsbot.Irc.Message
( IrcBotMsg (..)
, IrcCmd (..)
, IrcMsg (..)
, emptyIrcMsg
, parseIrcMsg
, serializeIrcMsg
) where
import Control.Monad.Identity
import Text.Parsec
-- | An IRC message
data IrcMsg = IrcMsg
{ ircMsgPrefix :: Maybe String -- the message prefix
, ircMsgCommand :: String -- the message command
, ircMsgParameters :: [String] -- the message parameters
} deriving (Show)
emptyIrcMsg :: IrcMsg
emptyIrcMsg = IrcMsg Nothing "" []
-- | An internal command
data IrcCmd = IrcCmd
{ ircCmdCmd :: String -- the internal command
, ircCmdFrom :: String -- who issues it
, ircCmdTo :: String -- who it is destinated to
, ircCmdMsg :: String -- the message to be transfered
, ircCmdBotMsg :: IrcMsg -- An IrcMsg attached to the command
} deriving (Show)
data IrcBotMsg = InIrcMsg IrcMsg | OutIrcMsg IrcMsg | IntIrcCmd IrcCmd deriving (Show)
-- | Parses an IrcInput
parseIrcMsg :: String -> Either ParseError IrcMsg
parseIrcMsg line = parse pMsg "" line
pMsg :: ParsecT String u Identity IrcMsg
pMsg = do
pfx <- optionMaybe pPrefix
cmd <- pCommand
params <- many (char ' ' >> (pLongParam <|> pShortParam))
_ <- char '\r'
--eof
return $ IrcMsg pfx cmd params
pPrefix :: ParsecT String u Identity [Char]
pPrefix = do
_ <- char ':'
pfx <- many1 (noneOf " ")
_ <- space
return pfx
pCommand :: ParsecT String u Identity [Char]
pCommand = count 3 digit <|> many1 upper
pLongParam :: ParsecT String u Identity [Char]
pLongParam = char ':' >> (many1 (noneOf "\r"))
pShortParam :: ParsecT String u Identity [Char]
pShortParam = many1 (noneOf " \r")
-- | Serialize an IRC message to a string.
serializeIrcMsg :: IrcMsg -> String
serializeIrcMsg (IrcMsg pfx cmd params) = pfxStr ++ cmd ++ paramStr
where pfxStr = case pfx of
Nothing -> ""
Just pfx' -> ":" ++ pfx' ++ " "
paramStr = concat (map paramToStr (init params)
++ [lastParamToStr (last params)])
paramToStr p = " " ++ p
lastParamToStr p = " :" ++ p
|
