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

-- | Parse a String into a Message.
decode :: ByteString    -- ^ Message string
       -> Maybe Message -- ^ Parsed 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

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

-- | Consume only spaces, tabs, or the bell character
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)

-- | Parse a Prefix
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"

-- | Parse a Server 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 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 :: 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)

-- | Parse a NickName prefix
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')

-- | Parse a command.  Either a string of capital letters, or 3 digits.
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]

-- | Parse a command parameter.
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"

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

-- | Parse a Message
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"