From 9a2aa6f0b408704ee9c59f1d0ea1fe4ceab66feb Mon Sep 17 00:00:00 2001
From: Yanick Champoux <yanick@babyl.ca>
Date: Tue, 31 Oct 2023 15:41:10 -0400
Subject: [PATCH] add Registry::Schema

---
 lib/Dancer2/Plugin/JsonApi/Registry/Schema.pm | 109 ++++++++++++++++++
 t/registry-schema.t                           |  40 +++++++
 2 files changed, 149 insertions(+)
 create mode 100644 lib/Dancer2/Plugin/JsonApi/Registry/Schema.pm
 create mode 100644 t/registry-schema.t

diff --git a/lib/Dancer2/Plugin/JsonApi/Registry/Schema.pm b/lib/Dancer2/Plugin/JsonApi/Registry/Schema.pm
new file mode 100644
index 0000000..f0dcf87
--- /dev/null
+++ b/lib/Dancer2/Plugin/JsonApi/Registry/Schema.pm
@@ -0,0 +1,109 @@
+use 5.32.0;
+
+package Dancer2::Plugin::JsonApi::Registry::Schema;
+
+use Moo;
+
+use experimental qw/ signatures /;
+use List::AllUtils qw/ pairmap /;
+
+=head1 ATTRIBUTES
+
+=head2 type
+
+The JSON:API object type. Required.
+
+=cut
+
+has type => (
+    required => 1,
+    is       => 'ro',
+);
+
+=head2 id
+
+Key to use as a reference to the object. Defaults to C<id>. Can be a string,
+    or a function that will be passed the original data object.
+
+=cut
+
+has id => (
+    is      => 'ro',
+    default => 'id'
+);
+
+has links => (is => 'ro');
+has top_level_links => (is => 'ro');
+has top_level_meta => (is => 'ro');
+
+=head1 METHODS
+
+=head2 top_level_serialize($data,$extra_data = {})
+
+Serializes C<$data> as a top-level
+JSON:API object. 
+
+=cut
+
+sub top_level_serialize ( $self, $data, $extra_data = {} ) {
+
+    my $serial = {};
+
+    $serial->{jsonapi} = { version => '1.0' };
+
+    $serial->{data} = $self->serialize($data,$extra_data);
+
+    $serial->{links} = gen_links($self->top_level_links,$data,$extra_data)
+        if $self->top_level_links;
+    $serial->{meta} = gen_links($self->top_level_meta,$data,$extra_data)
+        if $self->top_level_meta;
+
+
+    return $serial;
+
+}
+
+=head2 serialize($data,$extra_data)
+
+Serializes C<$data> as a JSON:API object. 
+
+=cut
+
+sub serialize ( $self, $data, $extra_data = {} ) {
+
+    return [ map { $self->serialize($_,$extra_data) } @$data ] if ref $data eq 'ARRAY';
+
+    my $s = {
+        type => $self->type,
+        id   => $self->gen_id($data) };
+
+    if($self->links) {
+        $s->{links} = gen_links($self->links,$data,$extra_data);
+    }
+
+    return $s;
+
+}
+
+sub gen_id($self,$data) {
+    my $id = $self->id;
+
+    return ref $id ? $id->($data) : $data->{$id};
+}
+
+sub gen_links($links,$data,$extra_data={})  {
+
+    return $links->($data,$extra_data) if ref $links eq 'CODE';
+
+    return {
+        pairmap { $a => gen_item($b, $data,$extra_data) } %$links
+    };
+}
+
+sub gen_item($item,$data,$extra_data) {
+    return $item unless ref $item;
+
+    return $item->($data,$extra_data);
+}
+
+1;
diff --git a/t/registry-schema.t b/t/registry-schema.t
new file mode 100644
index 0000000..576f007
--- /dev/null
+++ b/t/registry-schema.t
@@ -0,0 +1,40 @@
+use Test2::V0;
+
+use Dancer2::Plugin::JsonApi::Registry::Schema;
+
+use experimental qw/ signatures /;
+
+my $type =
+  Dancer2::Plugin::JsonApi::Registry::Schema->new( 'type' => 'thing' );
+
+like $type->top_level_serialize( { attr1 => 'a', id => '123' },
+    { foo => 1 } ) => {
+    jsonapi => { version => '1.0' },
+    data    => { type    => 'thing', id => '123' } };
+
+is( Dancer2::Plugin::JsonApi::Registry::Schema->new(
+        'type' => 'thing',
+        id     => 'foo'
+    )->serialize( { foo => '123' } )->{id} => '123',
+    'custom id'
+);
+
+my $serialized = schema_serialize(
+    {   'type' => 'thing',
+        id     => sub ($data) { $data->{x} . $data->{y} },
+        links  => { self => '/some/url' },
+    },
+    { x => '1', y => '2' } );
+
+is( $serialized->{id} => '12',
+    'custom id, function'
+);
+
+like $serialized, { links => { self => '/some/url' } }, "links";
+
+sub schema_serialize ( $schema, $data ) {
+    return Dancer2::Plugin::JsonApi::Registry::Schema->new(%$schema)
+      ->serialize($data);
+}
+
+done_testing();