proof of concept for Moosey refactoring of part of RDF::Trine

Trine_Statements.pm

use 5.014;
use Throwable::Error;

{
	package Trine::Role::Node;
	use Moose::Role;
	requires 'sse';
	requires 'from_sse';
	requires 'type';
	sub is_node     { 1 } 
	sub is_blank    { 0 } 
	sub is_resource { 0 } 
	sub is_literal  { 0 } 
	sub is_nil      { 0 } 
	sub is_variable { 0 } 
	sub as_string { shift->sse }
	sub equal {
		my ($x, $y) = @_;
		return unless $y->can('type') && $x->type eq $y->type;
		$x->sse eq $y->sse;
	}
}

{
	package Trine::Nil;
	use Moose;
	use MooseX::Singleton;
	use Scalar::Util qw(refaddr);
	with 'Trine::Role::Node';
	sub is_nil { 1 }
	sub sse { '(nil)' }
	sub value { '' }
	sub as_ntriples {
		my $self = shift;
		return sprintf('<%s>', RDF::Trine::NIL_GRAPH());
	}
	sub type { 'NIL' }
	sub from_sse {
		...;
	}
	sub equal { refaddr(shift)==refaddr(shift) }
}

{
	package Trine::Role::ConcreteNode;
	use Moose::Role;
	with 'Trine::Role::Node';
	requires 'as_ntriples';
	has value => (
		is   => 'ro',
		isa  => 'Str',
	);
	sub BUILDARGS {
		if (@_ == 2 and not ref $_[1]) {
			return +{ value => $_[1] };
		}
		return shift->SUPER::BUILDARGS(@_);
	}
	sub sse {
		shift->as_ntriples # not strictly correct
	}
	sub from_sse {
		...;
	}
}

{
	package Trine::Resource;
	use Moose;
	use MooseX::Aliases;
	with 'Trine::Role::ConcreteNode';
	alias $_ => 'value' for qw(uri uri_value);
	sub type {
		'IRI'
	}
	sub as_ntriples {
		sprintf('<%s>', shift->uri)
	}
	sub qname {
		...;
	}
	sub is_resource { 1 }
}

{
	package Trine::BlankNode;
	use Moose;
	use MooseX::Aliases;
	with 'Trine::Role::ConcreteNode';
	alias $_ => 'value' for qw(blank_identifier);
	sub type {
		'BLANK'
	}
	sub as_ntriples {
		sprintf('_:%s', shift->blank_identifier)
	}
	sub is_blank { 1 }
}


{
	package Trine::Literal;
	use Moose;
	use MooseX::Aliases;
	with 'Trine::Role::ConcreteNode';
	alias $_ => 'value' for qw(literal_value);
	has $_ => (
		is        => 'ro',
		isa       => 'Str',
		predicate => "has_$_",
		traits    => [qw( MooseX::UndefTolerant::Attribute )],
	) for qw(language datatype);
	alias literal_value_language => 'language';
	alias literal_datatype => 'datatype';
	sub BUILDARGS {
		if (@_ >= 2 and @_ <= 4 and not ref $_[1]) {
			return +{
				value    => $_[1],
				language => $_[2],
				datatype => $_[3],
			};
		}
		return shift->SUPER::BUILDARGS(@_);
	}
	my %SUBCLASS;
	sub BUILD {
		my $self = shift;
		
		Throwable::Error->new(
			message => "cannot have both a language and datatype",
		) if $self->has_datatype && $self->has_language;
		
		if (my $r = $SUBCLASS{ $self->datatype }) {
			$r->meta->rebless_instance($self);
		}
	}
	sub new_canonical {
		my $class = shift;
		my $self  = $class->new(@_);
		if ($self->does('Trine::Role::Canonicalization')) {
			return $self->canonicalize;
		}
		return $self;
	}
	sub type {
		'LITERAL'
	}
	sub as_ntriples {
		my $self = shift;
		return sprintf("\"%s\"^^<%s>", $self->value, $self->datatype)
			if $self->has_datatype;
		return sprintf("\"%s\"\@%s", $self->value, $self->language)
			if $self->has_language;
		return sprintf("\"%s\"", $self->value);
	}
	sub is_literal { 1 }
	
	sub _register_datatype {
		my ($datatype, $sc) = @_;
		$datatype = $datatype->value if blessed $datatype;
		$SUBCLASS{ $datatype } ||= $sc;
	}
}

{
	package Trine::Role::Canonicalization;
	use Moose::Role;
	requires 'value';
	requires 'datatype';
	requires 'is_valid_lexical_form';
	requires 'canonical_lexical_form';
		
	sub is_canonical_lexical_form
	{
		my $self = shift;
		$self->value eq $self->canonical_lexical_form
	}
	
	sub canonicalize
	{
		my $self = shift;
		Trine::Literal->new(
			value    => $self->canonical_lexical_form,
			datatype => $self->datatype,
		);
	}	
}

{
	package Trine::Literal::Boolean;
	use Moose;
	extends 'Trine::Literal';
	with 'Trine::Role::Canonicalization';
	
	sub is_valid_lexical_form
	{
		my $self = shift;
		$self->value =~ m{^( true | false | 1 | 0 )$}xi;
	}
	sub canonical_lexical_form
	{
		my $self = shift;
		return 'true'  if $self->value =~ m{^( true  | 1 )$}xi;
		return 'false' if $self->value =~ m{^( false | 0 )$}xi;
		Throwable::Error->throw(message => "Literal cannot be canonicalized");
	}
	sub truth
	{
		my $self = shift;
		return ($self->canonical_lexical_form eq 'true');
	}
	
	Trine::Literal::_register_datatype(
		q<http://www.w3.org/2001/XMLSchema#boolean>,
		__PACKAGE__,
	);
}

{
	package Trine::Variable;
	use Moose;
	with 'Trine::Role::Node';
	has name => (
		is   => 'ro',
		isa  => 'Str',
	);
	sub BUILDARGS {
		if (@_ == 2 and not ref $_[1]) {
			return +{ name => $_[1] };
		}
		return shift->SUPER::BUILDARGS(@_);
	}
	sub type {
		'VAR'
	}
	sub sse {
		sprintf '?%s', shift->name;
	}
	sub from_sse {
		...;
	}
	sub as_ntriples {
		Throwable::Error->throw(
			message => "Variable nodes aren't allowed in NTriples",
		);
	}
	sub is_variable { 1 }
}

{
	package Trine::Role::StatementElement;
	use MooseX::Role::Parameterized;
	parameter name => (
		isa      => 'Str',
		required => 1,
	);
	parameter require => (
		isa      => 'Bool',
		default  => 1,
	);
	role {
		my $p = shift;
		
		has $p->name => (
			is     => 'ro',
			does   => 'Trine::Role::Node',
			required => $p->require,
		);
	}
}

{
	package Trine::Role::StatementSubject;
	use Moose::Role;
	with 'Trine::Role::StatementElement' => { name => 'subject' }
}

{
	package Trine::Role::StatementPredicate;
	use Moose::Role;
	with 'Trine::Role::StatementElement' => { name => 'predicate' }
}

{
	package Trine::Role::StatementObject;
	use Moose::Role;
	with 'Trine::Role::StatementElement' => { name => 'object' }
}

{
	package Trine::Role::StatementGraph;
	use Moose::Role;
	with 'Trine::Role::StatementElement' => { name => 'graph' }
}

{
	package Trine::Role::Statement;
	use Moose::Role;
	with qw(
		Trine::Role::StatementSubject
		Trine::Role::StatementPredicate
		Trine::Role::StatementObject
		MooseX::Clone
	);
	requires 'node_names';
	requires 'type';
	sub nodes {
		my $self = shift;
		map { $self->$_ } $self->node_names
	}
	sub BUILDARGS {
		my $class    = shift;
		my @elements = $class->node_names;
		if (scalar @elements == scalar @_ and ref $_[0] and not ref $_[0] eq 'HASH') {
			return +{ map { $elements[$_] => $_[$_]; } 0 .. $#elements };
		}
		return $class->SUPER::BUILDARGS(@_);
	}
	sub has_blanks {
		my $self = shift;
		grep { $_->is_blank } $self->nodes;
	}
	sub referenced_variables {
		my $self = shift;
		RDF::Trine::_uniq(
			map { $_->name }
			grep { $_->is_variable }
			$self->nodes
		);
	}
	{
		no warnings 'once';
		*definite_variables = \&referenced_variables; # an alias???
	}
	sub as_string {
		...;
	}
	sub sse {
		...;
	}
	sub from_sse {
		...;
	}
	sub bind_variables {
		...;
	}
	sub subsumes {
		...;
	}
	sub from_redland {
		...;
	}
	sub to_triple {
		my $self = shift;
		Trine::Triple->new(
			subject    => $self->subject,
			predicate  => $self->predicate,
			object     => $self->object,
		);
	}
}

{
	package Trine::Triple;
	use Moose;
	with 'Trine::Role::Statement';
	
	sub type { 'TRIPLE' }
	sub node_names { qw(subject predicate object) }
	
	sub as_ntriples {
		my $self = shift;
		join q[ ] => (
			(map { $_->as_ntriples } $self->nodes),
			".\n"
		);
	}
}

{
	package Trine::Quad;
	use Moose;
	with qw(
		Trine::Role::Statement
		Trine::Role::StatementGraph
	);

	sub type { 'QUAD' }
	sub node_names { qw(subject predicate object graph) }
}


{
	package Local::Tests;
	use RDF::Trine qw(iri literal variable blank);
	use Test::More tests => 6;

	sub RDF::Trine::Statement::as_ntriples {
		my $self = shift;
		join q[ ] => (
			(map { $_->as_ntriples } $self->nodes),
			".\n"
		);
	}

	is(
		Trine::Triple->new(
			Trine::Resource->new('http://example.com/s'),
			Trine::Resource->new('http://example.com/p'),
			Trine::Resource->new('http://example.com/o'),
		)->as_ntriples,
		RDF::Trine::Statement->new(
			iri('http://example.com/s'),
			iri('http://example.com/p'),
			iri('http://example.com/o'),
		)->as_ntriples,
		'ntriples matches'
	);
	
	my $lit = Trine::Literal->new('TRUE', undef, 'http://www.w3.org/2001/XMLSchema#boolean');
	ok($lit->is_valid_lexical_form);
	ok not($lit->is_canonical_lexical_form);
	my $canon = $lit->canonicalize;
	ok($canon->is_valid_lexical_form);
	ok($canon->is_canonical_lexical_form);
	ok(
		$canon->equal(
			Trine::Literal->new('true', undef, 'http://www.w3.org/2001/XMLSchema#boolean'),
		),
	);
}