Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

functor / pointed / applicative / monad + identity / list

  • Loading branch information...
commit 5e8d0154424f9715174ea4967eb1458a8cb61df7 1 parent 9fdab59
Jonathan Rockway authored
2  .eproject
... ... @@ -1 +1 @@
1   -:mxdeclare-project-p t
  1 +:mxdeclare-project-p nil
96 lib/Data/Function.pm
... ... @@ -0,0 +1,96 @@
  1 +package Data::Function;
  2 +# ABSTRACT: helpful functions for working with functions
  3 +use strict;
  4 +use warnings;
  5 +
  6 +use Sub::Exporter -setup => {
  7 + exports => [qw/curry lambda flip id const/],
  8 +};
  9 +
  10 +sub curry($$) {
  11 + my ($code, $val) = @_;
  12 + return sub {
  13 + $code->($val, @_);
  14 + }
  15 +}
  16 +
  17 +sub lambda(&$;@);
  18 +sub lambda(&$;@) {
  19 + my ($code, $cnt) = @_;
  20 + return $code->() if $cnt < 1;
  21 + return sub {
  22 + my @args = @_;
  23 + return lambda {
  24 + $code->(@args, @_);
  25 + } ($cnt-@args);
  26 + }
  27 +
  28 +}
  29 +
  30 +
  31 +sub id() {
  32 + return lambda { my $arg = shift; $arg } 1;
  33 +}
  34 +
  35 +sub flip($) {
  36 + my $f = shift;
  37 + return lambda {
  38 + my ($x, $y) = @_;
  39 + $f->($y, $x);
  40 + } 2;
  41 +}
  42 +
  43 +sub const($) {
  44 + my $const = shift;
  45 + return lambda { $const } 1;
  46 +}
  47 +
  48 +1;
  49 +
  50 +__END__
  51 +
  52 +=head1 SYNOPSIS
  53 +
  54 + use Data::Function qw/lambda flip id const/;
  55 +
  56 + my $f = lambda { $_[0] - $_[1] } 2; # CODE(0x3974383) --> x - y
  57 + my $g = $f->(42); # CODE(0x1234567) --> 42 - y
  58 + $g->(1); # 41
  59 +
  60 + my $fprime = flip $f; # CODE(0x8374388) --> y - x
  61 + my $gprime = $fprime->(42); # CODE(0x1a423a2) --> y - 42
  62 + $gprime->(43); # 1
  63 +
  64 + my $forty_two = const 42; # CODE(0x2938473) --> sub { my $x = shift; 42 }
  65 + $forty_two->(1234548754); # 42
  66 +
  67 + my $id = id; # CODE(0x4985744)
  68 + $id->(123); # 123
  69 +
  70 +
  71 +=head1 DESCRIPTION
  72 +
  73 +This module provides a few utility functions for making functions more
  74 +Haskell-like.
  75 +
  76 +=head1 EXPORTS
  77 +
  78 +You must request each function that you want to use.
  79 +
  80 +=head2 lambda BLOCK SCALAR
  81 +
  82 +Creates an anonymous function from BLOCK. After being applied
  83 +with SCALAR arguments, it will call the BLOCK with all the args.
  84 +
  85 +=head2 flip CODEREF
  86 +
  87 +Converts a 2 arg lambda into a 2 arg lambda that takes its arguments
  88 +in the opposite order.
  89 +
  90 +=head2 id
  91 +
  92 +Returns the identity function.
  93 +
  94 +=head2 const VALUE
  95 +
  96 +Returns a function of one argument that always returns VALUE.
28 lib/Data/Functor.pm
... ... @@ -0,0 +1,28 @@
  1 +package Data::Functor;
  2 +# ABSTRACT: tags a data structure as a functor
  3 +use Moose::Role;
  4 +use Data::Monad::Util qw(make_type_checker);
  5 +use namespace::autoclean;
  6 +
  7 +with 'Data::Functor::API';
  8 +
  9 +around fmap => make_type_checker('fmap');
  10 +
  11 +1;
  12 +
  13 +__END__
  14 +
  15 +=head1 DESCRIPTION
  16 +
  17 +Consume this role to allow your data structure to work as a functor.
  18 +A functor is a container type that allows function application to be
  19 +lifted into the container with a function called C<fmap>.
  20 +
  21 +A list is a functor, with C<map> as its C<fmap> operation.
  22 +
  23 +=head1 METHODS
  24 +
  25 +=head2 fmap FUNCTION
  26 +
  27 +Apply the value inside the functor to FUNCTION, returning a new value
  28 +inside the functor.
8 lib/Data/Functor/API.pm
... ... @@ -0,0 +1,8 @@
  1 +package Data::Functor::API;
  2 +# ABSTRACT: API role for a functor
  3 +use Moose::Role;
  4 +use namespace::autoclean;
  5 +
  6 +requires 'fmap';
  7 +
  8 +1;
20 lib/Data/Functor/Applicative.pm
... ... @@ -0,0 +1,20 @@
  1 +package Data::Functor::Applicative;
  2 +# ABSTRACT: tags a data structure as an applicative functor
  3 +use Data::Monad::Util qw(make_type_checker);
  4 +use Moose::Role;
  5 +use namespace::autoclean;
  6 +
  7 +with 'Data::Functor::Applicative::API', 'Data::Functor', 'Data::Pointed';
  8 +
  9 +around ap => make_type_checker('ap');
  10 +
  11 +1;
  12 +
  13 +__END__
  14 +
  15 +=head1 DESCRIPTION
  16 +
  17 +This is a role that you can consume if your data structure is an
  18 +applicative functor. An applicative functor is a pointed functor with
  19 +the addition of an C<ap> function; function application lifted to your
  20 +functor.
10 lib/Data/Functor/Applicative/API.pm
... ... @@ -0,0 +1,10 @@
  1 +package Data::Functor::Applicative::API;
  2 +# ABSTRACT: API for an applicative functor
  3 +use Moose::Role;
  4 +use namespace::autoclean;
  5 +
  6 +with 'Data::Pointed::API', 'Data::Functor::API';
  7 +
  8 +requires 'ap';
  9 +
  10 +1;
29 lib/Data/Functor/Applicative/FromMonad.pm
... ... @@ -0,0 +1,29 @@
  1 +package Data::Functor::Applicative::FromMonad;
  2 +# ABSTRACT: make a monad an applicative functor
  3 +use Moose::Role;
  4 +use namespace::autoclean;
  5 +
  6 +with 'Data::Monad';
  7 +
  8 +requires 'bind';
  9 +requires 'pure';
  10 +
  11 +sub ap {
  12 + my ($self, $other) = @_;
  13 + return $self->bind(sub {
  14 + my $f = shift;
  15 + return $other->bind(sub {
  16 + my $x = shift;
  17 + return $self->pure($f->($x));
  18 + });
  19 + });
  20 +}
  21 +
  22 +1;
  23 +
  24 +__END__
  25 +
  26 +=head1 DESCRIPTION
  27 +
  28 +Consume this role to make a L<Data::Monad|Data::Monad> monad into an
  29 +applicative functor. It uses C<pure> and C<bind> to create C<ap>.
33 lib/Data/Identity.pm
... ... @@ -0,0 +1,33 @@
  1 +package Data::Identity;
  2 +# ABSTRACT: the identity monad
  3 +use Moose;
  4 +use namespace::autoclean;
  5 +
  6 +with 'Data::Monad::Cat', 'Data::Functor::Applicative::FromMonad';
  7 +
  8 +has 'it' => ( is => 'ro', isa => 'Any', required => 1 );
  9 +
  10 +sub pure {
  11 + my ($class, $it) = @_;
  12 + $class = $class->meta->name if blessed $class;
  13 + return $class->new( it => $it );
  14 +}
  15 +
  16 +sub fmap {
  17 + my ($self, $f) = @_;
  18 + return $self->pure($f->($self->it));
  19 +}
  20 +
  21 +sub join {
  22 + my ($self) = @_;
  23 + return $self->it;
  24 +}
  25 +
  26 +1;
  27 +
  28 +__END__
  29 +
  30 +=head1 DESCRIPTION
  31 +
  32 +This is an example monad / functor / applicative functor. It does
  33 +nothing.
