lib/SPVM/JSON.spvm - metacpan.org

# Copyright (c) 2023 Yuki Kimoto
# MIT License

class JSON : precompile {
  version "1.003";
  
  use Hash;
  use List;
  use StringBuffer;
  use Fn;
  use Array;
  use Sort;
  use Math;
  
  # Enumerations
  private enum {
    DECODE_NUM_BEGIN,
    DECODE_NUM_LEADING_DIGIT,
    DECODE_NUM_DOT,
    DECODE_NUM_FRAC,
    DECODE_NUM_EXP,
    DECODE_NUM_EXP_SIGN,
    DECODE_NUM_EXP_DIGIT,
    DECODE_NUM_END,
  }
  
  # Class Methods
  static method new : JSON () {
    my $self = new JSON;
    
    return $self;
  }
  
  # Instance Methods
  method encode : string ($spvm_data : object) {
    my $depth = 0;
    
    my $json_data = $self->_encode_recursive($spvm_data, $depth);
    
    return $json_data;
  }
  
  private method _encode_recursive : string ($spvm_data : object, $depth : int) {
    
    my $json_data : string;
    
    # undef
    if ($spvm_data == undef) {
      $json_data = "null";
    }
    # Hash
    elsif ($spvm_data isa Hash || is_options $spvm_data) {
      
      $spvm_data = Fn->to_hash($spvm_data);
      
      my $buffer = StringBuffer->new;
      $buffer->push_char('{');
      my $hash = (Hash)$spvm_data;
      my $keys = $hash->keys;
      
      # Sort keys
      Sort->sort_string_asc($keys, 0, scalar @$keys);
      
      for (my $keys_index = 0; $keys_index < @$keys; ++$keys_index) {
        if ($keys_index > 0) {
          $buffer->push_char(',');
        }
        $buffer->push_char('"');
        $buffer->push($keys->[$keys_index]);
        $buffer->push_char('"');
        $buffer->push_char(':');
        my $json_data_part = $self->_encode_recursive($hash->get($keys->[$keys_index]), $depth + 1);
        $buffer->push($json_data_part);
      }
      $buffer->push_char('}');
      
      $json_data = $buffer->to_string;
    }
    # List
    elsif ($spvm_data isa List || $spvm_data isa object[]) {
      
      if ($spvm_data isa object[]) {
        $spvm_data = List->new((object[])$spvm_data);
      }
      
      my $buffer = StringBuffer->new;
      $buffer->push_char('[');
      
      my $list = (List)$spvm_data;
      my $length = $list->length;
      for (my $list_index = 0; $list_index < $length; ++$list_index) {
        if ($list_index > 0) {
          $buffer->push_char(',');
        }
        my $json_data_part = $self->_encode_recursive($list->get($list_index), $depth + 1);
        $buffer->push($json_data_part);
      }
      $buffer->push_char(']');
      
      $json_data = $buffer->to_string;
    }
    # string
    elsif ($spvm_data isa string) {
      my $escaped = &_escape_string((string)$spvm_data);
      $json_data = "\"" . $escaped . "\"";
    }
    # Byte
    elsif ($spvm_data isa Byte) {
      $json_data = (string)$spvm_data->(Byte)->value;
    }
    # Short
    elsif ($spvm_data isa Short) {
      $json_data = (string)$spvm_data->(Short)->value;
    }
    # Int
    elsif ($spvm_data isa Int) {
      $json_data = (string)$spvm_data->(Int)->value;
    }
    # Long
    elsif ($spvm_data isa Long) {
      $json_data = (string)$spvm_data->(Long)->value;
    }
    # Float
    elsif ($spvm_data isa Float) {
      my $value = $spvm_data->(Float)->value;
      if (Math->isnanf($value)) {
        die "The \$spvm_data cannot contain a NaN float value. The found depth is $depth.";
      }
      elsif (Math->isinff($value)) {
        die "The \$spvm_data cannot contain an inifinity float value. The found depth is $depth.";
      }
      
      $json_data = (string)$value;
    }
    # Double
    elsif ($spvm_data isa Double) {
      my $value = $spvm_data->(Double)->value;
      if (Math->isnan($value)) {
        die "The \$spvm_data cannot contain a NaN double value. The found depth is $depth.";
      }
      elsif (Math->isinf($value)) {
        die "The \$spvm_data cannot contain an inifinity double value. The found depth is $depth.";
      }
      
      $json_data = (string)$value;
    }
    # Bool
    elsif ($spvm_data isa Bool) {
      if ($spvm_data->(Bool)) {
        $json_data = "true";
      }
      else {
        $json_data = "false";
      }
    }
    else {
      my $type_name = type_name $spvm_data;
      
      die "The \$spvm_data contains a value of an invalid type. The type is $type_name. The found depth is $depth.";
    }
    
    return $json_data;
  }
  
