apps/factorbot.factor

   1 ! Simple IRC bot written in Factor.
   2
   3 REQUIRES: libs/httpd ;
   4
   5 USING: errors generic hashtables help html http io kernel math
   6 memory namespaces parser prettyprint sequences strings threads
   7 words ;
   8 IN: factorbot
   9
  10 SYMBOL: irc-stream
  11 SYMBOL: nickname
  12 SYMBOL: speaker
  13 SYMBOL: receiver
  14
  15 : irc-write ( s -- ) irc-stream get stream-write ;
  16 : irc-print ( s -- )
  17     irc-stream get stream-print
  18     irc-stream get stream-flush ;
  19
  20 : nick ( nick -- )
  21     dup nickname set  "NICK " irc-write irc-print ;
  22
  23 : login ( nick -- )
  24     dup nick
  25     "USER " irc-write irc-write
  26     " hostname servername :irc.factor" irc-print ;
  27
  28 : connect ( server -- ) 6667 <client> irc-stream set ;
  29
  30 : disconnect ( -- ) irc-stream get stream-close ;
  31
  32 : join ( chan -- )
  33     "JOIN " irc-write irc-print ;
  34
  35 GENERIC: handle-irc ( line -- )
  36 PREDICATE: string privmsg " " split1 nip "PRIVMSG" head? ;
  37 PREDICATE: string ping "PING" head? ;
  38
  39 M: object handle-irc ( line -- )
  40     drop ;
  41
  42 : parse-privmsg ( line -- text )
  43     " " split1 nip
  44     "PRIVMSG " ?head drop
  45     " " split1 swap receiver set
  46     ":" ?head drop ;
  47
  48 M: privmsg handle-irc ( line -- )
  49     parse-privmsg
  50     " " split1 swap
  51     "factorbot-commands" lookup dup
  52     [ execute ] [ 2drop ] if ;
  53
  54 M: ping handle-irc ( line -- )
  55     "PING " ?head drop "PONG " swap append irc-print ;
  56
  57 : parse-irc ( line -- )
  58     ":" ?head [ "!" split1 swap speaker set ] when handle-irc ;
  59
  60 : say ( line nick -- )
  61     "PRIVMSG " irc-write irc-write " :" irc-write irc-print ;
  62
  63 : respond ( line -- )
  64     receiver get nickname get = speaker receiver ? get say ;
  65
  66 : irc-loop ( -- )
  67     irc-stream get stream-readln
  68     [ dup print flush parse-irc irc-loop ] when* ;
  69
  70 : factorbot
  71     "irc.freenode.net" connect
  72     "factorbot" login
  73     "#concatenative" join
  74     [ irc-loop ] [ irc-stream get stream-close ] cleanup ;
  75
  76 : factorbot-loop [ factorbot ] try 30000 sleep factorbot-loop ;
  77
  78 : multiline-respond ( string -- )
  79     string-lines [ respond ] each ;
  80
  81 : object-href
  82     "http://factorcode.org" swap browser-link-href append ;
  83
  84 : not-found ( str -- )
  85     "Sorry, I couldn't find anything for " swap append respond ;
  86
  87 IN: factorbot-commands
  88
  89 : see ( text -- )
  90     dup words-named dup empty? [
  91         drop
  92         not-found
  93     ] [
  94         nip [
  95             dup summary " -- "
  96             rot object-href 3append respond
  97         ] each
  98     ] if ;
  99
 100 : memory ( text -- )
 101     drop [ room. ] string-out multiline-respond ;
 102
 103 : quit ( text -- )
 104     drop speaker get "slava" = [ disconnect ] when ;
 105
 106 PROVIDE: apps/factorbot ;
 107
 108 MAIN: apps/factorbot factorbot ;