package Data::Sah::From::JSONSchema;

our $DATE = '2015-05-27'; # DATE
our $VERSION = '0.01'; # VERSION

use 5.010001;
use strict;
use warnings;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(
                       convert_json_schema_to_sah
               );

sub _clauses_common {
    my ($jsonsch, $sahsch) = @_;
    if (exists $jsonsch->{title}) {
        $sahsch->[1]{summary} = $jsonsch->{title};
    }
    if (exists $jsonsch->{description}) {
        $sahsch->[1]{description} = $jsonsch->{description};
    }
    if (exists $jsonsch->{default}) {
        $sahsch->[1]{default} = $jsonsch->{default};
    }
    # XXX enum/oneOf (which can be specified without 'type')
}

sub _convert_null {
    my $jsonsch = shift;
    my $sahsch = ["undef"];
    _clauses_common($jsonsch, $sahsch);
    $sahsch;
}

sub _clauses_num {
    my ($jsonsch, $sahsch) = @_;
    if (exists $jsonsch->{minimum}) {
        $sahsch->[1]{min} = $jsonsch->{minimum};
    }
    if (exists $jsonsch->{maximum}) {
        $sahsch->[1]{max} = $jsonsch->{maximum};
    }
    if (exists $jsonsch->{exclusiveMinimum}) {
        $sahsch->[1]{xmin} = $jsonsch->{exclusiveMinimum};
    }
    if (exists $jsonsch->{exclusiveMaximum}) {
        $sahsch->[1]{xmax} = $jsonsch->{exclusiveMaximum};
    }
    # XXX in sah, div_by is int only, not num
    if (exists $jsonsch->{multipleOf}) {
        $sahsch->[1]{div_by} = $jsonsch->{multipleOf};
    }
}

sub _convert_number {
    my $jsonsch = shift;
    my $sahsch = ["num", {req=>1}];
    _clauses_common($jsonsch, $sahsch);
    _clauses_num($jsonsch, $sahsch);
    $sahsch;
}

sub _convert_integer {
    my $jsonsch = shift;
    my $sahsch = ["int", {req=>1}];
    _clauses_common($jsonsch, $sahsch);
    _clauses_num($jsonsch, $sahsch);
    $sahsch;
}

sub _convert_boolean {
    my $jsonsch = shift;
    my $sahsch = ["bool", {req=>1}];
    _clauses_common($jsonsch, $sahsch);
    $sahsch;
}

sub _convert_string {
    my $jsonsch = shift;
    my $sahsch = ["str", {req=>1}];
    if (exists $jsonsch->{pattern}) {
        $sahsch->[1]{match} = $jsonsch->{pattern};
    }
    if (exists $jsonsch->{minLength}) {
        $sahsch->[1]{min_len} = $jsonsch->{minLength};
    }
    if (exists $jsonsch->{maxLength}) {
        $sahsch->[1]{max_len} = $jsonsch->{maxLength};
    }
    # XXX format, and builtin formats: date-time (RFC3339 section 5.6), email, hostname, ipv4, ipv6, uri
    $sahsch;
}

sub _convert_array {
    my $jsonsch = shift;
    my $sahsch = ["array", {req=>1}];
    if (exists($jsonsch->{minItems})) {
        $sahsch->[1]{min_len} = $jsonsch->{minItems};
    }
    if (exists($jsonsch->{maxItems})) {
        $sahsch->[1]{max_len} = $jsonsch->{maxItems};
    }
    if (exists($jsonsch->{items})) {
        if (ref($jsonsch->{items}) eq 'ARRAY') {
            $sahsch->[1]{elems} = [];
            my $i = 0;
            for my $el (@{ $jsonsch->{items} }) {
                $sahsch->[1]{elems}[$i] = _convert($el);
                $i++;
            }
            if (exists($jsonsch->{additionalItems}) && !$jsonsch->{additionalItems}) {
                $sahsch->[1]{max_len} = $i;
            }
        } else {
            $sahsch->[1]{of} = _convert($jsonsch->{items});
        }
    }
    # XXX uniqueItems
    $sahsch;
}

