look.rkt

#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))