new position logic for the lemmatizer and toggler; still need non-linear positions
[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / Relationship.pm
CommitLineData
d047cd52 1package Text::Tradition::Collation::Relationship;
2
3use Moose;
4use Moose::Util::TypeConstraints;
3265b0ce 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.
9use MooseX::NonMoose;
d047cd52 10
3265b0ce 11extends 'Graph::Easy::Edge';
d047cd52 12
ef9d481f 13enum 'RelationshipType' => qw( spelling orthographic grammatical repetition lexical );
3265b0ce 14
15subtype 'RelationshipVector',
16 => as 'ArrayRef',
17 => where { @$_ == 2
b15511bf 18 && $_->[0]->isa( 'Graph::Easy::Node' )
19 && $_->[1]->isa( 'Graph::Easy::Node' )
3265b0ce 20 },
21 message { 'Argument should be [ SourceReading, TargetReading ]' };
22
23subtype 'RelationshipTokenVector',
24 => as 'ArrayRef',
25 => where { @$_ == 2 },
26 message { 'Argument should be [ \'source\', \'target\' ]' };
27
28no Moose::Util::TypeConstraints; ## see comment above
29
4cdd82f1 30has 'type' => (
d047cd52 31 is => 'rw',
32 isa => 'RelationshipType',
33 required => 1,
34);
35
4cdd82f1 36has 'this_relation' => (
d047cd52 37 is => 'rw',
3265b0ce 38 isa => 'RelationshipVector',
d047cd52 39 required => 1,
40);
41
4cdd82f1 42has 'primary_relation' => (
3265b0ce 43 is => 'rw',
44 isa => 'RelationshipTokenVector',
45);
46
d047cd52 47has 'global' => (
48 is => 'rw',
49 isa => 'Bool',
3265b0ce 50 default => 0,
d047cd52 51);
52
b15511bf 53has 'non_correctable' => (
54 is => 'rw',
55 isa => 'Bool',
56 );
57
58has 'non_independent' => (
59 is => 'rw',
60 isa => 'Bool',
61 );
62
3265b0ce 63sub FOREIGNBUILDARGS {
64 my $class = shift;
65 my %args = @_;
66
4cdd82f1 67 # Make the label match our 'type' attribute.
3265b0ce 68 my @superclass_args;
4cdd82f1 69 if( exists $args{'type'} ) {
70 push( @superclass_args, 'label', $args{'type'} );
3265b0ce 71 }
72 return @superclass_args;
73}
74
75sub BUILD {
76 my( $self, $args ) = @_;
77
78 $self->set_attribute( 'class', 'relationship' );
79
4cdd82f1 80 my( $source, $target ) = @{$self->this_relation};
81 if( $source->has_position && $target->has_position ) {
82 # Harmonize the positions.
83 $source->match_position( $target );
3265b0ce 84 }
4cdd82f1 85 unless( $self->primary_relation ) {
86 $self->primary_relation( [ $self->this_relation->[0]->label,
87 $self->this_relation->[1]->label ] );
3265b0ce 88 }
89}
90
91no Moose;
92__PACKAGE__->meta->make_immutable;