json-generator.bas

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


#INCLUDE "json.bi"

FUNCTION JSON_GenerateObject(ArrayMembers() AS JSON_member) AS STRING
  DIM Result AS STRING, Count AS LONG = UBOUND(ArrayMembers)
  Result = CHR(JSON_TOKEN_OBJECT_OPEN) + CHR(JSON_TOKEN_LF)
  IF Count >= 0 THEN
    FOR i AS ULONG = 0 TO Count
      IF ArrayMembers(i).Name <> "" THEN
        'Add a 2 space indentation
        Result += CHR(JSON_TOKEN_SPACE) + CHR(JSON_TOKEN_SPACE)
        'Add the opening double quote
        Result += CHR(JSON_TOKEN_DOUBLE_QUOTE)
        'Place the name
        Result += ArrayMembers(i).Name
        'Add the closing double quote
        Result += CHR(JSON_TOKEN_DOUBLE_QUOTE)
        'Place the colon surounded by whitespaces
        Result += CHR(JSON_TOKEN_SPACE) + CHR(JSON_TOKEN_COLON) + CHR(JSON_TOKEN_SPACE)
        IF ArrayMembers(i).Value.ValueType <> JSON_TYPE_ERROR THEN
          'We want to only add valid JSON values
          Result += ArrayMembers(i).Value.RawContent
        ELSE
          'Instead of adding an erroneus value just place a null
          Result += "null"
        END IF
        IF i < UBOUND(ArrayMembers) THEN
          'Add a mmember separator except for the last one
          Result += CHR(JSON_TOKEN_SPACE) + CHR(JSON_TOKEN_COMMA)
        END IF
        'Add a final newline
        Result += CHR(JSON_TOKEN_LF)
      ELSE
        'Empty member name?, fail gracefully
        EXIT FOR
      END IF
    NEXT
  END IF
  Result += CHR(JSON_TOKEN_OBJECT_CLOSE)
  JSON_GenerateObject = Result
  Result = ""
END FUNCTION

FUNCTION JSON_GenerateArray (ArrayValues() AS JSON_Value) AS STRING
  DIM Result AS STRING, Count AS LONG = UBOUND(ArrayValues)
  Result = CHR(JSON_TOKEN_ARRAY_OPEN) + CHR(JSON_TOKEN_LF)
  IF Count >= 0 THEN
    FOR i AS ULONG = 0 TO Count
      'Add a 2 space indentation
      Result += CHR(JSON_TOKEN_SPACE) + CHR(JSON_TOKEN_SPACE)
      IF ArrayValues(i).ValueType <> JSON_TYPE_ERROR THEN
        'We want to only add valid JSON values
        Result += ArrayValues(i).RawContent
      ELSE
        'Instead of adding an erroneus value just place a null
        Result += "null"
      END IF
      IF i < UBOUND(ArrayValues) THEN
        'Add a value separator except for the last one
        Result += CHR(JSON_TOKEN_SPACE) + CHR(JSON_TOKEN_COMMA)
      END IF
      'Add a final newline
      Result += CHR(JSON_TOKEN_LF)
    NEXT
  END IF
  Result += CHR(JSON_TOKEN_ARRAY_CLOSE)
  JSON_GenerateArray = Result
  Result = ""
END FUNCTION

FUNCTION JSON_GenerateString (Content AS STRING) AS STRING
  DIM Result AS STRING, Char AS ULONG
  'Add opening double quote
  Result = CHR(JSON_TOKEN_DOUBLE_QUOTE)
  FOR i AS ULONG = 1 TO LEN(Content)
    Char = ASC(MID(Content, i, 1))
    SELECT CASE Char
      CASE JSON_TOKEN_TAB
        Result += CHR(JSON_TOKEN_ESCAPE) + "t"
      CASE JSON_TOKEN_LF
        Result += CHR(JSON_TOKEN_ESCAPE) + "n"
      CASE JSON_TOKEN_CR
        Result += CHR(JSON_TOKEN_ESCAPE) + "r"
      CASE JSON_TOKEN_DOUBLE_QUOTE
        Result += CHR(JSON_TOKEN_ESCAPE) + CHR(JSON_TOKEN_DOUBLE_QUOTE)
      CASE JSON_TOKEN_ESCAPE
        Result += CHR(JSON_TOKEN_ESCAPE) + "u005c"
      CASE JSON_TOKEN_SLASH
        Result += CHR(JSON_TOKEN_ESCAPE) + CHR(JSON_TOKEN_SLASH)
      CASE JSON_TOKEN_ARRAY_OPEN
        Result += CHR(JSON_TOKEN_ESCAPE) + "u005b"
      CASE JSON_TOKEN_ARRAY_CLOSE
        Result += CHR(JSON_TOKEN_ESCAPE) + "u005d"
      CASE JSON_TOKEN_OBJECT_OPEN
        Result += CHR(JSON_TOKEN_ESCAPE) + "u007b"
      CASE JSON_TOKEN_OBJECT_CLOSE
        Result += CHR(JSON_TOKEN_ESCAPE) + "u007d"
      CASE ELSE
        Result += CHR(Char)
    END SELECT
  NEXT
  Result += CHR(JSON_TOKEN_DOUBLE_QUOTE)
  JSON_GenerateString = Result
  Result = ""
END FUNCTION

SUB JSON_AddValue(ArrayValues AS JSON_Array, NewValue AS JSON_Value, ValueIndex AS ULONG = 0)
  IF ArrayValues.ValueCount >= 0 THEN
    DIM AS JSON_Value OldArrayValues(ArrayValues.ValueCount - 1), NewArrayValues(ArrayValues.ValueCount)
    JSON_ParseArray(ArrayValues, OldArrayValues())
    FOR CurPos AS ULONG = 0 TO ArrayValues.ValueCount
      IF CurPos = ValueIndex THEN
        NewArrayValues(CurPos) = NewValue
      ELSE
        IF CurPos > ValueIndex THEN
          NewArrayValues(CurPos) = OldArrayValues(CurPos - 1)
        ELSE
          NewArrayValues(CurPos) = OldArrayValues(CurPos)
        END IF
      END IF
    NEXT
    ERASE OldArrayValues
    ArrayValues.RawContent = JSON_GenerateArray(NewArrayValues())
    ERASE NewArrayValues
    ArrayValues.ValueCount += 1
  END IF
END SUB

SUB JSON_UpdateValue(ArrayValues AS JSON_Array, NewValue AS JSON_Value, ValueIndex AS ULONG)
  IF ArrayValues.ValueCount > 0 THEN
    DIM ValuesArray(ArrayValues.ValueCount - 1) AS JSON_Value
    JSON_ParseArray(ArrayValues, ValuesArray())
    FOR CurPos AS ULONG = 0 TO ArrayValues.ValueCount - 1
      IF CurPos = ValueIndex THEN
        ValuesArray(CurPos) = NewValue
        EXIT FOR
      END IF
    NEXT
    ArrayValues.RawContent = JSON_GenerateArray(ValuesArray())
    ERASE ValuesArray
  END IF
END SUB

SUB JSON_DeleteValue(ArrayValues AS JSON_Array, ValueIndex AS ULONG)
  IF ArrayValues.ValueCount > 0 THEN
    DIM AS JSON_Value OldArrayValues(ArrayValues.ValueCount - 1), NewArrayValues(ArrayValues.ValueCount - 2)
    DIM IsDeleted AS LONG
    JSON_ParseArray(ArrayValues, OldArrayValues())
    FOR CurPos AS ULONG = 0 TO ArrayValues.ValueCount
      IF CurPos = ValueIndex THEN
        IsDeleted = -1
        CurPos += 1
      ELSE
        IF IsDeleted THEN
          NewArrayValues(CurPos - 2) = OldArrayValues(CurPos - 1)
        ELSE
          NewArrayValues(CurPos) = OldArrayValues(CurPos)
        END IF
      END IF
    NEXT
    ERASE OldArrayValues
    ArrayValues.RawContent = JSON_GenerateArray(NewArrayValues())
    ERASE NewArrayValues
  END IF
END SUB

SUB JSON_AddMember(oJSON AS JSON_Object, NewMember AS JSON_Member, Index AS ULONG = 0)
  IF oJSON.MemberCount >= 0 THEN
    DIM AS JSON_Member ArrayOldMembers(oJSON.MemberCount - 1), ArrayNewMembers(oJSON.MemberCount)
    JSON_ParseObject(oJSON, ArrayOldMembers())
    FOR CurPos AS ULONG = 0 TO oJSON.MemberCount
      IF CurPos = Index THEN
        ArrayNewMembers(CurPos) = NewMember
      ELSE
        IF CurPos > Index THEN
          ArrayNewMembers(CurPos) = ArrayOldMembers(CurPos - 1)
        ELSE
          ArrayNewMembers(CurPos) = ArrayOldMembers(CurPos)
        END IF
      END IF
    NEXT
    ERASE ArrayOldMembers
    oJSON.RawContent = JSON_GenerateObject(ArrayNewMembers())
    ERASE ArrayNewMembers
    oJSON.MemberCount += 1
  END IF
END SUB

SUB JSON_UpdateMember(oJSON AS JSON_Object, UpdatedMember AS JSON_Member)
  IF oJSON.MemberCount > 0 THEN
    DIM ArrayMembers(oJSON.MemberCount - 1) AS JSON_Member
    JSON_ParseObject(oJSON, ArrayMembers())
    FOR CurPos AS ULONG = 0 TO oJSON.MemberCount - 1
      IF ArrayMembers(CurPos).Name = UpdatedMember.Name THEN
        ArrayMembers(CurPos) = UpdatedMember
        EXIT FOR
      END IF
    NEXT
    oJSON.RawContent = JSON_GenerateObject(ArrayMembers())
    ERASE ArrayMembers
  END IF
END SUB

SUB JSON_DeleteMember (oJSON AS JSON_Object, MemberName AS STRING)
  IF oJSON.MemberCount > 0 THEN
    DIM AS JSON_Member ArrayOldMembers(oJSON.MemberCount - 1), ArrayNewMembers(oJSON.MemberCount - 2)
    DIM IsDeleted AS LONG
    JSON_ParseObject(oJSON, ArrayOldMembers())
    FOR CurPos AS ULONG = 0 TO oJSON.MemberCount
      IF ArrayOldMembers(CurPos).Name = MemberName AND NOT IsDeleted THEN
        IsDeleted = -1
        CurPos += 1
      ELSE
        IF IsDeleted THEN
          ArrayNewMembers(CurPos - 2) = ArrayOldMembers(CurPos - 1)
        ELSE
          ArrayNewMembers(CurPos) = ArrayOldMembers(CurPos)
        END IF
      END IF
    NEXT
    ERASE ArrayOldMembers
    oJSON.RawContent = JSON_GenerateObject(ArrayNewMembers())
    ERASE ArrayNewMembers
  END IF
END SUB

SUB JSON_PreserveMembers (oJSON AS JSON_Object, ArrayMembers() AS JSON_Member)
  IF oJSON.MemberCount > 0 THEN
    DIM ArrayTemp(oJSON.MemberCount - 1) AS JSON_Member, PreservedItems AS LONG
    JSON_ParseObject(oJSON, ArrayTemp())
    'Are there snippets loaded previously in the array?
    PreservedItems = UBOUND(ArrayMembers) + 1
    IF PreservedItems > 0 THEN
      'The array is not empty, preserve the elements
      REDIM PRESERVE ArrayMembers(PreservedItems + oJSON.MemberCount - 1)
    ELSE
      'The array has not been filled yet
      REDIM ArrayMembers(oJSON.MemberCount - 1)
    END IF
    FOR i AS LONG = PreservedItems TO PreservedItems + oJSON.MemberCount - 1
      'Store the elements
      ArrayMembers(i) = ArrayTemp(i - PreservedItems)
    NEXT
    ERASE ArrayTemp
  END IF
END SUB

SUB JSON_SetMemberValue (ArrayMembers() AS JSON_Member, MemberName AS STRING, ValueContent AS STRING, ValueType AS JSON_Type = JSON_TYPE_STRING)
  DIM Count AS LONG = UBOUND(ArrayMembers)
  IF Count >= 0 THEN
    FOR i AS LONG = 0 TO Count
      WITH ArrayMembers(i)
        IF .Name = MemberName THEN
          IF ValueType = JSON_TYPE_STRING THEN
            .Value.RawContent = JSON_GenerateString(ValueContent)
            .Value.ValueType = JSON_TYPE_STRING
          ELSE
            ValueType = JSON_GetType(ValueContent)
            IF ValueType <> JSON_TYPE_ERROR THEN
              .Value.RawContent = ValueContent
              .Value.ValueType = ValueType
            END IF
          END IF
          EXIT FOR
        END IF
      END WITH
    NEXT
  END IF
END SUB

SUB JSON_FillObject(oJSON AS JSON_Object, MemberName AS STRING, MemberValue AS STRING)
  IF MemberName <> "" AND MemberValue <> "" THEN
    DIM NewMember AS JSON_Member, MemberType AS JSON_Type
    MemberType = JSON_GetType(MemberValue)
    IF MemberType <> JSON_TYPE_ERROR THEN
      WITH NewMember
        .Name = MemberName
        .Value.RawContent = MemberValue
        .Value.ValueType = MemberType
      END WITH
      JSON_AddMember(oJSON, NewMember, oJSON.MemberCount)
    END IF
  END IF
END SUB

SUB JSON_FillArray(ArrayValues AS JSON_Array, ValueContent AS STRING)
  IF ValueContent <> "" THEN
    DIM NewValue AS JSON_Value, ValueType AS JSON_Type
    ValueType = JSON_GetType(ValueContent)
    IF ValueType <> JSON_TYPE_ERROR THEN
      WITH NewValue
        .RawContent = ValueContent
        .ValueType = ValueType
      END WITH
      JSON_AddValue(ArrayValues, NewValue)
    END IF
  END IF
END SUB