早期 return でネスト解消

まぁ、これは書くまでもなく、わかる。

というか、例示コード書くのも辛い・・・

if ( $a == 1 ) {
    if ( $b == 2 ) {
        if ( $c == 3 ) {

        }
    }
}

的な。

これに else や elsif が入ってくるとさらにカオスになるという。

ネストの深淵を見つめる時、深淵もまたお前を見つめているのだ・・・的な。

解決策としては、「早期 return」。

早期 return によって見通しが良くなり・・・

条件ロジックと実行ロジックを分離できること

なるほど。ロジックの追加も怖くない、と。

switch 文の重複

まぁ、Perl には switch 文がない（厳密にはあるけど実験的機能＆推奨されていない）。

ということで軽く読み飛ばす。

ここでは、魔法の名前、消費魔法力、攻撃力ごとに switch 文を書いてる（リスト6.11,リスト 6.12, リスト6.13）・・・けど、普通そんなに小分けにして条件分岐というか switch 分書かないよね？

まぁ、当然そんな書き方をしていれば、追加漏れなんかも出てくるだろう。

例示を優先して執筆したんかな？

ただまぁ、伝えたいことはわかる。

のちに、魔法ごとに名前、消費魔法力、攻撃力をまとめて switch 文で切り替えるコード（リスト6.18）になっている。

こちらはわかる。

そしてここで、巨大な switch 文を解消する手段として interface が出てくる。

おおっと、さすがに Perl ではないかな・・・近そうなのは role ？

うーん、ここはわからないなぁ。

インターフェース自体、Go をちょっと勉強したときに「同じメソッドがあれば共通化できるのねー、ふーん、そういうものかー」程度の浅い理解しかない。

とりあえず、例示コードの四角形クラスと円クラスを書いてこう。

リスト6.19 四角形クラスと円クラス

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Function::Parameters;

