1. my class JSONException is Exception {
  2. has $.text;
  3. method message {
  4. 'Invalid JSON: ' ~ $!text
  5. }
  6. }
  7. my class Rakudo::Internals::JSON {
  8. my class JSONPrettyActions {
  9. method TOP($/) {
  10. make $/.values.[0].ast;
  11. };
  12. method object($/) {
  13. make $<pairlist>.ast.hash.item;
  14. }
  15. method pairlist($/) {
  16. make $<pair>>>.ast.flat;
  17. }
  18. method pair($/) {
  19. make $<string>.ast => $<value>.ast;
  20. }
  21. method array($/) {
  22. make $<arraylist>.ast.item;
  23. }
  24. method arraylist($/) {
  25. make [$<value>.map(*.made)];
  26. }
  27. method string($/) {
  28. make $0.elems == 1
  29. ?? ($0[0].<str> || $0[0].<str_escape>).ast
  30. !! join '', $0.list.map({ (.<str> || .<str_escape>).ast });
  31. }
  32. method value:sym<number>($/) { make +$/.Str }
  33. method value:sym<string>($/) { make $<string>.ast }
  34. method value:sym<true>($/) { make Bool::True }
  35. method value:sym<false>($/) { make Bool::False }
  36. method value:sym<null>($/) { make Any }
  37. method value:sym<object>($/) { make $<object>.ast }
  38. method value:sym<array>($/) { make $<array>.ast }
  39. method str($/) { make ~$/ }
  40. my $escapes := nqp::hash(
  41. '\\' , "\\",
  42. '/' , "/",
  43. 'b' , "\b",
  44. 'n' , "\x0A",
  45. 't' , "\t",
  46. 'f' , "\f",
  47. 'r' , "\r",
  48. '"' , "\"",
  49. );
  50. method str_escape($/) {
  51. make $<xdigit> ?? chr(:16($<xdigit>.join)) !! nqp::atkey($escapes,~$/)
  52. }
  53. }
  54. my grammar JSONPrettyGrammar {
  55. token TOP { ^ \s* [ <object> | <array> ] \s* $ }
  56. rule object { '{' ~ '}' <pairlist> }
  57. rule pairlist { <pair> * % \, }
  58. rule pair { <string> ':' <value> }
  59. rule array { '[' ~ ']' <arraylist> }
  60. rule arraylist { <value> * % [ \, ] }
  61. proto token value {*};
  62. token value:sym<number> {
  63. '-'?
  64. [ 0 | <[1..9]> <[0..9]>* ]
  65. [ \. <[0..9]>+ ]?
  66. [ <[eE]> [\+|\-]? <[0..9]>+ ]?
  67. }
  68. token value:sym<true> { <sym> };
  69. token value:sym<false> { <sym> };
  70. token value:sym<null> { <sym> };
  71. token value:sym<object> { <object> };
  72. token value:sym<array> { <array> };
  73. token value:sym<string> { <string> }
  74. token string {
  75. \" ~ \" ( <str> | \\ <str_escape> )*
  76. }
  77. token str {
  78. <-["\\\t\n]>+
  79. }
  80. token str_escape {
  81. <["\\/bfnrt]> | u <xdigit>**4
  82. }
  83. }
  84. proto sub to-json(|) {*}
  85. multi sub to-json(Version:D $v, :$indent = 0, :$first = 0) { to-json(~$v, :$indent, :$first) }
  86. multi sub to-json(Real:D $d, :$indent = 0, :$first = 0) { (' ' x $first) ~ ~$d }
  87. multi sub to-json(Bool:D $d, :$indent = 0, :$first = 0) { (' ' x $first) ~ ($d ?? 'true' !! 'false') }
  88. multi sub to-json(Str:D $d, :$indent = 0, :$first = 0) {
  89. (' ' x $first) ~ '"'
  90. ~ $d.trans(['"', '\\', "\b", "\f", "\x0A", "\r", "\t", "\r\n"]
  91. => ['\"', '\\\\', '\b', '\f', '\n', '\r', '\t', '\r\n'])\
  92. .subst(/<-[\c32..\c126]>/, { ord(~$_).fmt('\u%04x') }, :g)
  93. ~ '"'
  94. }
  95. multi sub to-json(Positional:D $d, :$indent = 0, :$first = 0) {
  96. (' ' x $first) ~ "\["
  97. ~ ($d ?? $d.map({ "\n" ~ to-json($_, :indent($indent + 2), :first($indent + 2)) }).join(",") ~ "\n" ~ (' ' x $indent) !! ' ')
  98. ~ ']';
  99. }
  100. multi sub to-json(Associative:D $d, :$indent = 0, :$first = 0) {
  101. (' ' x $first) ~ "\{"
  102. ~ ($d ?? $d.map({ "\n" ~ to-json(.key, :first($indent + 2)) ~ ' : ' ~ to-json(.value, :indent($indent + 2)) }).join(",") ~ "\n" ~ (' ' x $indent) !! ' ')
  103. ~ '}';
  104. }
  105. multi sub to-json(Mu:U $, :$indent = 0, :$first = 0) { 'null' }
  106. multi sub to-json(Mu:D $s, :$indent = 0, :$first = 0) {
  107. die "Can't serialize an object of type " ~ $s.WHAT.perl
  108. }
  109. method from-json($text) {
  110. my $a = JSONPrettyActions.new();
  111. my $o = JSONPrettyGrammar.parse($text, :actions($a));
  112. JSONException.new(:$text).throw unless $o;
  113. $o.ast;
  114. }
  115. method to-json(|c) { to-json(|c) }
  116. }