#!/usr/bin/perl

use strict; use warnings;
use Data::Dumper;

use Test::More tests => 23;

use Monad;

BEGIN {
use_ok 'Monad';
use_ok 'Monad::Writer';
use_ok 'Monad::Maybe';
use_ok 'Monad::List';
};

sub anon { my ($class, $val) = @_; return bless \$val, $class }

IDENTITY: {
    my $identity = Identity 4;
    isa_ok ($identity, 'Monad');
    is_deeply($identity, 
        anon('Monad', 4),
        'Identity value created ok');

    my $result =
        $identity >>
        L { my $x = shift;
            my $y = 5;    # e.g. calculation from lexicals
            (Identity 6)  # e.g. calculation returning monadic result
          >>
        L { my $z = shift;
            ($x+$y+$z)
        }};

    is ($result, 15, "Correct result passed through Identity chain" );
}

WRITER: {
    my $debug = Writer 2;

    isa_ok ($debug, 'Monad::Writer');
    is_deeply($debug, 
        (bless { value => 2, debug => '' }, 'Monad::Writer'),
        'Writer value created ok');

    my $result = 
      $debug >>
      L { my $x = shift; (Writer $x*2, "Doubled. ") >>
      L { my $y = shift; (Writer $y+1, "Plus 1. ")  >>
      L { my $z = shift; (Writer $z*3, "Tripled $z. ") 
      }}};

    is_deeply ($result, 
        (bless { value => 15, debug => 'Doubled. Plus 1. Tripled 5. ' }, 'Monad::Writer'),
        'Writer chain succeeded');
}

MAYBE: {
    my $just    = Just 2;
    isa_ok( $just, 'Monad::Maybe' );
    isa_ok( $just, 'Monad::Just' );
    is_deeply( $just, anon('Monad::Just', 2), 'Just value correct' );

    my $nothing = Nothing;
    isa_ok( $nothing, 'Monad::Maybe' );
    isa_ok( $nothing, 'Monad::Nothing' );
    is_deeply( $nothing, anon('Monad::Nothing'=> undef), 'Nothing value correct' );

    my $just_result =
    (Just 2) >>
      L { my $x = shift; (Just $x * 3) >>
      L { my $y = shift; (Just $y * 4) >>
      L { my $z = shift; (Just $z + 1)
      }}};

    is_deeply ($just_result, anon('Monad::Just'=>25), "Just 25 value calculated correctly");

    my $nothing_result =
    (Just 2) >>
      L { my $x = shift; (Just $x * 2) >>
      L { my $y = shift; Nothing    >>
      L { my $z = shift; (Just$z + 1) 
      }}};

    is_deeply ($nothing_result, anon('Monad::Nothing'=>undef), 'Nothing value calculated correctly');

    my $fail_result =
    (Just 2) >>
      L { my $x = shift; (Return $x * 2)   >>
      L { my $y = shift; (Fail "OH NOES!") >>
      L { my $z = shift; (Return $z + 1) 
      }}};

    is_deeply ($fail_result, anon('Monad::Nothing'=>undef), 'Nothing value calculated correctly via Fail/Return');
}

LIST: {
    my $list = List (1,2,3);
    isa_ok( $list, 'Monad::List' );
    is_deeply( $list, (bless [1,2,3], 'Monad::List'), 'List value correct' );

    my $comp_1 =    
        (List 1..10)       >> L { my $x = shift; 
        (List 5..10)       >> L { my $y = shift; 
        (Guard $y == 2*$x) >> L {                
        (Return [$x, $y])       
         }}};

    is_deeply ($comp_1, 
        (bless [[3,6], [4,8], [5,10]], 'Monad::List'),
        "List comprehension OK");

    my $comp_2 =    
        (List 1..2)  >> L { my $x = shift; 
        (List 1..2)  >> L { my $y = shift; 
        (List 1..2)  >> L { my $z = shift; 
        (Return [$x, $y, $z]) 
         }}};

    is_deeply ($comp_2, 
        (bless [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[2,1,1],[2,1,2],[2,2,1],[2,2,2]], 'Monad::List'),
        "List comprehension OK");
}

GENERATOR: {
    diag "Generator tests:";
    my $list = List (1,2);

    use Coro::State;
    use Carp 'cluck';

    sub yield {
        my $retval = $Monad::retval = shift;
        print STDERR "retval: " . Dumper($retval) . "\n";
        $Monad::cDo->transfer($Monad::cMain);
        print STDERR "returning retval: " . Dumper($retval) . "\n";
        return $retval->mjoin();
        #return $Monad::retval->mjoin();
    }

    {
    no warnings qw( redefine once );
    *Monad::Bind = sub {
        my ($monad, $f) = @_; # ignore $f!
        $monad->bind(
            sub {
                $Monad::cMain->transfer($Monad::cDo);
                return $Monad::prevval if ! $Monad::retval;
                local $Monad::prevval = $Monad::retval;
                $Monad::retval->Bind('DUMMY');
                });
        };
    }

    sub Do (&) {
        my $Do = shift;
        local $Monad::retval;

        local $Monad::cMain = Coro::State->new;
        my $DoSub = sub {
            my $result = $Do->();
            yield $result;
            yield undef;
        };
        local $Monad::cDo = Coro::State->new($DoSub);

        $Monad::cMain->transfer($Monad::cDo);
        my $monad = $Monad::retval;
        $monad->Bind($DoSub);
    }

    my $DEBUG;
    my $result = Do {
        my $x = yield (Just 3);
        my $y = yield (Just 4);
        my $z = yield (Just 5);
        $DEBUG = "x=$x, y=$y, z=$z";
        Just 6;
    };
    is($DEBUG, 'x=3, y=4, z=5', "Debugging shows plain values bound");
    is($result, (Just 6), "Correct result for Just chain");

    my $nresult = Do {
        my $x = yield (Just 3);
        my $y = yield (Nothing);
        my $z = yield (Just 5);
        Just 6;
    };
    is($nresult, (Nothing), "Correct result for Nothing chain");

    diag "Startin list comp";
    my $lresult = Do {
        #my $x = yield (List 1..10);
        my $x = List 1..10;
        yield $x;
        #my $y = yield (List 1..10);
        my $y = List 1..10;
        yield $y;
        Guard $y == 2*$x;
        List [$x,$y];
    };
    diag "Ended list comp";
    
    diag Dumper($lresult);
}

__END__

# if we had Devel::Declare style prototypes
    (Just 2) >>
      L ($x) { (Return $x * 2)   >>
      L ($y) { (Fail "OH NOES!") >>
      L ($z) { (Return $z + 1) 
      }}};

    my $just_result =    
        (List 1..10)       >> L ($x)
      { (List 5..10)       >> L ($y)
      { (Guard $y == 2*$x) >> L 
      { (Return [$x, $y])
      }}};