v0.0.1

- First release.

.gitignore

@@ -0,0 +1,9 @@
+.test_info.*
+lastlog.jsonl
+*.bak
+lab
+.envrc
+*.orig
+*.tdy
+*.ERR
+Dancer2-Plugin-JsonApi-*

.travis.yml

@@ -0,0 +1,17 @@
+---
+before_install:
+  - export HARNESS_OPTIONS=j10:c HARNESS_TIMER=1
+  - git config --global user.name "Dist Zilla Plugin TravisCI"
+  - git config --global user.email $HOSTNAME":not-for-mail@travis-ci.com"
+install:
+  - cpanm --with-recommends --installdeps -n .
+language: perl
+matrix:
+  include:
+    - perl: '5.22'
+    - perl: '5.24'
+    - perl: '5.26'
+    - perl: '5.28'
+    - perl: '5.30'
+script:
+  - prove -l t

AUTHOR_PLEDGE

@@ -0,0 +1,13 @@
+
+# CPAN Covenant for Dancer2-Plugin-JsonApi
+
+I, Yanick Champoux <yanick@babyl.ca>, hereby give modules@perl.org permission to grant co-maintainership 
+to Dancer2-Plugin-JsonApi, if all the following conditions are met:
+
+   (1) I haven't released the module for a year or more
+   (2) There are outstanding issues in the module's public bug tracker
+   (3) Email to my CPAN email address hasn't been answered after a month
+   (4) The requester wants to make worthwhile changes that will benefit CPAN
+
+In the event of my death, then the time-limits in (1) and (3) do not apply.
+

CODE_OF_CONDUCT.md

