Message.hs

{- This file is part of irc-fun-messages.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Network.IRC.Fun.Messages.Internal.Tokens.Message
    ( message
    )
where

import Data.Maybe (fromMaybe)
import Network.IRC.Fun.Messages.Internal.Tokens.Other
import Network.IRC.Fun.Messages.Internal.Tokens.Target
import Network.IRC.Fun.Messages.Internal.Types
import Text.Regex.Applicative

----------TOTO
{-
- go over errata, make sure everything here is correct
- some regexes, such as matchone and target, seem not to be used in the rules
  here. they're probably intended for later use, e.g. when matching a string
  against a mask. in such case the API should probably import them
-}

message :: Regex GenericMessage
message = GenericMessage <$> optional (sym ':' *> prefix <* space)
                         <*> command
                         <*> (fromMaybe [] <$> optional params)
                         <*  crlf

prefix :: Regex Prefix
prefix = Server <$> servername
     <|> nick <$> nickname
              <*> optional ((,) <$> optional (sym '!' *> user)
                                <*  sym '@'
                                <*> host)
    where
    nick n Nothing       = Nick n Nothing Nothing
    nick n (Just (u, h)) = Nick n u       (Just h)

command :: Regex Command
command = StringCommand <$> some letter <|> f <$> digit <*> digit <*> digit
    where
    f a b c = NumericCommand $ read [a, b, c]

params :: Regex [Parameter]
params = f <$> many (space *> middle)
           <*> optional (space *> sym ':' *> trailing)
    where
    f m (Just t) = m ++ [t]
    f m Nothing  = m

middle :: Regex Parameter
middle = (:) <$> paramchar <*> many (sym ':' <|> paramchar)

trailing :: Regex Parameter
trailing = many $ sym ':' <|> sym ' ' <|> paramchar

paramchar :: Regex Char
paramchar = psym (`notElem` "\0\r\n :")

space :: Regex Char
space = sym ' '

crlf :: Regex String
crlf = string "\r\n"