extra/irc/gitbot/gitbot.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: fry irc.client irc.client.chats kernel namespaces
   4 sequences threads io.encodings.8-bit io.launcher io splitting
   5 make mason.common mason.updates calendar math alarms ;
   6 IN: irc.gitbot
   7
   8 : bot-profile ( -- obj )
   9     "irc.freenode.org" 6667 "jackass" f <irc-profile> ;
  10
  11 : bot-channel ( -- seq ) "#concatenative" ;
  12
  13 GENERIC: handle-message ( msg -- )
  14
  15 M: object handle-message drop ;
  16
  17 : bot-loop ( chat -- )
  18     dup hear handle-message bot-loop ;
  19
  20 : start-bot ( -- chat )
  21     bot-profile <irc-client>
  22     [ connect-irc ]
  23     [
  24         [ bot-channel <irc-channel-chat> dup ] dip
  25         '[ _ [ _ attach-chat ] [ bot-loop ] bi ]
  26         "GitBot" spawn drop
  27     ] bi ;
  28
  29 : git-log ( from to -- lines )
  30     [
  31         "git-log" ,
  32         "--no-merges" ,
  33         "--pretty=format:%h %an: %s" ,
  34         ".." glue ,
  35     ] { } make
  36     latin1 [ lines ] with-process-reader ;
  37
  38 : updates ( from to -- lines )
  39     git-log reverse
  40     dup length 4 > [ 4 head "... and more" suffix ] when ;
  41
  42 : report-updates ( from to chat -- )
  43     [ updates ] dip
  44     [ 1 seconds sleep ] swap
  45     '[ _ speak ] interleave ;
  46
  47 : check-for-updates ( chat -- )
  48     [ git-id git-pull-cmd short-running-process git-id ] dip
  49     report-updates ;
  50
  51 : bot ( -- )
  52     start-bot
  53     '[ _ check-for-updates ] 5 minutes every drop ;
  54
  55 MAIN: bot