sub _convert_object {
    my $jsonsch = shift;
    my $sahsch = ["hash", {req=>1, 'keys.restrict'=>0}];
    if (exists($jsonsch->{minProperties})) {
        $sahsch->[1]{min_len} = $jsonsch->{minProperties};
    }
    if (exists($jsonsch->{maxProperties})) {
        $sahsch->[1]{max_len} = $jsonsch->{maxProperties};
    }
    if (exists $jsonsch->{properties}) {
        $sahsch->[1]{keys} = {};
        for my $k (keys %{ $jsonsch->{properties} }) {
            my $v = $jsonsch->{properties}{$k};
            $sahsch->[1]{keys}{$k} = _convert($v);
        }
    }
    if (exists($jsonsch->{additionalProperties}) && !$jsonsch->{additionalProperties}) {
        $sahsch->[1]{'keys.restrict'} = 1;
    }
    if (exists $jsonsch->{required}) {
        $sahsch->[1]{req_keys} = $jsonsch->{required};
    }
    if (exists $jsonsch->{dependencies}) {
        for my $k (keys %{ $jsonsch->{dependencies} }) {
            my $v = $jsonsch->{dependencies}{$k};
            if (ref($v) eq 'HASH') {
                # XXX schema dependencies
                die "Schema dependencies is not yet supported";
            } else {
                $sahsch->[1]{'req_dep_all&'} //= [];
                for my $d (@$v) {
                    push @{ $sahsch->[1]{'req_dep_all&'} }, [$d, [$k]];
                }
            }
        }
    }
    if (exists $jsonsch->{patternProperties}) {
        $sahsch->[1]{allowed_keys_re} = $jsonsch->{patternProperties};
    }
    $sahsch;
}

sub _convert {
    my $jsonsch = shift;

    ref($jsonsch) eq 'HASH' or die "JSON schema must be a hash";
    my $type = $jsonsch->{type} or die "JSON schema must have a type";
    # XXX type can be an array, e.g. [number, string] which means any one of those
    # XXX $ref instead of type
    # XXX format can be specified without type, implies string
    # XXX enum/oneOf (which can be specified without 'type')
    if ($type eq 'object') {
        _convert_object($jsonsch);
    } elsif ($type eq 'array') {
        _convert_array($jsonsch);
    } elsif ($type eq 'string') {
        _convert_string($jsonsch);
    } elsif ($type eq 'boolean') {
        _convert_boolean($jsonsch);
    } elsif ($type eq 'integer') {
        _convert_integer($jsonsch);
    } elsif ($type eq 'number') {
        _convert_number($jsonsch);
    } elsif ($type eq 'null') {
        _convert_null($jsonsch);
    } else {
        die "Unknown type '$type'";
    }
}

sub convert_json_schema_to_sah {
    _convert(@_);
}

1;
# ABSTRACT: Convert JSON schema to Sah schema

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::Sah::From::JSONSchema - Convert JSON schema to Sah schema

=head1 VERSION

This document describes version 0.01 of Data::Sah::From::JSONSchema (from Perl distribution Data-Sah-From-JSONSchema), released on 2015-05-27.

=head1 SYNOPSIS

 use Data::Sah::From::JSONSchema qw(convert_json_schema_to_sah);

 my $jsonsch = {
     description => "a representation of a person, company, organization, or place",
     type => "object",
     required => [qw/familyName givenName/],
     properties => {
         fn => {
             description => "formatted name",
             type => "string",
         },
         familyName => {type => "string"},
         givenName => {type => "string"},
     },
 };
 my $sahsch = convert_json_schema_to_sah($jsonsch);

 # $sahsch will contain something like:
 # [hash => {
 #     description => "a representation of a person, company, organization, or place",
 #     req_keys => ['familyName', 'givenName'],
 #     keys => {
 #         fn => [str => {
 #             description => "formatted name",
 #             req => 1,
 #         }],
 #         familyName => ['str', {req=>1}],
 #         givenName => ['str', {req=>1}],
 #     },
 # }]

=head1 DESCRIPTION

B<EARLY DEVELOPMENT, EXPERIMENTAL.>

Some features are not yet supported: $ref, $schema, id, array's uniqueItems, and
so on.

=head1 FUNCTIONS

=head2 convert_json_schema_to_sah($jsonsch) => ARRAY

Convert JSON schema in C<$jsonsch> (which must be a hash), to a L<Sah> schema.
Dies on failure.

=head1 SEE ALSO

http://json-schema.org/

L<Sah>, L<Data::Sah>

Implementation of JSON Schema in Perl: L<JSON::Schema>

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-From-JSONSchema>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Data-Sah-From-JSONSchema>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-From-JSONSchema>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
