# stag-handle.pl -p GO::Parsers::GoOntParser -m <THIS> function/function.ontology

package GO::Handlers::prolog;
use base qw(GO::Handlers::abstract_prolog_writer 
	    Data::Stag::Writer);
use strict;

sub s_obo {
    my $self = shift;
    $self->cmt("-- ********************************************************* --\n");
    $self->cmt("-- Autogenerated Prolog factfiles \n");
    $self->cmt("-- class(Id,Name) -- corresponds to OBO term \n");
    $self->cmt("-- belongs(Id,Ont) -- maps ID to ontology/domain \n");
    $self->cmt("-- subclass(Id,IdParent) -- corresponds to is_a relationship \n");
    $self->cmt("-- restriction(Id,Type,To) -- other relationships \n");
    $self->cmt("-- ********************************************************* --\n");
    $self->nl;
}

sub e_header {
    my ($self, $hdr) = @_;
    my $idspace = $hdr->sget_idspace;
    if ($idspace && $idspace =~ /(\S+)\s+(\S+)/) {
        $self->factq(idspace=>[$1,$2]);
    }
    $self->nl;
    return;
}


sub e_typedef {
    my ($self, $typedef) = @_;
    $self->cmt("-- Property/Slot --\n");
    my $ont = $typedef->get_namespace;
    my $id = $typedef->get_id || $self->throw($typedef->sxpr);
    my $proptype = 'property';
    my $domain = $typedef->get_domain;
    my $range = $typedef->get_range;
    if ($range && $range =~ /^xsd:/) {
        $proptype = 'slot';
    }
    $self->fact($proptype, [$id, $typedef->sget_name]);
    my @is_as = $typedef->get_is_a;
    $self->factq('subclass', [$id, $_]) foreach @is_as;
    if ($ont) {
	$self->factq('belongs', [$id, $ont]);
    }
    foreach (qw(is_reflexive is_anti_symmetric is_symmetric is_transitive)) {
        if ($typedef->sget($_)) {
            $self->factq($_,[$id]);
        }
    }
    $self->export_tags($typedef);
    foreach (qw(domain range)) {
        my $val = $typedef->sget($_);
        if ($val) {
            $self->fact("property_$_",[$id,convert_to_ref($val)]);
        }
    }
    foreach (qw(transitive_over inverse_of)) {
        my $val = $typedef->sget($_);
        if ($val) {
            $self->factq($_,[$id,$val]);
        }
    }
    $self->nl;
    return;
}

sub e_term {
    my ($self, $term) = @_;
    my $id = $term->get_id || $self->throw($term->sxpr);
    my $name_h = $self->{name_h};
    my $name = $term->get_name;
    #$name =~ s/_/ /g;   # ontologies lack consistency; force use of spc
    my $ont = $term->get_namespace || 'unknown';

    if ($term->get_is_obsolete) {
	$self->factq(obsolete => [$id,$name,$ont]);
	$self->factq(obsolete_class => [$id, $name]);
	return;
    }
    if ($name) {
	if (!$name_h) {
	    $name_h = {};
	    $self->{name_h} = $name_h;
	}
	$name_h->{$id} = $name;
	$self->cmt("-- $name --\n");
	$self->factq('class', [$id, $name]);
    }
    if ($ont) {
	$self->factq('belongs', [$id, $ont]);
    }
    my @is_as = $term->findval_is_a;
    $self->factq('subclass', [$id, $_], $name_h->{$_}) foreach @is_as;
    my @xp = $term->get_intersection_of;
    if (@xp) {
        my @genus_l = ();
        @xp = grep {
            # new style genus-differentia:
            #  we say intersection_of: ID rather than
            #         intersection_of: relation ID
            if (!$_->get_type || $_->get_type eq 'is_a') {
                if (@genus_l) {
                    $self->warn(">1 genus for $id/$name");
                }
                push(@genus_l, $_->get_to);
                0;
            }
            else {
                1;
            }
        } @xp;
        $self->factq('genus',[$id, $_])
          foreach @genus_l;
        $self->factq('differentium', [$id, $_->get_type, $_->sget_to])
          foreach @xp;
    }
    my @rels = $term->get_relationship;
    foreach (@rels) {
        $self->factq('restriction', 
                    [$id, $_->get_type, convert_to_ref($_->get_to)], $name_h->{$_->get_to}) 
    }

    foreach (qw(is_anonymous)) {
        if ($term->sget($_)) {
            $self->factq($_,[$id]);
        }
    }
    $self->export_tags($term);
    $self->nl;

    # metadata

    return;
}

# stuff common to terms and typedefs
sub export_tags {
    my ($self, $term) = @_;
    my $def = $term->get_def;
    my $id = $term->sget_id;
    if ($def) {
        $self->factq('def',[$id, $def->sget_defstr]);
    }
    foreach ($term->get_comment) {
        $self->factq('class_comment',[$id, $_]);
    }
    foreach ($term->get_synonym) {
        $self->factq('synonym',[$id, ($_->sget('@/scope') || ''),$_->sget_synonym_text]);
    }
    foreach ($term->get_xref_analog) {
        $self->factq('class_xref',[$id, sprintf("%s:%s",$_->sget_dbname,$_->sget_acc)]);
    }
    #foreach ($term->get_subset) {
    #    $self->fact('belongs_subset',$_->findval_scope || '',$_->sget_synonym_text);
    #}
    foreach (qw(inverse_of lexical_category)) {
        my $val = $term->sget($_);
        if ($val) {
            $self->factq($_,[$id,$val]);
        }
    }
    return;
}

sub nextid_by_prod {
    my $self = shift;
    $self->{_nextid_by_prod} = shift if @_;
    $self->{_nextid_by_prod} = {} 
      unless $self->{_nextid_by_prod};

    return $self->{_nextid_by_prod};
}

sub e_prod {
    my ($self, $gp) = @_;   
    my $proddb = $self->up(-1)->sget_proddb;
    my $prodacc = $gp->sget_prodacc;

    # all gene products go in seqfeature_db module
    my $id = "$proddb:$prodacc";
    $self->factq('seqfeature_db:feature',
                [$id,$gp->sget_prodsymbol,$gp->sget_prodtype]);
    $self->factq('seqfeature_db:feature_organism',
                [$id,'NCBITaxon:'.$gp->sget("prodtaxa")]);
    $self->factq('seqfeature_db:featureprop',
                [$id,'description',$gp->sget_prodname]);
    $self->factq('seqfeature_db:featureprop',
                [$id,'synonym',$_])
      foreach $gp->get_prodsyn;

    # associations between gp and term'
    my @assocs = $gp->get_assoc;
    my $idh = $self->nextid_by_prod;
    foreach my $assoc (@assocs) {
        my $n = $idh->{$id}++;
        my $aid = "$id-$n";
        $self->fact('association',
                    [$aid,$assoc->sget_termacc,$id,$assoc->sget_is_not ? 1 : 0]);
        my @evs = $assoc->get_evidence;
        my $ne=0;
        foreach my $ev (@evs) {
            my $eid = "$aid-$ne";
            $ne++;
            $self->factq('evidence',
                        [$eid,$aid,$ev->sget_evcode,$ev->sget_ref]);
            $self->factq('evidence_with',
                         [$eid,$_])
              foreach $ev->get_with;
        }
        my @pvs = $assoc->get_property_value;
        foreach my $pv (@pvs) {
            $self->factq('association_property_value',
                        [$aid,$pv->sget_type,$pv->sget_to]);
        }
    }
}


sub e_instance {
    my ($self, $inst) = @_; 
    my $id = $inst->get_id;
    my $class = $inst->get_instance_of;
    $self->factq('inst_of',[$id,$class]);
    my $name = $inst->sget_name;
    if (defined $name) {
        $self->factq('inst',[$id,$name]);
    }
    foreach my $pv ($inst->get_property_value) {
        my $dt = $pv->sget_datatype;
        my @args = ($id,$pv->sget_type);
        if ($dt) {
            $self->factq('inst_sv',[@args,$pv->sget_value,$dt]);
        }
        else {
            $self->factq('inst_rel',[@args,$pv->sget_to]);
        }

    }
}

# todo
sub convert_to_ref {
    my $to = shift;
    if (ref($to)) { # may be enum
        return '';
    }
    else {
        return $to;
    }
}

1;