package Rectangle {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0 };

    has width => (
        is       => 'ro',
        isa      => 'Num',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    has height => (
        is       => 'ro',
        isa      => 'Num',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    fun area($self) {
        return $self->width * $self->height;
    }

    __PACKAGE__->meta->make_immutable();
}

package Circle {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0, PI => 3.1415 };

    has radius => (
        is       => 'ro',
        isa      => 'Num',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    fun area($self) {
        return $self->radius * $self->radius * PI;
    }
    __PACKAGE__->meta->make_immutable();
}

package main;
my $rectangle = Rectangle->new( width => 4, height => 5 );
say $rectangle->area;  # 20

my $circle = Circle->new( radius => 1 );
say $circle->area;  # 3.1415

ここで作った rectangle と circle 、両方にある（面積を求める）area というメソッド。

この area メソッドを備えたオブジェクトなら同じインターフェースで扱うことができる・・・

いちいち、中に入っているのが rectangle か circle かという条件分岐をせずとも、area というメソッドを呼べる。

・・・いまの Perl のコードでもできてますがな。

まぁ、 Perl には（この本に書いてあるような用途での）型ないからな！！

リスト6.25 同じ Shape 型として利用可能

というわけで・・・ここは Perl でちゃんと実装できませんでした。

やりたかったのは、Shape というインターフェース型を用意し、Rectangle と Circle という型をそこに含める。

Shape->area とすることで、Shape の中身が Rectangle でも Circle でも面積を求めることができる・・・

ということを Perl でもやりたかったんだけど、いや別にインターフェース型用意しなくとも普通にメソッド使える（ダックタイピングできる）んだよなぁ。

ただ、「引数を特定のクラスのオブジェクトに限定することで、堅牢なクラスをつくる」というこの本のこれまでの趣旨とは合わない。

うーん。

で、Mouse::Role とか使ってみたのだけどなんか違う。

というわけで、インターフェース型じゃなくて、こういう型を作ってみた。

# Shape 型
declare 'Shape', as Object,
  where { ref $_ eq 'Rectangle' || ref $_ eq 'Circle' },
  where { $_->can('area') },
  message { 'Rectangle か Circle クラスかつ area メソッドのあるもののみ受け付けます' };

これで、

Rectangle 型か Circle 型しか受け付けず
area メソッドを持っている

ものしか受け取らない型ができた。もうこれはインターフェースと言っていいんじゃないか！！

いややっぱ違う？

違うけど、こっから先に進めなくなってしまったので、とりあえずこれで済ませよう。

なお、せっかく書いた、そして初めて Mouse::Role 使ったコードも置いておこう。

ちなみに、Role は初めて使いました。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Function::Parameters;

# role を インターフェース代わりに使う
package Shape {

    # use Mouse;
    use Mouse::Role;    # ロールを使うための便利モジュール

    # このロールを継承(?)するオブジェクトが持っているべきメソッド
    requires qw(area_of);

    # 継承したオブジェクトで area メソッドを呼ぶと、
    # 各オブジェクトの area_of メソッドの結果を返す
    sub area {
        my $self = shift;
        return $self->area_of();
    }
}

package Rectangle {
    use Carp qw/croak/;
    use Mouse;
    with qw/Shape/;

    has width => (
        is       => 'ro',
        isa      => 'Num',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    has height => (
        is       => 'ro',
        isa      => 'Num',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    fun area_of($self) {
        return $self->width * $self->height;
    }

    __PACKAGE__->meta->make_immutable();
}

package Circle {
    use Carp qw/croak/;
    use Mouse;
    use constant { PI => 3.1415 };

    with qw/Shape/;

    has radius => (
        is       => 'ro',
        isa      => 'Num',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    fun area_of($self) {
        return $self->radius * $self->radius * PI;
    }
    __PACKAGE__->meta->make_immutable();
}

package main;

my $rectangle = Rectangle->new( width => 4, height => 5 );
say $rectangle->area;    # 20

my $circle = Circle->new( radius => 1 );
say $circle->area;       # 3.1415

リスト6.37 魔法 interface の値オブジェクト導入版

・・・というのが例示コードのタイトル。

しかし、Perl で実装をこころみましたが実力及ばず、インターフェースをそのまま再現することができませんでした。

残念。

ただまぁ、それでもできるところまでやってみるべ、ということで

型を使って、指定したメソッドが含まれていることを確認
if 文を使わず、魔法の切り替えができるよう実装
一部のプロパティは型オブジェクトで返す

ところまでやってみました。

interface の代わりに、MagicAttack クラスの中に各魔法のプロパティを書くことで代用しています。

もう少し、良い手がありそうな気がするのですが、とりあえずここまでとします。

ここクリックして展開

型定義の MyType.pm

# Magic 型
declare 'Magic', as Object,
  where { ref $_ eq 'Fire' || ref $_ eq 'Shiden' || ref $_ eq 'HellFire' },
  where {
         $_->can('name')
      && $_->can('cost_magic_point')
      && $_->can('attack_power')
      && $_->can('cost_technical_point')
  }, message { 'Magic クラスのみ受け付けます' };

本体

#!/usr/bin/env perl
use strict;
use warnings;

use feature qw/say/;
use Function::Parameters qw/method/;

package Member {
    use Carp qw/croak/;
    use Mouse;
    use constant { MIN => 0 };

    has level => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    has agility => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    has magic_attack => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    has vitality => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    __PACKAGE__->meta->make_immutable();
}

package Fire {
    use Carp qw/croak/;
    use Mouse;

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    method name() {
        return "ファイア";
    }

    method cost_magic_point() {
        return MagicPoint->new( amount => 2 );
    }

    method attack_power() {
        return AttackPower->new( amount => 20 + $self->member->level * 0.5 );
    }

    method cost_technical_point() {
        return TechnicalPoint->new( amount => 0 )
    }

    __PACKAGE__->meta->make_immutable();
}

package Shiden {
    use Carp qw/croak/;
    use Mouse;

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    method name() {
        return "紫電";
    }

    method cost_magic_point() {
        return MagicPoint->new( amount => 5 * $self->member->level * 0.2 );
    }

    method attack_power() {
        return AttackPower->new( amount => 50 + $self->member->agility * 0.5 );
    }

    method cost_technical_point() {
        return TechnicalPoint->new( amount => 5 );
    }

    __PACKAGE__->meta->make_immutable();
}

package HellFire {
    use Carp qw/croak/;
    use Mouse;

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    method name() {
        return "地獄の業火";
    }

    method cost_magic_point() {
        return MagicPoint->new( amount => 16 );
    }

    method attack_power() {
        return AttackPower->new( amount => 200 +
              $self->member->magic_attack * 0.5 + $self->member->agility * 2 );
    }

    method cost_technical_point() {
        return TechnicalPoint->new( amount => 20 + $self->member->level * 0.4 );
    }

    __PACKAGE__->meta->make_immutable();
}

package MagicAttack {
    use Carp qw/croak/;
    use Mouse;

    use lib qw/./;
    use MyType;

    has member => (
        is       => 'ro',
        isa      => 'Member',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    has Fire => (
        is       => 'ro',
        isa      => MyType::Magic,
        required => 0,
        default  => sub { Fire->new( member => $_[0]->member ) }
    );

    has Shiden => (
        is       => 'ro',
        isa      => MyType::Magic,
        required => 0,
        default  => sub { Shiden->new( member => $_[0]->member ) }
    );

    has HellFire => (
        is       => 'ro',
        isa      => MyType::Magic,
        required => 0,
        default  => sub { HellFire->new( member => $_[0]->member ) }
    );

    __PACKAGE__->meta->make_immutable();
}

package MagicPoint {
    use Carp qw/croak/;
    use Mouse;

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,

        trigger => sub { croak '', unless ( $_[0] ) },
    );

    __PACKAGE__->meta->make_immutable();
}

package AttackPower {
    use Carp qw/croak/;
    use Mouse;

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,

        trigger => sub { croak '', unless ( $_[0] ) },
    );

    __PACKAGE__->meta->make_immutable();
}

package TechnicalPoint {
    use Carp qw/croak/;
    use Mouse;

    has amount => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,

        trigger => sub { croak '', unless ( $_[0] ) },
    );

    __PACKAGE__->meta->make_immutable();
}

package main;

my $member = Member->new(
    level        => 10,
    agility      => 10,
    magic_attack => 10,
    vitality     => 10,
);

my $magic_attack = MagicAttack->new( member => $member );

my $magic = $magic_attack->Fire;
say $magic->name;                            # ファイア
say $magic->cost_magic_point->amount;        # 2
say $magic->attack_power->amount;            # 25
say $magic->cost_technical_point->amount;    # 0

$magic = $magic_attack->Shiden;
say $magic->name;                            # 紫電
say $magic->cost_magic_point->amount;        # 10
say $magic->attack_power->amount;            # 55
say $magic->cost_technical_point->amount;    # 5

$magic = $magic_attack->HellFire;
say $magic->name;                            # 地獄の業火
say $magic->cost_magic_point->amount;        # 16
say $magic->attack_power->amount;            # 225
say $magic->cost_technical_point->amount;    # 24

sironekotoroの日記

Perl で楽をしたい

「良いコード／悪いコードで学ぶ設計入門」第6章その1 ストラテジーパターン #ミノ駆動本

早期 return でネスト解消

switch 文の重複

リスト6.19 四角形クラスと円クラス

リスト6.25 同じ Shape 型として利用可能

リスト6.37 魔法 interface の値オブジェクト導入版