lambot/irc.lamb

import("std/list").
import("std/str").
import("std/http").
import("config").

-- the lexical environment that $eval uses
EVAL_ENV = [("id", id),
			("loop", loop),
			("repr", repr),
			("itos", itos),
			("globals", globals),
			("locals", locals),
			("list", list)].

irc_eval(code, chan, nick) -> do
	eval_watchdog = \_ -> do
		value = ref!(false);
		f = \_ -> do
			ret = eval(code, EVAL_ENV);
			setRef!(value, (ret,))
		end;

		thread = thread!(f);
		sleep!(3000); -- wait 3 seconds

		val = readRef!(value);
		if val == false then do
			kill!(thread);
			say(chan, nick + ": time limit exceeded")
		end
		else do
			(ret,) = val;
			say(chan, nick + ": " + repr(ret))
		end
	end;
	thread!(eval_watchdog)
end.

fst((x, _)) -> x.

-- maybe stuff

is_just(("just", _)) -> true.
is_just(_) -> false.

is_nothing(("nothing",)) -> true.
is_nothing(_) -> false.

unwrap_maybe(("just", x)) -> x.

-- association list

-- insert a pair into a map
map_insert(assoc, key, value) -> (key, value) :: assoc.

-- lookup by key
map_lookup([], _) -> ("nothing",).
map_lookup((k,v)::xs, key) ->
	if k == key then ("just", v)
	else map_lookup(xs, key).

-- remove a key from a map
map_remove([], key) -> [].
map_remove((k,v)::xs, key) ->
	if k == key then xs
	else (k,v) :: map_remove(xs, key).

-- dead simple XML tag line parser
tag_contents("<"::xs, tag) -> do
	len = list\length(tag);
	if str\takeS(len, xs) == tag then do
		_ :: rest = str\dropWhileS(\c -> c != ">", xs);
		("just", str\takeUntilS(\c -> c == "<", rest))
	end
	else
		tag_contents(str\dropS(len+1, xs), tag)
end.
tag_contents(_::xs, tag) -> tag_contents(xs, tag).
tag_contents(_, tag) -> ("nothing",). -- assert?

-- irc stuff

-- Splits a string by spaces, or until it encounters a :, whereby the following is considered one element.
splitirc'("", stracc, acc) -> acc + [stracc].
splitirc'(" "::xs, stracc, acc) -> do
	splitirc'(xs, "", acc + [stracc])
end.
-- prefix message
splitirc'(":"::xs, _, acc) -> acc + [xs].
splitirc'(x::xs, stracc, acc) -> splitirc'(xs, stracc + x, acc).
-- helper function
splitirc(str) -> splitirc'(str, "", []).

-- (result, rest)
takeUntilSpace'("", acc) -> (acc, ""). -- no spaces
takeUntilSpace'(" "::xs, acc) -> (acc, xs).
takeUntilSpace'(x::xs, acc) -> takeUntilSpace'(xs, acc + x).
takeUntilSpace(str) -> takeUntilSpace'(str, "").

-- takes x!y and returns x
ircnick'("!"::xs, acc) -> acc.
ircnick'(x::xs, acc) -> ircnick'(xs, acc + x).
ircnick(str) -> ircnick'(str, "").

isAdmin(nick) -> list\memberOf?(config\ADMINS, nick).

-- state getters
getFactoids(state) -> do
	(factoids,) = state;
	factoids
end.

-- state setters
setFactoids(state, factoids) -> do
	(factoids,)
end.

-- factoid serialization
-- basic "key value" (space-separated) format
saveFactoids(factoids) -> do
	file = fopen("factoids.txt", "w");
	list\map(\(k,v) -> fputstr(file, k + " " + v + "\n"), factoids);
	fclose(file)
end.

loadFactoids() -> do
	file = fopen("factoids.txt", "r");
	fact = loop(\pairs ->
		if feof(file) != true then do
			line = fgetline(file);
			pair = takeUntilSpace(line);
			pair :: pairs
		end else false, []);
	fclose(file);
	fact
end.

-- event handling

say(chan, msg) -> fputstr(sock, "PRIVMSG " + chan + " :" + msg + "\r\n").

handleMessage(s, nick, chan, "$factoids") -> do
	factoids = list\map(fst, getFactoids(s));
	say(chan, nick + ": " + list\intercalate(" ", factoids));
	s
end.

handleMessage(s, nick, chan, "$defact "::line) -> do
	(k,v) = takeUntilSpace(line);
	factoids = getFactoids(s);
	say(chan, nick + ": defined " + k);
	setFactoids(s, map_insert(factoids, k, v))
end.

handleMessage(s, nick, chan, "$savefacts") -> do
	if isAdmin(nick) then do
		saveFactoids(getFactoids(s));
		say(chan, "factoids saved.")
	end
	else say(chan, nick + ": you are not an admin");
	s
end.

