
use v5.10;
use strict;
use warnings;

package Examples::Context::Singleton::Frame;

our $VERSION = v1.0.0;

use Test::Spec::Util;
use Hash::Util qw[ ];

use Context::Singleton::Frame;
use Sample::Context::Singleton::Frame;

sub evaluate (&) {
	my ($code) = @_;
	my $value;
	my $lives_ok = eval { $value = $code->(); 1 };
	my $error = $@;

	($lives_ok, $error, $value);
}

sub behaves_like_proclaim {
	my ($title, %params) = @_;
	Hash::Util::lock_keys %params,
		qw[ object ],
		qw[ with_key with_value ],
		qw[ throws expect_value ],
		;

	$params{throws} = qr/Key already resolved/
		if exists $params{throws};

	my ($lives, $error, $returns) = evaluate {
		$params{object}->proclaim ($params{with_key}, $params{with_value});
	};

	context $title => as {
		if ($params{throws}) {
			it "should throw exception" => as { throws_ok { die $error unless $lives } $params{throws} };
			it "should deduce value" => as { is $params{object}->deduce ($params{with_key}), $params{expect_value} }
				if exists $params{expect_value};
		} else {
			it "should not throw exception" => as { lives_ok { die $error unless $lives } };
			it "should return 'self'" => as { is $returns, $params{object} };
			it "should deduce value" => as { is $params{object}->deduce ($params{with_key}), $params{with_value} };
		}
	};
}

sub behaves_like_is_deduced {
	my ($title, %params) = @_;
	Hash::Util::lock_keys %params, qw[ object expect with_key ];

	my ($lives_ok, $error, $status) = evaluate {
		$params{object}->is_deduced ($params{with_key})
	};

	it $title => $lives_ok
		? as { cmp_deeply $status, bool $params{expect} }
		: as { lives_ok { die $error } }
		;
}

sub behaves_like_deduce {
	my ($title, %params) = @_;
	Hash::Util::lock_keys %params, qw[ object throws with_key expect_value ];

	my ($lives_ok, $error, $got) = evaluate {
		$params{object}->deduce ($params{with_key});
	};

	my $code;
	$code = as { throws_ok { die $error unless $lives_ok } $params{throws} }
		if $params{throws};
	$code //= as { lives_ok { die $error } }
		unless $lives_ok;
	$code //= as { cmp_deeply $got, $params{expect_value} };

	it $title => $code;
}

export build_frame => as {
	my $parent = shared->frame_class // 'Context::Singleton::Frame';
	$parent = shift if @_ % 2;
	return $parent->new (@_);
};

export build_sample_dependencies => as {
	build_frame ('Sample::Context::Singleton::Frame::002::Resolve::Dependencies', @_);
};

export build_sample_unique => as {
	build_frame ('Sample::Context::Singleton::Frame::001::Unique::DB', @_);
};

example expect_depth => as {
	my $title = shift if @_ % 2;
	my (%params) = @_;
	Hash::Util::lock_keys %params, qw[ object expect ];

	it $title // "expect depth $params{expect}" => as { cmp_deeply $params{object}{depth}, $params{expect} };
};

example it_should_have_parent => as {
	my (%params) = @_;

	it "should have parent" => as { ok $params{object}->{parent} };
};

example it_should_not_have_parent => as {
	my (%params) = @_;

	it "should not have parent" => as { ok ! $params{object}->{parent} };
};

example should_proclaim => as {
	my ($title, %params) = @_;

	behaves_like_proclaim $title, %params;
};

example should_not_proclaim => as {
	my ($title, %params) = @_;

	behaves_like_proclaim $title, throws => 1, %params;
};

example should_be_deduced => as {
	my ($title, %params) = @_;

	test_method $title, %params, expect => expect_true;
};

example should_not_be_deduced => as {
	my ($title, %params) = @_;

	test_method $title, %params, expect => expect_false;
};

example should_be_deducible => as {
	my ($title, %params) = @_;

	test_method $title, %params, expect => expect_true;
};

example should_not_be_deducible => as {
	my ($title, %params) = @_;

	test_method $title, %params, expect => expect_false;
};

example should_deduce => as {
	my ($title, %params) = @_;

	test_method $title, %params;
};

example should_not_deduce => as {
	my ($title, %params) = @_;

	test_method $title, %params, throws => 'Context::Singleton::Exception::Nondeducible';
};

example it_should_have_db => as {
	my (%params) = @_;

	it "should have db" => as { ok $params{object}->db };
	it "should share db with its ancestor" => as { is $params{object}->db, $params{ancestor}->db }
		if $params{ancestor};
};

example frame_constructor => as {
	my ($title, %params) = @_;
	Hash::Util::lock_keys %params,
		qw[ object plan ],
		qw[ expect_class expect_depth expect_parent expect_resolved ],
		qw[ expect_root ],
		;

	$params{expect_resolved} //= [];

	context $title => as {
		Test::More::plan tests => $params{plan} if $params{plan};
		is_instance_of (
			object => $params{object},
			class  => $params{expect_class},
		) if exists $params{expect_class};

		expect_depth ("expect depth $params{expect_depth}" => do {
			object => $params{object},
				expect => $params{expect_depth},
			}) if exists $params{expect_depth};

		it_should_have_parent (object => $params{object})
			if exists $params{expect_parent} and $params{expect_parent};

		it_should_not_have_parent (object => $params{object})
			if exists $params{expect_parent} and not $params{expect_parent};

		is ($params{object}->root_resolver, $params{expect_root})
			if exists $params{expect_root};

		#it_should_have_db (
		#    object => $params{object},
		#    ancestor => $params{expect_parent},
		#);

		for my $key (@{ $params{expect_resolved} }) {
			should_be_deduced (
				"'$key' should be deduced",
				object => $params{object},
				with_key => $key,
			)
		}
	};
};

example test_method_proclaim => as {
	my ($title, %params) = @_;
	Hash::Util::lock_keys %params, qw[ object with_rule with_value throws expect ];

	$params{expect} = $params{with_value}
		unless exists $params{expect} or $params{throws};

	test_method $title => %params;
};

1;
