#
# Copyright (c) 2012, 2014, 2017 LAAS/CNRS
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software for any purpose
# with or without   fee is hereby granted, provided   that the above  copyright
# notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
# REGARD TO THIS  SOFTWARE INCLUDING ALL  IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS. IN NO EVENT SHALL THE AUTHOR  BE LIABLE FOR ANY SPECIAL, DIRECT,
# INDIRECT, OR CONSEQUENTIAL DAMAGES OR  ANY DAMAGES WHATSOEVER RESULTING  FROM
# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION,   ARISING OUT OF OR IN    CONNECTION WITH THE USE   OR
# PERFORMANCE OF THIS SOFTWARE.
#
#                                            Anthony Mallet on Mon Mar 19 2012
#

# --- json-param -----------------------------------------------------------
#
# Return a json description of a service parameters
#
proc json-param { service args } {
  set desc [list]
  foreach p [$service parameter {*}$args] {
    lappend desc [subst {"[$p name]":[json-type-r [$p type]]}]
  }
  return [concat "{" [join $desc ","] "}"]
}


# --- json-port ------------------------------------------------------------
#
# Return a json description of a port
#
proc json-port { port } {
  set desc [subst {"[$port name]":[json-type-r [$port datatype]]}]
  return [concat "{" $desc "}"]
}


# --- json-type-r ----------------------------------------------------------
#
proc json-type-r { type } {
  switch -- [$type kind] {
    const - typedef {
      return [json-type-r [$type type]]
    }

    {struct member} - {union member} {
      return [subst {"[$type name]":[json-type-r [$type type]]}]
    }
  }

  set desc [list]
  lappend desc [subst {"kind":"[$type kind]"}]

  switch -- [$type kind] {
    enum {
      set n [list]
      foreach e [$type members] {
        lappend n [subst {"[$e fullname]"}]
      }
      lappend desc [subst {"values":\[[join $n ,]\]}]
    }

    string {
      if {![catch {$type length} l]} {
        lappend desc [subst {"length":$l}]
      }
    }

    array - sequence - optional {
      if {![catch {$type length} l]} {
        lappend desc [subst {"length":$l}]
      }

      lappend desc [subst {"type":[json-type-r [$type type]]}]
    }

    struct {
      set n [list]
      foreach e [$type members] {
        lappend n [json-type-r $e]
      }
      lappend desc [subst {"type":[concat "{" [join $n ","] "}"]}]
    }

    union {
      set n [list]
      set c [list]
      foreach e [$type members] {
        lappend n [json-type-r $e]
        switch [[$type discriminator] kind] {
          char - enum {
            set cv [list]
            foreach v [$e value] { lappend cv [subst {"$v"}] }
          }
          default {
            set cv [$e value]
          }
        }
        lappend c [subst {"[$e name]":\[[join $cv ","]\]}]
      }

      lappend desc [subst {"discr":[json-type-r [$type discriminator]]}]
      lappend desc [subst {"cases":[concat "{" [join $c ","] "}"]}]
      lappend desc [subst {"type":[concat "{" [join $n ","] "}"]}]
    }
  }

  return [concat "{" [join $desc ","] "}"]
}


# --- json-param-meta ------------------------------------------------------
#
# Return a json description of a parameter meta data (doc and default value)
#
proc json-param-meta { service args } {
  set desc [list]
  foreach p [$service parameter {*}$args] {
    if {![catch {$p initializer} initer]} {
      lappend desc [subst {"[$p name]":[json-type-meta-r $initer]}]
    }
  }
  return [concat "{" [join $desc ","] "}"]
}


# --- json-port-meta -------------------------------------------------------
#
# Return a json description of a port documentation. TODO :)
#
proc json-port-meta { port } {
  return "{}"
}


# --- json-type-meta-r -----------------------------------------------------
#
proc json-type-meta-r { initer } {
  set desc [list]

  if {![catch {$initer doc} doc]} {
    lappend desc [subst {"doc":"$doc"}]
  }

  switch -- [$initer kind] {
    void {}

    compound {
      set n [list]
      foreach i [$initer value] {
        lappend n [subst {"[$i member]":[json-type-meta-r $i]}]
      }
      lappend desc [subst {"items":[concat "{" [join $n ","] "}"]}]
    }

    char - enum - string {
      if {![catch {$initer value} value]} {
        lappend desc [subst {"default":"$value"}]
      }
    }

    default {
      if {![catch {$initer value} value]} {
        lappend desc [subst {"default":$value}]
      }
    }
  }

  return [concat "{" [join $desc ","] "}"]
}


# --- json-param-defval ----------------------------------------------------
#
# Return a json value correcponding to a parameter default value
#
proc json-param-defval { service args } {
  set desc [list]
  foreach p [$service parameter {*}$args] {
    if {![catch {$p initializer} initer]} {
      if {![catch {json-type-defval-r $initer} v]} {
        lappend desc [subst {"[$p name]":$v}]
      }
    }
  }
  return [concat "{" [join $desc ","] "}"]
}


# --- json-type-defval-r ---------------------------------------------------
#
proc json-type-defval-r { initer } {
  switch -- [$initer kind] {
    void { error void; # catched above }

    compound {
      set n [list]
      foreach i [$initer value] {
        if {![catch {json-type-defval-r $i} v]} {
          lappend n [subst {"[$i member]":$v}]
        }
      }
      set desc [concat "{" [join $n ","] "}"]
    }

    char - enum - string {
      set desc [subst {"[$initer value]"}]
    }

    default {
      set desc [$initer value]
    }
  }

  return $desc
}
