package Test::RandomCheck;
use strict;
use warnings;
use Data::Dumper;
use Exporter qw(import);
use Test::RandomCheck::Generator;
use Test::RandomCheck::PRNG;
use Test::More ();
use 5.008_005;
use constant DEBUG => $ENV{RANDOMCHECK_DEBUG};
our $VERSION = '0.01';

our @EXPORT = qw(random_ok);

sub _dump_args ($) {
    my $args = shift;
    my $str = Data::Dumper->new([$args])->Indent(0)->Terse(1)->Dump;

    # Use the list style instead of the array-ref style
    $str =~ s/^\[/(/;
    $str =~ s/\]$/)/;

    "\@_ = $str";
}

sub random_ok (&$;@) {
    my $code = shift;
    my $type = shift;

    my @types;
    push @types, shift
                 while eval { $_[0]->isa("Test::RandomCheck::Types") };
    $type = concat ($type, @types) if @types;

    my %params = @_;
    my $shots = delete $params{shots} // 202;

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $generator = $type->arbitrary->map(sub { scalar $code->(@_), [@_] });
    my $rand = Test::RandomCheck::PRNG->new;
    for (1 .. $shots) {
        my $size = ($_ - 1) % 101;
        my ($is_success, $args) = $generator->pick($rand, $size);
        unless ($is_success) {
            Test::More::diag("Faild by following args: " . _dump_args($args));
            Test::More::diag(
                sprintf "Generated by size=%d", $size
            ) if DEBUG;
            return Test::More::ok 0 ;
        }
    }
    Test::More::ok 1;
}

1;
__END__

=encoding utf-8

=head1 NAME

Test::RandomCheck - Yet another QuickCheck for Perl

=head1 SYNOPSIS

  use Test::RandomCheck;
  use Test::RandomCheck::Generator;
  use Test::More;

  sub my_length { ... }

  # Define types of values which is used while testing.
  my $type_of_arguments = concat(string, string);

  random_ok {
      my ($s1, $s2) = @_;
      # Write a property which the my_length has.
      my_length($s1) + my_length($s2) == my_length($s1 . $s2);
  } $type_of_arguments;

  done_testing;

=head1 DESCRIPTION

B<THIS IS EXPERIMENTAL!>

Test::RandomCheck is an implementation of QuickCheck in Perl.

You may want to define any kind of test arguments by using conbinators
prepared by L<Test::RandomCheck::Generator>.

=head1 FUNCTIONS

=over 4

=item C<<random_ok { ... } $generator;>>

Run blocks with arguments generated by $generator. $generator must have
arbitrary() method which returns the L<Test::RandomCheck::Generator> instance.

It outputs "OK" if the block returns the true value for all random petterns.

=back

=head1 SEE ALSO

L<http://hackage.haskell.org/package/QuickCheck> is a test library for Haskell
to define properties of functions and to run tests randomly.

L<Test::LectroTest> is another implementation of QuickTest which uses
the source code filter and has haskell like syntax (CamelCase class names).

=head1 AUTHOR

Masahiro Honma E<lt>hiratara@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright 2013- Masahiro Honma

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

=cut
