Raku By Example

## Classes
#---------

class Point {
    has Str $!name;   # twigil `!` declares a private attribute.
    has Int $.x;      # twigil `.` declares an outwardly available attribute 
    has Int $.y;      # which is equivalent to a private attribute with
                      # a read-only accesor generated automatically.

    # this is a private method accesible only within the class. Note
    # the `!` in front of its name.
    method !to-center {
        sqrt($!x ** 2 + $!y ** 2); # use the `!` to access/assign to 
                                   # attributes internally
    }

    # this is a public method accesible
    # from outside the class.
    method distance-from-center {
        self!to-center;           # private methods must be invoked using
                                  # `!` on `self` or explicit invocant.
    }

    # this method is also public. 
    method set-name(Str $name) {
        $!name = $name;
    }

}

# Instantiate a class with the default constructor `new`
# by providing named arguments.
my $point = Point.new(x => 3, y => 4);

# Private attributes cannot be set with `new` so here it's done after the 
# object construction. Nonetheless, this can be achieved during object
# construction by different mechanisms.
$point.set-name('Point 1');

# Calling a method on the instance object is done with dot notation.
say $point.distance-from-center;

# As mentioned previously, free accesor methods are provided whenever
# attributes are declared with the `.` twigil. So:
say $point.x;
say $point.y;


class Circle {
    has Point $.center;
    has Int $.radius = 1; # attributes can have default values

    method area {
        pi * $!radius ** 2;
    }
}

my $circle = Circle.new(
    center => Point.new(x => 5, y => 10),
    radius => 50
);

say $circle.area; # 7853.98...

## Inheritance - achieved through the use of the keyword `is`.
##------------

class Mammal {
    has $.name;
    has $.nourishment-type = "milk from mother's mammary glands";

    method sound {
        say "mammal makes sound";
    }
    # And more methods, submethods, attributes common to mammals
}


## Roles - a role is declared with `role` and applied with the keyword `does`.
##-------
role Pet {
    method is-companion { True }

    # And other methods that apply to Pets
}

role Shepherd {
    method does-herd { True }

    # And other methods that apply to Shepherds
}

## Inheritance and roles: Application
## -----------------------

class Dog is Mammal does Pet does Shepherd {
    has $.name = 'Doggy';

    # sound specific to dogs
    method sound {
        say "woof woof";
    }
    # And more methods, submethods, attributes common to Dogs
}

class Cat is Mammal does Pet {
    has $.name = 'Cattie';

    # sound specific to cats
    method sound {
        say "meow";
    }
    # And more methods, submethods, attributes common to Cats
}

my $cornie = Dog.new(name => 'Cornie');
say $cornie.name;   # 'Cornie'
$cornie.sound;      # 'woof woof'

my $prosia = Cat.new(name => 'Prosia');
say $prosia.name;   # 'Prosia'
$prosia.sound;      # 'meow'

if $cornie.is-companion {
    my $output = $cornie.name ~ " is a pet.";
    $output   ~= " And is herding the sheep!" if $cornie.does-herd;

    say $output;
}

if $prosia.is-companion {
    say $prosia.name, " is a pet";
}


## bless all the attributes

# bless 的原理
class Dog {
    has $.name;
    my $.counter; # 类方法
    # 重写 new 方法, 使用位置参数创建实例
    method new ($newName) {
        $.counter++;
        self.bless(name => $newName);
    }
}

my $dog = Dog.new("yayaya");
say $dog.name;
say Dog.counter;

## bless

class Human {
  has $.name;
  has $.age;
  has $.sex;
  has $.nationality;
  has $.eligible;
  method assess-eligibility {
      if self.age < 21 {
        $!eligible = 'No'
    } else {
        $!eligible = 'Yes'
      }
  }

}

my $john = Human.new(name => 'John', age => 23, sex => 'M', nationality => 'American');
$john.assess-eligibility;
say $john.eligible;

my $name="czq";
my $human = Human.new(:$name);
say $human.name;


class Point {
    has $.x;
    has $.y;

    # multi 是可选的
    multi method new($x, $y) {
        self.bless(:$x, :$y);
    }
}

