JParseFunctions

# -------------------------------- JParseFunctions ---------------------------------------------------
# ------------------------------- fJParsePrint ----------------------------------------------------------------
:global fJParsePrint
:if (!any $fJParsePrint) do={ :global fJParsePrint do={
  :global JParseOut
  :local TempPath
  :global fJParsePrint

  :if ([:len $1] = 0) do={
    :set $1 "\$JParseOut"
    :set $2 $JParseOut
   }
   
  :foreach k,v in=$2 do={
    :if ([:typeof $k] = "str") do={
      :set k "\"$k\""
    }
    :set TempPath ($1. "->" . $k)
    :if ([:typeof $v] = "array") do={
      :if ([:len $v] > 0) do={
        $fJParsePrint $TempPath $v
      } else={
        :put "$TempPath = [] ($[:typeof $v])"
      }
    } else={
        :put "$TempPath = $v ($[:typeof $v])"
    }
  }
}}
# ------------------------------- fJParsePrintVar ----------------------------------------------------------------
:global fJParsePrintVar
:if (!any $fJParsePrintVar) do={ :global fJParsePrintVar do={
  :global JParseOut
  :local TempPath
  :global fJParsePrintVar
  :local fJParsePrintRet ""

  :if ([:len $1] = 0) do={
    :set $1 "\$JParseOut"
    :set $2 $JParseOut
   }
   
  :foreach k,v in=$2 do={
    :if ([:typeof $k] = "str") do={
      :set k "\"$k\""
    }
    :set TempPath ($1. "->" . $k)
    :if ($fJParsePrintRet != "") do={
      :set fJParsePrintRet ($fJParsePrintRet . "\r\n")
    }    
    :if ([:typeof $v] = "array") do={
      :if ([:len $v] > 0) do={
        :set fJParsePrintRet ($fJParsePrintRet . [$fJParsePrintVar $TempPath $v])
      } else={
        :set fJParsePrintRet ($fJParsePrintRet . "$TempPath = [] ($[:typeof $v])")
      }
    } else={
        :set fJParsePrintRet ($fJParsePrintRet . "$TempPath = $v ($[:typeof $v])")
    }
  }
  :return $fJParsePrintRet
}}
# ------------------------------- fJSkipWhitespace ----------------------------------------------------------------
:global fJSkipWhitespace
:if (!any $fJSkipWhitespace) do={ :global fJSkipWhitespace do={
  :global Jpos
  :global JSONIn
  :global Jdebug
  :while ($Jpos < [:len $JSONIn] and ([:pick $JSONIn $Jpos] ~ "[ \r\n\t]")) do={
    :set Jpos ($Jpos + 1)
  }
  :if ($Jdebug) do={:put "fJSkipWhitespace: Jpos=$Jpos Char=$[:pick $JSONIn $Jpos]"}
}}
# -------------------------------- fJParse ---------------------------------------------------------------
:global fJParse
:if (!any $fJParse) do={ :global fJParse do={
  :global Jpos
  :global JSONIn
  :global Jdebug
  :global fJSkipWhitespace
  :local Char

  :if (!$1) do={
    :set Jpos 0
   }
  
  $fJSkipWhitespace
  :set Char [:pick $JSONIn $Jpos]
  :if ($Jdebug) do={:put "fJParse: Jpos=$Jpos Char=$Char"}
  :if ($Char="{") do={
    :set Jpos ($Jpos + 1)
    :global fJParseObject
    :return [$fJParseObject]
  } else={
    :if ($Char="[") do={
      :set Jpos ($Jpos + 1)
      :global fJParseArray
      :return [$fJParseArray]
    } else={
      :if ($Char="\"") do={
        :set Jpos ($Jpos + 1)
        :global fJParseString
        :return [$fJParseString]
      } else={
#        :if ([:pick $JSONIn $Jpos ($Jpos+2)]~"^-\?[0-9]") do={
        :if ($Char~"[eE0-9.+-]") do={
          :global fJParseNumber
          :return [$fJParseNumber]
        } else={

          :if ($Char="n" and [:pick $JSONIn $Jpos ($Jpos+4)]="null") do={
            :set Jpos ($Jpos + 4)
            :return []
          } else={
            :if ($Char="t" and [:pick $JSONIn $Jpos ($Jpos+4)]="true") do={
              :set Jpos ($Jpos + 4)
              :return true
            } else={
              :if ($Char="f" and [:pick $JSONIn $Jpos ($Jpos+5)]="false") do={
                :set Jpos ($Jpos + 5)
                :return false
              } else={
                :put "Err.Raise 8732. No JSON object could be fJParseed"
                :set Jpos ($Jpos + 1)
                :return []
              }
            }
          }
        }
      }
    }
  }
}}

