# support for Frappy

proc find_config {files obj {driver 0}} {
  # try to find out in which of the files the object was defined
  set config ""
  foreach file $files {
    lassign [split $file .] addon kind
    if {$kind eq "config"} {
      set config $file
    } else {
      if {[addon_$addon exists $obj]} {
        return $file
      }
    }
  }
  return $config
}

proc cfg_files {} {
  set name [samenv name]
  set nl [split $name /]
  set files []
  if {[llength $nl] == 1} {
    lappend files ${name}.config
  } else {
    set name [lindex $nl 0]
    lappend files ${name}.config
    set selected_stick [lindex $nl 1]
    if {[file exists ${selected_stick}.stick]} {
      set selected_addons [lrange $nl 2 end]
    } else {
      set selected_stick ""
      set selected_addons [lrange $nl 1 end]
    }
    if {$selected_stick ne ""} {
      lappend files ${selected_stick}.stick
    }
    foreach addon $selected_addons {
      lappend files ${addon}.addon
    }
  }
  return $files
}

proc get_obj_path {obj} {
  set g [silent ""  hgetpropval /$obj group]
  if {$g eq "_pardef_"} {
    return /$obj
  }
  return [silent /sics/$obj hgetpropval /sics/$obj objectPath]
}

proc describe_node {base path {visibility 1}} {
  upvar result result

  set hp $base/$path
  lassign [split [hinfo $hp] ,] type nkids length
  set enum [silent 0 hgetpropval $hp enum_]
  if {$enum eq "0"} {
    set enum [silent 0 hgetpropval $hp enum]
  }
  set extra ""
  if {$enum eq "1"} {
    set type bool
  } elseif {$enum ne "0"} {
    set type enum
    set idx 0
    set elements [list]
    foreach item [split $enum ,] {
      lassign [split $item =] name num
      if {$num != ""} {
        set idx $num
      }
      lappend elements [format {"%s": %d} $name $idx]
      incr idx
    }
    set extra [format {, "enum": {%s}} [join $elements ", "]]
  }
  set item [list [format {"path": "%s", "type": "%s"%s} $path $type $extra]]
  set priv [silent internal hgetpropval $hp priv]
  if {$priv eq "internal"} {
    lassign [split $base /] null obj
    if {[sicstype $obj] eq "DRIV" && $path eq ""} {  # treat special easedriv (mf, old ips)
      lappend item {"readonly": false} [format {"cmd": "run %s"} $obj]
    }
  } else {
    lappend item {"readonly": false} [format {"cmd": "%s"} [hgetpropval $hp sicscommand]]
  }
  set description [silent "" hgetpropval $hp help]
  if {$description ne ""} {
    lappend item [format {"description": "%s"} $description]
  }
  if {[silent true hgetpropval $hp visible] eq "false"} {
    lappend item {"visibility": 3}
  } elseif {$visibility != 1} {
    lappend item [format {"visibility": %s} $visibility]
  }
  if {$nkids > 0} {
    lappend item [format {"kids": %d} $nkids]
  }
  lappend result [format {{%s}} [join $item ", "]]
  if {$nkids > 0} {
    if {[silent "" hgetpropval $hp group] ne ""} {
      set visibility 1
    } else {
      set visibility 3
    }
    foreach kid [hlist $hp] {
      if {[catch {
        #describe_node $hp [join "$path $kid" /] $visibility
        if {[silent "" hgetpropval $hp/$kid sicsdev] eq ""} {
          describe_node $base [join "$path $kid" /] $visibility
        }
      } msg]} {
        clientput "WARNING: $msg"
      }
    }
  }
}

proc describe_obj {obj} {
  # make a json description out of a SICS object.
  set result [list]
  set hp [get_obj_path $obj]
  describe_node $hp ""
  set cfgfile [find_config [cfg_files] $obj]
  if {[llength $cfgfile] == 0} {
    error "can not find config file for $obj"
  }
  if {[llength $cfgfile] > 1} {
    clientput "WARNING: ambiguous config file for $obj: $cfgfile"
    lassign $cfgfile cfgfile
  }
  set params [join $result ",\n  "]
  return [format {["%s",%s"%s", {"base": "%s", "params": [%s]}]} $cfgfile "\n" $obj $hp "\n  $params\n"]
}