# 重写构造函数后, 不需要传具名参数了
my $p = Point.new(-1, 1);
say $p.x;

## --------------------------------

## call a random method

class Enemy {
    method attack-with-arrows   { say "peow peow peow" }
    method attack-with-swords   { say "swish cling clang" }
    method attack-with-fireball { say "sssSSS fwoooof" }
    method attack-with-camelia  { say "flap flap RAWWR!" }
}

# 创建一个方法筛选器， 方法名以 attack-with- 开头
# 对象的 ^methods 方法返回该对象所有的方法，包括自定义的方法
my $selector = { .name ~~ /^ 'attack-with-' / };
given Enemy.new -> $e {
    my $attack-strategy
        = $e.^methods().grep($selector).pick();

    $e.$attack-strategy();           # call a random method
}

## --------------------------------

## 重写 gist 方法

class Chemical {
    has $.formula;
    method gist {
        my $output = $!formula;
        $output ~~ s:g/(<[0..9]>)/{(0x2080+$0).chr}/;
        $output;
    }
}

## 继承

class Parent {
    method frob {
        say "the parent class frobs"
    }
}

class Child is Parent {
    method frob {
        say "the child's somewhat more fancy frob is called"
    }
}
# 对象的实际类型决定了要调用哪个方法
my Parent $test;
$test = Child.new;
$test.frob;          # calls the frob method of Child rather than Parent


## --------------------------------

class Employee {
    has $.salary is rw = 1000 ;
    has %.hash is rw = 'Perl' => 5, 'Takudo' => 6;

    method pay() {
        say "Here is \$$.salary";
    }
}

class Programmer is Employee {
    has @.known_languages is rw;
    has $.favorite_editor;

    method code_to_solve( $problem ) {
        $.salary = 100;
        %.hash{'ha'} = 'haha';
        say %.hash{'ha'};
        say "Solving $problem using $.favorite_editor in "
        ~ $.known_languages[0] ~ '.' ~ ' with slary ' ~ $.salary;
    }
}

my $programmer = Programmer.new(
    salary => 100_000,
    known_languages => <Perl5 Perl6 Erlang C++>,
    favorite_editor => 'vim'
);

$programmer.code_to_solve('halting problem');
$programmer.pay();


## --------------------------------

## 类方法

## Perl 6 中的 ::?CLASS:U:

class Dog { method legs { 4 } }               # class method
class Dog { method legs (Dog:) { 4 } }        # same
class Dog { method legs (::?CLASS:) { 4 } }   # same

class Dog { method legs (Dog:U:) { 4 } }      # only accepts an undefined dog

class Dog { method legs (::?CLASS:U:) { 4 } } # only accepts an undefined Dog
class Cat { method legs (::?CLASS:U:) { 4 } } # only accepts an undefined Cat

# `::?CLASS:U:` 是一种使用闭合类的动态查询的类型约束.

role with-method {
    method a-method { return "in-a-method of " ~ $?CLASS.^name  };
}

class a-class does with-method {
    method another-method { return 'in-another-method' };
}

class b-class does with-method {};

my $what-class='a-class';

say ::($what-class).a-method;
$what-class = 'b-class';
say ::($what-class).a-method;

my $what-method='a-method';
say a-class."$what-method"();
$what-method='another-method';
say a-class."$what-method"();

## costomizable attributes

my $ⲧ = " " xx 4;
class Journey {
    has $.origin;
    has $.destination;
    has @.travelers;
    has Str $.notes is rw;

    multi method notes() { "$!notes\n" };
    multi method notes( Str $note ) { $!notes ~= "$note\n$ⲧ" };

    method Str { "⤷ $!origin\n$ⲧ" ~ self.notes() ~ "$!destination ⤶\n" };
}

my $trip = Journey.new( :origin<Here>, :destination<There>,
			travelers => <þor Freya> );

$trip.notes("First steps");
$trip.notes("Almost there");
print $trip;

## method call

class Department {
    has @.employees;
    has $.name;

    method gen_print_info {
        return “$.name:\n” ~ “\t\t” ~ @.employees.sort.join(“, ”)
    }
}

