# This is a quick hack implementing composable comparison objects, aka
# Constraint-Based Assert Model in NUnit.
# http://www.nunit.org/index.php?p=constraintModel&r=2.4.8

{
    package Comparison;

    use Mouse;

    has code => (
        is              => 'ro',
        isa             => 'CodeRef',
        required        => 1,
    );

    sub compare {
        my($self, $thing) = @_;

        return $self->code->($thing);
    }
}


{
    package Result;

    use Mouse;

    use overload
      'bool' => sub { $_[0]->result ? 1 : 0 };

    has result => (
        is              => 'ro',
        isa             => 'Bool',
        required        => 1,
    );

    has diag => (
        is              => 'ro',
        isa             => 'Str',
        default         => ''
    );
}


sub test {
    my($thing, $cmp) = @_;

    my $result = $cmp->compare($thing);
    if( $result ) {
        print "ok\n";
        return 1;
    }
    else {
        print "not ok\n";
        print map { "# $_\n" } split /\n/, $result->diag;
        return 0;
    }
}


sub track {
    my($thing, $cmp) = @_;

    my $result = $cmp->compare($thing);
    if( $result ) {
        print "LOGGED: TRUE\n";
    }
    else {
        print "LOGGED: FALSE - @{[ $result->diag ]}\n";
    }
}


use Carp;
sub assert {
    my($thing, $cmp) = @_;

    my $result = $cmp->compare($thing);
    unless( $result ) {
        croak "Assert failed!  @{[ $result->diag ]}";
    }
}


use List::Util qw(first);

sub any {
    my @cmps = @_;

    return Comparison->new(
        code => sub {
            my @results;
            for my $cmp (@cmps) {
                push @results, $cmp->compare(@_);
            }

            return Result->new(
                result => (first { $_ } @results) ? 1 : 0,
                diag   => join "\n", map { $_->diag } @results
            );
        }
    );
}


sub all {
    my @cmps = @_;

    return Comparison->new(
        code => sub {
            my @results;
            for my $cmp (@cmps) {
                push @results, $cmp->compare(@_);
            }

            return Result->new(
                result => (first { !$_ } @results ? 0 : 1),
                diag   => join "\n", map { $_->diag } @results
            );
        }
    );
}


sub contains {
    my(@sublist) = @_;

    return Comparison->new(
        code => sub {
            my @missing;
            my @found;
            for my $thing (@sublist) {
                (first { $_ eq $thing } @{$_[0]}) ? push @found, $thing : push @missing, $thing;
            }

            return Result->new(
                result  => !@missing,
                diag    => "(@found) were found, (@missing) were not",
            );
        }
    );
}


# Write tests with them
test(   [1,2,3], contains(2,3,4) );

# Or log the result
track(  [1,2,3], contains(2,3,4) );

# What about putting two together?
test(   [1,2,3,4], any( contains(4), contains(5,6) ) );
test(   [1,2,3,4], all( contains(2,3), contains(5,6) ) );

# Or use them to make C-style asserts
assert( [1,2,3], contains(2,3,4) );