summaryrefslogtreecommitdiffstats
path: root/lib/Bread/Board.pm
blob: d1d638507cd46abb9087227ecd46b6b924a83347 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
use v6;

class Bread::Board::Container {...}
class Bread::Board::Dependency {...}

role Bread::Board::Service {
    has Str $.name;
    has Bread::Board::Container $.parent is rw = Bread::Board::Container;

    # XXX not sure how to make these optional - specifying the types here
    # makes it fail when the parameters aren't passed
    # shouldn't the " = {}" part be taking care of that?
    # has Hash of Bread::Board::Dependency $.dependencies = {};
    has $.dependencies = {};

    # XXX overriding new here is an extremely suboptimal solution
    # does perl 6 have anything like moose's coercions?
    method new (*%params is copy) {
        if %params.<dependencies> {
            my $deps = {};
            for %params.<dependencies>.keys -> $name {
                my $dep = %params.<dependencies>.{$name};
                $deps.{$name} = $dep.isa(Bread::Board::Dependency)
                    ?? $dep
                    !! Bread::Board::Dependency.new(service => $dep);
            }
            %params.<dependencies> = $deps;
        }
        nextwith(|%params);
    }

    method get {*};

    method get_dependency ($name) {
        return $.dependencies.{$name};
    }
}

role Bread::Board::HasParameters {
    # XXX not sure how to make these optional - specifying the types here
    # makes it fail when the parameters aren't passed
    # shouldn't the " = {}" part be taking care of that?
    # has Hash of Hash $.parameters = {};
    has $.parameters = {};

    method check_parameters (%params) {
        for $.parameters.keys -> $name {
            if not %params.{$name}:exists {
                die "Required parameter $name not given";
            }
        }

        for %params.keys -> $name {
            if not $.parameters.{$name}:exists {
                die "Unknown parameter $name given";
            }
            if not %params.{$name}.isa($.parameters.{$name}.<isa>) {
                die "{%params.{$name}.perl} is not a valid value for the $name parameter";
            }
        }

        # XXX why is this return necessary?
        return;
    }
}

class Bread::Board::Dependency {
    has Bread::Board::Service $.service handles 'get';
}

class Bread::Board::ConstructorInjection
    does Bread::Board::Service
    does Bread::Board::HasParameters {

    has $.class;
    has Str $.constructor_name is rw = 'new';

    method get (*%params is copy) {
        # XXX remove more duplication?
        self.check_parameters(%params);
        for $.dependencies.keys -> $name {
            %params{$name} = $.dependencies{$name}.get;
        }
        return $.class."$.constructor_name"(|%params);
    }
}

class Bread::Board::Parameters {
    has Hash $.params;
    # XXX do we really want to keep this API?
    has $.class;

    method param (Str $name) {
        return $.params.{$name};
    }
}

class Bread::Board::BlockInjection
    does Bread::Board::Service
    does Bread::Board::HasParameters {

    has Callable $.block;
    has $.class = Any;

    method get (*%params is copy) {
        # XXX remove more duplication?
        self.check_parameters(%params);
        for $.dependencies.keys -> $name {
            %params{$name} = $.dependencies{$name}.get;
        }
        return $.block.(
            Bread::Board::Parameters.new(
                params => %params,
                class  => $.class,
            )
        );
    }
}

class Bread::Board::Literal does Bread::Board::Service {
    has $.value;

    method get {
        return $.value;
    }
}

class Bread::Board::Container {
    has Str $.name;
    has Bread::Board::Container $.parent is rw = Bread::Board::Container;
    # XXX again, as above
    # has Hash of Bread::Board::Container $.sub_containers = {};
    # has Hash of Bread::Board::Service $.services = {};
    has $.sub_containers = {};
    has $.services = {};

    # XXX again, as above
    method new (*%params is copy) {
        if %params.<sub_containers>.isa(Array) {
            %params.<sub_containers> = %params.<sub_containers>.map(-> $c { $c.name => $c }).hash;
        }
        if %params.<services>.isa(Array) {
            %params.<services> = %params.<services>.map(-> $c { $c.name => $c }).hash;
        }
        my $container = callwith(|%params);
        if %params.<sub_containers>:exists {
            for %params.<sub_containers>.values -> $c {
                $c.parent = $container;
            }
        }
        if %params.<services>:exists {
            for %params.<services>.values -> $c {
                $c.parent = $container;
            }
        }
        return $container;
    }

    method add_sub_container (Bread::Board::Container $c) {
        $.sub_containers.{$c.name} = $c;
        $c.parent = self;
    }

    method get_sub_container (Str $name) {
        return $.sub_containers.{$name};
    }

    method has_services {
        return $.services > 0;
    }

    method get_service (Str $name) {
        return $.services.{$name};
    }
}