module Ircmsg
  ( module Ircmsg
  , parse
  ) where

import Text.ParserCombinators.Parsec

{-
From RFC 1459:

<message> ::=
    [':' <prefix> <SPACE> ] <command> <params> <crlf>
<prefix> ::=
    <servername> | <nick> [ '!' <user> ] [ '@' <host> ]
<command> ::=
    <letter> { <letter> } | <number> <number> <number>
<SPACE> ::=
    ' ' { ' ' }
<params> ::=
    <SPACE> [ ':' <trailing> | <middle> <params> ]
<middle> ::=
    <Any *non-empty* sequence of octets not including SPACE or NUL
    or CR or LF, the first of which may not be ':'>
<trailing> ::=
    <Any, possibly *empty*, sequence of octets not including NUL
    or CR or LF>
<crlf> ::=
    CR LF

<target> ::=
    <to> [ "," <target> ]
<to> ::=
    <channel> | <user> '@' <servername> | <nick> | <mask>
<channel> ::=
    ('#' | '&') <chstring>
<servername> ::=
    <host>
<host> ::=
    see RFC 952 [DNS:4] for details on allowed hostnames
<nick> ::=
    <letter> { <letter> | <number> | <special> }
<mask> ::=
    ('#' | '$') <chstring>
<chstring> ::=
    <any 8bit code except SPACE, BELL, NUL, CR, LF and comma (',')>

<user> ::=
    <nonwhite> { <nonwhite> }
<letter> ::=
    'a' ... 'z' | 'A' ... 'Z'
<number> ::=
    '0' ... '9'
<special> ::=
    '-' | '[' | ']' | '\' | '`' | '^' | '{' | '}'
<nonwhite> ::=
    <any 8bit code except SPACE (0x20), NUL (0x0), CR (0xd), and
    LF (0xa)>
-}

data Msg = Msg Nck Usr Hst Cmd [Par]
         | Status String String
         | Raw String
         deriving (Show, Read)
type Nck = String
type Usr = String
type Hst = String
type Cmd = String
type Par = String


p_message = p_statusmsg <|> p_ircmessage

p_statusmsg = do char '%'
                 skipMany (char ' ')
                 msg <- many (noneOf " \r\n")
                 args <- many (noneOf "\r\n")
                 return (Status msg args)

p_ircmessage
  = do (nick,user,host) <- p_prefix' <|> return ("","","")
       cmd <- p_command
       par <- p_params
       skip (char '\r') <|> eof  -- be lenient with the line endings
       skip (char '\n') <|> eof
       return (Msg nick user host cmd par)
  where
  skip p = p >> return ()

p_prefix'
  = do char ':'
       p <- p_prefix
       return p

p_prefix = try p_nick' <|> p_servername'

p_servername'
  = do h <- p_servername
       p_space
       return ("","",h)

p_nick'
  = do n <- p_nick
       u <- (char '!' >> p_user) <|> return ""
       h <- (char '@' >> p_host) <|> return ""
       p_space
       return (n,u,h)
       
p_command = many1 p_letter <|> sequence (replicate 3 p_number)

p_space = many1 (char ' ')

p_params
  = (p_space >> (p_trailing' <|> p_middle' <|> return []))
    <|> return []

p_trailing'
  = do char ':'
       p <- p_trailing
       return [p]

p_middle'
  = do p <- p_middle
       ps <- p_params
       return (p:ps)

p_middle = many1 (noneOf " \r\n\NUL")
p_trailing = many (noneOf "\r\n\NUL")

p_servername = p_host

p_nick = many1 (p_letter <|> p_number <|> p_special)

p_user = many1 (noneOf " @\r\n\NUL")

p_host = many1 (p_letter <|> p_number <|> oneOf "-.:")

p_letter = oneOf (['a'..'z']++['A'..'Z'])
p_number = oneOf ['0'..'9']
p_special = oneOf "_-[]\\`^{}"