Created
October 26, 2011 22:58
-
-
Save benkolera/1318273 to your computer and use it in GitHub Desktop.
MaybeCake ... perl style. :) This one is nicer though: https://github.com/techtangents/maybecake/blob/master/MaybeCakeAnswer.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use MooseX::Declare; | |
use 5.10.1; | |
class Egg {} | |
class Coup { | |
has chook => ( is => 'ro' , isa => 'Chook' , required => 0); | |
} | |
class Chook { | |
has egg => ( is => 'ro' , isa => 'Egg' , required => 0); | |
} | |
class Cocoa { } | |
class Chocolate { } | |
class Flour { } | |
class Fridge { | |
has chocolate => ( is => 'ro' , isa => 'Chocolate' , required => 0); | |
has egg => ( is => 'ro' , isa => 'Egg' , required => 0); | |
} | |
class Pantry { | |
has chocolate => ( is => 'ro' , isa => 'Chocolate' , required => 0); | |
has cocoa => ( is => 'ro' , isa => 'Cocoa' , required => 0); | |
has flour => ( is => 'ro' , isa => 'Flour' , required => 0); | |
} | |
class Cake { | |
method isALie { 1 } | |
} | |
class BakeryCake extends Cake; | |
class MudCake extends Cake { | |
has chocolate => ( is => 'ro' , isa => 'Chocolate' , required => 1 ); | |
has flour => ( is => 'ro' , isa => 'Flour' , required => 1 ); | |
has egg => ( is => 'ro' , isa => 'Egg' , required => 1 ); | |
} | |
class FlourlessCake extends Cake { | |
has chocolate => ( is => 'ro' , isa => 'Chocolate' , required => 1 ); | |
has cocoa => ( is => 'ro' , isa => 'Cocoa' , required => 1 ); | |
has egg => ( is => 'ro' , isa => 'Egg' , required => 1 ); | |
} | |
class Bakery { | |
has cake => ( is => 'ro' , isa => 'Cake' , required => 0); | |
} | |
class Baker { | |
use List::Util qw(reduce); | |
method maybeConstruct( CodeRef $f , HashRef $args ) { | |
( reduce { $a && defined $b } 1 , values %$args ) && $f->( %$args ); | |
} | |
method bakeMeACake( Coup $coup, Fridge $fridge, Pantry $pantry, Bakery $bakery ) { | |
my $chook = $coup && $coup->chook; | |
my $egg = $chook && $chook->egg; | |
my $choc = $pantry->chocolate || $fridge->chocolate; | |
my $flour = $pantry->flour; | |
my $cocoa = $pantry->cocoa; | |
my $mudcakeIngredients = | |
{ egg => $egg , chocolate => $choc , flour => $flour }; | |
my $flourlessIngredients = | |
{ egg => $egg , chocolate => $choc , cocoa => $cocoa }; | |
my $cake1 = $self->maybeConstruct( | |
sub { MudCake->new ( @_ ) } , $mudcakeIngredients | |
); | |
my $cake2 = $self->maybeConstruct( | |
sub { FlourlessCake->new ( @_ ) } , $flourlessIngredients | |
); | |
my $cake3 = $bakery->cake; | |
$cake1 || $cake2 || $cake3; | |
} | |
} | |
class BakerTests { | |
use Set::CrossProduct; | |
#I'm sure there is a better way to permute these but the hash keys in the constructor are a pain and I am late for work. :) | |
method run_tests { | |
my $baker = Baker->new(); | |
my $egg = Egg->new(); | |
my $chookNoEgg = Chook->new(); | |
my $chookEgg = Chook->new( egg => $egg ); | |
my $coupChookEgg = Coup->new( chook => $chookEgg ); | |
my $coupChookNoEgg = Coup->new( chook => $chookNoEgg ); | |
my $coupNoChook = Coup->new(); | |
my $choc = Chocolate->new; | |
my $flour = Flour->new(); | |
my $cocoa = Cocoa->new(); | |
my $fridgeNoChocNoEgg = Fridge->new(); | |
my $fridgeChocEgg = Fridge->new( egg => $egg, choc => $choc ); | |
my $fridgeChocNoEgg = Fridge->new( choc => $choc ); | |
my $fridgeNoChocEgg = Fridge->new( egg => $egg ); | |
my $pantryNoCocoaNoFlourNoChoc = Pantry->new(); | |
my $pantryCocoaFlourChoc = | |
Pantry->new( cocoa => $cocoa, flour => $flour, chocolate => $choc ); | |
my $pantryNoCocoaFlourChoc = | |
Pantry->new( flour => $flour, chocolate => $choc ); | |
my $pantryNoCocoaFlourNoChoc = Pantry->new( flour => $flour ); | |
my $pantryNoCocoaNoFlourChoc = Pantry->new( chocolate => $choc ); | |
my $pantryCocoaNoFlourChoc = | |
Pantry->new( cocoa => $cocoa, chocolate => $choc ); | |
my $pantryCocoaFlourNoChoc = | |
Pantry->new( cocoa => $cocoa, flour => $flour ); | |
my $pantryCocoaNoFlourNoChoc = Pantry->new( cocoa => $cocoa ); | |
my $bakeryCake = BakeryCake->new(); | |
my $bakeryNoBakeryCake = Bakery->new(); | |
my $bakeryBakeryCake = Bakery->new( cake => $bakeryCake ); | |
my @tests = Set::CrossProduct->new( [ | |
[ $coupChookEgg, $coupChookNoEgg , $coupNoChook ], | |
[ | |
$fridgeNoChocNoEgg , | |
$fridgeChocEgg, | |
$fridgeChocNoEgg, | |
$fridgeNoChocEgg | |
] , | |
[ | |
$pantryNoCocoaNoFlourNoChoc, | |
$pantryCocoaFlourChoc, | |
$pantryNoCocoaFlourChoc , | |
$pantryNoCocoaFlourNoChoc, | |
$pantryNoCocoaNoFlourChoc, | |
$pantryCocoaNoFlourChoc, | |
$pantryCocoaFlourNoChoc, | |
$pantryCocoaNoFlourNoChoc | |
], | |
[ $bakeryNoBakeryCake, $bakeryBakeryCake ] | |
])->combinations; | |
say $baker->bakeMeACake( @$_ ) || "NO CAKE :(" for @tests; | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment