<commit_before>! Copyright (C) 2008 <NAME>, <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar
       accessors destructors namespaces io assocs arrays qualified fry
       continuations threads strings classes combinators splitting hashtables
       ascii irc.messages irc.messages.private ;
RENAME: join sequences => sjoin
EXCLUDE: sequences => join ;
IN: irc.client

! ======================================
! Setup and running objects
! ======================================

: irc-port 6667 ; ! Default irc port

TUPLE: irc-profile server port nickname password ;
C: <irc-profile> irc-profile

TUPLE: irc-client profile stream in-messages out-messages join-messages
       listeners is-running connect reconnect-time ;
: <irc-client> ( profile -- irc-client )
    f <mailbox> <mailbox> <mailbox> H{ } clone f
    [ <inet> latin1 <client> ] 15 seconds irc-client boa ;

TUPLE: irc-listener in-messages out-messages ;
TUPLE: irc-server-listener < irc-listener ;
TUPLE: irc-channel-listener < irc-listener name password timeout participants ;
TUPLE: irc-nick-listener < irc-listener name ;
SYMBOL: +server-listener+

! participant modes
SYMBOL: +operator+
SYMBOL: +voice+
SYMBOL: +normal+

: participant-mode ( n -- mode )
    H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ;

! participant changed actions
SYMBOL: +join+
SYMBOL: +part+
SYMBOL: +mode+

! listener objects
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;

: <irc-server-listener> ( -- irc-server-listener )
     <mailbox> <mailbox> irc-server-listener boa ;

: <irc-channel-listener> ( name -- irc-channel-listener )
     [ <mailbox> <mailbox> ] dip f 60 seconds H{ } clone
     irc-channel-listener boa ;

: <irc-nick-listener> ( name -- irc-nick-listener )
     [ <mailbox> <mailbox> ] dip irc-nick-listener boa ;

! ======================================
! Message objects
! ======================================

TUPLE: participant-changed nick action ;
C: <participant-changed> participant-changed

SINGLETON: irc-listener-end ! send to a listener to stop its execution
SINGLETON: irc-end          ! sent when the client isn't running anymore
SINGLETON: irc-disconnected ! sent when connection is lost
SINGLETON: irc-connected    ! sent when connection is established
UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;

: terminate-irc ( irc-client -- )
    [ is-running>> ] keep and [
        [ [ irc-end ] dip in-messages>> mailbox-put ]
        [ [ f ] dip (>>is-running) ]
        [ stream>> dispose ]
        tri
    ] when* ;

<PRIVATE

SYMBOL: current-irc-client

! ======================================
! Utils
! ======================================

: irc> ( -- irc-client ) current-irc-client get ;
: irc-stream> ( -- stream ) irc> stream>> ;
: irc-write ( s -- ) irc-stream> stream-write ;
: irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ;
: listener> ( name -- listener/f ) irc> listeners>> at ;

: maybe-mailbox-get ( mailbox quot: ( irc-message -- ) -- )
    [ dup mailbox-empty? [ drop yield ] ] dip '[ mailbox-get @ ] if ; inline

GENERIC: to-listener ( message obj -- )

M: string to-listener ( message string -- )
    listener> [ +server-listener+ listener> ] unless*
    [ to-listener ] [ drop ] if* ;

: unregister-listener ( name -- )
    irc> listeners>>
        [ at [ irc-listener-end ] dip to-listener ]
        [ delete-at ]
    2bi ;

M: irc-listener to-listener ( message irc-listener -- )
    in-messages>> mailbox-put ;

: remove-participant ( nick channel -- )
    listener> [ participants>> delete-at ] [ drop ] if* ;

: listeners-with-participant ( nick -- seq )
    irc> listeners>> values
    [ dup irc-channel-listener? [ participants>> key? ] [ 2drop f ] if ]
    with filter ;

: remove-participant-from-all ( nick -- )
    dup listeners-with-participant [ delete-at ] with each ;

: add-participant ( mode nick channel -- )
    listener> [ participants>> set-at ] [ 2drop ] if* ;

DEFER: me?

: maybe-forward-join ( join -- )
    [ prefix>> parse-name me? ] keep and
    [ irc> join-messages>> mailbox-put ] when* ;

! ======================================
! IRC client messages
! ======================================

: /NICK ( nick -- )
    "NICK " irc-write irc-print ;

: /LOGIN ( nick -- )
    dup /NICK
    "USER " irc-write irc-write
    " hostname servername :irc.factor" irc-print ;

: /CONNECT ( server port -- stream )
    irc> connect>> call drop ;<commit_msg>irc.client: Fix removing of participant on quit<commit_after>! Copyright (C) 2008 <NAME>, <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar
       accessors destructors namespaces io assocs arrays qualified fry
       continuations threads strings classes combinators splitting hashtables
       ascii irc.messages irc.messages.private ;