  method decode : object ($json_data : string) {
    my $json_data_index = 0;
    my $spvm_data = $self->_decode_recursive($json_data, \$json_data_index);
    
    # allow $json_data to have trailing spaces.
    $self->_skip_spaces($json_data, \$json_data_index);
    
    # do not allow $json_data to have non-space string after a json object,
    # something like `{"key":1} [1,2]`
    my $length = length $json_data;
    unless ($json_data_index == $length) {
      &_decode_error("The \$json_data can't end with non-space characters", $json_data, $json_data_index);
    }
    
    return $spvm_data;
  }
  
  private method _decode_recursive : object ($json_data : string, $json_data_index : int*) {
    my $json_data_length = length $json_data;
    
    $self->_skip_spaces($json_data, $json_data_index);
    
    if ($$json_data_index == $json_data_length) {
      &_decode_error("Unexpected character \"\"", $json_data, $$json_data_index);
    }
    
    my $char = (int)($json_data->[$$json_data_index]);
    switch ($char) {
      case '{': {
        # objects
        return $self->_decode_hash($json_data, $json_data_index);
      }
      case '[': {
        return $self->_decode_list($json_data, $json_data_index);
      }
      case '"': {
        return $self->_decode_string($json_data, $json_data_index);
      }
      case '-':
      case '0': case '1': case '2': case '3': case '4':
      case '5': case '6': case '7': case '8': case '9': {
        return $self->_decode_num($json_data, $json_data_index);
      }
      case 't': {
        return $self->_decode_true($json_data, $json_data_index);
      }
      case 'f': {
        return $self->_decode_false($json_data, $json_data_index);
      }
      case 'n': {
        &_expect_token($json_data, $json_data_index, "null");
        return undef;
      }
      default: {
        &_decode_error("Unexpected character \"" . Fn->chr($char) . "\"", $json_data, $$json_data_index);
      }
    }
  }
  
  private static method _decode_error : void ($message : string, $json_data : string, $pos : int) {
    
    my $json_data_from_pos = Fn->substr($json_data, 0, $pos);
    
    my $lines = (string[])undef;
    if ($json_data eq "") {
      $lines = [$json_data];
    }
    else {
      $lines = Fn->split("\n", $json_data);
    }
    my $lines_length = @$lines;
    
    my $last_line = (mutable string)copy $lines->[$lines_length - 1];
    if (length $last_line > 0 && $last_line->[length $last_line - 1] == '\r') {
      Fn->shorten($last_line, length $last_line - 1);
    }
    my $last_new_line_pos = Fn->rindex($json_data, "\n", $pos);
    
    my $last_line_pos = 0;
    if ($last_new_line_pos >= 0) {
      $last_line_pos = $pos - $last_new_line_pos - 1;
    }
    else {
      $last_line_pos = $pos;
    }
    my $last_line_pos_disp = $last_line_pos + 1;
    
    my $line = $lines_length;
    
    die "The decoding of the \$json_data failed. $message at line $line column $last_line_pos_disp.";
  }
  
  private method _skip_spaces : void ($json_data : string, $json_data_index : int*) {
    my $json_data_length = length $json_data;
    for (; 1 ; ++$$json_data_index) {
      if ($$json_data_index == $json_data_length) {
        return;
      }
      unless ($json_data->[$$json_data_index] == ' ' || $json_data->[$$json_data_index] == '\n' || $json_data->[$$json_data_index] == '\t' || $json_data->[$$json_data_index] == '\r') {
        last;
      }
    }
  }
  
  private static method _expect_char : void ($json_data : string, $json_data_index : int*, $expected : byte) {
    my $json_data_length = length $json_data;
    unless ($$json_data_index + 1 <= $json_data_length && $json_data->[$$json_data_index] == $expected) {
      &_decode_error("Expected character: \"" . Fn->chr($expected) . "\"", $json_data, $$json_data_index);
    }
    ++$$json_data_index;
  }
  