proc describe_all {} {
  set objs [list]
  foreach obj [obj_list items] {
    if {![string match _* $obj] && ![string match addon_* $obj]} {
      if {[catch {
        lappend objs [describe_obj $obj]
      } msg]} {
        clientput "WARNING: $msg"
      }
    }
  }
  set descr [list]
  lappend descr [format {"%s.config": "%s"} [result device name] [result deviceDesc]]
  set stick_name [result device stick_name]
  if {$stick_name ne ""} {
    lappend descr [format {"%s.stick": "%s"} $stick_name [result stickDesc]]
  }
  foreach addon [addon_list items] {
    lappend descr [format {"%s.addon": "%s"} $addon [findDesc ${addon}.addon addonDesc]]
  }
  return [format {[{%s}, [%s]]} [join $descr ", "] [join $objs ",\n"]]
}

proc get_param_values {hp} {
  lassign [split [hinfo $hp] ,] type nkids length
  if [catch {
    # trigger notify event
    hupdate $hp [hval $hp]
  } msg] {
    if {$type ne "none"} {
      clientput [format "_E /%s %s" $hp $msg] warning
    }
    set type none
  }
  if {$nkids > 0} {
    foreach kid [hlist $hp] {
      get_param_values $hp/$kid
    }
  }
}

proc check_or_do {doit service cfgs} {
  # result: 1: no change needed, 0: change needed, "ERROR:...": failure
  set result 1
  set config ""
  set stick ""
  set addons [list]

  foreach cfg $cfgs {
    if {[regexp {(.*)\.addon} $cfg -> addon]} {
      if {![addon_list exists $addon]} {
        device makeitem frappy_u_addon 1
        lappend addons $addon
      }
    } elseif {![regexp {(.*)\.config} $cfg -> config] && ![regexp {(.*)\.stick} $cfg -> stick]} {
      error "what is $cfg?"
    }
  }
  if {$config ne ""} {
    device makeitem frappy_u_config 1
    if {$config ne [hval /device/name]} {
      if {$doit} {
        if {[hval /device/confirmed] eq [hval /device/name]} {
          set msg "do not allow frappy to change from [hval /device/name] to $config"
          clientlog ERROR:$msg
          return $msg
        }
        clientlog 0
        clientlog TRANSACTIONFINISHED
        samenv -q $config
      } else {
        device makeitem frappy_u_config 0
      }
      if {[hval /device/name] == "none"} {
        return none
      }
      set result 0
    }
  }
  if {$stick ne ""} {
    device makeitem frappy_u_stick 1
    if {$stick ne [hval /device/stick_name]} {
      if {$doit} {
        clientlog 0
        clientlog TRANSACTIONFINISHED
        addon stick $stick
      } else {
        device makeitem frappy_u_stick 0
      }
      if {[hval /device/name] == "none"} {
        return nonestick
      }
      set result 0
    }
  }
  foreach addon $addons {
    if {$doit} {
      clientlog 0
      clientlog TRANSACTIONFINISHED
      addon $addon
    } else {
      device makeitem frappy_u_addon 0
    }
    set result 0
  }
  device makeitem frappy_$service $cfgs
  # return 1 when nothing has to be changed
  return $result
}

proc frappy_config {service args} {
  check_or_do 1 $service $args
}

proc check_config {service args} {
  return [check_or_do 0 $service $args]
}

proc frappy_remove {service} {
  set cfgs [silent "" result device frappy_$service]
  set config ""
  set addons [list]
  foreach cfg $cfgs {
    if {[regexp {(.*)\.addon} $cfg -> addon]} {
      lappend addons $addon
    } elseif {![regexp {(.*)\.config} $cfg -> config] && ![regexp {(.*)\.stick} $cfg -> stick]} {
      error "what is $cfg?"
    }
  }
  if {"$config" ne ""} {
    samenv none
  }
  foreach addon $addons {
    if {[addon_list exists $addon]} {
      addon delete $addon
    }
  }

}

proc frappy_async_client {} {
  protocol set json
  hnotify /device/changetime 2
  hnotify /device/frappy_main 2
  hnotify /device/frappy_stick 2
  hnotify /device/frappy_addons 2
}

proc get_all_param {args} {
  foreach obj $args {
    catch {
      set hp [get_obj_path $obj]
      hnotify $hp 1
      get_param_values $hp
    }
    # todo: create error message on failure
  }
}

