use v6;

# perl 5's Class::Publisher redone for all the Perl 6 OOP goodness

# something which does publisher can send events
# something which does subscriber can recieve them
# two kinds of things that can do subscriber:
# - Code
# - Object

# The notification process involves:
# creating an *event*
# getting the *subscriptions* for it, and converting them to *notifications* when they match
# asking the notifications to dispatch themselves

# the code tries to provide reusable code for driving events, and implements a
# "named event" mechanism, for Class::Publisher like behavior.

module Class::Events-0.0.1;

role Class::Events::Publisher {
	use Set;
	has Set $.subscriptions handles :add_subscription<insert> :remove_subscription<remove> .= new; # FIXME we need one at the class level too

	method notify (Class::Events::Event $event) {
		(.get_subscriptions($event) ==> .mk_notifications)».dispatch;
	}
	
	method notify (*@args) {
		.notify(Class::Events::Event.new(*@args));
	}

	method mk_notifications (*@subscriptions of Class::Events::Subscription) {
		map { Class::Events::Notification.new(:subscriber($_), :event($event)) } *@subscriptions;
	}
	
	method get_subscriptions (Class::Events::Publisher $publisher, Class::Publisher::Event $event) {
		grep { .match($event) } gather {
			take $.subscriptions.members;

			# FIXME this is bullshit - i ought to read the details
			#for $class ($self.meta.superclasses){
			#	take $class.subscriptions;
			#}
		}
	}
}

role Class::Events::Subscriber {
	use Set;
	has Set $.subscriptions handles :note_subscription<insert> :remove_subscription<remove> .= new;
}

class Class::Events::Subscription {
	has Class::Events::Publisher $.publisher;
	has Class::Events::Subscriber $.subscriber;

	method match ($notification) {
		# this is really up to your subscription and event subclasses to define these
		# if at all.

		# the default Event/Subscriber pair really means that all notifications are sent everywhere
		1;
	}

	method delete {
		$.publisher.remove_subscription($?SELF);
	}
}

class Class::Events::Subscription::Named {
	is Class::Events::Subscription;

	has $.name;

	role Class::Events::Publisher is extended {
		use Set;
		has %.subscriptions of Set;

		# when you say add_subscription("foo", ...) then "foo" is the name of the subscription
		method add_subscription (String $name, $subscriber = $?CALLER::?SELF) {
			my $subscription = Class::Events::Subscription::Named.new(:name($name), :subscriber($subscriber), :publisher($?SELF));
			( %.subscriptions<$name> ||= Set.new ).insert($subscription);
			$subscriber.note_subscription($subscription);
		}

		method remove_subscription (Class::Events::Subscription::Named $subscription) {
			%.subscriptions<$subscrption.name>.remove($subscription);
			$subscription.subscriber.remove_subscription($subscription);
		}
		
		method get_subscriptions (Class::Publisher::Event::Named $event) {
			# an optimizing lookup for named events stores things in a hash to reduce algorithmic complexity
			gather {
				given $event.name {
					when '*' { take %.subscription.values».members };
					default { take %.subscriptions<$_>.members }
					# FIXME look at superclass subscriptions too
				}
			}
		}
	
		method notify (String $name, *@args) {
			$publisher.notify(Class::Events::Event::Named.new($name));
		}
	}
}

class Class::Events::Event {
	# pretty much an abstract baseclass
	# an empty implementation is useful on it's own

	has @.args;
	method new (*@.args) { super }
}

class Class::Events::Event::Named {
	has $.name;

	method new ($.name, *@args) {
		super *@args;
	}
}

class Class::Events::Notification {
	has Class::Events::Subscription $.subscription;
	has Class::Events::Event $.event;

	method dispatch {
		dispatch($?SELF, $.subscription.subscriber);
	}
	
	method dispatch (Code & Class::Events::Subscriber $subscriber) {
		$subscriber.($.subscription, $.event.args);
	}

	method dispatch (Class::Events::Subscriber $subscriber) {
		$subscriber.update($.subscription, $.event.args);
	}
}