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 :: Char -> Word8
asciiToWord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
wSpace :: Word8
wSpace :: Word8
wSpace = Char -> Word8
asciiToWord8 Char
' '
wTab :: Word8
wTab :: Word8
wTab = Char -> Word8
asciiToWord8 Char
'\t'
wBell :: Word8
wBell :: Word8
wBell = Char -> Word8
asciiToWord8 Char
'\b'
wDot :: Word8
wDot :: Word8
wDot = Char -> Word8
asciiToWord8 Char
'.'
wExcl :: Word8
wExcl :: Word8
wExcl = Char -> Word8
asciiToWord8 Char
'!'
wAt :: Word8
wAt :: Word8
wAt = Char -> Word8
asciiToWord8 Char
'@'
wCR :: Word8
wCR :: Word8
wCR = Char -> Word8
asciiToWord8 Char
'\r'
wLF :: Word8
wLF :: Word8
wLF = Char -> Word8
asciiToWord8 Char
'\n'
wColon :: Word8
wColon :: Word8
wColon = Char -> Word8
asciiToWord8 Char
':'
decode :: ByteString
-> Maybe Message
decode :: ByteString -> Maybe Message
decode ByteString
str = case Parser Message -> ByteString -> Either String Message
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser Message
message ByteString
str of
Left String
_ -> Maybe Message
forall a. Maybe a
Nothing
Right Message
r -> Message -> Maybe Message
forall a. a -> Maybe a
Just Message
r
parseMessage :: ByteString -> Maybe Message
parseMessage :: ByteString -> Maybe Message
parseMessage = ByteString -> Maybe Message
decode
tokenize :: Parser a -> Parser a
tokenize :: forall a. Parser a -> Parser a
tokenize Parser a
p = Parser a
p Parser a -> Parser ByteString () -> Parser a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
spaces
spaces :: Parser ()
spaces :: Parser ByteString ()
spaces = (Word8 -> Bool) -> Parser ByteString ()
skip (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wSpace Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wTab Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wBell)
prefix :: Parser Prefix
prefix :: Parser Prefix
prefix = Word8 -> Parser Word8
word8 Word8
wColon Parser Word8 -> Parser Prefix -> Parser Prefix
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Prefix -> Parser Prefix
forall i a. Parser i a -> Parser i a
try Parser Prefix
nicknamePrefix Parser Prefix -> Parser Prefix -> Parser Prefix
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Prefix
serverPrefix)
Parser Prefix -> String -> Parser Prefix
forall i a. Parser i a -> String -> Parser i a
<?> String
"prefix"
serverPrefix :: Parser Prefix
serverPrefix :: Parser Prefix
serverPrefix = ByteString -> Prefix
Server (ByteString -> Prefix)
-> Parser ByteString ByteString -> Parser Prefix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wSpace)
Parser Prefix -> String -> Parser Prefix
forall i a. Parser i a -> String -> Parser i a
<?> String
"serverPrefix"
optionMaybe :: Parser a -> Parser (Maybe a)
optionMaybe :: forall a. Parser a -> Parser (Maybe a)
optionMaybe Parser a
p = Maybe a
-> Parser ByteString (Maybe a) -> Parser ByteString (Maybe a)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser ByteString (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p)
nicknamePrefix :: Parser Prefix
nicknamePrefix :: Parser Prefix
nicknamePrefix = do
ByteString
n <- (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (String -> Word8 -> Bool
inClass String
" .!@\r\n")
Maybe Word8
p <- Parser (Maybe Word8)
peekWord8
case Maybe Word8
p of
Just Word8
c | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wDot -> Parser Prefix
forall a. Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a
empty
Maybe Word8
_ -> ByteString -> Maybe ByteString -> Maybe ByteString -> Prefix
NickName ByteString
n (Maybe ByteString -> Maybe ByteString -> Prefix)
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString -> Prefix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall a. Parser a -> Parser (Maybe a)
optionMaybe (Word8 -> Parser Word8
word8 Word8
wExcl Parser Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wSpace Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wAt Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wCR Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wLF))
Parser ByteString (Maybe ByteString -> Prefix)
-> Parser ByteString (Maybe ByteString) -> Parser Prefix
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall a. Parser a -> Parser (Maybe a)
optionMaybe (Word8 -> Parser Word8
word8 Word8
wAt Parser Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wSpace Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wCR Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wLF))
Parser Prefix -> String -> Parser Prefix
forall i a. Parser i a -> String -> Parser i a
<?> String
"nicknamePrefix"
isWordAsciiUpper :: Word8 -> Bool
isWordAsciiUpper :: Word8 -> Bool
isWordAsciiUpper Word8
w = Char -> Word8
asciiToWord8 Char
'A' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
asciiToWord8 Char
'Z'
digit :: Parser Word8
digit :: Parser Word8
digit = (Word8 -> Bool) -> Parser Word8
satisfy (\Word8
w -> Char -> Word8
asciiToWord8 Char
'0' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
asciiToWord8 Char
'9')
command :: Parser Command
command :: Parser ByteString ByteString
command = (Word8 -> Bool) -> Parser ByteString ByteString
takeWhile1 Word8 -> Bool
isWordAsciiUpper
Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> Word8 -> Word8 -> ByteString
digitsToByteString (Word8 -> Word8 -> Word8 -> ByteString)
-> Parser Word8 -> Parser ByteString (Word8 -> Word8 -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Parser Word8
digit
Parser ByteString (Word8 -> Word8 -> ByteString)
-> Parser Word8 -> Parser ByteString (Word8 -> ByteString)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
digit
Parser ByteString (Word8 -> ByteString)
-> Parser Word8 -> Parser ByteString ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
digit
Parser ByteString ByteString
-> String -> Parser ByteString ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"command"
where digitsToByteString :: Word8 -> Word8 -> Word8 -> ByteString
digitsToByteString Word8
x Word8
y Word8
z = [Word8] -> ByteString
pack [Word8
x,Word8
y,Word8
z]
parameter :: Parser Parameter
parameter :: Parser ByteString ByteString
parameter = (Word8 -> Parser Word8
word8 Word8
wColon Parser Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wCR Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wLF))
Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wSpace Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wCR Bool -> Bool -> Bool
||
Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wLF)
Parser ByteString ByteString
-> String -> Parser ByteString ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"parameter"
crlf :: Parser ()
crlf :: Parser ByteString ()
crlf = Parser (Maybe Word8) -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Word8 -> Parser Word8
word8 Word8
wCR Parser Word8 -> Parser (Maybe Word8) -> Parser (Maybe Word8)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word8 -> Parser (Maybe Word8)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Word8 -> Parser Word8
word8 Word8
wLF))
Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Word8 -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Word8 -> Parser Word8
word8 Word8
wLF)
message :: Parser Message
message :: Parser Message
message = Maybe Prefix -> ByteString -> [ByteString] -> Message
Message (Maybe Prefix -> ByteString -> [ByteString] -> Message)
-> Parser ByteString (Maybe Prefix)
-> Parser ByteString (ByteString -> [ByteString] -> Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Parser Prefix -> Parser ByteString (Maybe Prefix)
forall a. Parser a -> Parser (Maybe a)
optionMaybe (Parser Prefix -> Parser Prefix
forall a. Parser a -> Parser a
tokenize Parser Prefix
prefix)
Parser ByteString (ByteString -> [ByteString] -> Message)
-> Parser ByteString ByteString
-> Parser ByteString ([ByteString] -> Message)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
command
Parser ByteString ([ByteString] -> Message)
-> Parser ByteString [ByteString] -> Parser Message
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString -> Parser ByteString [ByteString]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString () -> Parser ByteString [()]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser ByteString ()
spaces Parser ByteString [()]
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
parameter)
Parser Message -> Parser ByteString (Maybe ()) -> Parser Message
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
crlf
Parser Message -> Parser ByteString () -> Parser Message
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput
Parser Message -> String -> Parser Message
forall i a. Parser i a -> String -> Parser i a
<?> String
"message"