From 78a70ab703db2f44d4af3117388e62a2ac1396fa Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Fri, 28 Dec 2012 06:09:41 -0600
Subject: implement fetch, and path resolution

---
 lib/Bread/Board.pm | 110 +++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 103 insertions(+), 7 deletions(-)

(limited to 'lib/Bread/Board.pm')

diff --git a/lib/Bread/Board.pm b/lib/Bread/Board.pm
index b80a093..51f5934 100644
--- a/lib/Bread/Board.pm
+++ b/lib/Bread/Board.pm
@@ -3,19 +3,81 @@ use v6;
 class Bread::Board::Container {...}
 class Bread::Board::Dependency {...}
 
-role Bread::Board::Service {
+role Bread::Board::Traversable {
+    has Bread::Board::Traversable $.parent is rw;
+
+    method fetch (Str $path is copy) {
+        # TODO substitutions don't return a useful value? # '
+        # if $path ~~ s/^ \/ // {
+        if $path ~~ m[^ '/' ] {
+            $path ~~ s[^ '/' ] = '';
+            return self.get_root_container._fetch($path);
+        }
+        else {
+            return self.get_enclosing_container._fetch($path);
+        }
+    }
+
+    method get_root_container {
+        my $root = self;
+        $root = $root.parent while $root.parent;
+        return $root;
+    }
+
+    method get_enclosing_container {*}
+
+    method _fetch (Str $path) {
+        return self if $path eq '';
+
+        my @parts = $path.split('/').grep(* ne '');
+        my $rest = @parts[1..*-1].join('/');
+
+        return $.parent._fetch($rest)
+            if @parts[0] eq '..';
+
+        return self._fetch_single(@parts[0])._fetch($rest);
+    }
+
+    method _fetch_single (Str $path) {*}
+}
+
+role Bread::Board::Service does Bread::Board::Traversable {
     has Str $.name;
-    has Bread::Board::Container $.parent is rw = Bread::Board::Container;
 
     # TODO: typed hashes NYI
     # has Hash of Bread::Board::Dependency $.dependencies = {};
     has $.dependencies = {};
 
+    # XXX there doesn't appear to be any way for roles to do things at # '
+    # construction time without breaking things - so, just call this method
+    # in the constructor of all classes that use this role manually
+    method _set_dependency_parents {
+        for $.dependencies.values -> $dep {
+            $dep.parent = self;
+        }
+
+        # TODO: for loops are currently lazy, so won't get evaluated until # '
+        # something evaluates the return value if they are the last statement
+        # in a method. this may change in the future, because it's pretty # '
+        # weird
+        return;
+    }
+
     method get {*};
 
     method get_dependency ($name) {
         return $.dependencies.{$name};
     }
+
+    method get_enclosing_container {
+        return $.parent;
+    }
+
+    method _fetch_single (Str $name) {
+        # XXX parameters?
+        return self.get_dependency($name)
+            // die "No dependency $name found for $.name";
+    }
 }
 
 role Bread::Board::HasParameters {
@@ -23,6 +85,10 @@ role Bread::Board::HasParameters {
     # has Hash of Hash $.parameters = {};
     has $.parameters = {};
 
+    method get_parameter (Str $name) {
+        return $.parameters.{$name};
+    }
+
     method check_parameters (%params) {
         for $.parameters.keys -> $name {
             if not %params.{$name}:exists {
@@ -47,8 +113,25 @@ role Bread::Board::HasParameters {
     }
 }
 
-class Bread::Board::Dependency {
+class Bread::Board::Dependency does Bread::Board::Traversable {
+    has Str $.service_path;
     has Bread::Board::Service $.service handles 'get';
+
+    # XXX is this the best way to do this?
+    # we can't do it at construction time, since $.parent doesn't get set
+    # until the current object is completely constructed
+    method service {
+        $!service //= self.fetch($.service_path);
+        return $!service;
+    }
+
+    method get_enclosing_container {
+        return $.parent.parent;
+    }
+
+    method _fetch_single (Str $name) {
+        die "Can't fetch $name from a dependency";
+    }
 }
 
 class Bread::Board::ConstructorInjection
@@ -70,7 +153,10 @@ class Bread::Board::ConstructorInjection
             }
             %params.<dependencies> = $deps;
         }
-        nextwith(|%params);
+        my $self = callwith(|%params);
+        # XXX see above
+        $self._set_dependency_parents;
+        return $self;
     }
 
     method get (*%params is copy) {
@@ -113,7 +199,10 @@ class Bread::Board::BlockInjection
             }
             %params.<dependencies> = $deps;
         }
-        nextwith(|%params);
+        my $self = callwith(|%params);
+        # XXX see above
+        $self._set_dependency_parents;
+        return $self;
     }
 
     method get (*%params is copy) {
@@ -139,9 +228,8 @@ class Bread::Board::Literal does Bread::Board::Service {
     }
 }
 
-class Bread::Board::Container {
+class Bread::Board::Container does Bread::Board::Traversable {
     has Str $.name;
-    has Bread::Board::Container $.parent is rw = Bread::Board::Container;
     # TODO: typed hashes NYI
     # has Hash of Bread::Board::Container $.sub_containers = {};
     # has Hash of Bread::Board::Service $.services = {};
@@ -186,6 +274,14 @@ class Bread::Board::Container {
     method get_service (Str $name) {
         return $.services.{$name};
     }
+
+    method get_enclosing_container { self }
+
+    method _fetch_single (Str $name) {
+        return self.get_sub_container($name)
+            // self.get_service($name)
+            // die "Couldn't find service or container for $name in $.name";
+    }
 }
 
 # vim:ft=perl6:foldmethod=manual
-- 
cgit v1.2.3-54-g00ecf