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 (the file is assumed to be open) |
||
| 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] |
|
| integer(kind=IK), | intent(inout) | :: | iloc | current index in |
recursive subroutine json_value_print(json,p,iunit,str,indent,&
need_comma,colon,is_array_element,&
is_compressed_vector,iloc)
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 (the
!! file is assumed to be open)
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]].
integer(IK),intent(inout) :: iloc !! current index in `str`. should be set to 0 initially.
!! [only used when `str` is used.]
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_indent !! the string of spaces for
!! indenting (see `tab` and `spaces`)
character(kind=CK,len=:),allocatable :: s !! the string appended to `str`
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
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 (.not. associated(p)) then
! note: a null() pointer will trigger this error.
! However, if the pointer is undefined, then this will
! crash (if this wasn't here it would crash below when
! we try to access the contents)
call json%throw_exception('Error in json_value_print: '//&
'the pointer is not associated')
return
end if
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_indent = CK_''
else
s_indent = 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
s = s_indent//start_object//end_object
call write_it( comma=print_comma )
else
s = s_indent//start_object
call write_it()
!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
s = repeat(space, spaces)//quotation_mark//&
str_escaped//quotation_mark//colon_char
call write_it(advance=.false.)
else
s = repeat(space, spaces)//quotation_mark//&
str_escaped//quotation_mark//colon_char//space
call write_it(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_IK, &
need_comma=i<count, colon=.true., str=str, iloc=iloc)
if (json%exception_thrown) return
! 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) then
s = repeat(space, max(0_IK,spaces-json%spaces_per_tab))//end_object
else
s = s_indent//end_object
end if
call write_it( comma=print_comma )
nullify(element)
end if
case (json_array)
count = json%count(p)
if (count==0) then ! special case for empty array
s = s_indent//start_array//end_array
call write_it( comma=print_comma )
else
! if every child is the same type & a scalar:
is_vector = json%is_vector(p)
if (json%failed()) return
s = s_indent//start_array
call write_it( 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_IK,&
need_comma=i<count, is_array_element=.false., &
str=str, iloc=iloc,&
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, iloc=iloc)
end if
if (json%exception_thrown) return
! get the next child the list:
element => element%next
end do
!indent the closing array character:
if (is_vector) then
s = end_array
call write_it( comma=print_comma )
else
s = repeat(space, max(0_IK,spaces-json%spaces_per_tab))//end_array
call write_it( comma=print_comma )
end if
nullify(element)
end if
case (json_null)
s = s_indent//null_str
call write_it( 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)
s = s_indent//quotation_mark//str_escaped//quotation_mark
call write_it( 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
s = s_indent//true_str
call write_it( comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
else
s = s_indent//false_str
call write_it( 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)
s = s_indent//trim(tmp)
call write_it( comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
case (json_real)
if (allocated(json%real_fmt)) then
call real_to_string(p%dbl_value,json%real_fmt,json%compact_real,json%non_normals_to_null,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,json%non_normals_to_null,tmp)
end if
s = s_indent//trim(tmp)
call write_it( comma=print_comma, &
advance=(.not. is_vector),&
space_after_comma=is_vector )
case default
call integer_to_string(p%var_type,int_fmt,tmp)
call json%throw_exception('Error in json_value_print: '//&
'unknown data type: '//trim(tmp))
end select
end if
contains
subroutine write_it(advance,comma,space_after_comma)
!! write the string `s` to the file (or the output string)
implicit none
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
integer(IK) :: n !! length of actual string `s` appended to `str`
integer(IK) :: room_left !! number of characters left in `str`
integer(IK) :: n_chunks_to_add !! number of chunks to add to `str` for appending `s`
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:
if (add_comma) then
if (add_space) then
s = s // delimiter // space
else
s = s // delimiter
end if
end if
if (write_file) then
if (add_line_break) then
write(iunit,fmt='(A)') s
else
write(iunit,fmt='(A)',advance='NO') s
end if
else !write string
if (add_line_break) s = s // newline
n = len(s)
room_left = len(str)-iloc
if (room_left < n) then
! need to add another chunk to fit this string:
n_chunks_to_add = max(1_IK, ceiling( real(len(s)-room_left,RK) / real(chunk_size,RK), IK ) )
str = str // repeat(space, print_str_chunk_size*n_chunks_to_add)
end if
! append s to str:
str(iloc+1:iloc+n) = s
iloc = iloc + n
end if
end subroutine write_it
end subroutine json_value_print