A Parse::RecDescent implementation of JSONY

MyJSONY.pm

use 5.12.0;

package MyJSONY;

use Parse::RecDescent;

use JSON qw/ to_json from_json /;
use Scalar::Util qw/ looks_like_number /;


$::RD_AUTOSTUB = 1;
$::RD_TRACE = 0;

# skip comments too
$Parse::RecDescent::skip = qr/ ( , | \s+ | \# .*?$ )* /xms;

my $parser = Parse::RecDescent->new( <<'END' );

top_level: ( hash | array )
    { $return = $item[1] }

hash: explicit_hash | implicit_hash

explicit_hash: '{' kv_pair(s) '}' { $return = { map { @$_ } @{ $item[2] } } }

implicit_hash: kv_pair_strict(s)  { $return = { map { @$_ } @{ $item[1] } } }

kv_pair: word colon(?) value { [ $item[1] => $item[3] ] }

kv_pair_strict: word colon value { [ $item[1] => $item[3] ] }

array: explicit_array | yaml_array | implicit_array

yaml_array: yaml_array_entry(s)

yaml_array_entry: '-' value(s)

explicit_array: '[' implicit_array ']' { $item[2] }

implicit_array: value(s)

value: ( explicit_array | explicit_hash | word )

word: ( bare_word | quoted_word ) comma(?) { $item[1] }

bare_word: /\w+/ { Scalar::Util::looks_like_number($item[1]) ? $item[1] + 0 : $item[1] }

quoted_word: <rulevar: $quote >
quoted_word: /["']/ { $quote = $item[1] } /.*?[^\\](?=$quote)/ "$item[1]" { $item[3] }

comma: ','

colon: ':'

END

sub jsony_to_struct {
    return  $parser->top_level(shift);
}

sub jsony_to_json {
    return  to_json( jsony_to_struct( shift) , { pretty => 1, canonical => 1 } )
}


my @tests = (
    'foo bar baz' => [ "foo", "bar", "baz" ],
    'foo, bar, baz' => [ "foo", "bar", "baz" ],
    '"stuff with space" baz' => [ 'stuff with space', 'baz' ],
    '"stuff with \"space\"" baz' => [ 'stuff with \"space\"', 'baz' ],
    "'stuff with \\'space\\'' baz" => [ "stuff with \\'space\\'", 'baz' ],
    '1 2 three' => [ 1, 2, "three" ],
    '{ a b c d }' => { a => 'b', c => 'd' },
    '{ a, b, c, d }' => { a => 'b', c => 'd' },
    '{ a: b, c: d }' => { a => 'b', c => 'd' },
    '{ a: b }' => { a => 'b' },
    ' a: b ' => { a => 'b' },
    'a [ 1 2 ]' => [ a => [1,2] ],
    'a [ 1 [2] ]' => [ a => [1,[2]] ],
    'a: { b: c }' => { a =>  {b => 'c'} },
    "a # some comments\n#and more\nb" => [ 'a', 'b' ],
    "- one two\n- 3 4\n 5" => [ [ qw/ one two / ], [3,4,5] ],
);

use Test::More;

while( my( $in, $out ) = splice @tests, 0, 2 ) {
    subtest $in => sub {
        my $struct = jsony_to_struct($in);

        is_deeply $struct => $out, $in or diag explain $struct;

        return if $in =~ /\\/;  # escaping is not re-entrant for now

        is_deeply jsony_to_struct( to_json($struct) ) => $struct, "re-entrant"
            or diag explain $struct;
    };
}

unlike jsony_to_json( "1" ), qr/"/, "not quoted numbers";


done_testing;