  private static method _expect_token : void ($json_data : string, $json_data_index : int*, $expected : string) {
    my $json_data_length = length $json_data;
    my $length = length $expected;
    unless ($$json_data_index + $length <= $json_data_length) {
      &_decode_error("Expected token: \"$expected\"", $json_data, $$json_data_index);
    }
    my $got = Fn->substr($json_data, $$json_data_index, $length);
    if ($got eq $expected) {
      $$json_data_index += $length;
    }
    else {
      &_decode_error("Expected token: \"$expected\"", $json_data, $$json_data_index);
    }
  }
  
  private method _decode_string : string ($json_data : string, $json_data_index : int*) {
    my $json_data_length = length $json_data;
    my $buffer = StringBuffer->new;

    &_expect_char($json_data, $json_data_index, '"');

    my $special_char_expected = 0;
    while (1) {
      if ($$json_data_index >= $json_data_length || (!$special_char_expected && $json_data->[$$json_data_index] == '"')) {
        last;
      }
      my $char = $json_data->[$$json_data_index];
      if ($special_char_expected) {
        switch ((int)$char) {
          case '"':
          case '\\':
          case '/': {
            $buffer->push_char($char);
            break;
          }
          case 'b': {
            $buffer->push_char('\x08');
            break;
          }
          case 'f': {
            $buffer->push_char('\f');
            break;
          }
          case 'n': {
            $buffer->push_char('\n');
            break;
          }
          case 'r': {
            $buffer->push_char('\r');
            break;
          }
          case 't': {
            $buffer->push_char('\t');
            break;
          }
          default: {
            &_decode_error("Invalid string", $json_data, $$json_data_index);
          }
        }
        $special_char_expected = 0;
      }
      elsif ($char == '\\') {
        $special_char_expected = 1;
      }
      else {
        if ($char <= 31 || $char == 127) {
          &_decode_error("Invalid string", $json_data, $$json_data_index);
        }
        $buffer->push_char($char);
      }
      ++$$json_data_index;
    }
    if ($$json_data_index == $json_data_length) {
      &_decode_error("Invalid string", $json_data, $$json_data_index);
    }

    &_expect_char($json_data, $json_data_index, '\"');

    return (string)$buffer->to_string;
  }

  private method _decode_num : object ($json_data : string, $json_data_index : int*) {
    my $json_data_length = length $json_data;

    my $json_data_index_decode_begin = $$json_data_index;

    # validate number
    my $state = &DECODE_NUM_BEGIN();

    if ($json_data->[$$json_data_index] == '-') {
      unless ($$json_data_index + 1 < $json_data_length && Fn->is_digit($json_data->[$$json_data_index + 1])) {
        &_decode_error("Invalid number", $json_data, $$json_data_index);
      }
      $$json_data_index += 2;
    }
    elsif (!Fn->is_digit($json_data->[$$json_data_index])) {
      &_decode_error("Invalid number", $json_data, $$json_data_index);
    }

    $state = &DECODE_NUM_LEADING_DIGIT();

    while ($state != &DECODE_NUM_END()) {
      my $ch = (int) $json_data->[$$json_data_index];

      switch($ch) {
        case '.': {
          unless ($state == &DECODE_NUM_LEADING_DIGIT()) {
            &_decode_error("Invalid number", $json_data, $$json_data_index);
          }
          $state = &DECODE_NUM_DOT();
          break;
        }
        case 'e': {
          switch ($state) {
            case &DECODE_NUM_DOT():
            case &DECODE_NUM_EXP():
            case &DECODE_NUM_EXP_SIGN():
            case &DECODE_NUM_EXP_DIGIT(): {
              &_decode_error("Invalid number", $json_data, $$json_data_index);
              break;
            }
            default: {
              $state = &DECODE_NUM_EXP();
            }
          }
          break;
        }
        default: {
          switch ($state) {
            case &DECODE_NUM_DOT(): {
              unless (Fn->is_digit($ch)) {
                &_decode_error("Invalid number", $json_data, $$json_data_index);
              }
              $state = &DECODE_NUM_FRAC();
              break;
            }
            case &DECODE_NUM_EXP(): {
              if ($ch == '+' || $ch == '-') {
                $state = &DECODE_NUM_EXP_SIGN();
              }
              elsif (Fn->is_digit($ch)) {
                $state = &DECODE_NUM_EXP_DIGIT();
              }
              else {
                &_decode_error("Invalid number", $json_data, $$json_data_index);
              }
              break;
            }
            case &DECODE_NUM_EXP_SIGN(): {
              unless (Fn->is_digit($ch)) {
                &_decode_error("Invalid number", $json_data, $$json_data_index);
              }
              $state = &DECODE_NUM_EXP_DIGIT();
              break;
            }
            default: {
              unless (Fn->is_digit($ch)) {
                $state = &DECODE_NUM_END();
              }
              break;
            }
          }
          break;
        }
      }

      if ($state == &DECODE_NUM_END()) {
        last;
      }

      ++$$json_data_index;

      if ($json_data_length <= $$json_data_index) {
        unless ($state == &DECODE_NUM_LEADING_DIGIT() ||
                $state == &DECODE_NUM_FRAC() ||
                $state == &DECODE_NUM_EXP_DIGIT()) {
          &_decode_error("Invalid number", $json_data, $$json_data_index);
        }
        $state = &DECODE_NUM_END();
      }
    }

    my $json_data_index_decode_end = $$json_data_index;

    # decode number by Fn->to_double
    my $decode_length = $json_data_index_decode_end - $json_data_index_decode_begin;
    my $decode_string = Fn->substr($json_data, $json_data_index_decode_begin, $decode_length);
    my $result_number = Fn->to_double($decode_string);

    return Double->new($result_number);
  }