handleMessage(s, nick, chan, "$eval "::line) -> do
	irc_eval(line, chan, nick);
	s
end.

handleMessage(s, nick, chan, "$np "::lastfm_user) -> do
	http\async_http_get("http://ws.audioscrobbler.com/2.0/?method=user.getrecenttracks&user=" + lastfm_user + "&api_key=" + config\LASTFM_API_KEY + "&limit=1",
		\resp -> do
			("ok", xml) = resp;
			("just", artist) = tag_contents(xml, "artist");
			("just", album) = tag_contents(xml, "album");
			("just", title) = tag_contents(xml, "name");
			say(chan, nick + ": " + lastfm_user + " is listening to " + artist + " - " + title + " (from " + album + ")")
		end);
	s
end.

handleMessage(s, nick, chan, "$join "::j) -> do
	if isAdmin(nick) then do
		fputstr(sock, "JOIN " + j + "\r\n");
		s
	end else s
end.

handleMessage(s, nick, chan, "$ping") -> do say(chan, nick + ": pong"); s end.

handleMessage(s, nick, chan, "$quit") -> do
	if isAdmin(nick) then do
		say(chan, "bye!");
		fputstr(sock, "QUIT\r\n");
		fclose(sock)
	end
	else say(chan, nick + ": you are not an admin");
	s
end.

handleMessage(s, nick, chan, "$at "::line) -> do
	(toNick, fact) = takeUntilSpace(line);
	factoids = getFactoids(s);
	factoid  = map_lookup(factoids, fact);
	if is_just(factoid) then do
		say(chan, toNick + ": " + unwrap_maybe(factoid));
		s
	end
	else do
		say(chan, nick + ": No such factoid: " + fact);
		s
	end
end.

-- unknown command, search factoids
handleMessage(s, nick, chan, "$"::line) -> do
	(fact, rest) = takeUntilSpace(line);
	if rest != "" then s -- it had spaces after it, might not want a factoid
	else do
		factoids = getFactoids(s);
		factoid  = map_lookup(factoids, fact);
		if is_just(factoid) then do
			say(chan, unwrap_maybe(factoid));
			s
		end
		else s
	end
end.

handleMessage(s, nick, chan, msg) -> s.

-- handleCommand(source, cmd, args)

handleCommand(s, _, "PING", [ping]) -> do
	putstrln("ping: " + ping);
	fputstr(sock, "PONG :" + ping + "\r\n");
	s
end.

handleCommand(s, user, "JOIN", [chan]) -> do
	putstrln("nick " + ircnick(user) + " joins " + chan);
	s
end.

handleCommand(s, user, "PRIVMSG", [recipient, msg]) -> do
	nick = ircnick(user);
	target = if recipient != config\NICK then recipient else nick;
	putstrln(target + " " + "<" + nick + "> " + msg);
	handleMessage(s, nick, target, msg)
end.

-- nick list
handleCommand(s, _, "353", _::"="::chan::[nicks]) -> do
	-- nicks is space-separated
	putstrln("nicks in " + chan + ": " + nicks);
	s
end.

handleCommand(s, _, "372", [_,msg]) -> do putstrln("MOTD: " + msg); s end.
handleCommand(s, _, "422", [_,msg]) -> do putstrln(msg); s end. -- MOTD is missing

handleCommand(s, _, "251", _) -> s. -- There are X users and Y services on Z server(s)
handleCommand(s, _, "331", _) -> s. -- No topic is set
handleCommand(s, _, "366", _) -> s. -- End of NAMES list

handleCommand(s, src, cmd, args) -> do
	putstrln("Unhandled command: " + cmd + ", with args: " + repr(args) + " from " + src);
	s
end.

handleLine(s, ":" :: line) -> do
	-- sourced message
	(source, rest) = takeUntilSpace(line);
	command::args = splitirc(rest);
	handleCommand(s, source, command, args)
end.

handleLine(s, line) -> do
	-- non-sourced message
	command::args = splitirc(line);
	handleCommand(s, "", command, args)
end.

-- now for our actual program!

-- build our socket and connect to the server
sock = sockopen(config\HOST, config\PORT).

-- send introduction
fputstr(sock, "PASS " + config\NICK + "\r\n").
fputstr(sock, "NICK " + config\NICK + "\r\n").
fputstr(sock, "USER " + config\NICK + " 0 * :Lamb Da. Bot\r\n").

-- note: workaround for issue #19 (passing lambdas to modules in the global scope is incorrect)
joinChans() -> list\map(\chan -> fputstr(sock, "JOIN " + chan + "\r\n"), config\CHANS).
joinChans().

-- loop receiving lines
mainloop(state) ->
	if feof(sock) != true then do
		line = fgetline(sock);
		handleLine(state, line)
	end
	else false. -- EOF, stop looping

putstrln("initializing").
initialState = (loadFactoids(),).

putstrln("beginning mainloop").
loop(mainloop, initialState).
fclose(sock).
putstrln("done").