package AspectC::Repo;

use strict;
use warnings;
use 5.020;
use List::Util qw(first);
use XML::LibXML;

our $VERSION = '0.00';

my @source_loc_kind = (qw(none definition declaration));
my @function_kind   = (
	qw(unknown non_member static_non_member member
	  static_member virtual_member pure_virtual_member conctructor destructor
	  virtual_destructor pure_virtual_destructor)
);
my @pointcut_kind = (qw(normal virtual pure_virtual));
my @variable_kind
  = (qw(unknown non_member static_non_member member static_member));
my @advice_code_kind = (qw(before after around));
my @advice_code_context
  = (qw(none type obj type_obj vars type_vars obj_vars type_obj_vars));
my @cv_qualifiers = (qw(none const volatile const_volatile));

sub new {
	my ( $class, %opt ) = @_;

	my $self = \%opt;

	$self->{xml}
	  = XML::LibXML->load_xml( location => '../kratos/src/repo.acp' );

	bless( $self, $class );
	$self->parse_xml;
	return $self;
}

sub parse_xml {
	my ($self) = @_;

	my $xml = $self->{xml};

	for my $node (
		$xml->findnodes('/ac-model/files/TUnit | /ac-model/files/Header') )
	{
		my $filename = $node->getAttribute('filename');
		my $id       = $node->getAttribute('id');
		if ( defined $id ) {
			$self->{files}{$id} = $filename;
		}
		else {
			say STDERR "repo.acp: File ${filename} has no ID";
		}
	}

	for my $aspect (
		$xml->findnodes(
			    '/ac-model/root/Namespace[@name="::"]/children/Aspect'
			  . ' | /ac-model/root/Namespace[@name="::"]/children/Namespace'
		)
	  )
	{
		my $aspect_name = $aspect->getAttribute('name');
		for my $attr_node ( $aspect->findnodes('./children/Attribute') ) {
			my $attr_name = $attr_node->getAttribute('name');
			my $attr_id   = $attr_node->getAttribute('id');
			if ( defined $attr_id ) {
				$self->{attributes}{$attr_id} = {
					namespace => $aspect_name,
					name      => $attr_name,
				};
			}
		}
	}

	for my $node (
		$xml->findnodes('/ac-model/root/Namespace[@name="::"]/children/Class') )
	{
		my $class      = {};
		my $class_name = $node->getAttribute('name');
		my $id         = $node->getAttribute('id');
		my @bases;
		my @functions;
		my @sources;
		if ( my $base_str = $node->getAttribute('bases') ) {
			@bases = split( qr{ }, $base_str );
		}

		for my $source ( $node->findnodes('./source/Source') ) {
			push(
				@sources,
				{
					file => $self->{files}{ $source->getAttribute('file') },
					kind => $source_loc_kind[ $source->getAttribute('kind') ],
				}
			);
		}

		$class->{name}    = $class_name;
		$class->{id}      = $id;
		$class->{sources} = [@sources];

		for my $fnode ( $node->findnodes('./children/Function') ) {
			my $name        = $fnode->getAttribute('name');
			my $id          = $fnode->getAttribute('id') // q{?};
			my $kind        = $fnode->getAttribute('kind');
			my $attributes  = $fnode->getAttribute('attributes');
			my $result_type = q{?};
			my @args;

			if ( my $typenode = ( $fnode->findnodes('./result_type/Type') )[0] )
			{
				$result_type = $typenode->getAttribute('signature');
			}

			for my $argnode ( $fnode->findnodes('./arg_types/Type') ) {
				push( @args, $argnode->getAttribute('signature') );
			}

			my $fun = {
				name     => $name,
				returns  => $result_type,
				argtypes => [@args],
			};

			if ($attributes) {
				$fun->{attributes} = [
					map { $self->{attributes}{$_}{name} }
					  split( qr{ \s+ }x, $attributes )
				];
			}
			$class->{function}{$name} = $fun;
		}
		$self->{class}{$class_name} = $class;
	}

	for my $node (
		$xml->findnodes(
			'/ac-model/root/Namespace[@name="::"]/children/Variable')
	  )
	{
		my $sig_node  = ( $node->findnodes('./type/Type') )[0];
		my $kind      = $node->getAttribute('kind');
		my $name      = $node->getAttribute('name');
		my $signature = $sig_node->getAttribute('signature');

		if ( $variable_kind[$kind] eq 'non_member' ) {
			$self->{class_instance}{$signature} = $name;
		}
	}

	return $self;
}

sub get_class_path_prefix {
	my ( $self, $class_name ) = @_;

	my $header = first { $_->{kind} eq 'definition' }
	@{ $self->{class}{$class_name}{sources} };
	$header = $header->{file};
	$header =~ s{ \. h $ }{}x;

	return $header;
}

sub get_class_instance {
	my ( $self, $class_name ) = @_;

	return $self->{class_instance}{$class_name};
}

1;