# Copyrights 2023 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.

package Math::Formula::Context;
use vars '$VERSION';
$VERSION = '0.11';


use warnings;
use strict;

use Log::Report 'math-formula';
use Scalar::Util qw/blessed/;


sub new(%) { my $class = shift; (bless {}, $class)->init({@_}) }

sub _default($$$$)
{	my ($self, $name, $type, $value, $default) = @_;
	my $form
	  = ! $value         ? $type->new(undef, $default)
	  : ! blessed $value ? ($value ? Math::Formula->new($name, $value) : undef)
	  : $value->isa('Math::Formula') ? $value
	  : error __x"unexpected value for '{name}' in #{context}", name => $name, context => $self->name;
}

sub init($)
{	my ($self, $args) = @_;
	my $name   = $self->{MFC_name}   = $args->{name} or error __x"context without a name";

	$self->{MFC_attrs} = {
		name       => MF::STRING->new($name),
		mf_version => MF::STRING->new(undef, $Math::Formula::VERSION),
		version    => $args->{version} ? MF::STRING->new($args->{version}) : undef,
		created    => $self->_default(created => 'MF::DATETIME', $args->{created}, DateTime->now),
	};

	if(my $forms = $args->{formula})
	{	$self->add(ref $forms eq 'ARRAY' ? @$forms : $forms);
	}

	$self->{MFC_claims} = { };
	$self;
}

#--------------

sub name   { $_[0]->{MFC_name} }

#--------------

sub attribute($)
{	my ($self, $name) = @_;
	my $def = $self->{MFC_attrs}{$name} or return;
	Math::Formula->new($name => $def);
}

#XXX example with fragment

sub add(@)
{	my $self = shift;
	unless(ref $_[0])
	{	my $name = shift;
		return $name =~ s/^#// ? $self->addFragment($name, @_) : $self->addFormula($name, @_);
	}

	foreach my $obj (@_)
	{	if(ref $obj eq 'HASH')
		{	$self->add($_, $obj->{$_}) for keys %$obj;
		}
		elsif(blessed $obj && $obj->isa('Math::Formula'))
		{	$self->{MFC_forms}{$obj->name} = $obj;
		}
		elsif(blessed $obj && $obj->isa('Math::Formula::Context'))
		{	$self->{MFC_frags}{$obj->name} = $obj;
		}
		else
		{	panic __x"formula add '{what}' not understood", what => $obj;
		}
	}

	undef;
}


sub addFormula(@)
{	my ($self, $first) = (shift, shift);
	my $next = $_[0];

	my ($name, $form) =
	  !@_ && blessed $first && $first->isa('Math::Formula')
	? ($first->name, $first)
	: @_==1 && !ref $first && blessed $next && $next->isa('Math::Formula')
	? ($first, $next)
	: @_==1 && !ref $first && ref $next eq 'ARRAY'
	? ($first, Math::Formula->new($first, @{$next}))
	: @_ && !ref $first &&
		 (!ref $next || ref $next eq 'CODE' || blessed $next && $next->isa('Math::Formula::Type'))
	? ($first, Math::Formula->new($first, @_))
	: panic __x"formula declaration '{name}' not understood", name => $first;

	$self->{MFC_forms}{$name} = $form;
}


sub formula($) { $_[0]->{MFC_forms}{$_[1]} }


sub addFragment($;$)
{	my $self = shift;
	my ($name, $fragment) = @_==2 ? @_ : ($_[0]->name, $_[0]);
	$self->{MFC_frags}{$name} = MF::FRAGMENT->new($name, $fragment);
}


sub fragment($) { $_[0]->{MFC_frags}{$_[1]} }


sub evaluate($$%)
{	my ($self, $name) = (shift, shift);

	# Wow, I am impressed!  Caused by prefix(#,.) -> infix
	length $name or return $self;

	my $form = $self->attribute($name) || $self->formula($name);
	unless($form)
	{	warning __x"no formula '{name}' in {context}", name => $name, context => $self->name;
		return undef;
	}

	my $claims = $self->{MFC_claims};
	! $claims->{$name}++
		or error __x"recursion in expression '{name}' at {context}",
			name => $name, context => $self->name;

	my $result = $form->evaluate($self, @_);

	delete $claims->{$name};
	$result;
}


sub run($%)
{	my ($self, $expr, %args) = @_;
	my $name  = delete $args{name} || join '#', (caller)[1,2];
	my $result = Math::Formula->new($name, $expr)->evaluate($self, %args);

	while($result && $result->isa('MF::NAME'))
	{	$result = $self->evaluate($result->token, %args);
	}

	$result;
}


sub value($@)
{	my $self = shift;
	my $result = $self->run(@_);
	$result ? $result->value : undef;
}

#--------------

1;
