package Scalar::Annotated;

use 5.010;
use strict;
use utf8;

use Carp;
use Scalar::Util qw/looks_like_number blessed/;

sub _swap
{
	my ($sub, $x, $y, $swap) = @_;
	$swap ? $sub->($y, $x) : $sub->($x, $y);
}

sub _promote
{
	map {
		blessed($_) && $_->isa(__PACKAGE__)
			? $_
			: an($_)
	} @_
}

use namespace::clean;

use parent qw/Exporter/;
use Object::AUTHORITY;
use Object::DOES;
use Object::Stash -type => 'object';

our ($AUTHORITY, $VERSION, @EXPORT);
BEGIN {
	$AUTHORITY = 'cpan:TOBYINK';
	$VERSION   = '0.001';
	@EXPORT    = qw/an/;
}

sub new
{
	my ($class, $value, $derivation) = @_;
	croak "Needs to be a simple scalar" if ref $value;
	$derivation //= looks_like_number($value) ? $value : "q{$value}";
	my $self = bless \$value, $class;
	$self->derivation = $derivation;
	return $self;
}

sub an
{
	return __PACKAGE__->new(@_);
}

sub derivation :lvalue
{
	my $self = shift;
	$self->stash->derivation(@_)
}

use overload
	'+0'   => sub { ${ $_[0] } },
	q{""}  => sub { ${ $_[0] } },
	'+'    => sub { _swap(\&add, @_) },
	'-'    => sub { _swap(\&subtract, @_) },
	'*'    => sub { _swap(\&multiply, @_) },
	'/'    => sub { _swap(\&divide, @_) },
	'%'    => sub { _swap(\&modulus, @_) },
	;

sub add
{
	my ($x, $y) = _promote(@_);
	return an(
		$$x + $$y,
		sprintf('(%s + %s)', $x->derivation, $y->derivation),
		);
}

sub subtract
{
	my ($x, $y) = _promote(@_);
	return an(
		$$x - $$y,
		sprintf('(%s - %s)', $x->derivation, $y->derivation),
		);
}

sub multiply
{
	my ($x, $y) = _promote(@_);
	return an(
		$$x * $$y,
		sprintf('(%s × %s)', $x->derivation, $y->derivation),
		);
}

sub divide
{
	my ($x, $y) = _promote(@_);
	return an(
		$$x / $$y,
		sprintf('(%s ÷ %s)', $x->derivation, $y->derivation),
		);
}

sub modulus
{
	my ($x, $y) = _promote(@_);
	return an(
		$$x % $$y,
		sprintf('(%s mod %s)', $x->derivation, $y->derivation),
		);
}

__PACKAGE__

##</code><code>##

use 5.010;
use strict;
use utf8::all;

use lib "lib";
use Scalar::Annotated;

my $foo  = an(5, '$foo');
my $bar  = an(2, '$bar');
my $baz  = 2 * ($foo + $bar - 1);
my $quux = $baz % $foo;

say '$quux is ', $quux;
say '$quux was calculated as ', $quux->derivation;

# Reset the derivation of $quux, because we are no longer
# interested in how it was derived.
$quux->derivation = '$quux';

$quux *= 2;

say '$quux is now ', $quux;
say '$quux was calculated as ', $quux->derivation;


##</code><code>##

$quux is 2
$quux was calculated as ((2 × (($foo + $bar) - 1)) mod $foo)
$quux is now 4
$quux was calculated as ($quux × 2)