Commit c78c6197 authored by Mart Lubbers's avatar Mart Lubbers

IRC moved to platform

parent f379174b
Pipeline #15451 failed with stages
in 46 seconds
definition module GenIRC
import StdGeneric
from Data.Either import :: Either
from Data.Maybe import :: Maybe
from Text.Parsers.Simple.Core import :: Error
from IRC import :: IRCCommand, :: CSepList
generic gIRCParse a :: [String] -> (Either Error a, [String])
generic gIRCPrint a :: a -> [String]
derive gIRCParse IRCCommand, String, Int, Maybe, (,), [], CSepList
derive gIRCPrint IRCCommand, String, Int, Maybe, (,), [], CSepList
implementation module GenIRC
import StdEnv
import StdGeneric
import Data.Either
import Data.Func
import Data.Functor
import Data.Maybe
import Data.Tuple
import Text
import IRC
pOne [] = (Left "Expected an argument", [])
pOne [a:as] = (Right a, as)
generic gIRCParse a :: [String] -> (Either Error a, [String])
gIRCParse{|UNIT|} a = (Right UNIT, a)
gIRCParse{|String|} as = pOne as
gIRCParse{|Int|} as = appFst (fmap toInt) $ pOne as
gIRCParse{|EITHER|} lp rp as = case lp as of
(Right a, rest) = (Right $ LEFT a, rest)
(Left e1, _) = case rp as of
(Right a, rest) = (Right $ RIGHT a, rest)
(Left e2, _) = (Left $ e2, [])
gIRCParse{|OBJECT|} p as = appFst (fmap OBJECT) $ p as
gIRCParse{|CONS of d|} p []
= (Left $ concat ["Expected a cmd constructor: ", d.gcd_name], [])
gIRCParse{|CONS of d|} p [a:as]
| a <> d.gcd_name = (Left $ concat [
"Wrong constructor. expected: ", d.gcd_name, ", got: ", a], [])
= case p as of
(Right a, rest) = (Right $ CONS a, rest)
(Left e, _) = (Left e, [])
gIRCParse{|PAIR|} pl pr as = case pl as of
(Right a1, rest) = case pr rest of
(Right a2, rest) = (Right $ PAIR a1 a2, rest)
(Left e, _) = (Left e, [])
(Left e, _) = (Left e, [])
gIRCParse{|[]|} pl as = case pl as of
(Right e, rest) = case gIRCParse{|*->*|} pl rest of
(Right es, rest) = (Right [e:es], rest)
(Left e, _) = (Left e, [])
(Left e, _) = (Right [], as)
gIRCParse{|Maybe|} pm as
= appFst (either (const $ Right Nothing) $ Right o Just) $ pm as
gIRCParse{|CSepList|} as = appFst (fmap $ CSepList o split ",") $ pOne as
derive gIRCParse (,), IRCCommand
derive gIRCPrint (,), IRCCommand
generic gIRCPrint a :: a -> [String]
gIRCPrint{|UNIT|} _ = []
gIRCPrint{|String|} s = if (indexOf " " s == -1) [s] [":"+++s]
gIRCPrint{|Int|} i = [toString i]
gIRCPrint{|EITHER|} lp rp (LEFT i) = lp i
gIRCPrint{|EITHER|} lp rp (RIGHT i) = rp i
gIRCPrint{|OBJECT|} lp (OBJECT p) = lp p
gIRCPrint{|PAIR|} lp rp (PAIR l r) = lp l ++ rp r
gIRCPrint{|CONS of d|} pc (CONS c) = [d.gcd_name:pc c]
gIRCPrint{|[]|} pl x = flatten $ map pl x
gIRCPrint{|Maybe|} pl m = gIRCPrint{|*->*|} pl $ maybeToList m
gIRCPrint{|CSepList|} (CSepList as) = [join "," as]
definition module IRC
from StdOverloaded import class fromInt, class toInt, class toString, class fromString
from Data.Either import :: Either
from Data.Maybe import :: Maybe
from Text.Parsers.Simple.Core import :: Error
:: IRCMessage =
{ irc_prefix :: Maybe (Either IRCUser String)
, irc_command :: Either IRCNumReply IRCCommand}
:: IRCNumReply =
{ irc_reply :: IRCReplies
, irc_recipient :: String
, irc_message :: String
}
:: IRCUser =
{ irc_nick :: String
, irc_user :: Maybe String
, irc_host :: Maybe String
}
parseIRCMessage :: String -> Either [Error] IRCMessage
instance toString IRCCommand, IRCReplies, IRCErrors, IRCMessage, IRCUser, IRCNumReply
instance fromInt IRCReplies, IRCErrors
instance toInt IRCReplies, IRCErrors
:: CSepList = CSepList [String]
:: IRCCommand
= ADMIN (Maybe String)
| AWAY String
| CONNECT String (Maybe (Int, Maybe String))
| DIE
| ERROR String
| INFO (Maybe String)
| INVITE String String
| ISON [String]
| JOIN CSepList (Maybe String)
| KICK String String (Maybe String)
| KILL String String
| LINKS (Maybe (Maybe String, String))
| LIST (Maybe (CSepList, Maybe String))
| LUSERS (Maybe (String, Maybe String))
| MODE String String (Maybe String) (Maybe String) (Maybe String)
| MOTD (Maybe String)
| NAMES CSepList
| NICK String (Maybe String)
| NJOIN
| NOTICE String String
| OPER String String
| PART CSepList
| PASS String
| PING String (Maybe String)
| PONG String (Maybe String)
| PRIVMSG CSepList String
| QUIT (Maybe String)
| REHASH
| RESTART
| SERVER
| SERVICE String String String String
| SERVLIST (Maybe (String, Maybe String))
| SQUERY String String
| SQUIRT
| SQUIT String String
| STATS (Maybe (String, Maybe String))
| SUMMON String (Maybe (String, Maybe String))
| TIME (Maybe String)
| TOPIC String (Maybe String)
| TRACE (Maybe String)
| USER String String String String
| USERHOST CSepList
| USERS (Maybe String)
| VERSION (Maybe String)
| WALLOPS String
| WHO (Maybe String)
| WHOIS (Maybe String) String
| WHOWAS String (Maybe (String, Maybe String))
:: IRCReplies = RPL_WELCOME | RPL_YOURHOST | RPL_CREATED | RPL_MYINFO |
RPL_BOUNCE | RPL_TRACELINK | RPL_TRACECONNECTING | RPL_TRACEHANDSHAKE |
RPL_TRACEUNKNOWN | RPL_TRACEOPERATOR | RPL_TRACEUSER | RPL_TRACESERVER |
RPL_TRACESERVICE | RPL_TRACENEWTYPE | RPL_TRACECLASS | RPL_TRACERECONNECT |
RPL_STATSLINKINFO | RPL_STATSCOMMANDS | RPL_ENDOFSTATS | RPL_UMODEIS |
RPL_SERVLIST | RPL_SERVLISTEND | RPL_STATSUPTIME | RPL_STATSOLINE |
RPL_LUSERCLIENT | RPL_LUSEROP | RPL_LUSERUNKNOWN | RPL_LUSERCHANNELS |
RPL_LUSERME | RPL_ADMINME | RPL_ADMINLOC1 | RPL_ADMINLOC2 | RPL_ADMINEMAIL |
RPL_TRACELOG | RPL_TRACEEND | RPL_TRYAGAIN | RPL_AWAY | RPL_USERHOST |
RPL_ISON | RPL_UNAWAY | RPL_NOWAWAY | RPL_WHOISUSER | RPL_WHOISSERVER |
RPL_WHOISOPERATOR | RPL_WHOWASUSER | RPL_ENDOFWHO | RPL_WHOISIDLE |
RPL_ENDOFWHOIS | RPL_WHOISCHANNELS | RPL_LISTSTART | RPL_LIST |
RPL_LISTEND | RPL_CHANNELMODEIS | RPL_UNIQOPIS | RPL_NOTOPIC | RPL_TOPIC |
RPL_INVITING | RPL_SUMMONING | RPL_INVITELIST | RPL_ENDOFINVITELIST |
RPL_EXCEPTLIST | RPL_ENDOFEXCEPTLIST | RPL_VERSION | RPL_WHOREPLY |
RPL_NAMREPLY | RPL_LINKS | RPL_ENDOFLINKS | RPL_ENDOFNAMES | RPL_BANLIST |
RPL_ENDOFBANLIST | RPL_ENDOFWHOWAS | RPL_INFO | RPL_MOTD | RPL_ENDOFINFO |
RPL_MOTDSTART | RPL_ENDOFMOTD | RPL_YOUREOPER | RPL_REHASHING |
RPL_YOURESERVICE | RPL_TIME | RPL_USERSSTART | RPL_USERS | RPL_ENDOFUSERS |
RPL_NOUSERS | RPL_UNKNOWN
:: IRCErrors = ERR_NOSUCHNICK | ERR_NOSUCHSERVER | ERR_NOSUCHCHANNEL |
ERR_CANNOTSENDTOCHAN | ERR_TOOMANYCHANNELS | ERR_WASNOSUCHNICK |
ERR_TOOMANYTARGETS | ERR_NOSUCHSERVICE | ERR_NOORIGIN | ERR_NORECIPIENT |
ERR_NOTEXTTOSEND | ERR_NOTOPLEVEL | ERR_WILDTOPLEVEL | ERR_BADMASK |
ERR_UNKNOWNCOMMAND | ERR_NOMOTD | ERR_NOADMININFO | ERR_FILEERROR |
ERR_NONICKNAMEGIVEN | ERR_ERRONEUSNICKNAME | ERR_NICKNAMEINUSE |
ERR_NICKCOLLISION | ERR_UNAVAILRESOURCE | ERR_USERNOTINCHANNEL |
ERR_NOTONCHANNEL | ERR_USERONCHANNEL | ERR_NOLOGIN | ERR_SUMMONDISABLED |
ERR_USERSDISABLED | ERR_NOTREGISTERED | ERR_NEEDMOREPARAMS |
ERR_ALREADYREGISTRED | ERR_NOPERMFORHOST | ERR_PASSWDMISMATCH |
ERR_YOUREBANNEDCREEP | ERR_YOUWILLBEBANNED | ERR_KEYSET |
ERR_CHANNELISFULL | ERR_UNKNOWNMODE | ERR_INVITEONLYCHAN |
ERR_BANNEDFROMCHAN | ERR_BADCHANNELKEY | ERR_BADCHANMASK |
ERR_NOCHANMODES | ERR_BANLISTFULL | ERR_NOPRIVILEGES |
ERR_CHANOPRIVSNEEDED | ERR_CANTKILLSERVER | ERR_RESTRICTED |
ERR_UNIQOPPRIVSNEEDED | ERR_NOOPERHOST | ERR_UMODEUNKNOWNFLAG |
ERR_USERSDONTMATCH | ERR_UNKNOWN
This diff is collapsed.
Subproject commit 665acb6181353b484790c5e5b1e6edd3026090ed
Subproject commit 49a6c636f3888f129807cd2b9d1a9cfe53e44bfd
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment