json-parser.bas

File libs/json-parser.bas from the latest check-in


#INCLUDE "json.bi"

FUNCTION JSON_IsWhiteSpace (Char AS UINTEGER) AS SHORT
  SELECT CASE Char
    CASE JSON_TOKEN_TAB, JSON_TOKEN_LF, JSON_TOKEN_CR, JSON_TOKEN_SPACE
      JSON_IsWhiteSpace = -1
    CASE ELSE
      JSON_IsWhiteSpace = 0
  END SELECT
END FUNCTION

FUNCTION JSON_IsControl (value AS STRING) AS SHORT
  IF LEFT(value, 1) = CHR(JSON_TOKEN_ESCAPE) THEN
    SELECT CASE LCASE(MID(value, 2, 1))
      CASE CHR(JSON_TOKEN_DOUBLE_QUOTE), _
           CHR(JSON_TOKEN_SLASH), _
           CHR(JSON_TOKEN_ESCAPE), _
           "b", "f", "n", "r", "t", "u"
        JSON_IsControl = -1
      CASE ELSE
        JSON_IsControl = 0
    END SELECT
  ELSE
    JSON_IsControl = 0
  END IF
END FUNCTION

SUB JSON_GetValue (BYREF i AS ULONG, Char AS USHORT, RawContent AS STRING, ValueContent AS STRING = "")
  DIM AS ULONG LastOpen, NextClose, NextComma
  SELECT CASE Char
    CASE JSON_TOKEN_DOUBLE_QUOTE
      LastOpen = i
      DO
        NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
        IF JSON_IsControl(MID(RawContent, NextClose - 1, 2)) THEN
          'Escaped double-quote
          i = NextClose + 1
        ELSE
          EXIT DO
        END IF
      LOOP
      ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
      i = NextClose + 1
    CASE JSON_TOKEN_OBJECT_OPEN
      LastOpen = i
      DO
        NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_OBJECT_CLOSE))
        IF INSTR(MID(RawContent, i + 1, NextClose - i), CHR(JSON_TOKEN_OBJECT_OPEN)) > 0 THEN
          i += NextClose
        ELSE
          EXIT DO
        END IF
      LOOP
      ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
      i = NextClose + 1
    CASE JSON_TOKEN_ARRAY_OPEN
      IF i = 1 THEN
        i += 1
      ELSE
        LastOpen = i
        DO
          NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_ARRAY_CLOSE))
          IF INSTR(MID(RawContent, i + 1, NextClose - i), CHR(JSON_TOKEN_ARRAY_OPEN)) > 0 THEN
            i += NextClose
          ELSE
            EXIT DO
          END IF
        LOOP
        ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
        i = NextClose + 1
      END IF
    CASE ELSE
      IF NOT JSON_IsWhiteSpace(Char) THEN
        LastOpen = i
        WHILE NOT JSON_IsWhiteSpace(ASC(MID(RawContent, i, 1)))
          i += 1
        WEND
        ValueContent = MID(RawContent, LastOpen, i - LastOpen)
        i += 1
      END IF
  END SELECT
END SUB

SUB JSON_ParseArray (ArrayJSON AS JSON_Array, ArrayValues() AS JSON_Value)
  DIM AS ULONG ValueCount, LastPos, NextComma
  DIM ValueContent AS STRING
  FOR i AS ULONG = 1 TO LEN(ArrayJSON.RawContent)
    LastPos = i
    JSON_GetValue(i, ASC(MID(ArrayJSON.RawContent, i, 1)), ArrayJSON.RawContent, ValueContent)
    IF i > LastPos AND ValueContent <> "" THEN
      ValueCount += 1
      WITH ArrayValues(ValueCount - 1)
        .ValueType = JSON_GetType(ValueContent)
        .RawContent = ValueContent
      END WITH
      WHILE JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, i, 1)))
        i += 1
      WEND
      NextComma = INSTR(i, ArrayJSON.RawContent, CHR(JSON_TOKEN_COMMA))
      IF NextComma > 0 THEN
        'To be considered as member separator it must be surrounded by whitespaces
        IF JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma - 1, 1))) AND JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma + 1, 1))) THEN
          i = NextComma + 1
        END IF
      END IF
    END IF
  NEXT
END SUB

SUB JSON_CountValues (ArrayJSON AS JSON_Array)
  DIM AS ULONG LastPos, NextComma
  'Reset value count
  ArrayJSON.ValueCount = 0
  FOR i AS ULONG = 1 TO LEN(ArrayJSON.RawContent)
    LastPos = i
    JSON_GetValue(i, ASC(MID(ArrayJSON.RawContent, i, 1)), ArrayJSON.RawContent)
    IF i > LastPos THEN
      ArrayJSON.ValueCount += 1
      WHILE JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, i, 1)))
        i += 1
      WEND
      NextComma = INSTR(i, ArrayJSON.RawContent, CHR(JSON_TOKEN_COMMA))
      IF NextComma > 0 THEN
        'To be considered as member separator it must be surrounded by whitespaces
        IF JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma - 1, 1))) AND JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma + 1, 1))) THEN
          i = NextComma + 1
        END IF
      END IF
    END IF
  NEXT
END SUB

SUB JSON_ParseObject (oJSON AS JSON_Object, ArrayMembers() AS JSON_Member)
  DIM AS ULONG Char, LastOpen, NextClose, NextColon, NextComma
  DIM ValueContent AS STRING
  'Reset Member Count
  oJSON.MemberCount = 0
  FOR i AS ULONG = 1 TO LEN(oJSON.RawContent)
    Char = ASC(MID(oJSON.RawContent, i, 1))
    IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
      LastOpen = i
      NextClose = INSTR(i + 1, oJSON.RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
      i = NextClose + 1
      NextColon = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COLON))
      IF NextColon > 0 THEN
        oJSON.MemberCount += 1
        ArrayMembers(oJSON.MemberCount - 1).Name = MID(oJSON.RawContent, LastOpen + 1, (NextClose - LastOpen) - 1)
        i = NextColon + 1
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        JSON_GetValue (i, ASC(MID(oJSON.RawContent, i, 1)), oJSON.RawContent, ValueContent)
        WITH ArrayMembers(oJSON.MemberCount - 1).Value
          .ValueType = JSON_GetType(ValueContent)
          .RawContent = ValueContent
        END WITH
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        NextComma = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COMMA))
        IF NextComma > 0 THEN
          'To be considered as member separator it must be surrounded by whitespaces
          IF JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma - 1, 1))) AND JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma + 1, 1))) THEN
            i = NextComma + 1
          END IF
        END IF
      END IF
    END IF
  NEXT
END SUB

SUB JSON_CountMembers (oJSON AS JSON_Object)
  DIM AS ULONG Char, LastOpen, NextClose, NextColon, NextComma
  'Reset Member Count
  oJSON.MemberCount = 0
  FOR i AS ULONG = 1 TO LEN(oJSON.RawContent)
    Char = ASC(MID(oJSON.RawContent, i, 1))
    IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
      LastOpen = i
      NextClose = INSTR(i + 1, oJSON.RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
      i = NextClose + 1
      NextColon = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COLON))
      IF NextColon > 0 THEN
        oJSON.MemberCount += 1
        i = NextColon + 1
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        JSON_GetValue (i, ASC(MID(oJSON.RawContent, i, 1)), oJSON.RawContent)
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        NextComma = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COMMA))
        IF NextComma > 0 THEN
          'To be considered as member separator it must be surrounded by whitespaces
          IF JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma - 1, 1))) AND JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma + 1, 1))) THEN
            i = NextComma + 1
          END IF
        END IF
      END IF
    END IF
  NEXT
END SUB