my @company = (
    Department.new(name      => ‘Accounting’,
                  employees  => <Jeff Jane Susan>),
    Department.new(name      => ‘Security’,
                  employees  => <Alice Bob>),
    Department.new(name      => ‘Marketing’,
                  employees  => <Margaret Terry Lawrence>),
    Department.new(name      => ‘Development’,
                  employees  => <Matt Fred Steve Joe Alith Jie>)
);

my @print_info = @company».gen_print_info;
.say for @print_info;

## invoke multiple matched methods

class Dog {
    method talk {‘bark’}
}

class TalkingDog is Dog {
    method talk {‘Hello’}
}

my TalkingDog $td .= new;
say $td.talk;
say $td.?talk;

say $td.*talk;
say $td.+talk;

say $td.*caculate_pi;
say $td.caculate_pi;
say $td.?caculate_pi; # Nil
say $td.+caculate_pi; # dies

## read only attribute

class Dog {
    has $.name is rw;
    has $.color;

    method kugo {
       say "hello ",$.name;
    }
}
my $pet = Dog.new(
    name => 'Spot', color => 'Black'
);
$pet.kugo();
$pet.name = 'Fido'; # OK
$pet.kugo();
$pet.color = 'White'; # Fails

## overeride gist method

class Employee {
    subset Salary         of Real where * > 0;
    subset NonEmptyString of Str  where * ~~ /\S/;

    has NonEmptyString $.name    is rw;
    has NonEmptyString $.surname is rw;
    has Salary         $.salary  is rw;

    method gist {
        return qq:to[END];
        Name:    {$.name}
        Surname: {$.surname}
        Salary:  {$.salary}
        END
    }
}
my $employee = Employee.new();

given $employee {
    .name    = 'Sally';
    .surname = 'Ride';
    .salary  = 200;
}

say $employee;

## failback

grammar Calculator {
    token TOP { [ <add> | <sub> ] }
    rule  add { <num> '+' <num> }
    rule  sub { <num> '-' <num> }
    token num { \d+ }
}

class Calculations {
    method ws($) {}
    method FALLBACK($token, $match-data) {
        $match-data.make( [~] $match-data.chunks.map: {
            $_.value.?made // $_.value;
        } );
    }
}

say Calculator.parse('2 + 3', actions => Calculations).made;

## Private method

class Journey {
    has $.origin;
    has $.destination;
    has @!travellers;
    has $.notes is rw;

    method add_traveller($name) {
        if $name ne any(@!travellers) {
            push @!travellers, $name;
        } else {
            warn "$name is already going on the journey!";
        }
    }

    method describe() {
        "From $!origin to $!destination";
    }
    # Private method
    method !do-something-private($x) {
       ($x + 120)*0.88; # 先加价，再打折！
    }

    method price($x) {
        self!do-something-private(2*$x);
    }

}

my $vacation = Journey.new(
    origin      => 'China',
    destination => 'Sweden',
    notes       => 'Pack hiking'
);

say $vacation.origin;
$vacation.notes = 'Pack hiking gear and sunglasses!';
say $vacation.notes;
$vacation.add_traveller('Larry Wall');
say $vacation.price(40);
$vacation.add_traveller('Larry Wall');

## attributes

class Journey {
    has $.origin;
    has $.destination;
    has @!travellers;
    has $.notes is rw;

    method add_traveller($name) {
        if $name ne any(@!travellers) {
            push @!travellers, $name;
        }
        else {
            warn "$name is already going on the journey!";
        }
    }

    method describe() {
        "From $!origin to $!destination"
    }
}


## Point 

class Point {
    has $.x;
    has $.y = 2 * $!x;
}

my $p = Point.new( x => 1, y => 2);
say "x: ", $p.x;
say "y: ", $p.y;

my $p2 = Point.new( x => 5 );
# the given value for x is used to calculate the right
# value for y.
say "x: ", $p2.x;
say "y: ", $p2.y;

## 私有方法

class Point {
    has $.x;
    has $!y;


    method print() {
        say self.x(); # 调用实例的名为 x 的方法
        say $!y;
    }
}

my $point = Point.new(x => 10, y => 20);
$point.print;

