1 package Text::Tradition::Collation::Relationship;
4 use Moose::Util::TypeConstraints;
5 ## CAREFUL in our use of Moose::Util::TypeConstraints. That 'from'
6 ## clashes with Graph::Easy::Edge 'from', so we'll need to unimport
7 ## TypeConstraints after defining the types. Or else we would have to
8 ## finally split out our types into another module.
11 extends 'Graph::Easy::Edge';
13 enum 'RelationshipType' => qw( spelling orthographic grammatical repetition );
15 subtype 'RelationshipVector',
18 && $_->[0]->isa( 'Text::Tradition::Collation::Reading' )
19 && $_->[1]->isa( 'Text::Tradition::Collation::Reading' )
21 message { 'Argument should be [ SourceReading, TargetReading ]' };
23 subtype 'RelationshipTokenVector',
25 => where { @$_ == 2 },
26 message { 'Argument should be [ \'source\', \'target\' ]' };
28 no Moose::Util::TypeConstraints; ## see comment above
32 isa => 'RelationshipType',
36 has 'orig_relation' => (
38 isa => 'RelationshipVector',
42 has 'related_readings' => (
44 isa => 'RelationshipTokenVector',
53 sub FOREIGNBUILDARGS {
57 # Make the label match our 'sort' attribute.
59 if( exists $args{'sort'} ) {
60 push( @superclass_args, 'label', $args{'sort'} );
62 return @superclass_args;
66 my( $self, $args ) = @_;
68 $self->set_attribute( 'class', 'relationship' );
70 my( $source, $target ) = @{$self->orig_relation};
71 if( $source->has_position && $target->has_position
72 && $source->position ne $target->position ) {
73 die "Cannot set relationship between readings in different positions";
75 unless( $self->related_readings ) {
76 $self->related_readings( [ $self->orig_relation->[0]->label,
77 $self->orig_relation->[1]->label ] );
82 __PACKAGE__->meta->make_immutable;