write_key_json Subroutine

private subroutine write_key_json(u, box, is_last)

Write one key as a JSON object. A select type over the concrete key recovers the kind-specific fields (vmin/vmax, allowed(:), array size) that nml_key_t’s abstract interface does not carry – the one place this walk needs the concrete type (schema_render_markdown does not, since default_string() is polymorphic).

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: u
type(nml_key_box_t), intent(in) :: box
logical, intent(in) :: is_last

Calls

proc~~write_key_json~~CallsGraph proc~write_key_json write_key_json proc~fmt_int fmt_int proc~write_key_json->proc~fmt_int proc~fmt_json_bool fmt_json_bool proc~write_key_json->proc~fmt_json_bool proc~json_escape json_escape proc~write_key_json->proc~json_escape proc~json_fmt_real json_fmt_real proc~write_key_json->proc~json_fmt_real proc~json_real_array json_real_array proc~write_key_json->proc~json_real_array proc~json_string_array json_string_array proc~write_key_json->proc~json_string_array proc~json_real_array->proc~json_fmt_real proc~json_string_array->proc~json_escape

Called by

proc~~write_key_json~~CalledByGraph proc~write_key_json write_key_json proc~schema_render_json nml_schema_t%schema_render_json proc~schema_render_json->proc~write_key_json

Variables

Type Visibility Attributes Name Initial
character(len=:), private, allocatable :: dead_str

Source Code

   subroutine write_key_json(u, box, is_last)
      !! Write one key as a JSON object.  A `select type` over the
      !! concrete key recovers the kind-specific fields (vmin/vmax,
      !! allowed(:), array size) that `nml_key_t`'s abstract interface
      !! does not carry -- the one place this walk needs the concrete
      !! type (`schema_render_markdown` does not, since `default_string()`
      !! is polymorphic).
      integer, intent(in) :: u
      type(nml_key_box_t), intent(in) :: box
      logical, intent(in) :: is_last
      character(len=:), allocatable :: dead_str

      dead_str = ""
      if (allocated(box%key%dead_reason)) dead_str = trim(box%key%dead_reason)

      write (u, "(A)") "        {"
      write (u, "(A)") '          "name": "'//json_escape(box%key%name)//'",'
      write (u, "(A)") '          "doc": "'//json_escape(trim(box%key%doc))//'",'
      write (u, "(A)") '          "units": "'//json_escape(trim(box%key%units))//'",'
      write (u, "(A)") '          "required": '//fmt_json_bool(box%key%required)//","
      write (u, "(A)") '          "dead_on_ocean_path": "'//json_escape(dead_str)//'",'

      select type (k => box%key)
      type is (nml_enum_key_t)
         write (u, "(A)") '          "kind": "enum",'
         write (u, "(A)") '          "default": "'//json_escape(trim(k%default))//'",'
         write (u, "(A)") '          "allowed": ['//json_string_array(k%allowed)//"]"
      type is (nml_string_key_t)
         write (u, "(A)") '          "kind": "string",'
         write (u, "(A)") '          "max_len": '//fmt_int(len(k%tgt))//","
         write (u, "(A)") '          "default": "'//json_escape(trim(k%default))//'"'
      type is (nml_real_array_key_t)
         write (u, "(A)") '          "kind": "real_array",'
         write (u, "(A)") '          "size": '//fmt_int(size(k%tgt))//","
         write (u, "(A)") '          "default": ['//json_real_array(k%default)//"]"
      type is (nml_real_key_t)
         write (u, "(A)") '          "kind": "real",'
         write (u, "(A)") '          "default": '//json_fmt_real(k%default)//","
         write (u, "(A)") '          "has_min": '//fmt_json_bool(k%has_min)//","
         write (u, "(A)") '          "vmin": '//json_fmt_real(k%vmin)//","
         write (u, "(A)") '          "has_max": '//fmt_json_bool(k%has_max)//","
         write (u, "(A)") '          "vmax": '//json_fmt_real(k%vmax)
      type is (nml_int_key_t)
         write (u, "(A)") '          "kind": "int",'
         write (u, "(A)") '          "default": '//fmt_int(k%default)//","
         write (u, "(A)") '          "has_min": '//fmt_json_bool(k%has_min)//","
         write (u, "(A)") '          "vmin": '//fmt_int(k%vmin)//","
         write (u, "(A)") '          "has_max": '//fmt_json_bool(k%has_max)//","
         write (u, "(A)") '          "vmax": '//fmt_int(k%vmax)
      type is (nml_logical_key_t)
         write (u, "(A)") '          "kind": "logical",'
         write (u, "(A)") '          "default": '//fmt_json_bool(k%default)
      class default
         write (u, "(A)") '          "kind": "unknown"'
      end select

      if (is_last) then
         write (u, "(A)") "        }"
      else
         write (u, "(A)") "        },"
      end if
   end subroutine write_key_json