@@ -0,0 +1,128 @@
+# Contributor Covenant Code of Conduct
+
+## Our Pledge
+
+We as members, contributors, and leaders pledge to make participation in our
+community a harassment-free experience for everyone, regardless of age, body
+size, visible or invisible disability, ethnicity, sex characteristics, gender
+identity and expression, level of experience, education, socio-economic status,
+nationality, personal appearance, race, religion, or sexual identity
+and orientation.
+
+We pledge to act and interact in ways that contribute to an open, welcoming,
+diverse, inclusive, and healthy community.
+
+## Our Standards
+
+Examples of behavior that contributes to a positive environment for our
+community include:
+
+* Demonstrating empathy and kindness toward other people
+* Being respectful of differing opinions, viewpoints, and experiences
+* Giving and gracefully accepting constructive feedback
+* Accepting responsibility and apologizing to those affected by our mistakes,
+  and learning from the experience
+* Focusing on what is best not just for us as individuals, but for the
+  overall community
+
+Examples of unacceptable behavior include:
+
+* The use of sexualized language or imagery, and sexual attention or
+  advances of any kind
+* Trolling, insulting or derogatory comments, and personal or political attacks
+* Public or private harassment
+* Publishing others' private information, such as a physical or email
+  address, without their explicit permission
+* Other conduct which could reasonably be considered inappropriate in a
+  professional setting
+
+## Enforcement Responsibilities
+
+Community leaders are responsible for clarifying and enforcing our standards of
+acceptable behavior and will take appropriate and fair corrective action in
+response to any behavior that they deem inappropriate, threatening, offensive,
+or harmful.
+
+Community leaders have the right and responsibility to remove, edit, or reject
+comments, commits, code, wiki edits, issues, and other contributions that are
+not aligned to this Code of Conduct, and will communicate reasons for moderation
+decisions when appropriate.
+
+## Scope
+
+This Code of Conduct applies within all community spaces, and also applies when
+an individual is officially representing the community in public spaces.
+Examples of representing our community include using an official e-mail address,
+posting via an official social media account, or acting as an appointed
+representative at an online or offline event.
+
+## Enforcement
+
+Instances of abusive, harassing, or otherwise unacceptable behavior may be
+reported to the community leaders responsible for enforcement at
+yanick@babyl.ca.
+All complaints will be reviewed and investigated promptly and fairly.
+
+All community leaders are obligated to respect the privacy and security of the
+reporter of any incident.
+
+## Enforcement Guidelines
+
+Community leaders will follow these Community Impact Guidelines in determining
+the consequences for any action they deem in violation of this Code of Conduct:
+
+### 1. Correction
+
+**Community Impact**: Use of inappropriate language or other behavior deemed
+unprofessional or unwelcome in the community.
+
+**Consequence**: A private, written warning from community leaders, providing
+clarity around the nature of the violation and an explanation of why the
+behavior was inappropriate. A public apology may be requested.
+
+### 2. Warning
+
+**Community Impact**: A violation through a single incident or series
+of actions.
+
+**Consequence**: A warning with consequences for continued behavior. No
+interaction with the people involved, including unsolicited interaction with
+those enforcing the Code of Conduct, for a specified period of time. This
+includes avoiding interactions in community spaces as well as external channels
+like social media. Violating these terms may lead to a temporary or
+permanent ban.
+
+### 3. Temporary Ban
+
+**Community Impact**: A serious violation of community standards, including
+sustained inappropriate behavior.
+
+**Consequence**: A temporary ban from any sort of interaction or public
+communication with the community for a specified period of time. No public or
+private interaction with the people involved, including unsolicited interaction
+with those enforcing the Code of Conduct, is allowed during this period.
+Violating these terms may lead to a permanent ban.
+
+### 4. Permanent Ban
+
+**Community Impact**: Demonstrating a pattern of violation of community
+standards, including sustained inappropriate behavior,  harassment of an
+individual, or aggression toward or disparagement of classes of individuals.
+
+**Consequence**: A permanent ban from any sort of public interaction within
+the community.
+
+## Attribution
+
+This Code of Conduct is adapted from the [Contributor Covenant][homepage],
+version 2.0, available at
+https://www.contributor-covenant.org/version/2/0/code_of_conduct.html.
+
+Community Impact Guidelines were inspired by [Mozilla's code of conduct
+enforcement ladder](https://github.com/mozilla/diversity).
+
+[homepage]: https://www.contributor-covenant.org
+
+For answers to common questions about this code of conduct, see the FAQ at
+https://www.contributor-covenant.org/faq. Translations are available at
+https://www.contributor-covenant.org/translations.

Changes

@@ -0,0 +1,17 @@
+Revision history for Dancer2-Plugin-JsonApi
+
+{{$NEXT}}
+ [API CHANGES]
+
+ [BUG FIXES]
+
+ [DOCUMENTATION]
+
+ [ENHANCEMENTS]
+
+ [NEW FEATURES]
+
+ [STATISTICS]
+
+0.0.1 2023-11-15
+ - First release.

MANIFEST

@@ -0,0 +1,34 @@
+AUTHOR_PLEDGE
+CODE_OF_CONDUCT.md
+Changes
+INSTALL
+LICENSE
+MANIFEST
+META.json
+META.yml
+Makefile.PL
+README.mkdn
+SIGNATURE
+Taskfile.yaml
+cpanfile
+dist.ini
+doap.xml
+lib/Dancer2/Plugin/JsonApi.pm
+lib/Dancer2/Plugin/JsonApi/Registry.pm
+lib/Dancer2/Plugin/JsonApi/Schema.pm
+lib/Dancer2/Serializer/JsonApi.pm
+t/00-compile.t
+t/00-report-prereqs.dd
+t/00-report-prereqs.t
+t/compile.t
+t/example.t
+t/plugin.t
+t/registry.t
+t/relationships.t
+t/schema.t
+t/serializer.t
+t/todos.t
+xt/added-test.t
+xt/perltidy.t
+xt/release/unused-vars.t
+xt/worktree-clean.t

Taskfile.yaml

@@ -0,0 +1,17 @@
+# https://taskfile.dev
+
+version: '3'
+
+vars:
+  GREETING: Hello, World!
+  TARGET_BRANCH: main
+
+tasks:
+  tidy:
+    cmds:
+      - git diff-ls --diff-filter=ACMR {{.TARGET_BRANCH}} | grep -e '\.pm$\|\.t$|\.pod$' | xargs -IX perltidy -b X
+    
+  default:
+    cmds:
+      - echo "{{.GREETING}}"
+    silent: true

cpanfile

@@ -0,0 +1,43 @@
+# This file is generated by Dist::Zilla::Plugin::CPANFile v6.030
+# Do not edit this file directly. To change prereqs, edit the `dist.ini` file.
+
+requires "Carp" => "0";
+requires "Dancer2::Core::Role::Serializer" => "0";
+requires "Dancer2::Plugin" => "0";
+requires "Dancer2::Serializer::JSON" => "0";
+requires "List::AllUtils" => "0";
+requires "Moo" => "0";
+requires "Set::Object" => "0";
+requires "experimental" => "0";
+requires "perl" => "v5.38.0";
+
+on 'test' => sub {
+  requires "Clone" => "0";
+  requires "Dancer2" => "0";
+  requires "ExtUtils::MakeMaker" => "0";
+  requires "File::Spec" => "0";
+  requires "IO::Handle" => "0";
+  requires "IPC::Open3" => "0";
+  requires "JSON" => "0";
+  requires "Test2::Plugin::ExitSummary" => "0";
+  requires "Test2::V0" => "0";
+  requires "Test::More" => "0";
+  requires "strict" => "0";
+  requires "warnings" => "0";
+};
+
+on 'test' => sub {
+  recommends "CPAN::Meta" => "2.120900";
+};
+
+on 'configure' => sub {
+  requires "ExtUtils::MakeMaker" => "0";
+};
+
+on 'develop' => sub {
+  requires "Git::Wrapper" => "0";
+  requires "Test2::V0" => "0";
+  requires "Test::More" => "0.96";
+  requires "Test::PerlTidy" => "0";
+  requires "Test::Vars" => "0";
+};

dist.ini

@@ -0,0 +1,8 @@
+name    = Dancer2-Plugin-JsonApi
+author  = Yanick Champoux <yanick@babyl.ca>
+license = Perl_5
+copyright_holder = Yanick Champoux
+copyright_year   = 2023
+ 
+[@YANICK]
+

lib/Dancer2/Plugin/JsonApi.pm

@@ -0,0 +1,70 @@
+# ABSTRACT: JsonApi helpers for Dancer2 apps
+
+use 5.38.0;
+
+package Dancer2::Plugin::JsonApi;
+
+use Dancer2::Plugin::JsonApi::Registry;
+use Dancer2::Plugin;
+use Dancer2::Serializer::JsonApi;
+
+has registry => (
+    plugin_keyword => 'jsonapi_registry',
+    is             => 'ro',
+    default        => sub ($self) {
+        Dancer2::Plugin::JsonApi::Registry->new( app => $self->app );
+    }
+);
+
+sub jsonapi : PluginKeyword ( $plugin, $type, $sub ) {
+
+    return sub {
+        my $result = $sub->();
+
+        return [
+            $type => $result,
+            {   vars    => $plugin->app->request->vars,
+                request => $plugin->app->request
+            }
+        ];
+    };
+}
+
+sub BUILD ( $self, @ ) {
+    my $serializer = eval {
+         $self->app->serializer_engine 
+    };
+
+    unless ($serializer) {
+        $self->app->set_serializer_engine(
+            Dancer2::Serializer::JsonApi->new );
+        $serializer = $self->app->serializer_engine;
+
+    }
+
+    $serializer->registry( $self->registry )
+      if ref $serializer eq 'Dancer2::Serializer::JsonApi';
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Dancer2::Plugin::JsonAPI
+
+=head2 DESCRIPTION
+
+If the serializer is not already explicitly set, the plugin will configure it to be L<Dancer2::Serializer::JsonApi>.
+
+=head2 SEE ALSO
+
+=over
+
+=item * The L<JSON:API|https://jsonapi.org> specs, natch.
+
+=item * L<json-api-serializer|https://www.npmjs.com/package/json-api-serializer> My go to for serializing JSON API documents in JavaScript-land. Also, inspiration for this module.
+
+=back
+

lib/Dancer2/Plugin/JsonApi/Registry.pm

@@ -0,0 +1,48 @@
+package Dancer2::Plugin::JsonApi::Registry;
+
+use 5.32.0;
+use Dancer2::Plugin::JsonApi::Schema;
+
+use Carp;
+
+use Moo;
+
+use experimental qw/ signatures /;
+
+sub serialize ( $self, $type, $data, $extra_data = {} ) {
+    return $self->type($type)->serialize( $data, $extra_data );
+}
+
+sub deserialize ( $self, $data, $included = [] ) {
+
+    my $type =
+      ref $data->{data} eq 'ARRAY'
+      ? $data->{data}[0]->{type}
+      : $data->{data}{type};
+
+    return $self->type($type)->deserialize( $data, $included );
+}
+
+has types => (
+    is      => 'ro',
+    default => sub { +{} },
+);
+
+has app => ( is => 'ro', );
+
+sub add_type ( $self, $type, $definition = {} ) {
+    $self->{types}{$type} = Dancer2::Plugin::JsonApi::Schema->new(
+        registry => $self,
+        type     => $type,
+        %$definition
+    );
+}
+
+sub type ( $self, $type ) {
+    return $self->types->{$type} //=
+      Dancer2::Plugin::JsonApi::Schema->new( type => $type );
+}
+
+1;
+
+__END__

lib/Dancer2/Plugin/JsonApi/Registry.pod

@@ -0,0 +1,23 @@
+
+=head1 DESCRIPTION
+
+The registry for the different types of data managed by the plugin.
+
+=head1 METHODS
+
+=head2 add_type($type, $definition = {})
+
+Adds a data type to the registry.
+
+=head2 type($type)
+
+Returns the type's C<Dancer2::Plugin::JsonApi::Schema>. Throws an
+error if the type does not exist.
+
+=cut
+
+=head2 serialize($type,$data,$extra_data={})
+
+Returns the serialized form of C<$data>.
+
+=cut

lib/Dancer2/Plugin/JsonApi/Schema.pm

@@ -0,0 +1,223 @@
+use 5.32.0;
+
+package Dancer2::Plugin::JsonApi::Schema;
+
+use Moo;
+
+use experimental   qw/ signatures /;
+use List::AllUtils qw/ pairmap pairgrep /;
+
+use Set::Object qw/set/;
+
+has registry => ( is => 'ro' );
+
+has type => (
+    required => 1,
+    is       => 'ro',
+);
+
+has id => (
+    is      => 'ro',
+    default => 'id'
+);
+
+has links           => ( is => 'ro' );
+has top_level_links => ( is => 'ro' );
+has top_level_meta  => ( is => 'ro' );
+has relationships   => ( is => 'ro', default => sub { +{} } );
+
+has allowed_attributes => ( is => 'ro' );
+has before_serialize   => ( is => 'ro' );
+
+sub serialize ( $self, $data, $extra_data = {} ) {
+
+    my $serial = {};
+
+    $serial->{jsonapi} = { version => '1.0' };
+
+    my @included;
+
+    if ( defined $data ) {
+        $serial->{data} =
+          $self->serialize_data( $data, $extra_data, \@included );
+    }
+
+    $serial->{links} = gen_links( $self->top_level_links, $data, $extra_data )
+      if $self->top_level_links;
+
+    if ( $self->registry and $self->registry->app ) {
+        $serial->{links}{self} = $self->registry->app->request->path;
+    }
+
+    $serial->{meta} = gen_links( $self->top_level_meta, $data, $extra_data )
+      if $self->top_level_meta;
+
+    $serial->{included} = [ dedupe_included(@included) ] if @included;
+
+    return $serial;
+}
+
+sub dedupe_included {
+    my %seen;
+    return grep { not $seen{ $_->{type} }{ $_->{id} }++ } @_;
+}
+
+has attributes => (
+    is      => 'ro',
+    default => sub {
+        my $self = shift;
+        return sub {
+            my ( $data, $extra_data ) = @_;
+            return {} if ref $data ne 'HASH';
+            my @keys = grep { not $self->relationships->{$_} }
+              grep { $_ ne $self->id } keys %$data;
+            return { $data->%{@keys} };
+        }
+    }
+);
+
+sub serialize_data ( $self, $data, $extra_data = {}, $included = undef ) {
+
+    return [ map { $self->serialize_data( $_, $extra_data, $included ) }
+          @$data ]
+      if ref $data eq 'ARRAY';
+
+    if ( $self->before_serialize ) {
+        $data = $self->before_serialize->( $data, $extra_data );
+    }
+
+    # it's a scalar? it's the id
+    return { id => $data, type => $self->type } unless ref $data;
+
+    my $s = {
+        type => $self->type,
+        id   => $self->gen_id( $data, $extra_data )
+    };
+
+    if ( $self->links ) {
+        $s->{links} = gen_links( $self->links, $data, $extra_data );
+    }
+
+    $s->{attributes} = gen_links( $self->attributes, $data, $extra_data );
+
+    my %relationships = $self->relationships->%*;
+
+    for my $key ( keys %relationships ) {
+        my $attr = $data->{$key};
+
+        my @inc;
+
+        my $t = $self->registry->serialize( $relationships{$key}{type},
+            $attr, \@inc );
+
+        if ( my $data = obj_ref( $t->{data}, \@inc ) ) {
+            $s->{relationships}{$key}{data} = $data;
+        }
+
+        if ( my $links = $relationships{$key}{links} ) {
+            $s->{relationships}{$key}{links} =
+              gen_links( $links, $data, $extra_data );
+        }
+
+        push @$included, @inc if $included;
+    }
+
+    delete $s->{attributes} unless $s->{attributes}->%*;
+
+    if ( $self->allowed_attributes ) {
+        delete $s->{attributes}{$_}
+          for ( set( keys $s->{attributes}->%* ) -
+            set( $self->allowed_attributes->@* ) )->@*;
+    }
+
+    return $s;
+
+}
+
+sub obj_ref ( $data, $included ) {
+    return [ map { obj_ref( $_, $included ) } @$data ]
+      if ref $data eq 'ARRAY';
+
+    return $data if keys %$data == 2;
+
+    return unless keys %$data;
+
+    push @$included, $data;
+
+    return +{ $data->%{qw/ id type/} };
+}
+
+sub gen_id ( $self, $data, $xtra ) {
+    my $id = $self->id;
+
+    return ref $id ? $id->( $data, $xtra ) : $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 );
+}
+
+sub deserialize ( $self, $serialized, $included = [] ) {
+
+    my $data     = $serialized->{data};
+    my @included = ( ( $serialized->{included} // [] )->@*, @$included );
+
+    return $self->deserialize_data( $data, \@included );
+}
+
+sub expand_object ( $obj, $included ) {
+
+    if ( ref $obj eq 'ARRAY' ) {
+        return [ map { expand_object( $_, $included ) } @$obj ];
+    }
+
+    for (@$included) {
+        return $_ if $_->{type} eq $obj->{type} and $_->{id} eq $obj->{id};
+    }
+
+    return $obj;
+}
+
+sub deserialize_data ( $self, $data, $included ) {
+
+    if ( ref $data eq 'ARRAY' ) {
+        return [ map { $self->deserialize_data( $_, $included ) } @$data ];
+    }
+
+    my %obj = (
+        ( $data->{attributes} // {} )->%*,
+        pairmap {
+            $a =>
+              $self->registry->type( $self->relationships->{$a}{type} )
+              ->deserialize_data( $b, $included )
+          } pairmap { $a => expand_object( $b, $included ) }
+          pairmap { $a => $b->{data} } ( $data->{relationships} // {} )->%*
+    );
+
+    my $id_key = $self->id;
+    if ( !ref $id_key ) {
+        $obj{$id_key} = $data->{id};
+    }
+
+    if ( $data->{type} eq 'photo' ) {
+
+        #        die keys %$data;
+    }
+
+    if ( 1 == keys %obj and exists $obj{id} ) {
+        return $data->{id};
+    }
+
+    return \%obj;
+}
+
+1;

lib/Dancer2/Plugin/JsonApi/Schema.pod

@@ -0,0 +1,64 @@
+
+=head1 DESCRIPTION
+
+Defines a type of object to serialize/deserialize from/to the 
+JSON:API format.
+
+=head1 ATTRIBUTES
+
+=head2 registry
+
+L<Dancer2::Plugin::JsonApi::Registry> to use to find the definition of
+other object types.
+
+=head2 before_serialize
+
+Accepts a function, which will be called on the original C<$data> to serialize
+to groom it.
+
+    before_serialize => sub($data,$xtra) {
+       # lowercase all keys
+       return +{ pairmap { lc($a) => $b } %$data } 
+    }
+
+=head2 type
+
+The JSON:API object type. Read-only, required.
+
+=head2 id
+
+Key to use as a reference to the object. Can be a string,
+or a function that will be passed the original data object.
+Read-only, defaults to the string C<id>. 
+
+=head2 links 
+
+Links to include as part of the object. 
+
+=head2 top_level_links
+
+Links to include to the serialized top level, if the top level object 
+is of the type defined by this class.
+
+=head2 top_level_meta
+
+Meta information to include to the serialized top level, if the top level object 
+is of the type defined by this class.
+
+=head2 relationships
+
+Relationships for the object type.
+
+=head2 allowed_attributes
+
+List of attributes that can be serialized/deserialized.
+
+=head1 METHODS
+
+=head2 top_level_serialize($data,$extra_data = {})
+
+Serializes C<$data> as a top-level JSON:API object. 
+
+=head2 serialize_data($data,$extra_data)
+
+Serializes the inner C<$data>. 

lib/Dancer2/Serializer/JsonApi.pm

@@ -0,0 +1,119 @@
+use 5.38.0;
+
+=head1 DESCRIPTION
+
+Serializer for JSON:API. Takes in a data structure, munge it to conforms to the JSON:API format (potentially based on a provided registry of JSON:API schemas),
+and encode it as JSON.
+
+Note that using Dancer2::Plugin::JsonApi in an app will automatically
+set C<Dancer2::Serializer::JsonApi> as its serializer if it's not already defined.
+
+=head1 SYNOPSIS
+
+As part of a Dancer2 App: 
+
+    # in config.yaml
+    
+    serializer: JsonApi  
+
+As a standalone module: 
+
+    use Dancer2::Serializer::JsonApi;
+    use Dancer2::Plugin::JsonApi::Registry;
+
+    my $registry = Dancer2::Plugin::JsonApi::Registry->new;
+
+    $registry->add_type( 'spaceship' => {
+        relationships => {
+            crew => { type => 'person' }
+        }
+    } );
+
+    $registry->add_type( 'person' );
+
+    my $serializer = Dancer2::Serializer::JsonApi->new( 
+        registry => $registry 
+    );
+
+    my $serialized = $serializer->serialize([ 
+        'spaceship', {
+            id => 1,
+            name => 'Unrequited Retribution',
+            crew => [
+                { id => 2, name => 'One-eye Flanagan', species => 'human' },
+                { id => 3, name => 'Flabgor', species => 'Moisterian' },
+            ]
+        }
+    ]);
+
+=cut 
+
+package Dancer2::Serializer::JsonApi;
+
+use Dancer2::Plugin::JsonApi::Registry;
+use Dancer2::Serializer::JSON;
+
+use Moo;
+
+=head1 ATTRIBUTES
+
+=head2 content_type
+
+Returns the content type used by the serializer, which is C<application/vnd.api+json>;
+
+=cut
+
+has content_type => ( is => 'ro', default => 'application/vnd.api+json' );
+
+with 'Dancer2::Core::Role::Serializer';
+
+=head2 registry 
+
+The L<Dancer2::Plugin::JsonApi::Registry> to use. 
+
+=cut
+
+has registry => (
+    is      => 'rw',
+    default => sub { Dancer2::Plugin::JsonApi::Registry->new }
+);
+
+=head2 json_serializer
+
+The underlying JSON serializer. Defaults to L<Dancer2::Serializer::JSON>.
+
+=cut
+
+has json_serializer => (
+    is      => 'ro',
+    default => sub { Dancer2::Serializer::JSON->new }
+);
+
+=head1 METHODS
+
+=head2 $self->serialize( [ $type, $data, $xtra ])
+
+Serializes the C<$data> using the C<$type> from the registry. 
+The returned value will be a JSON string.
+
+=cut
+
+sub serialize {
+    my ( $self, $data ) = @_;
+
+    return $self->json_serializer->serialize(
+        $self->registry->serialize(@$data) );
+}
+
+=head2 $self->deserialize( $json_string )
+
+Takes in the serialized C<$json_string> and recreate data out of it.
+
+=cut
+
+sub deserialize ( $self, $serialized, @ ) {
+    $self->registry->deserialize(
+        $self->json_serializer->deserialize($serialized) );
+}
+
+1;

t/compile.t

@@ -0,0 +1,8 @@
+use Dancer2::Plugin::JsonApi::Registry;
+
+use Test2::V0;
+
+# we have to start somewhere
+ok "it compiles!";
+
+done_testing;

t/example.t

@@ -0,0 +1,226 @@
+use 5.32.0;
+
+use Test2::V0;
+
+use Clone qw/ clone /;
+
+use Dancer2::Plugin::JsonApi::Registry;
+
+use experimental qw/ signatures /;
+
+# example taken straight from https://www.npmjs.com/package/json-api-serializer
+
+my $data = [
+    {   id      => "1",
+        title   => "JSON API paints my bikeshed!",
+        body    => "The shortest article. Ever.",
+        created => "2015-05-22T14:56:29.000Z",
+        updated => "2015-05-22T14:56:28.000Z",
+        author  => {
+            id        => "1",
+            firstName => "Kaley",
+            lastName  => "Maggio",
+            email     => "Kaley-Maggio\@example.com",
+            age       => "80",
+            gender    => "male"
+        },
+        tags   => [ "1", "2" ],
+        photos => [
+            "ed70cf44-9a34-4878-84e6-0c0e4a450cfe",
+            "24ba3666-a593-498c-9f5d-55a4ee08c72e",
+            "f386492d-df61-4573-b4e3-54f6f5d08acf"
+        ],
+        comments => [
+            {   _id     => "1",
+                body    => "First !",
+                created => "2015-08-14T18:42:16.475Z"
+            },
+            {   _id     => "2",
+                body    => "I Like !",
+                created => "2015-09-14T18:42:12.475Z"
+            },
+            {   _id     => "3",
+                body    => "Awesome",
+                created => "2015-09-15T18:42:12.475Z"
+            }
+        ]
+    }
+];
+
+my $registry = Dancer2::Plugin::JsonApi::Registry->new;
+
+$registry->add_type(
+    'article',
+    {   top_level_meta => sub ( $data, $xtra ) {
+            return +{
+                count => $xtra->{count},
+                total => 0 + @$data,
+            };
+        },
+        top_level_links => { self => '/articles', },
+        links           => {
+            self => sub ( $data, @ ) {
+                return "/articles/" . $data->{id};
+            },
+        },
+        relationships => {
+            'tags'     => { type => 'tag' },
+            'comments' => { type => 'comment' },
+            photos     => { type => 'photo' },
+            author     => {
+                type  => "people",
+                links => sub ( $data, @ ) {
+                    return +{
+                        self => "/articles/"
+                          . $data->{id}
+                          . "/relationships/author",
+                        related => "/articles/" . $data->{id} . "/author"
+                    };
+                }
+            },
+        }
+    }
+);
+
+$registry->add_type('tag');
+$registry->add_type('photo');
+$registry->add_type( 'comment',
+    { id => '_id', allowed_attributes => ['body'] } );
+$registry->add_type(
+    'people',
+    {   links => sub ( $data, @ ) { +{ self => '/peoples/' . $data->{id} } }
+    }
+);
+
+my $output = $registry->serialize( 'article', $data, { count => 2 } );
+
+like $output->{data}[0]{relationships}{author},
+  { links => {
+        "self"    => "/articles/1/relationships/author",
+        "related" => "/articles/1/author"
+    }
+  };
+
+like $output->{data}[0]{relationships}{author},
+  { links => {
+        "self"    => "/articles/1/relationships/author",
+        "related" => "/articles/1/author"
+    }
+  };
+
+like $output => {
+    "jsonapi" => { "version" => "1.0" },
+    "meta"    => {
+        "count" => 2,
+        "total" => 1
+    },
+    "links" => { "self" => "/articles" },
+    "data"  => [
+        {   "type"       => "article",
+            "id"         => "1",
+            "attributes" => {
+                "title"   => "JSON API paints my bikeshed!",
+                "body"    => "The shortest article. Ever.",
+                "created" => "2015-05-22T14:56:29.000Z"
+            },
+            "relationships" => {
+                "author" => {
+                    "data" => {
+                        "type" => "people",
+                        "id"   => "1"
+                    },
+                    "links" => {
+                        "self"    => "/articles/1/relationships/author",
+                        "related" => "/articles/1/author"
+                    }
+                },
+                "tags" => {
+                    "data" => [
+                        {   "type" => "tag",
+                            "id"   => "1"
+                        },
+                        {   "type" => "tag",
+                            "id"   => "2"
+                        }
+                    ]
+                },
+                "photos" => {
+                    "data" => [
+                        {   "type" => "photo",
+                            "id"   => "ed70cf44-9a34-4878-84e6-0c0e4a450cfe"
+                        },
+                        {   "type" => "photo",
+                            "id"   => "24ba3666-a593-498c-9f5d-55a4ee08c72e"
+                        },
+                        {   "type" => "photo",
+                            "id"   => "f386492d-df61-4573-b4e3-54f6f5d08acf"
+                        }
+                    ]
+                },
+                "comments" => {
+                    "data" => [
+                        {   "type" => "comment",
+                            "id"   => "1"
+                        },
+                        {   "type" => "comment",
+                            "id"   => "2"
+                        },
+                        {   "type" => "comment",
+                            "id"   => "3"
+                        }
+                    ]
+                }
+            },
+            "links" => { "self" => "/articles/1" }
+        }
+    ],
+};
+
+is $output->{included}, bag {
+    item($_)
+      for (
+        {   "type"       => "people",
+            "id"         => "1",
+            "attributes" => {
+                "firstName" => "Kaley",
+                "lastName"  => "Maggio",
+                "email"     => "Kaley-Maggio\@example.com",
+                "age"       => "80",
+                "gender"    => "male"
+            },
+            "links" => { "self" => "/peoples/1" },
+        },
+        {   "type"       => "comment",
+            "id"         => "1",
+            "attributes" => { "body" => "First !" }
+        },
+        {   "type"       => "comment",
+            "id"         => "2",
+            "attributes" => { "body" => "I Like !" }
+        },
+        {   "type"       => "comment",
+            "id"         => "3",
+            "attributes" => { "body" => "Awesome" }
+        }
+      );
+};
+
+subtest 'comments only have the body attribute' => sub {
+    for
+      my $comment ( grep { $_->{type} eq 'comment' } $output->{included}->@* )
+    {
+        my @attr = keys $comment->{attributes}->%*;
+        is( \@attr => ['body'], "only the body for comments" );
+    }
+};
+
+subtest 'deserialize' => sub {
+    my $roundtrip = $registry->deserialize($output);
+
+    my $expected = clone($data);
+    delete $_->{created} for $expected->[0]{comments}->@*;
+
+    like $roundtrip => $expected;
+};
+
+done_testing;

t/plugin.t

@@ -0,0 +1,10 @@
+use 5.38.0;
+
+use Test2::V0;
+
+use Dancer2;
+use Dancer2::Plugin::JsonApi;
+
+pass 'we compile!';
+
+done_testing;

t/registry.t

@@ -0,0 +1,28 @@
+use Test2::V0;
+
+use Dancer2::Plugin::JsonApi::Registry;
+
+use experimental qw/ signatures /;
+
+my $registry = Dancer2::Plugin::JsonApi::Registry->new;
+
+$registry->add_type(
+    people => {
+        id    => 'id',
+        links => {
+            self => sub ( $data, @ ) {
+                no warnings qw/ uninitialized /;
+                return "/peoples/$data->{id}";
+            }
+        }
+    }
+);
+
+isa_ok $registry->type('people') => 'Dancer2::Plugin::JsonApi::Schema';
+
+like(
+    $registry->serialize( people => {} ),
+    { jsonapi => { version => '1.0' } }
+);
+
+done_testing();

t/relationships.t

@@ -0,0 +1,66 @@
+use Test2::V0;
+
+use Dancer2::Plugin::JsonApi::Registry;
+
+use experimental qw/ signatures /;
+
+my $registry = Dancer2::Plugin::JsonApi::Registry->new;
+
+$registry->add_type( 'thing',
+    { relationships => { subthings => { type => 'subthing' }, } } );
+$registry->add_type('subthing');
+
+subtest basic => sub {
+    my $s = $registry->serialize(
+        'thing',
+        {   id        => 1,
+            subthings => [ { id => 2, x => 10 }, { id => 3 } ]
+        }
+    );
+
+    ok not $s->{data}{attributes};
+
+    like $s => {
+        data => {
+            id            => 1,
+            type          => 'thing',
+            relationships =>
+              { subthings => { data => [ { id => 2 }, { id => 3 } ] } }
+        },
+        included =>
+          [ { type => 'subthing', id => 2, attributes => { x => 10 } }, ]
+    };
+
+};
+
+subtest "don't repeat includes" => sub {
+    my $s = $registry->serialize(
+        'thing',
+        [
+            {   id        => 1,
+                subthings => [
+                    {   id => 2,
+                        x  => 10
+                    },
+                    {   id => 3,
+                        y  => 20
+                    }
+                ]
+            },
+            {   id        => 2,
+                subthings => [
+                    {   id => 3,
+                        y  => 20
+                    },
+                    {   id => 2,
+                        x  => 10
+                    }
+                ]
+            }
+        ]
+    );
+
+    is $s->{included}->@* + 0, 2;
+};
+
+done_testing;

t/schema.t

@@ -0,0 +1,145 @@
+use Test2::V0;
+
+use Dancer2::Plugin::JsonApi::Schema;
+use Dancer2::Plugin::JsonApi::Registry;
+
+use experimental qw/ signatures /;
+
+my $type = Dancer2::Plugin::JsonApi::Schema->new( 'type' => 'thing' );
+
+like $type->serialize( { attr1 => 'a', id => '123' }, { foo => 1 } ) => {
+    jsonapi => { version => '1.0' },
+    data    => { type    => 'thing', id => '123' }
+};
+
+is( Dancer2::Plugin::JsonApi::Schema->new(
+        'type' => 'thing',
+        id     => 'foo'
+      )->serialize( { foo => '123' } )->{data}{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->{data}{id} => '12',
+    'custom id, function'
+  );
+
+like $serialized->{data}, { links => { self => '/some/url' } }, "links";
+
+sub schema_serialize ( $schema, $data ) {
+    return Dancer2::Plugin::JsonApi::Schema->new(%$schema)->serialize($data);
+}
+
+like(
+    Dancer2::Plugin::JsonApi::Schema->new(
+        type           => 'thing',
+        top_level_meta => {
+            foo => 1,
+            bar => sub ( $data, $xtra ) {
+                $xtra->{bar};
+            }
+        }
+      )->serialize( {}, { bar => 'yup' } ),
+    { meta => { foo => 1, bar => 'yup' } }
+);
+
+subtest 'attributes' => sub {
+    my $serialized =
+      Dancer2::Plugin::JsonApi::Schema->new( type => 'thing', )
+      ->serialize( { id => 1, foo => 'bar' } );
+
+    is $serialized->{data} => {
+        type       => 'thing',
+        id         => 1,
+        attributes => { foo => 'bar', }
+    };
+
+};
+
+subtest 'a single scalar == id', sub {
+    my $serialized =
+      Dancer2::Plugin::JsonApi::Schema->new( type => 'thing' )
+      ->serialize('blah');
+
+    is $serialized->{data} => {
+        type => 'thing',
+        id   => 'blah',
+    };
+};
+
+subtest 'allowed_attributes', sub {
+    my $serialized = Dancer2::Plugin::JsonApi::Schema->new(
+        type               => 'thing',
+        allowed_attributes => ['foo'],
+    )->serialize( { id => 1, foo => 2, bar => 3 } );
+
+    is $serialized->{data} => {
+        type       => 'thing',
+        id         => 1,
+        attributes => { foo => 2, }
+    };
+};
+
+subtest 'empty data', sub {
+    my $serialized =
+      Dancer2::Plugin::JsonApi::Schema->new( type => 'thing' )
+      ->serialize(undef);
+
+    ok( !$serialized->{data}, "there is no data" );
+};
+
+package FakeRequest {
+    use Moo;
+    has path => ( is => 'ro', default => '/some/path' );
+}
+
+package FakeApp {
+    use Moo;
+    has request => (
+        is      => 'ro',
+        default => sub {
+            FakeRequest->new;
+        }
+    );
+}
+
+subtest "add the self link if tied to the app" => sub {
+    my $serialized = Dancer2::Plugin::JsonApi::Schema->new(
+        type     => 'thing',
+        registry =>
+          Dancer2::Plugin::JsonApi::Registry->new( app => FakeApp->new )
+    )->serialize(undef);
+
+    is $serialized->{links}{self} => '/some/path';
+};
+
+subtest 'attributes function' => sub {
+    my $serialized = Dancer2::Plugin::JsonApi::Schema->new(
+        type       => 'thing',
+        attributes => sub ( $data, @ ) {
+            return +{ reverse %$data },;
+        },
+    )->serialize( { id => 1, 'a' .. 'd' } );
+
+    is $serialized->{data}{attributes} => { 1 => 'id', b => 'a', d => 'c' };
+};
+
+subtest 'before_serializer' => sub {
+    my $serialized = Dancer2::Plugin::JsonApi::Schema->new(
+        type             => 'thing',
+        before_serialize => sub ( $data, @ ) {
+            return +{ %$data, nbr_attrs => scalar keys %$data };
+        },
+    )->serialize( { id => 1, a => 'b' } );
+
+    is $serialized->{data}{attributes}{nbr_attrs} => 2;
+};
+
+done_testing();

t/serializer.t

@@ -0,0 +1,22 @@
+use Test2::V0;
+
+use JSON qw/ from_json /;
+use Dancer2::Serializer::JsonApi;
+
+my $serializer =
+  Dancer2::Serializer::JsonApi->new( log_cb => sub { warn @_ } );
+
+my $data = [ 'thing' => { id => 2 } ];
+
+my $serialized = $serializer->serialize($data);
+
+like from_json($serialized),
+  { jsonapi => { version => '1.0' },
+    data    => { id      => 2, type => 'thing' },
+  };
+
+todo 'not implemented yet' => sub {
+    is $serializer->deserialize($serialized) => $data;
+};
+
+done_testing;

t/todos.t

@@ -0,0 +1,9 @@
+use Test2::V0;
+use Test2::Plugin::ExitSummary;
+
+todo 'general list of todos' => sub {
+    fail $_ for 
+        'blocked_attributes';
+};
+
+done_testing;

xt/added-test.t

@@ -0,0 +1,36 @@
+# verifies that at least one test file has been modified
+# (the goal being that one test has been added or altered)
+
+use 5.38.0;
+
+use Test2::V0;
+
+use Git::Wrapper;
+
+my $target_branch = $ENV{TARGET_BRANCH} // 'main';
+
+my $git = Git::Wrapper->new('.');
+
+my $on_target = grep { "* $target_branch" eq $_ } $git->branch;
+
+skip_all "already on target branch" if $on_target;
+
+skip_all "manually disabled" if $ENV{NO_NEW_TEST};
+
+ok test_file_modified( $git->diff($target_branch) ), "added to a test file";
+
+sub test_file_modified (@diff) {
+    my $in_test_file = 0;
+    for (@diff) {
+        if (/^diff/) {
+            $in_test_file = /\.t$/;
+            next;
+        }
+
+        return 1 if $in_test_file and /^\+/;
+    }
+
+    return 0;
+}
+
+done_testing;

xt/perltidy.t

@@ -0,0 +1,25 @@
+use 5.32.0;
+
+use Test2::V0;
+
+use Git::Wrapper;
+use Test::PerlTidy qw( run_tests );
+
+my $target_branch = $ENV{TARGET_BRANCH} // 'main';
+
+my $git = Git::Wrapper->new('.');
+
+my $on_target = grep { "* $target_branch" eq $_ } $git->branch;
+
+if ($on_target) {
+    run_tests();
+}
+else {
+    my @files =
+      $git->diff( { name_only => 1, diff_filter => 'ACMR' }, $target_branch );
+    ok Test::PerlTidy::is_file_tidy($_), $_
+      for grep { /\.(pl|pm|pod|t)$/ } @files;
+
+}
+
+done_testing;

xt/worktree-clean.t

@@ -0,0 +1,12 @@
+use Test2::V0;
+
+use Git::Wrapper;
+
+my $git = Git::Wrapper->new('.');
+
+my $status = $git->status;
+
+# note: 'yath' might create .test_info and lastlog.jsonl files
+ok !$status->is_dirty => "worktree is clean";
+
+done_testing;