module Network.IRC.Parser (
decode
, prefix
, serverPrefix
, nicknamePrefix
, command
, parameter
, message
, crlf
, spaces
, 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
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 ':'
decode :: ByteString
-> Maybe Message
decode str = case parseOnly message str of
Left _ -> Nothing
Right r -> Just r
parseMessage :: ByteString -> Maybe Message
parseMessage = decode
tokenize :: Parser a -> Parser a
tokenize p = p <* spaces
spaces :: Parser ()
spaces = skip (\w -> w == wSpace ||
w == wTab ||
w == wBell)
prefix :: Parser Prefix
prefix = word8 wColon *> (try nicknamePrefix <|> serverPrefix)
<?> "prefix"
serverPrefix :: Parser Prefix
serverPrefix = Server <$> takeTill (== wSpace)
<?> "serverPrefix"
optionMaybe :: Parser a -> Parser (Maybe a)
optionMaybe p = option Nothing (Just <$> p)
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')
command :: Parser Command
command = takeWhile1 isWordAsciiUpper
<|> digitsToByteString <$>
digit
<*> digit
<*> digit
<?> "command"
where digitsToByteString x y z = pack [x,y,z]
parameter :: Parser Parameter
parameter = (word8 wColon *> takeTill (\w -> w == wCR ||
w == wLF))
<|> takeTill (\w -> w == wSpace ||
w == wCR ||
w == wLF)
<?> "parameter"
crlf :: Parser ()
crlf = void (word8 wCR *> optional (word8 wLF))
<|> void (word8 wLF)
message :: Parser Message
message = Message <$>
optionMaybe (tokenize prefix)
<*> command
<*> many (spaces *> parameter)
<* optional crlf
<* endOfInput
<?> "message"