RENAME: join sequences => sjoin
EXCLUDE: sequences => join ;
IN: irc.client

! ======================================
! Setup and running objects
! ======================================

: irc-port 6667 ; ! Default irc port

TUPLE: irc-profile server port nickname password ;
C: <irc-profile> irc-profile

TUPLE: irc-client profile stream in-messages out-messages join-messages
       listeners is-running connect reconnect-time ;
: <irc-client> ( profile -- irc-client )
    f <mailbox> <mailbox> <mailbox> H{ } clone f
    [ <inet> latin1 <client> ] 15 seconds irc-client boa ;

TUPLE: irc-listener in-messages out-messages ;
TUPLE: irc-server-listener < irc-listener ;
TUPLE: irc-channel-listener < irc-listener name password timeout participants ;
TUPLE: irc-nick-listener < irc-listener name ;
SYMBOL: +server-listener+

! participant modes
SYMBOL: +operator+
SYMBOL: +voice+
SYMBOL: +normal+

: participant-mode ( n -- mode )
    H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ;

! participant changed actions
SYMBOL: +join+
SYMBOL: +part+
SYMBOL: +mode+

! listener objects
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;

: <irc-server-listener> ( -- irc-server-listener )
     <mailbox> <mailbox> irc-server-listener boa ;

: <irc-channel-listener> ( name -- irc-channel-listener )
     [ <mailbox> <mailbox> ] dip f 60 seconds H{ } clone
     irc-channel-listener boa ;

: <irc-nick-listener> ( name -- irc-nick-listener )
     [ <mailbox> <mailbox> ] dip irc-nick-listener boa ;

! ======================================
! Message objects
! ======================================

TUPLE: participant-changed nick action ;
C: <participant-changed> participant-changed

SINGLETON: irc-listener-end ! send to a listener to stop its execution
SINGLETON: irc-end          ! sent when the client isn't running anymore
SINGLETON: irc-disconnected ! sent when connection is lost
SINGLETON: irc-connected    ! sent when connection is established
UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;

: terminate-irc ( irc-client -- )
    [ is-running>> ] keep and [
        [ [ irc-end ] dip in-messages>> mailbox-put ]
        [ [ f ] dip (>>is-running) ]
        [ stream>> dispose ]
        tri
    ] when* ;

<PRIVATE

SYMBOL: current-irc-client

! ======================================
! Utils
! ======================================

: irc> ( -- irc-client ) current-irc-client get ;
: irc-stream> ( -- stream ) irc> stream>> ;
: irc-write ( s -- ) irc-stream> stream-write ;
: irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ;
: listener> ( name -- listener/f ) irc> listeners>> at ;

: maybe-mailbox-get ( mailbox quot: ( irc-message -- ) -- )
    [ dup mailbox-empty? [ drop yield ] ] dip '[ mailbox-get @ ] if ; inline

GENERIC: to-listener ( message obj -- )

M: string to-listener ( message string -- )
    listener> [ +server-listener+ listener> ] unless*
    [ to-listener ] [ drop ] if* ;

: unregister-listener ( name -- )
    irc> listeners>>
        [ at [ irc-listener-end ] dip to-listener ]
        [ delete-at ]
    2bi ;

M: irc-listener to-listener ( message irc-listener -- )
    in-messages>> mailbox-put ;

: remove-participant ( nick channel -- )
    listener> [ participants>> delete-at ] [ drop ] if* ;

: listeners-with-participant ( nick -- seq )
    irc> listeners>> values
    [ dup irc-channel-listener? [ participants>> key? ] [ 2drop f ] if ]
    with filter ;

: remove-participant-from-all ( nick -- )
    dup listeners-with-participant [ participants>> delete-at ] with each ;

: add-participant ( mode nick channel -- )
    listener> [ participants>> set-at ] [ 2drop ] if* ;

DEFER: me?

: maybe-forward-join ( join -- )
    [ prefix>> parse-name me? ] keep and
    [ irc> join-messages>> mailbox-put ] when* ;

! ======================================
! IRC client messages
! ======================================

: /NICK ( nick -- )
    "NICK " irc-write irc-print ;

: /LOGIN ( nick -- )
    dup /NICK
    "USER " irc-write irc-write
    " hostname servername :irc.factor" irc-print ;

: /CONNECT ( server port -- stream )
    irc> connect>> call drop ;
{'fraction_non_alphanumeric': 0.19409650364883999, 'fraction_numerical': 0.004792506262934321, 'mean_word_length': 3.280652680652681, 'pattern_counts': {'":': 0, '<': 57, '<?xml version=': 0, '>': 145, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '99720', 'n_tokens_mistral': 2977, 'n_tokens_neox': 2857, 'n_words': 785}