#-------------------------------- fJParseString ---------------------------------------------------------------
:global fJParseString
:if (!any $fJParseString) do={ :global fJParseString do={
  :global Jpos
  :global JSONIn
  :global Jdebug
  :global fUnicodeToUTF8
  :local Char
  :local StartIdx
  :local Char2
  :local TempString ""
  :local UTFCode
  :local Unicode

  :set StartIdx $Jpos
  :set Char [:pick $JSONIn $Jpos]
  :if ($Jdebug) do={:put "fJParseString: Jpos=$Jpos Char=$Char"}
  :while ($Jpos < [:len $JSONIn] and $Char != "\"") do={
    :if ($Char="\\") do={
      :set Char2 [:pick $JSONIn ($Jpos + 1)]
      :if ($Char2 = "u") do={
        :set UTFCode [:tonum "0x$[:pick $JSONIn ($Jpos+2) ($Jpos+6)]"]
        :if ($UTFCode>=0xD800 and $UTFCode<=0xDFFF) do={
# Surrogate pair
          :set Unicode  (($UTFCode & 0x3FF) << 10)
          :set UTFCode [:tonum "0x$[:pick $JSONIn ($Jpos+8) ($Jpos+12)]"]
          :set Unicode ($Unicode | ($UTFCode & 0x3FF) | 0x10000)
          :set TempString ($TempString . [:pick $JSONIn $StartIdx $Jpos] . [$fUnicodeToUTF8 $Unicode])         
          :set Jpos ($Jpos + 12)
        } else= {
# Basic Multilingual Plane (BMP)
          :set Unicode $UTFCode
          :set TempString ($TempString . [:pick $JSONIn $StartIdx $Jpos] . [$fUnicodeToUTF8 $Unicode])
          :set Jpos ($Jpos + 6)
        }
        :set StartIdx $Jpos
        :if ($Jdebug) do={:put "fJParseString Unicode: $Unicode"}
      } else={
        :if ($Char2 ~ "[\\bfnrt\"]") do={
          :if ($Jdebug) do={:put "fJParseString escape: Char+Char2 $Char$Char2"}
          :set TempString ($TempString . [:pick $JSONIn $StartIdx $Jpos] . [[:parse "(\"\\$Char2\")"]])
          :set Jpos ($Jpos + 2)
          :set StartIdx $Jpos
        } else={
          :if ($Char2 = "/") do={
            :if ($Jdebug) do={:put "fJParseString /: Char+Char2 $Char$Char2"}
            :set TempString ($TempString . [:pick $JSONIn $StartIdx $Jpos] . "/")
            :set Jpos ($Jpos + 2)
            :set StartIdx $Jpos
          } else={
            :put "Err.Raise 8732. Invalid escape"
            :set Jpos ($Jpos + 2)
          }
        }
      }
    } else={
      :set Jpos ($Jpos + 1)
    }
    :set Char [:pick $JSONIn $Jpos]
  }
  :set TempString ($TempString . [:pick $JSONIn $StartIdx $Jpos])
  :set Jpos ($Jpos + 1)
  :if ($Jdebug) do={:put "fJParseString: $TempString"}
  :return $TempString
}}

#-------------------------------- fJParseNumber ---------------------------------------------------------------
:global fJParseNumber
:if (!any $fJParseNumber) do={ :global fJParseNumber do={
  :global Jpos
  :local StartIdx
  :global JSONIn
  :global Jdebug
  :local NumberString
  :local Number

  :set StartIdx $Jpos   
  :set Jpos ($Jpos + 1)
  :while ($Jpos < [:len $JSONIn] and [:pick $JSONIn $Jpos]~"[eE0-9.+-]") do={
    :set Jpos ($Jpos + 1)
  }
  :set NumberString [:pick $JSONIn $StartIdx $Jpos]
  :set Number [:tonum $NumberString] 
  :if ([:typeof $Number] = "num") do={
    :if ($Jdebug) do={:put "fJParseNumber: StartIdx=$StartIdx Jpos=$Jpos $Number ($[:typeof $Number])"}
    :return $Number
  } else={
    :if ($Jdebug) do={:put "fJParseNumber: StartIdx=$StartIdx Jpos=$Jpos $NumberString ($[:typeof $NumberString])"}
    :return $NumberString
  }
}}

#-------------------------------- fJParseArray ---------------------------------------------------------------
:global fJParseArray
:if (!any $fJParseArray) do={ :global fJParseArray do={
  :global Jpos
  :global JSONIn
  :global Jdebug
  :global fJParse
  :global fJSkipWhitespace
  :local Value
  :local ParseArrayRet [:toarray ""]
  
  $fJSkipWhitespace    
  :while ($Jpos < [:len $JSONIn] and [:pick $JSONIn $Jpos]!= "]") do={
    :set Value [$fJParse true]
    :set ($ParseArrayRet->([:len $ParseArrayRet])) $Value
    :if ($Jdebug) do={:put "fJParseArray: Value="; :put $Value}
    $fJSkipWhitespace
    :if ([:pick $JSONIn $Jpos] = ",") do={
      :set Jpos ($Jpos + 1)
      $fJSkipWhitespace
    }
  }
  :set Jpos ($Jpos + 1)
#  :if ($Jdebug) do={:put "ParseArrayRet: "; :put $ParseArrayRet}
  :return $ParseArrayRet
}}

