More complex example of marshalling and unmarshalling using Zydeco

marshalling-3.pl

use v5.16;
use strict;
use warnings;
use JSON::MaybeXS;
use Data::Dumper;

package MyApp {
  use Zydeco;
  use Carp 'confess';
  
  role ToJSON {
    method TO_JSON () {
      my %hash = %$self;
      return \%hash;
    }
  }
  
  class Farm with ToJSON {
    has fields (
      type         => 'ArrayRef[Field]',
      default      => sub { [] },
      handles_via  => 'Array',
      handles      => {
        'add_field'    => 'push',
        'count_fields' => 'count',
        'last_field'   => [ 'get', -1 ],
      },
    );
    
    method add_animal ( @animals ) {
      confess "No fields!" unless $self->count_fields;
      return $self->last_field->add_animal( @animals );
    }
    
    multi factory new_farm ( %args ) {
      return $class->new( %args );
    }
    
    multi factory new_farm :coercion ( HashRef $args ) {
      return $class->new( $args );
    }
    
    multi factory new_farm :coercion ( Undef $arg ) {
      return $class->new();
    }
  }
  
  class Field with ToJSON {
    has animals (
      type        => 'ArrayRef[Animal]',
      default     => sub { [] },
      handles_via => 'Array',
      handles     => {
        'add_animal'     => 'push',
        'count_animals'  => 'count',
        'last_animal'    => [ 'get', -1 ],
      },
    );
    
    multi factory new_field ( %args ) {
      return $class->new( %args );
    }
    
    multi factory new_field :coercion ( HashRef $args ) {
      return $class->new( $args );
    }
    
    multi factory new_field :coercion ( Undef $arg ) {
      return $class->new();
    }
  }
  
  class Animal with ToJSON {
    has name ( type => Str );
    
    # Subclasses
    #
    class Pig;
    class Cow;
    class Sheep;
    class Goat;
    class Horse;
    class Chicken;
    
    # Override TO_JSON so that it stores the species of the
    # animal (last component in the class name) in the hash.
    #
    method TO_JSON () {
      my $species = lc( (split '::', $class)[-1] );
      my %hash = ( 'species' => $species, %$self );
      return \%hash;
    }
    
    multi factory new_animal ( %args ) {
      return $class->FACTORY->new_animal( \%args );
    }
    
    # Teach MyApp->new_animal to construct using subclasses
    # for each species of animal, instead of generic Animal
    # objects.
    #
    multi factory new_animal :coercion ( HashRef $args ) {
      my $species = delete $args->{'species'};
      my $method  = "new_$species";
      if ( $class->FACTORY->can($method) ) {
        return $class->FACTORY->$method($args);
      }
      else {
        return $class->new($args);
      }
    }
  }
}

my $farm = MyApp->new_farm( JSON->new->decode(<<'JSON') );
{
  "fields" : [
    {
      "animals" : [
        {
          "name" : "Daisy",
          "species" : "cow"
        },
        {
          "name" : "Gertrude",
          "species" : "goat"
        }
      ]
    },
    {
      "animals" : [
        {
          "name" : "Woolly",
          "species" : "sheep"
        }
      ]
    }
  ]
}
JSON

say Dumper($farm);