49 lib/Data/List.pm
... ... @@ -0,0 +1,49 @@
  1 +package Data::List;
  2 +# ABSTRACT: The Haskell-style List monad
  3 +use Moose;
  4 +use namespace::autoclean;
  5 +
  6 +with 'Data::Monad::Cat', 'Data::Functor::Applicative::FromMonad';
  7 +
  8 +has 'list' => (
  9 + is => 'ro',
  10 + isa => 'ArrayRef',
  11 + required => 1,
  12 +);
  13 +
  14 +sub pure {
  15 + my ($class, $value) = @_;
  16 + $class = $class->meta->name if blessed $class;
  17 + return $class->new( list => [$value] );
  18 +}
  19 +
  20 +sub fmap {
  21 + my ($self, $f) = @_;
  22 + return $self->meta->name->new(
  23 + list => [ map { $f->($_) } @{$self->list} ],
  24 + );
  25 +}
  26 +
  27 +sub join {
  28 + my ($self) = @_;
  29 + return $self->meta->name->new(
  30 + list => [ map { @{$_->list} } @{$self->list} ],
  31 + );
  32 +}
  33 +
  34 +1;
  35 +
  36 +__END__
  37 +
  38 +=head1 DESCRIPTION
  39 +
  40 +The List monad represents a computation strategy where each
  41 +computation may return zero or more results.
  42 +
  43 +=head1 SEE ALSO
  44 +
  45 +L<Data::Functor>
  46 +
  47 +L<Data::Functor::Applicative>
  48 +
  49 +L<Data::Monad>
41 lib/Data/Monad.pm
... ... @@ -0,0 +1,41 @@
  1 +package Data::Monad;
  2 +# ABSTRACT: tags a data structure as a monad
  3 +use Data::Monad::Util qw(make_type_checker);
  4 +use Moose::Util qw(does_role);
  5 +use Moose::Role;
  6 +use namespace::autoclean;
  7 +
  8 +with 'Data::Monad::API', 'Data::Functor::Applicative';
  9 +
  10 +around join => make_type_checker('join');
  11 +around bind => make_type_checker('bind');
  12 +
  13 +1;
  14 +
  15 +__END__
  16 +
  17 +=head1 DESCRIPTION
  18 +
  19 +Consume this role if your type can act as a monad.
  20 +
  21 +=head1 METHODS
  22 +
  23 +=head2 pure VALUE
  24 +
  25 +Lift a value into the monad
  26 +
  27 +=head2 fmap FUNCTION
  28 +
  29 +Apply a function inside the monad
  30 +
  31 +=head2 join
  32 +
  33 +Remove one level of nesting
  34 +
  35 +=head2 bind FUNCTION
  36 +
  37 +Apply the value inside the monad to FUNCTION, returning a monad.
  38 +
  39 +=head2 ap
  40 +
  41 +Lifted function application
11 lib/Data/Monad/API.pm
... ... @@ -0,0 +1,11 @@
  1 +package Data::Monad::API;
  2 +# ABSTRACT: API role for a monad
  3 +use Moose::Role;
  4 +use namespace::autoclean;
  5 +
  6 +with 'Data::Functor::Applicative::API';
  7 +
  8 +requires 'join';
  9 +requires 'bind';
  10 +
  11 +1;
