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
148
149
150
151
152
|
-- | Parsec parsers and a general parsing interface for IRC messages
module Network.IRC.Parser (
-- * Parsing and Formatting Functions
decode -- :: String -> Maybe Message
-- * Parsec Combinators for Parsing IRC messages
, prefix -- :: Parser Prefix
, serverPrefix -- :: Parser Prefix
, nicknamePrefix -- :: Parser Prefix
, command -- :: Parser Command
, parameter -- :: Parser Parameter
, message -- :: Parser Message
, crlf -- :: Parser ()
, spaces -- :: Parser ()
-- * Deprecated Functions
, parseMessage
) where
import Network.IRC.Base
import Data.Char
import Data.Word
import Data.ByteString hiding (elem, map, empty)
import Control.Monad (void)
import Control.Applicative
import Data.Attoparsec.ByteString
-- | Casts a character (assumed to be ASCII) to its corresponding byte.
asciiToWord8 :: Char -> Word8
asciiToWord8 = fromIntegral . ord
wSpace :: Word8
wSpace = asciiToWord8 ' '
wTab :: Word8
wTab = asciiToWord8 '\t'
wBell :: Word8
wBell = asciiToWord8 '\b'
wDot :: Word8
wDot = asciiToWord8 '.'
wExcl :: Word8
wExcl = asciiToWord8 '!'
wAt :: Word8
wAt = asciiToWord8 '@'
wCR :: Word8
wCR = asciiToWord8 '\r'
wLF :: Word8
wLF = asciiToWord8 '\n'
wColon :: Word8
wColon = asciiToWord8 ':'
-- | Parse a String into a Message.
decode :: ByteString -- ^ Message string
-> Maybe Message -- ^ Parsed message
decode str = case parseOnly message str of
Left _ -> Nothing
Right r -> Just r
-- | The deprecated version of decode
parseMessage :: ByteString -> Maybe Message
parseMessage = decode
-- | Convert a parser that consumes all space after it
tokenize :: Parser a -> Parser a
tokenize p = p <* spaces
-- | Consume only spaces, tabs, or the bell character
spaces :: Parser ()
spaces = skip (\w -> w == wSpace ||
w == wTab ||
w == wBell)
-- | Parse a Prefix
prefix :: Parser Prefix
prefix = word8 wColon *> (try nicknamePrefix <|> serverPrefix)
<?> "prefix"
-- | Parse a Server prefix
serverPrefix :: Parser Prefix
serverPrefix = Server <$> takeTill (== wSpace)
<?> "serverPrefix"
-- | optionMaybe p tries to apply parser p. If p fails without consuming input,
-- | it return Nothing, otherwise it returns Just the value returned by p.
optionMaybe :: Parser a -> Parser (Maybe a)
optionMaybe p = option Nothing (Just <$> p)
-- | Parse a NickName prefix
nicknamePrefix :: Parser Prefix
nicknamePrefix = do
n <- takeTill (inClass " .!@\r\n")
p <- peekWord8
case p of
Just c | c == wDot -> empty
_ -> NickName n <$>
optionMaybe (word8 wExcl *> takeTill (\w -> w == wSpace ||
w == wAt ||
w == wCR ||
w == wLF))
<*> optionMaybe (word8 wAt *> takeTill (\w -> w == wSpace ||
w == wCR ||
w == wLF))
<?> "nicknamePrefix"
isWordAsciiUpper :: Word8 -> Bool
isWordAsciiUpper w = asciiToWord8 'A' <= w && w <= asciiToWord8 'Z'
digit :: Parser Word8
digit = satisfy (\w -> asciiToWord8 '0' <= w && w <= asciiToWord8 '9')
-- | Parse a command. Either a string of capital letters, or 3 digits.
command :: Parser Command
command = takeWhile1 isWordAsciiUpper
<|> digitsToByteString <$>
digit
<*> digit
<*> digit
<?> "command"
where digitsToByteString x y z = pack [x,y,z]
-- | Parse a command parameter.
parameter :: Parser Parameter
parameter = (word8 wColon *> takeTill (\w -> w == wCR ||
w == wLF))
<|> takeTill (\w -> w == wSpace ||
w == wCR ||
w == wLF)
<?> "parameter"
-- | Parse a cr lf
crlf :: Parser ()
crlf = void (word8 wCR *> optional (word8 wLF))
<|> void (word8 wLF)
-- | Parse a Message
message :: Parser Message
message = Message <$>
optionMaybe (tokenize prefix)
<*> command
<*> many (some spaces *> parameter)
<* optional crlf
<* endOfInput
<?> "message"
|