proc error_update_script {hp} {
  hupdate $hp/_read_error [silent "" hgetpropval $hp geterror]
}

proc register_node {hp} {
  # register hipadaba path hp (and <hp>/is_running. if availabale)
  # 0: not recursive
  hnotify $hp 1 0
  catch {
    hfactory $hp/_read_error plain internal text
  }
  hsetprop $hp/_read_error visible false
  set upd "error_update_script $hp"
  if {[silent "" hgetpropval $hp updatescript] ne $upd} {
    hscriptnotify $hp $upd
  }
  hnotify $hp/_read_error 1 0
  if [catch {
    # trigger notify event
    hupdate $hp [hval $hp]
  } msg] {
    clientput [format "_E %s %s" $hp $msg] warning
  }
  catch {
    # in case of sct drivable
    hnotify $hp/is_running 1 0
  }
}

proc put_secop_info {{path ""}} {
  set newmodules [list "" $path]
  set trigger [list]
  while {[llength $newmodules]} {
    set modulestodo $newmodules
    set newmodules []
    foreach {module modnode} $modulestodo {
      set modlen [expr [string length $modnode] + 1]
      set newnodes [list $modnode]
      set keydict [dict create]
      while {[llength $newnodes]} {
        set nodelist $newnodes
        set newnodes [list]
        foreach node $nodelist {
          set newmodule [silent "" hgetpropval $node secop_module]
          if {$newmodule ne "" && $newmodule ne $module} {
            hsetprop $node secop_module $newmodule
            lappend newmodules $newmodule $node
          } else {
            lassign [split [hinfo $node] ,] type nkids size
            foreach kid [hlist $node] {
              lappend newnodes $node/$kid
            }
            if {$module eq ""} continue
            switch $type {
              float - int - text {
                if {$node eq $modnode} {
                  set key value
                } else {
                  set key [lindex [split $node /] end]
                  if {$node ne "$modnode/$key"} {
                    hsetprop $node secop_group [join [lrange [split $node /] [llength [split $modnode /]] end-1] .]
                  }
                }
                if {[dict exists $keydict $key]} {
                  set other [dict get $keydict $key]
                  if {[llength [split $other /]] eq [llength [split $node /]]} {
                    hsetprop $other secop_id ${module}:[string map {/ _} [string range $other $modlen end]]
                    dict unset keydict $key
                  }
                  set key [string map {/ _} [string range $node $modlen end]]
                } else {
                  dict set keydict $key $node
                }
                hsetprop $node secop_id ${module}:$key
                lappend trigger $node
              }
            }
          }
        }
      }
    }
  }
  foreach node $trigger {
    if {[catch {hupdate $node [hval $node]}]} {
      logsetup $node 0
      logsetup $node clear
    }
  }
}

proc treatvars {} {
  set vdict [dict create]
  foreach data [hval /vars] {
    lassign [split $data |] var unit label color
    set key [string map {. __} $var]
    dict set vdict $key [list $var $unit $label $color]
  }
  set keys [silent 0 hlist /graph_data]
  if {$keys eq "0"} {
     hfactory /graph_data plain spy text
     set keys [list]
  }
  # disable unused curves
  foreach key $keys {
    if {![dict exists $vdict $key]} {
      set data [lrange [hval /graph_data/$key] 1 end]
      hupdate /graph_data/$key [concat 0 $data]
    }
  }
  # loop over vars: enable curves and create curve metadata
  foreach {key data} [dict get $vdict] {
    set old [silent "" hval /graph_data/$key]
    if {$old eq ""} {
      hfactory /graph_data/$key plain spy text
      lassign $data var
      set secop_id [silent "" hgetpropval [string map {. /} $var] secop_id]
      if {$secop_id eq ""} {
        put_secop_info /$var
        hsetprop /graph_data/$key secop_id "#GRAPH_$secop_id"
      }
      logsetup /graph_data/$key 0
    }
    hupdate /graph_data/$key [concat 1 $data]
  }
}

hscriptnotify /vars treatvars

publishLazy describe_all Spy
publishLazy describe_all2 Spy
publishLazy get_all_param Spy
publishLazy register_node Spy
publishLazy get_param_values Spy
publishLazy frappy_async_client Spy
publishLazy frappy_config Spy
publishLazy frappy_remove Spy
publishLazy check_config Spy
publishLazy describe_obj Spy
publishLazy treatvars