-- | 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 :: 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 ' '

wTab :: Word8
wTab :: Word8
wTab = Char -> Word8
asciiToWord8 '\t'

wBell :: Word8
wBell :: Word8
wBell = Char -> Word8
asciiToWord8 '\b'

wDot :: Word8
wDot :: Word8
wDot = Char -> Word8
asciiToWord8 '.'

wExcl :: Word8
wExcl :: Word8
wExcl = Char -> Word8
asciiToWord8 '!'

wAt :: Word8
wAt :: Word8
wAt = Char -> Word8
asciiToWord8 '@'

wCR :: Word8
wCR :: Word8
wCR = Char -> Word8
asciiToWord8 '\r'

wLF :: Word8
wLF :: Word8
wLF = Char -> Word8
asciiToWord8 '\n'

wColon :: Word8
wColon :: Word8
wColon = Char -> Word8
asciiToWord8 ':'

-- | Parse a String into a Message.
decode :: ByteString    -- ^ Message string
       -> Maybe Message -- ^ Parsed message
decode :: ByteString -> Maybe Message
decode str :: 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 _ -> Maybe Message
forall a. Maybe a
Nothing
  Right r :: Message
r -> Message -> Maybe Message
forall a. a -> Maybe a
Just Message
r

-- | The deprecated version of decode
parseMessage :: ByteString -> Maybe Message
parseMessage :: ByteString -> Maybe Message
parseMessage  = ByteString -> Maybe Message
decode

-- | Convert a parser that consumes all space after it
tokenize  :: Parser a -> Parser a
tokenize :: Parser a -> Parser a
tokenize p :: Parser a
p = Parser a
p Parser a -> Parser ByteString () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
spaces

-- | Consume only spaces, tabs, or the bell character
spaces :: Parser ()
spaces :: Parser ByteString ()
spaces  = (Word8 -> Bool) -> Parser ByteString ()
skip (\w :: 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)

-- | Parse a Prefix
prefix :: Parser Prefix
prefix :: Parser Prefix
prefix  = Word8 -> Parser Word8
word8 Word8
wColon Parser Word8 -> Parser Prefix -> Parser Prefix
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 (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
<?> "prefix"

-- | Parse a Server 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
<?> "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 :: Parser a -> Parser (Maybe a)
optionMaybe p :: Parser a
p = Maybe a -> Parser (Maybe a) -> Parser (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 (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p)

-- | Parse a NickName prefix
nicknamePrefix :: Parser Prefix
nicknamePrefix :: Parser Prefix
nicknamePrefix  = do
  ByteString
n <- (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (String -> Word8 -> Bool
inClass " .!@\r\n")
  Maybe Word8
p <- Parser (Maybe Word8)
peekWord8
  case Maybe Word8
p of
    Just c :: Word8
c | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
wDot -> Parser Prefix
forall (f :: * -> *) a. Alternative f => f a
empty
    _                  -> 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\w :: 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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\w :: 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
<?> "nicknamePrefix"

isWordAsciiUpper :: Word8 -> Bool
isWordAsciiUpper :: Word8 -> Bool
isWordAsciiUpper w :: Word8
w = Char -> Word8
asciiToWord8 '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 'Z'

digit :: Parser Word8
digit :: Parser Word8
digit = (Word8 -> Bool) -> Parser Word8
satisfy (\w :: Word8
w -> Char -> Word8
asciiToWord8 '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 '9')

-- | Parse a command.  Either a string of capital letters, or 3 digits.
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 (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 (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 (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
<?> "command"
    where digitsToByteString :: Word8 -> Word8 -> Word8 -> ByteString
digitsToByteString x :: Word8
x y :: Word8
y z :: Word8
z = [Word8] -> ByteString
pack [Word8
x,Word8
y,Word8
z]

-- | Parse a command parameter.
parameter :: Parser Parameter
parameter :: Parser ByteString ByteString
parameter  =  (Word8 -> Parser Word8
word8 Word8
wColon Parser Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\w :: 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Bool) -> Parser ByteString ByteString
takeTill (\w :: 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
<?> "parameter"

-- | Parse a cr lf
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 (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 (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)

-- | Parse a Message
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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString -> Parser ByteString [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString ()
spaces Parser ByteString ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
parameter)
  Parser Message -> Parser ByteString (Maybe ()) -> Parser Message
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 (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
<?> "message"