## 只读属性

class Journey {
    has $.origin;
    has $.destination;
    has @!travellers;
    has $.notes;  # 没有添加 is rw 限制时, 属性默认是只读的!
}

my $j = Journey.new(
    origin      => 'Sweden',
    destination => 'China',
    notes       => 'Be careful your money!'
);

say $j.origin;
say $j.destination;
say $j.notes;

# now, try to change notes
$j.notes = 'gun nima dan'; # Cannot modify an immutable Str
say $j.notes;

## 可读可写属性

class Journey {
    has $.origin;
    has $.destination;
    has @!travellers;
    has $.notes is rw;
}

# Create a new instance of the class.
my $vacation = Journey.new(
    origin      => 'Sweden',
    destination => 'Switzerland',
    notes       => 'Pack hiking gear!'
);

# 使用取值器, 这输出 Sweden.
say $vacation.origin;
# 使用 rw 存取器修改属性的值
$vacation.notes = 'Pack hiking gear and sunglasses!';
say $vacation.notes;

## 石头剪刀布游戏

class Paper   { }
class Scissor { }
class Stone   { }

multi win(Paper   $a, Stone   $b) { 1 }
multi win(Scissor $a, Paper   $b) { 1 }
multi win(Stone   $a, Scissor $b) { 1 }
multi win(Any     $a, Any     $b) { 0 }

say win(Paper.new, Scissor.new); # 0 
say win(Stone.new, Stone.new); #0 
say win(Paper.new, Stone.new); #1

## submethod

class Point2D {
    has $.x;
    has $.y;

    submethod BUILD(:$!x, :$!y) {
        say "Initalizing Point2D";
    }
}

class InvertiblePoint2D is Point2D {
    submethod BUILD() {
        say "Initilizing InvertiblePoint2D";
    }
    method invert {
        self.new(x => - $.x, y => - $.y);
    }
}

say InvertiblePoint2D.new( x => 1, y => 2);

## ----

class Cat {
    has $.fullname;
    has $.nickname;

    submethod BUILD(:$!fullname, :$!nickname) {
        say "造了一只猫, 它的全名是 $!fullname, 它的昵称是 $!nickname";
    }
}

# 造了一只猫, 它的全名是 Camelia, 它的昵称是 Rakudo Star
Cat.new(fullname => 'Camelia', nickname => 'Rakudo Star');

# class C {
#     has $.size;
#     method new($x) {
#         self.bless(*, size => 2 * $x);
#     }
# }
#
# say C.new(3).size;      # prints 6

## tweak

class A {
    has $.value = 42;
    method TWEAK(:$value = 0) { # default prevents warning
        # change the attribute if the default value is specified
        $!value = 666 if $value == $!value;
    }
}
# no value specified, it gets the default attribute value
dd A.new;              # A.new(value => 42)

# value specified, but it is not the default
dd A.new(value => 77); # A.new(value => 77)

# value specified, and it is the default
dd A.new(value => 42); # A.new(value => 666)

## ?CLASS 

class C {
    multi method f(::?CLASS:U:){say "class method"}
    multi method f(::?CLASS:D:){say "object method"}
}
C.f;       # says class method
C.new.f;   # says object method


## initalizer

class B {
    has $.name;

    submethod BUILD(:$!name) {
        say "调用了 B 的 BUILD, 我叫 $!name"
    }
}

class C is B {
    has $.nickname;

    submethod BUILD(:$!nickname, :$name) {
        say "调用了 C 的 BUILD, 我叫 $!nickname, 我爸爸是 $name"
    }
    method new(:$nickname) {
        self.bless(nickname => 'Camelia', name => 'Lucy');
    }
}

my $c = C.new(nickname => 'HANMEIMEI');

## word count 

class WordCount {
  has Int %.words is default(0);

  method new($string) {
    my Int %words;
    for $string.split(/\s+/) -> $word {
      %words{$word}++;
    }

    self.bless(:%words)
  }

  method gist {
    %.words.map({.value ~ " " ~ .key}).join("\n")
  }
}

my $word-count = WordCount.new('the boy jumped over the dog');
say $word-count;
Examples
