Monads in Perl 6

monad.p6

use v6.d;

role Monad[::T] {
    method ACCEPTS(::?ROLE: ::?ROLE $m --> Bool:D) {
        for $m.^attributes -> Attribute $x {
            my Attribute $y = self.^get_attribute_for_usage: $x.name;
            return False unless $x.get_value($m) ~~ $y.get_value(self);
        }
        True
    }

    method new (::?ROLE: | --> ::?ROLE)                 { ... } # AKA pure
    method bind(::?ROLE: Callable[::?ROLE] --> ::?ROLE) { ... }
    method then(::?ROLE: ::?ROLE --> ::?ROLE)           { ... }
}

role Identity[::T] does Monad[T] {
    has T $!value;

    submethod BUILD(T :$!value) {}

    method new(Identity: T $a --> Identity:D) {
        self.bless: value => $a
    }

    method bind(Identity:D: Identity:D &f --> Identity:D) {
        &f($!value)
    }

    method then(Identity:D: Identity:D $m --> Identity:D) {
        $m
    }
}

proto sub infix:«>>=»(|) {*}
multi sub infix:«>>=»(Monad:D $m, Monad:D &f --> Monad:D) {
    $m.bind: &f
}

proto sub infix:«>>»(|) {*}
multi sub infix:«>>»(Monad:D $m, Mu $a --> Monad:D) {
    $m.then: $a
}

proto sub pure(|) {*}
multi sub pure(Mu $a --> Identity:D) {
    Identity[$a.WHAT].new: $a
}

sub f(Str $a --> Identity[Str]) { pure $a                  }
sub h(Str $a --> Identity[Str]) { pure ($a xx 2).join(' ') }
sub k(Str $a --> Identity[Str]) { pure $a.split(' ').head  }

my Str           $a = 'ayy lmao';
my Identity[Str] $m = pure $a;
say ($m >>= &h) ~~ &h($a);  # OUTPUT: True
say ($m >>= &f) ~~ $m;      # OUTPUT: True
say ($m >>= sub (Str $x --> Identity[Str]) {
    &h($x) >>= &k
}) ~~ (($m >>= &h) >>= &k); # OUTPUT: True

That would be pretty awesome. Thanks!