FUNCTION JSON_ParseString (RawString AS STRING) AS STRING
  DIM Char AS ULONG, EscapedChar AS ULONG, Result AS STRING
  FOR i AS ULONG = 1 TO LEN(RawString)
    Char = ASC(MID(RawString, i, 1))
    IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
      IF i = 1 OR i = LEN(RawString) THEN
        'Do nothing
      END IF
    ELSEIF Char = JSON_TOKEN_ESCAPE THEN
      EscapedChar = ASC(MID(RawString, i + 1, 1))
      SELECT CASE EscapedChar
        CASE JSON_TOKEN_DOUBLE_QUOTE, JSON_TOKEN_SLASH, JSON_TOKEN_ESCAPE
          Result += CHR(EscapedChar)
        CASE ASC("b")
          Result += CHR(08)
        CASE ASC("f")
          Result += CHR(12)
        CASE ASC("n")
          Result += CHR(JSON_TOKEN_LF)
        CASE ASC("r")
          Result += CHR(JSON_TOKEN_CR)
        CASE ASC("t")
          Result += CHR(JSON_TOKEN_TAB)
        CASE ASC("u")
          Result += CHR(VALINT("&H" + MID(RawString, i + 2, 4)))
          i += 4
      END SELECT
      i += 1
    ELSE
      Result += CHR(Char)
    END IF
  NEXT
  JSON_ParseString = Result
  Result = ""
END FUNCTION

FUNCTION JSON_GetType (value AS STRING) AS USHORT
  'Guess the type of the value
  SELECT CASE LCASE(value)
    CASE "null"
      JSON_GetType = JSON_TYPE_NULL
    CASE "true", "false"
      JSON_GetType = JSON_TYPE_BOOLEAN
    CASE ELSE
      DIM AS USHORT OpenChar, CloseChar
      OpenChar = ASC(LEFT(value, 1))
      CloseChar = ASC(RIGHT(value, 1))
      IF OpenChar = JSON_TOKEN_DOUBLE_QUOTE AND CloseChar = JSON_TOKEN_DOUBLE_QUOTE THEN
        JSON_GetType = JSON_TYPE_STRING
      ELSEIF OpenChar = JSON_TOKEN_ARRAY_OPEN AND CloseChar = JSON_TOKEN_ARRAY_CLOSE THEN
        JSON_GetType = JSON_TYPE_ARRAY
      ELSEIF OpenChar = JSON_TOKEN_OBJECT_OPEN AND CloseChar = JSON_TOKEN_OBJECT_CLOSE THEN
        JSON_GetType = JSON_TYPE_OBJECT
      ELSE
        'Fallback to numeric type
        DIM AS SHORT IsDigit, IsNegative, IsFraction, HasExponent, ExponentHasSign
        DIM AS INTEGER Char, EPos, i
        FOR i = 1 TO LEN(value)
          Char = ASC(MID(value, i, 1))
          SELECT CASE Char
            CASE 48 TO 57 'Zero - Onenine
              IsDigit = -1
            CASE 46 '.
              IF IsFraction THEN
                IsDigit = 0
              ELSE
                IsFraction = -1
              END IF
            CASE 69, 101 'E, e
              IF HasExponent THEN
                IsDigit = 0
              ELSE
                HasExponent = -1
                EPos = i
              END IF
            CASE 43, 45 '+, -
              IF ExponentHasSign THEN
                IsDigit = 0
              ELSE
                IF HasExponent AND i = EPos + 1 THEN
                  ExponentHasSign = -1
                ELSE
                  IsDigit = 0
                END IF
              END IF
              IF IsNegative THEN
                IsDigit = 0
              ELSE
                IF i = 1 AND Char = 45 THEN
                  IsNegative = -1
                ELSE
                  IsDigit = 0
                END IF
              END IF
            CASE ELSE
              IsDigit = 0
          END SELECT
        NEXT
        IF IsDigit THEN
          JSON_GetType = JSON_TYPE_NUMERIC
        ELSE
          'All possible types failed, return error
          JSON_GetType = JSON_TYPE_ERROR
        END IF
      END IF
  END SELECT
END FUNCTION