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