# -------------------------------- fJParseObject ---------------------------------------------------------------
:global fJParseObject
:if (!any $fJParseObject) do={ :global fJParseObject do={
  :global Jpos
  :global JSONIn
  :global Jdebug
  :global fJSkipWhitespace
  :global fJParseString
  :global fJParse
# Syntax :local ParseObjectRet ({}) don't work in recursive call, use [:toarray ""] for empty array!!!
  :local ParseObjectRet [:toarray ""]
  :local Key
  :local Value
  :local ExitDo false
  
  $fJSkipWhitespace
  :while ($Jpos < [:len $JSONIn] and [:pick $JSONIn $Jpos]!="}" and !$ExitDo) do={
    :if ([:pick $JSONIn $Jpos]!="\"") do={
      :put "Err.Raise 8732. Expecting property name"
      :set ExitDo true
    } else={
      :set Jpos ($Jpos + 1)
      :set Key [$fJParseString]
      $fJSkipWhitespace
      :if ([:pick $JSONIn $Jpos] != ":") do={
        :put "Err.Raise 8732. Expecting : delimiter"
        :set ExitDo true
      } else={
        :set Jpos ($Jpos + 1)
        :set Value [$fJParse true]
        :set ($ParseObjectRet->$Key) $Value
        :if ($Jdebug) do={:put "fJParseObject: Key=$Key Value="; :put $Value}
        $fJSkipWhitespace
        :if ([:pick $JSONIn $Jpos]=",") do={
          :set Jpos ($Jpos + 1)
          $fJSkipWhitespace
        }
      }
    }
  }
  :set Jpos ($Jpos + 1)
#  :if ($Jdebug) do={:put "ParseObjectRet: "; :put $ParseObjectRet}
  :return $ParseObjectRet
}}

# ------------------- fByteToEscapeChar ----------------------
:global fByteToEscapeChar
:if (!any $fByteToEscapeChar) do={ :global fByteToEscapeChar do={
#  :set $1 [:tonum $1]
  :return [[:parse "(\"\\$[:pick "0123456789ABCDEF" (($1 >> 4) & 0xF)]$[:pick "0123456789ABCDEF" ($1 & 0xF)]\")"]]
}}

# ------------------- fUnicodeToUTF8----------------------
:global fUnicodeToUTF8
:if (!any $fUnicodeToUTF8) do={ :global fUnicodeToUTF8 do={
  :global fByteToEscapeChar
#  :local Ubytes [:tonum $1]
  :local Nbyte
  :local EscapeStr ""

  :if ($1 < 0x80) do={
    :set EscapeStr [$fByteToEscapeChar $1]
  } else={
    :if ($1 < 0x800) do={
      :set Nbyte 2
    } else={  
      :if ($1 < 0x10000) do={
        :set Nbyte 3
      } else={
        :if ($1 < 0x20000) do={
          :set Nbyte 4
        } else={
          :if ($1 < 0x4000000) do={
            :set Nbyte 5
          } else={
            :if ($1 < 0x80000000) do={
              :set Nbyte 6
            }
          }
        }
      }
    }
    :for i from=2 to=$Nbyte do={
      :set EscapeStr ([$fByteToEscapeChar ($1 & 0x3F | 0x80)] . $EscapeStr)
      :set $1 ($1 >> 6)
    }
    :set EscapeStr ([$fByteToEscapeChar (((0xFF00 >> $Nbyte) & 0xFF) | $1)] . $EscapeStr)
  }
  :return $EscapeStr
}}

# ------------------- Load JSON from arg --------------------------------
global JSONLoads
if (!any $JSONLoads) do={ global JSONLoads do={
    global JSONIn $1
    global fJParse
    local ret [$fJParse]
    set JSONIn
    global Jpos; set Jpos
    global Jdebug; if (!$Jdebug) do={set Jdebug}
    return $ret
}}

# ------------------- Load JSON from file --------------------------------
global JSONLoad
if (!any $JSONLoad) do={ global JSONLoad do={
    if ([len [/file find name=$1]] > 0) do={
        global JSONLoads
        return [$JSONLoads [/file get $1 contents]]
    }
}}

# ------------------- Unload JSON parser library ----------------------
global JSONUnload
if (!any $JSONUnload) do={ global JSONUnload do={
    global JSONIn; set JSONIn
    global Jpos; set Jpos
    global Jdebug; set Jdebug
    global fByteToEscapeChar; set fByteToEscapeChar
    global fJParse; set fJParse
    global fJParseArray; set fJParseArray
    global fJParseNumber; set fJParseNumber
    global fJParseObject; set fJParseObject
    global fJParsePrint; set fJParsePrint
    global fJParsePrintVar; set fJParsePrintVar
    global fJParseString; set fJParseString
    global fJSkipWhitespace; set fJSkipWhitespace
    global fUnicodeToUTF8; set fUnicodeToUTF8
    global JSONLoads; set JSONLoads
    global JSONLoad; set JSONLoad
    global JSONUnload; set JSONUnload
}}
# ------------------- End JParseFunctions----------------------