61 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			61 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2008, 2010 Slava Pestov.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: fry irc.client irc.client.chats kernel namespaces
 | 
						|
sequences threads io.launcher io splitting
 | 
						|
make mason.common mason.git calendar math timers
 | 
						|
io.encodings.8-bit.latin1 debugger ;
 | 
						|
IN: irc.gitbot
 | 
						|
 | 
						|
: bot-profile ( -- obj )
 | 
						|
    "irc.freenode.org" 6667 "stackoid" f <irc-profile> ;
 | 
						|
 | 
						|
: bot-channel ( -- seq ) "#concatenative" ;
 | 
						|
 | 
						|
GENERIC: handle-message ( msg -- )
 | 
						|
 | 
						|
M: object handle-message drop ;
 | 
						|
 | 
						|
: bot-loop ( chat -- )
 | 
						|
    dup hear handle-message bot-loop ;
 | 
						|
 | 
						|
: start-bot ( -- chat )
 | 
						|
    bot-profile <irc-client>
 | 
						|
    [ connect-irc ]
 | 
						|
    [
 | 
						|
        [ bot-channel <irc-channel-chat> dup ] dip
 | 
						|
        '[ _ [ _ attach-chat ] [ bot-loop ] bi ]
 | 
						|
        "GitBot" spawn drop
 | 
						|
    ] bi ;
 | 
						|
 | 
						|
: git-log ( from to -- lines )
 | 
						|
    [
 | 
						|
        "git-log" ,
 | 
						|
        "--no-merges" ,
 | 
						|
        "--pretty=format:%h %an: %s" ,
 | 
						|
        ".." glue ,
 | 
						|
    ] { } make
 | 
						|
    latin1 [ lines ] with-process-reader ;
 | 
						|
 | 
						|
: updates ( from to -- lines )
 | 
						|
    git-log reverse
 | 
						|
    dup length 4 > [ 4 head "... and more" suffix ] when ;
 | 
						|
 | 
						|
: report-updates ( from to chat -- )
 | 
						|
    [ updates ] dip
 | 
						|
    [ 1 seconds sleep ] swap
 | 
						|
    '[ _ speak ] interleave ;
 | 
						|
 | 
						|
: check-for-updates ( chat -- )
 | 
						|
    '[
 | 
						|
        git-id
 | 
						|
        { "git" "pull" "origin" "master" } short-running-process
 | 
						|
        git-id
 | 
						|
        _ report-updates
 | 
						|
    ] try ;
 | 
						|
 | 
						|
: bot ( -- )
 | 
						|
    start-bot
 | 
						|
    '[ _ check-for-updates ] 5 minutes every drop ;
 | 
						|
 | 
						|
MAIN: bot
 |