Print the JSON structure to a string or a file.
str argument is non-optional is because of a
bug in v4.9 of the gfortran compiler.| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(json_core), | intent(inout) | :: | json | |||
| type(json_value), | intent(in), | pointer | :: | p | ||
| integer(kind=IK), | intent(in) | :: | iunit | file unit to write to (6=console) |
||
| character(kind=CK,len=:), | intent(inout), | allocatable | :: | str | if |
|
| integer(kind=IK), | intent(in), | optional | :: | indent | indention level |
|
| logical(kind=LK), | intent(in), | optional | :: | need_comma | if it needs a comma after it |
|
| logical(kind=LK), | intent(in), | optional | :: | colon | if the colon was just written |
|
| logical(kind=LK), | intent(in), | optional | :: | is_array_element | if this is an array element |
|
| logical(kind=LK), | intent(in), | optional | :: | is_compressed_vector | if True, this is an element from an array being printed on one line [default is False] |
recursive subroutine json_value_print(json,p,iunit,str,indent,&
need_comma,colon,is_array_element,&
is_compressed_vector)
implicit none
class(json_core),intent(inout) :: json
type(json_value),pointer,intent(in) :: p
integer(IK),intent(in) :: iunit !! file unit to write to (6=console)
integer(IK),intent(in),optional :: indent !! indention level
logical(LK),intent(in),optional :: is_array_element !! if this is an array element
logical(LK),intent(in),optional :: need_comma !! if it needs a comma after it
logical(LK),intent(in),optional :: colon !! if the colon was just written
character(kind=CK,len=:),intent(inout),allocatable :: str
!! if `iunit==unit2str` (-1) then the structure is
!! printed to this string rather than
!! a file. This mode is used by
!! [[json_value_to_string]].
logical(LK),intent(in),optional :: is_compressed_vector !! if True, this is an element
!! from an array being printed
!! on one line [default is False]
character(kind=CK,len=max_numeric_str_len) :: tmp !! for value to string conversions
character(kind=CK,len=:),allocatable :: s !! the string of spaces for
!! indenting (see `tab` and `spaces`)
type(json_value),pointer :: element !! for getting children
integer(IK) :: tab !! number of `tabs` for indenting
integer(IK) :: spaces !! number of spaces for indenting
integer(IK) :: i !! counter
integer(IK) :: count !! number of children
logical(LK) :: print_comma !! if the comma will be printed after the value
logical(LK) :: write_file !! if we are writing to a file
logical(LK) :: write_string !! if we are writing to a string
logical(LK) :: is_array !! if this is an element in an array
integer(IK) :: var_type !! for getting the variable type of children
integer(IK) :: var_type_prev !! for getting the variable type of children
logical(LK) :: is_vector !! if all elements of a vector
!! are scalars of the same type
character(kind=CK,len=:),allocatable :: str_escaped !! escaped version of
!! `name` or `str_value`
if (.not. json%exception_thrown) then
if (present(is_compressed_vector)) then
is_vector = is_compressed_vector
else
is_vector = .false.
end if
!whether to write a string or a file (one or the other):
write_string = (iunit==unit2str)
write_file = .not. write_string
!if the comma will be printed after the value
! [comma not printed for the last elements]
if (present(need_comma)) then
print_comma = need_comma
else
print_comma = .false.
end if
!number of "tabs" to indent:
if (present(indent) .and. .not. json%no_whitespace) then
tab = indent
else
tab = 0
end if
!convert to number of spaces:
spaces = tab*json%spaces_per_tab
!if this is an element in an array:
if (present(is_array_element)) then
is_array = is_array_element
else
is_array = .false.
end if
!if the colon was the last thing written
if (present(colon)) then
s = CK_''
else
s = repeat(space, spaces)
end if
select case (p%var_type)
case (json_object)
count = json%count(p)
if (count==0) then !special case for empty object
call write_it( s//start_object//end_object, comma=print_comma )
else
call write_it( s//start_object )
!if an object is in an array, there is an extra tab:
if (is_array) then
if ( .not. json%no_whitespace) tab = tab+1
spaces = tab*json%spaces_per_tab
end if
nullify(element)
element => p%children
do i = 1, count
if (.not. associated(element)) then
call json%throw_exception('Error in json_value_print: '//&
'Malformed JSON linked list')
return
end if
! print the name
if (allocated(element%name)) then
call escape_string(element%name,str_escaped,json%escape_solidus)
if (json%no_whitespace) then
!compact printing - no extra space
call write_it(repeat(space, spaces)//quotation_mark//&
str_escaped//quotation_mark//colon_char,&
advance=.false.)
else
call write_it(repeat(space, spaces)//quotation_mark//&
str_escaped//quotation_mark//colon_char//space,&
advance=.false.)
end if
else
call json%throw_exception('Error in json_value_print:'//&
' element%name not allocated')
nullify(element)
return
end if
! recursive print of the element
call json%json_value_print(element, iunit=iunit, indent=tab + 1, &
need_comma=i<count, colon=.true., str=str)
! get the next child the list:
element => element%next
end do
! [one fewer tab if it isn't an array element]
if (.not. is_array) s = repeat(space, max(0,spaces-json%spaces_per_tab))
call write_it( s//end_object, comma=print_comma )
nullify(element)
end if
case (json_array)
count = json%count(p)
if (json%compress_vectors) then
! check to see if every child is the same type,
! and a scalar:
is_vector = .true.
var_type_prev = -1 ! an invalid value
nullify(element)
element => p%children
do i = 1, count
if (.not. associated(element)) then
call json%throw_exception('Error in json_value_print: '//&
'Malformed JSON linked list')
return
end if
! check variable type of all the children.
! They must all be the same, and a scalar.
call json%info(element,var_type=var_type)
if (var_type==json_object .or. &
var_type==json_array .or. &
(i>1 .and. var_type/=var_type_prev)) then
is_vector = .false.
exit
end if
var_type_prev = var_type
! get the next child the list:
element => element%next
end do
else
is_vector = .false.
end if
if (count==0) then !special case for empty array
call write_it( s//start_array//end_array, comma=print_comma )
else
call write_it( s//start_array, advance=(.not. is_vector) )
!if an array is in an array, there is an extra tab:
if (is_array) then
if ( .not. json%no_whitespace) tab = tab+1
spaces = tab*json%spaces_per_tab
end if
nullify(element)
element => p%children
do i = 1, count
if (.not. associated(element)) then
call json%throw_exception('Error in json_value_print: '//&
'Malformed JSON linked list')
return
end if
! recursive print of the element
if (is_vector) then
call json%json_value_print(element, iunit=iunit, indent=0,&
need_comma=i<count, is_array_element=.false., str=str,&
is_compressed_vector = .true.)
else
call json%json_value_print(element, iunit=iunit, indent=tab,&
need_comma=i<count, is_array_element=.true., str=str)
end if
! get the next child the list:
element => element%next
end do
!indent the closing array character:
if (is_vector) then
call write_it( end_array,comma=print_comma )
else
call write_it( repeat(space, max(0,spaces-json%spaces_per_tab))//end_array,&
comma=print_comma )
end if
nullify(element)
end if
case (json_null)
call write_it( s//null_str, comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
case (json_string)
if (allocated(p%str_value)) then
! have to escape the string for printing:
call escape_string(p%str_value,str_escaped,json%escape_solidus)
call write_it( s//quotation_mark// &
str_escaped//quotation_mark, &
comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
else
call json%throw_exception('Error in json_value_print:'//&
' p%value_string not allocated')
return
end if
case (json_logical)
if (p%log_value) then
call write_it( s//true_str, comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
else
call write_it( s//false_str, comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
end if
case (json_integer)
call integer_to_string(p%int_value,int_fmt,tmp)
call write_it( s//trim(tmp), comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
case (json_double)
if (allocated(json%real_fmt)) then
call real_to_string(p%dbl_value,json%real_fmt,json%compact_real,tmp)
else
!use the default format (user has not called initialize() or specified one):
call real_to_string(p%dbl_value,default_real_fmt,json%compact_real,tmp)
end if
call write_it( s//trim(tmp), comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
case default
call json%throw_exception('Error in json_value_print: unknown data type')
end select
!cleanup:
if (allocated(s)) deallocate(s)
end if
contains
subroutine write_it(s,advance,comma,space_after_comma)
!! write the string to the file (or the output string)
implicit none
character(kind=CK,len=*),intent(in) :: s !! string to print
logical(LK),intent(in),optional :: advance !! to add line break or not
logical(LK),intent(in),optional :: comma !! print comma after the string
logical(LK),intent(in),optional :: space_after_comma !! print a space after the comma
logical(LK) :: add_comma !! if a delimiter is to be added after string
logical(LK) :: add_line_break !! if a line break is to be added after string
logical(LK) :: add_space !! if a space is to be added after the comma
character(kind=CK,len=:),allocatable :: s2 !! temporary string
if (present(comma)) then
add_comma = comma
else
add_comma = .false. !default is not to add comma
end if
if (json%no_whitespace) then
add_space = .false.
else
if (present(space_after_comma)) then
add_space = space_after_comma
else
add_space = .false. !default is not to add space
end if
end if
if (present(advance)) then
if (json%no_whitespace) then
! overrides input value:
add_line_break = .false.
else
add_line_break = advance
end if
else
add_line_break = .not. json%no_whitespace ! default is to advance if
! we are printing whitespace
end if
!string to print:
s2 = s
if (add_comma) then
s2 = s2 // delimiter
if (add_space) s2 = s2 // space
end if
if (write_file) then
if (add_line_break) then
write(iunit,fmt='(A)') s2
else
write(iunit,fmt='(A)',advance='NO') s2
end if
else !write string
str = str // s2
if (add_line_break) str = str // newline
end if
!cleanup:
if (allocated(s2)) deallocate(s2)
end subroutine write_it
end subroutine json_value_print