Last active
March 15, 2017 17:01
-
-
Save foxiepaws/6f69d3badf56c8c5b9cec0d846d7868e to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang typed/racket | |
; very quick and dirty bot for doing kinda a | |
; channel/user description thing | |
; author: Rachel Fae Fox | |
(require typed/irc/main | |
typed/irc/irc-message | |
typed/db) | |
(define sqc (sqlite3-connect #:database "test.db" #:mode 'create)) | |
(define (remove-rubbish [channel : String] [user : String]) : Void | |
(query-exec sqc | |
(string-append | |
"DELETE FROM nicks where cid = (SELECT id FROM channels WHERE lower(channel) = lower($1)) and lower(nick) = lower($2) " | |
"and id < (select (select id from nicks where cid = (SELECT id from channels where lower(channel) = lower($1)) " | |
"and lower(nick) = lower($2) order by id desc) limit 1)") channel user)) | |
; schema rubbish | |
(query-exec sqc | |
"CREATE TABLE IF NOT EXISTS channels (id INTEGER PRIMARY KEY, channel TEXT UNIQUE, desc TEXT)") | |
(query-exec sqc ; this table is for future dev. | |
"CREATE TABLE IF NOT EXISTS accounts (id INTEGER PRIMARY KEY, username STRING UNIQUE, pass TEXT)") | |
(query-exec sqc | |
"CREATE TABLE IF NOT EXISTS nicks (id INTEGER PRIMARY KEY, cid INTEGER, nick TEXT, desc TEXT, FOREIGN KEY(cid) REFERENCES channels(id))") | |
(define (create-channel [channel : String]) | |
(query-exec sqc "INSERT OR IGNORE INTO channels (channel) VALUES ($1)" channel)) | |
(define-struct (not-found exn:fail:user) ()) | |
(define (get-channel [channel : String]) | |
(let ([x (query-maybe-value sqc "SELECT desc FROM channels WHERE lower(channel) = lower($1)" channel)]) | |
(cond | |
[(eq? x #f) | |
(raise (make-not-found "failed to find channel" (current-continuation-marks)))] | |
[else | |
(cast x String)]))) | |
(define (get-user [channel : String] [user : String]) | |
; we let the SQL server do the normalisation of nicks and channels instead, we don't really care! | |
(let ([x (query-list sqc "SELECT nicks.desc FROM nicks INNER JOIN channels ON cid = channels.id WHERE lower(nick) = lower($1) and lower(channel) = lower($2) ORDER BY nicks.id ASC" user channel)]) | |
(cond | |
[(eq? x null) | |
(raise (make-not-found "failed to find user" (current-continuation-marks)))] | |
[else | |
(cast (last x) String)]))) | |
(define (save [channel : String] [user : String] [args : String]) | |
(query-exec sqc "INSERT OR REPLACE INTO nicks (cid, nick, desc) VALUES ((SELECT id from channels where lower(channel) = lower($1)), $2, $3)" channel user args) | |
(remove-rubbish channel user)) | |
(define (setuser [i : IRC] [msg : IRC-Message]) : Void | |
(define target : String | |
(list-ref (send msg args) 0)) | |
(define args : String | |
(string-join (list-tail (string-split (list-ref (send msg args) 1) " " #:trim? #f) 1) " ")) | |
(define user : String | |
(list-ref (string-split (send msg prefix) "!") 0)) | |
(cond | |
[(string? args) (save target user args)(send i msg target (string-append user ": updated"))] | |
[else | |
(send i msg target | |
(string-append user ": use -setme <message> it will be sent with -look in the format \"You see <nick>, <message>\""))])) | |
(define (look [i : IRC] [msg : IRC-Message]) : Void | |
(define target : String | |
(list-ref (send msg args) 0)) | |
(define args : (Listof String) | |
(string-split (list-ref (send msg args) 1))) | |
(define user : String | |
(list-ref (string-split (send msg prefix) "!") 0)) | |
(cond | |
[(eq?(length args) 2) | |
(with-handlers | |
( | |
[exn:fail:sql? (lambda (e) | |
(send i msg target (string-append user ": SQL related error.")))] | |
[not-found? | |
(lambda (e) | |
(send i msg target (string-append user ": I don't know what " (list-ref args 1) " looks like.")))]) | |
(send i msg target (string-append user ": You see " (list-ref args 1) ", " (get-user target (list-ref args 1)))))] | |
[else | |
(with-handlers | |
([not-found? | |
(lambda (e) | |
(send i msg target (string-append user ": I don't know what this place looks like.")))]) | |
(send i msg target (string-append user ": You see " (get-channel target))))])) | |
(define i : IRC (new irc% | |
[host "irc.anthrochat.org"] | |
[port 6697] | |
[nick "look"] | |
[user "irc"] | |
[defaultmode 8] | |
[ssl #t] | |
[sasl #f] ; to enable sasl, set this and the other sasl related fields. | |
[sasl-username #f] ; set to a String containing your username | |
[sasl-password #f] ; set to a String containing your password | |
)) | |
(define joinchannels : (Listof String) (list "#Thezoo")) | |
(map create-channel joinchannels) | |
(define ircmsgs (send i hosepipe!)) | |
(void (sync (send i ready?))) | |
(map (lambda ([x : String]) (send i join x)) joinchannels) | |
(let loop () | |
; todo: Fix this nasty syntax crap. | |
(define msg : IRC-Message (cast (sync ircmsgs) IRC-Message)) ; type is Evtof Any data is always IRC-Message | |
(display (send msg raw)) | |
(cond | |
[ | |
(and (string=? (send msg verb) "PRIVMSG") (string=? (first | |
(string-split | |
(list-ref | |
(send msg args) 1))) "-look" )) | |
(look i msg)] | |
[ | |
(and (string=? (send msg verb) "PRIVMSG") (string=? (first | |
(string-split | |
(list-ref | |
(send msg args) 1))) "-setme" )) | |
(setuser i msg)] | |
) | |
(loop)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment