=head1 NAME

C<IMPL::Condig::YAMLConfig> - YAML configuration parser for the container

=head1 SYNOPSIS

=begin code

use IMPL::require {
    YAMLConfig => 'IMPL::Config::YAMLConfig',
    Container => 'IMPL::Config::Container'
};

my $config = YAMLConfig->new('config.yaml');
$config->Load('additional.yaml');
my $container = Container->new($parent);
$config->ConfigureContainer($container);

=end code

=head1 DESCRIPTION

This module load YAML configuration and applies it to the container. 

=head1 MEMBERS

=cut

package IMPL::Config::YAMLConfig;
use strict;

use IMPL::Debug;
use IMPL::lang qw(:base);
use IMPL::Exception();
use YAML::XS();
use Sub::Util;
use File::Spec();
use URI::file();

use IMPL::declare {
    require => {
        ReferenceDescriptor => 'IMPL::Config::ReferenceDescriptor',
        ServiceDescriptor   => 'IMPL::Config::ServiceDescriptor',
        ValueDescriptor     => 'IMPL::Config::ValueDescriptor',
        Descriptor          => '-IMPL::Config::Descriptor'
    },
    base => [
        'IMPL::Object' => undef
    ],
    props => [
        _services => 'ro',
        _stack    => 'ro',
        _visited  => 'ro',
        _current  => 'ro'
    ]
};

sub CTOR {
    my ( $this, %args ) = @_;
    $this->_services( {} );
    $this->_stack( [] );
    $this->_visited( {} );
    $this->Load( $args{load} ) if ( $args{load} );
}

sub Load {
    my ( $this, $file ) = @_;

    dbg_log("Load $file");
    my $prev = $this->_current;
    push @{ $this->_stack }, "$file";
    
    dbg_log( "base: ", $prev || '' );

    $this->_current( $prev ? URI::file->new($file)->abs($prev) : URI::file->new_abs($file))
      unless ref $file;
    
    dbg_log( "translated: ", $this->_current);

    my $config;

    if ( isscalar($file) ) {
        $this->LoadConfiguration( YAML::XS::Load( ${$file} ) );
    }
    else {
        if ( not ref $file and defined $file ) {
            if ( not $this->_visited->{$this->_current} ) {
                $this->_visited->{$this->_current} = 1;
                
                dbg_log("Loading YAML from file ", $this->_current->file);
                
                $config = YAML::XS::LoadFile($this->_current->file);
            } else {
                dbg_warn("recursive includes: \n\t", join("\n\t", reverse @{$this->_stack}));
            }
        }
        else {
            $config = YAML::XS::LoadFile($file);
        }
    }

    $this->LoadConfiguration($config) if defined $config;

    $this->_current($prev);
    pop @{ $this->_stack };

    return 1;
}

sub LoadConfiguration {
    my ( $this, $config ) = @_;

    die IMPL::InvalidArgumentException->new('config')
      unless ishash($config);

    $this->Include( $config->{include} );

    $this->_services( $this->ParseServices( $config->{services} ) );
}

sub Include {
    my ( $this, $inc ) = @_;
    if ( isarray($inc) ) {
        $this->Include($_) foreach @$inc;
    }
    elsif ( defined $inc and not ref $inc ) {
        dbg_log("include: $inc");
        $this->Load( $inc );
    }
}

sub ConfigureContainer {
    my ( $this, $container ) = @_;

    die IMPL::InvalidArgumentException->new($container)
      unless $container;

    foreach my $item ( @{ $this->_services } ) {
        $container->Register( $item->{role}, $item->{descriptor} );
    }

    return $container;
}

sub ParseServices {
    my ( $this, $services ) = @_;

    return $services
      ? [
        map {
            {
                role       => delete $_->{name},
                descriptor => $this->ParseDescriptor($_)
            };
        } @$services
      ]
      : undef;
}

sub ParseDescriptor {
    my ( $this, $data ) = @_;

    my %opts;
    if ( ref $data ) {
        if ( my $type = $data->{'$type'} ) {
            $opts{services} = $this->ParseServices( $data->{services} );
            $opts{type}     = $type;
            $opts{args}     = $this->ParseParams( $data->{params} )
              if $data->{params};
            $opts{norequire}  = $data->{norequire};
            $opts{activation} = $data->{activation};

            return ServiceDescriptor->new(%opts);
        }
        elsif ( my $dep = $data->{'$ref'} ) {
            $opts{services} = $this->ParseServices( $data->{services} );
            $opts{lazy}     = $data->{lazy};
            $opts{optional} = $data->{optional};
            $opts{default}  = $this->ParseDescriptor( $data->{default} )
              if exists $data->{default};

            return ReferenceDescriptor->new( $dep, %opts );
        }
        elsif ( my $value = $data->{'$value'} ) {
            my ( $parsed, $raw ) = $this->ParseValue($value);
            $opts{services} = $this->ParseServices( $data->{services} );
            $opts{raw}      = $raw;
            return ValueDescriptor->new( $parsed, %opts );
        }

    }

    my ( $parsed, $raw ) = $this->ParseValue($data);
    $opts{raw} = $raw;
    return is( $parsed, Descriptor )
      ? $parsed
      : ValueDescriptor->new( $parsed, %opts );
}

sub IsDescriptorSpec {
    my ( $this, $spec ) = @_;
    return ( ishash($spec) and grep exists $spec->{$_}, qw($type $ref $value) );
}

sub ParseParams {
    my ( $this, $params ) = @_;

    if ( isarray($params) ) {
        return [ map $this->ParseDescriptor($_), @$params ];
    }
    elsif ( ishash($params) and not $this->IsDescriptorSpec($params) ) {
        return {
            map { $_, $this->ParseDescriptor( $params->{$_} ) }
              keys %$params
        };
    }
    return $this->ParseDescriptor($params);
}

# parses value and returns a reference to the parsed value, i.e. descriptors
# are recognized and instantinated.
# returns ($parsed, $raw)
#   $parsed - the parsed value
#   $raw - the parsed value doesn't contain descriptors
sub ParseValue {
    my ( $this, $value ) = @_;

    my $raw = 1;

    if ( ishash($value) ) {
        return ( $this->ParseDescriptor($value), 0 )
          if $this->IsDescriptorSpec($value);

        my %res;
        while ( my ( $k, $v ) = each %$value ) {
            my ( $parsed, $flag ) = $this->ParseValue($v);
            $res{$k} = $parsed;
            $raw &&= $flag;
        }
        return ( \%res, $raw );
    }
    elsif ( isarray($value) ) {
        return (
            [
                map {
                    my ( $parsed, $flag ) = $this->ParseValue($_);
                    $raw &&= $flag;
                    $parsed;
                } @$value
            ],
            $raw
        );
    }
    else {
        return ( $value, 1 );
    }
}

1;