extra/irc/gitbot/gitbot.factor

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