26 lib/Data/Monad/Cat.pm
... ... @@ -0,0 +1,26 @@
  1 +package Data::Monad::Cat;
  2 +# ABSTRACT: make a Data::Monad from a pure/fmap/join triple
  3 +use Moose::Role;
  4 +use namespace::autoclean;
  5 +
  6 +with 'Data::Monad';
  7 +
  8 +requires 'pure';
  9 +requires 'fmap';
  10 +requires 'join';
  11 +
  12 +sub bind {
  13 + my ($k, $f) = @_;
  14 + return $k->fmap($f)->join;
  15 +}
  16 +
  17 +1;
  18 +
  19 +__END__
  20 +
  21 +=head1 DESCRIPTION
  22 +
  23 +Consume this role to make C<bind> from C<pure>, C<fmap>, and C<join>.
  24 +
  25 +(The "Cat" in the name means, "make a monad from its I<cat>egory
  26 +theory definition".)
32 lib/Data/Monad/Haskell.pm
... ... @@ -0,0 +1,32 @@
  1 +package Data::Monad::Haskell;
  2 +# ABSTRACT: create a Data::Monad monad from return and bind
  3 +use Moose::Role;
  4 +use Data::Function qw(id);
  5 +use namespace::autoclean;
  6 +
  7 +with 'Data::Monad';
  8 +
  9 +requires 'pure';
  10 +requires 'bind';
  11 +
  12 +sub fmap {
  13 + my ($self, $f) = @_;
  14 + $self->bind(sub {
  15 + my $k = shift;
  16 + return $self->pure($f->($k));
  17 + });
  18 +}
  19 +
  20 +sub join {
  21 + my ($self) = @_;
  22 + $self->bind(id);
  23 +}
  24 +
  25 +1;
  26 +
  27 +__END__
  28 +
  29 +=head1 DESCRIPTION
  30 +
  31 +Build C<fmap> and C<join> from C<pure> (C<return>) and C<bind>. This
  32 +is how Haskell programmers typically define a monad.
24 lib/Data/Monad/Util.pm
... ... @@ -0,0 +1,24 @@
  1 +package Data::Monad::Util;
  2 +use strict;
  3 +use warnings;
  4 +use Sub::Exporter -setup => { exports => ['make_type_checker'] };
  5 +
  6 +use Carp 'confess';
  7 +use Scalar::Util 'blessed';
  8 +
  9 +sub make_type_checker {
  10 + my ($name) = @_;
  11 + return sub {
  12 + my ($orig, $self, @args) = @_;
  13 + my $result = $self->$orig(@args);
  14 + my $type = blessed $result || '<not even an object>';
  15 + $self = ref $self ? ref $self : $self;
  16 + confess "The result of $name ('$result') must be a '$self', ".
  17 + "but is actually a '$type'"
  18 + unless blessed $result && $type->isa($self->meta->name);
  19 +
  20 + return $result;
  21 + };
  22 +}
  23 +
  24 +1;
22 lib/Data/Pointed.pm
... ... @@ -0,0 +1,22 @@
  1 +package Data::Pointed;
  2 +# ABSTRACT: tags a data structure as a pointed
  3 +use Moose::Role;
  4 +use Data::Monad::Util qw(make_type_checker);
  5 +use namespace::autoclean;
  6 +
  7 +with 'Data::Pointed::API';
  8 +
  9 +around 'pure' => make_type_checker('pure');
  10 +
  11 +1;
  12 +
  13 +__END__
  14 +
  15 +=head1 DESCRIPTION
  16 +
  17 +A type that can have a value lifted into it. This is slightly
  18 +different than a functor, since there is no operation to apply
  19 +a function to the value.
  20 +
  21 +Typically, you'll consume both Pointed and Functor and implement
  22 +C<join> or C<ap> to become a Monad or Applicative Functor.
9 lib/Data/Pointed/API.pm
... ... @@ -0,0 +1,9 @@
  1 +package Data::Pointed::API;
  2 +# ABSTRACT: API role for a pointed
  3 +
  4 +use Moose::Role;
  5 +use namespace::autoclean;
  6 +
  7 +requires 'pure';
  8 +
  9 +1;
15 t/00use.t
... ... @@ -0,0 +1,15 @@
  1 +use strict;
  2 +use warnings;
  3 +use Test::More;
  4 +
  5 +use ok 'Data::Pointed';
  6 +use ok 'Data::Functor';
  7 +use ok 'Data::Functor::Applicative';
  8 +use ok 'Data::Monad';
  9 +
  10 +use ok 'Data::Pointed::API';
  11 +use ok 'Data::Functor::API';
  12 +use ok 'Data::Functor::Applicative::API';
  13 +use ok 'Data::Monad::API';
  14 +
  15 +done_testing;
37 t/bad.t
... ... @@ -0,0 +1,37 @@
  1 +use strict;
  2 +use warnings;
  3 +use Test::More;
  4 +use Test::Exception;
  5 +
  6 +{ package Bad;
  7 + use Moose;
  8 + with 'Data::Monad';
  9 +
  10 + sub pure { 'oh noes' };
  11 + sub fmap { 'oh noes' };
  12 + sub ap { 'oh noes' };
  13 + sub join { 'oh noes' };
  14 + sub bind { 'oh noes' };
  15 +}
  16 +
  17 +throws_ok {
  18 + Bad->pure(123);
  19 +} qr/the result of pure \('oh noes'\) must be a 'Bad', but is actually a '<not even an object>'/i, 'bad pure threw error';
  20 +
  21 +throws_ok {
  22 + Bad->new->fmap(sub {})
  23 +} qr/the result of fmap \('oh noes'\) must be a 'Bad', but is actually a '<not even an object>'/i, 'bad fmap threw error';
  24 +
  25 +throws_ok {
  26 + Bad->new->join
  27 +} qr/the result of join \('oh noes'\) must be a 'Bad', but is actually a '<not even an object>'/i, 'bad join threw error';
  28 +
  29 +throws_ok {
  30 + Bad->new->bind(sub {})
  31 +} qr/the result of bind \('oh noes'\) must be a 'Bad', but is actually a '<not even an object>'/i, 'bad bind threw error';
  32 +
  33 +throws_ok {
  34 + Bad->new->ap(Bad->new)
  35 +} qr/the result of ap \('oh noes'\) must be a 'Bad', but is actually a '<not even an object>'/i, 'bad ap threw error';
  36 +
  37 +done_testing;
46 t/function.t
... ... @@ -0,0 +1,46 @@
  1 +use strict;
  2 +use warnings;
  3 +use Test::More;
  4 +
  5 +use Data::Function qw/curry lambda id flip const/;
  6 +
  7 +{
  8 + my $add = sub { $_[0] + $_[1] };
  9 + my $add1 = curry $add, 1;
  10 + is $add1->(2), 3, 'currying works';
  11 +
  12 + my $three = curry $add1, 2;
  13 + is ref $three, 'CODE', 'is still a coderef';
  14 + is $three->(), 3, 'currying twice works';
  15 +}
  16 +
  17 +my $nullary = lambda { 42 } 0;
  18 +is $nullary, 42, '0-ary function is a value';
  19 +
  20 +my $add42 = lambda { 42 + $_[0] } 1;
  21 +is ref $add42, 'CODE', '1-ary function is a coderef';
  22 +
  23 +my $fortythree = $add42->(1);
  24 +is $fortythree, 43, 'applying 1 to add42 == 43';
  25 +
  26 +my $f = lambda { $_[0] - $_[1] } 2;
  27 +is ref $f, 'CODE', 'f is code';
  28 +my $g = $f->(42);
  29 +is ref $g, 'CODE', 'g is code';
  30 +my $r = $g->(1);
  31 +is $r, 41, 'and now it is evaulated';
  32 +
  33 +is $g->(42), 0, 'g was reused OK';
  34 +my $g2 = $f->(1);
  35 +is ref $g2, 'CODE', 'f reused into g2';
  36 +is $g2->(42), -41, 'g2 used ok';
  37 +
  38 +is(flip($f)->(42)->(1), -41, 'flip works');
  39 +
  40 +is ref (const 42), 'CODE', 'const returns a coderef';
  41 +is((const 42)->(123), 42, 'const works');
  42 +
  43 +is ref id, 'CODE', 'id returns a coderef';
  44 +is(id->(42), 42, 'id works');
  45 +
  46 +done_testing;
60 t/identity.t
... ... @@ -0,0 +1,60 @@
  1 +use strict;
  2 +use warnings;
  3 +use Test::More;
  4 +use Test::Exception;
  5 +
  6 +use Data::Function qw/lambda/;
  7 +use ok 'Data::Identity';
  8 +
  9 +my $id;
  10 +lives_ok {
  11 + $id = Data::Identity->pure(42);
  12 +} 'did not die';
  13 +ok $id, 'got something';
  14 +isa_ok $id, 'Data::Identity';
  15 +is $id->it, 42, 'got wrapped value';
  16 +
  17 +my $result;
  18 +lives_ok {
  19 + $result = Data::Identity->pure(42)->fmap(sub { $_[0] - 42 });
  20 +} '(fmap . pure) lives ok';
  21 +
  22 +is $result->it, 0, 'got correct result';
  23 +
  24 +lives_ok {
  25 + $result = Data::Identity->pure($id);
  26 +} 'id can hold an id';
  27 +
  28 +lives_ok {
  29 + $result = $result->join;
  30 +} 'result can join';
  31 +
  32 +isa_ok $result, 'Data::Identity';
  33 +
  34 +is $result->it, 42, 'got thing back';
  35 +
  36 +my $new = Data::Identity->pure(42);
  37 +
  38 +throws_ok {
  39 + $new->bind(sub { $_[0] - 42 });
  40 +} qr/must be a 'Data::Identity'/,
  41 + 'dies when bound function returns the wrong thing';
  42 +
  43 +lives_ok {
  44 + $result = $new->bind(sub { Data::Identity->pure($_[0] - 42) });
  45 +} 'bind works';
  46 +
  47 +is $result->it, 0, 'bind works';
  48 +
  49 +lives_ok {
  50 + $result =
  51 + Data::Identity->pure(lambda { $_[0] - $_[1] } 2)->ap(
  52 + Data::Identity->pure(42),
  53 + )->ap(
  54 + Data::Identity->pure(1),
  55 + );
  56 +} '"xpure (-) `ap` pure 42 `ap` pure 1" lives';
  57 +
  58 +is $result->it, 41, 'and is == 41';
  59 +
  60 +done_testing;
46 t/list.t
... ... @@ -0,0 +1,46 @@
  1 +use strict;
  2 +use warnings;
  3 +use Test::More;
  4 +
  5 +use Data::Function qw(lambda);
  6 +
  7 +use ok 'Data::List';
  8 +
  9 +is_deeply(
  10 + Data::List->new( list => [1..10] )->fmap(sub { $_[0] + 1 })->list,
  11 + [2..11],
  12 + '(+1) <$> [1..10] works',
  13 +);
  14 +
  15 +is_deeply(
  16 + Data::List->pure( lambda { $_[0] - $_[1] } 2 )->ap(
  17 + Data::List->pure(1),
  18 + )->ap(
  19 + Data::List->new(list => [1..10]),
  20 + )->list,
  21 + [0,-1,-2,-3,-4,-5,-6,-7,-8,-9],
  22 + 'pure (-) <*> [1] <*> [1..10] works',
  23 +);
  24 +
  25 +is_deeply(
  26 + Data::List->new( list => [1..3] )->fmap( lambda { $_[0] + $_[1] } 2 )->ap(
  27 + Data::List->new( list => [10..12] ),
  28 + )->list,
  29 + [11, 12, 13, 12, 13, 14, 13, 14, 15],
  30 + '(+) <$> [1..3] <*> [10..12] works',
  31 +);
  32 +
  33 +is_deeply(
  34 + Data::List->new( list => [1..3] )->bind( sub {
  35 + my $x = shift;
  36 + Data::List->new( list => [4..6] )->bind( sub {
  37 + my $y = shift;
  38 + return Data::List->new( list => [$x * $y, $x + $y] );
  39 + });
  40 + })->list,
  41 + [4,5,5,6,6,7,8,6,10,7,12,8,12,7,15,8,18,9],
  42 + '[1..3] >>= \x -> [4..6] >>= \y -> [x * y, x + y] works',
  43 +);
  44 +
  45 +
  46 +done_testing;

0 comments on commit 5e8d015

Please sign in to comment.
Something went wrong with that request. Please try again.