  private method _decode_true : Bool ($json_data : string, $json_data_index : int*) {
    &_expect_token($json_data, $json_data_index, "true");
    return true;
  }

  private method _decode_false : Bool ($json_data : string, $json_data_index : int*) {
    &_expect_token($json_data, $json_data_index, "false");
    return false;
  }

  private method _decode_hash : Hash ($json_data : string, $json_data_index : int*) {
    my $json_data_length = length $json_data;
    my $hash = Hash->new({});
    my $has_element = 0;

    &_expect_char($json_data, $json_data_index, '{');

    while (1) {
      $self->_skip_spaces($json_data, $json_data_index);
      if ($$json_data_index == $json_data_length) {
        &_decode_error("Unexpected character \"\"", $json_data, $$json_data_index);
      }

      # end of hash
      if ($json_data->[$$json_data_index] == '}') {
        last;
      }

      # comma
      if ($has_element) {
        &_expect_char($json_data, $json_data_index, ',');
        $self->_skip_spaces($json_data, $json_data_index);
      }
      else {
        $has_element = 1;
      }

      # key
      my $key = $self->_decode_string($json_data, $json_data_index);

      # separator
      $self->_skip_spaces($json_data, $json_data_index);
      &_expect_char($json_data, $json_data_index, ':');

      # value
      my $value = $self->_decode_recursive($json_data, $json_data_index);
      $hash->set($key, $value);
    }

    &_expect_char($json_data, $json_data_index, '}');

    return $hash;
  }

  private method _decode_list : object[] ($json_data : string, $json_data_index : int*) {
    my $json_data_length = length $json_data;
    my $list = List->new([]);
    my $has_element = 0;

    &_expect_char($json_data, $json_data_index, '[');

    while (1) {
      $self->_skip_spaces($json_data, $json_data_index);
      if ($$json_data_index == $json_data_length) {
        &_decode_error("Unexpected character \"\"", $json_data, $$json_data_index);
      }

      # end of list
      if ($json_data->[$$json_data_index] == ']') {
        last;
      }

      # comma
      if ($has_element) {
        &_expect_char($json_data, $json_data_index, ',');
      }
      else {
        $has_element = 1;
      }
      $list->push($self->_decode_recursive($json_data, $json_data_index));
    }

    &_expect_char($json_data, $json_data_index, ']');

    return $list->get_array;
  }

  private static method _escape_string : string ($string : string) {
    my $length = length $string;
    my $buffer = StringBuffer->new;
    for (my $i = 0; $i < $length; ++$i) {
      my $char = $string->[$i];
      my $special : byte = -1;
      switch ((int)$char) {
        case '"': {
          $special = '"';
          break;
        }
        case '\\': {
          $special = '\\';
          break;
        }
        case '/': {
          $special = '/';
          break;
        }
        case '\x08': {
          $special = 'b';
          break;
        }
        case '\f': {
          $special = 'f';
          break;
        }
        case '\n': {
          $special = 'n';
          break;
        }
        case '\r': {
          $special = 'r';
          break;
        }
        case '\t': {
          # Note: Decoded char from literal ASCII tab will be encoded with "\\t" (non-reversible).
          $special = 't';
          break;
        }
      }
      if ($special == -1) {
        $buffer->push_char($char);
      }
      else {
        $buffer->push_char('\\');
        $buffer->push_char($special);
      }
    }
    return $buffer->to_string;
  }
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)