Skip to content

Commit 354224c

Browse files
jacobwilliamsjacobwilliams
committed
Added option to print vectors on one line. Fixes #228.
1 parent 609dc0c commit 354224c

File tree

3 files changed

+128
-27
lines changed

3 files changed

+128
-27
lines changed

‎src/json_file_module.F90

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -337,7 +337,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
337337
unescape_strings,&
338338
comment_char,&
339339
path_mode,&
340-
path_separator)
340+
path_separator,&
341+
compress_vectors)
341342

342343
implicit none
343344

@@ -353,7 +354,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
353354
unescape_strings,&
354355
comment_char,&
355356
path_mode,&
356-
path_separator)
357+
path_separator,&
358+
compress_vectors)
357359

358360
end subroutine initialize_json_core_in_file
359361
!*****************************************************************************************
@@ -416,7 +418,8 @@ function initialize_json_file(p,verbose,compact_reals,&
416418
unescape_strings,&
417419
comment_char,&
418420
path_mode,&
419-
path_separator) result(file_object)
421+
path_separator,&
422+
compress_vectors) result(file_object)
420423

421424
implicit none
422425

@@ -434,7 +437,8 @@ function initialize_json_file(p,verbose,compact_reals,&
434437
unescape_strings,&
435438
comment_char,&
436439
path_mode,&
437-
path_separator)
440+
path_separator,&
441+
compress_vectors)
438442

439443
if (present(p)) file_object%p => p
440444

‎src/json_initialize_arguments.inc

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,3 +38,9 @@
3838
!! Example: `.` [default] or `%`.
3939
!! Note: if `path_mode/=1`
4040
!! then this is ignored.
41+
logical(LK),intent(in),optional :: compress_vectors !! If true, then arrays of integers,
42+
!! nulls, doubles, and logicals are
43+
!! printed all on one line.
44+
!! [Note: `no_whitespace` will
45+
!! override this option if necessary].
46+
!! (Default is False).

‎src/json_value_module.F90

Lines changed: 114 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -222,6 +222,12 @@ module json_value_module
222222
!! Note: if `path_mode/=1`
223223
!! then this is ignored.
224224

225+
logical(LK) :: compress_vectors = .false. !! If true, then arrays of integers,
226+
!! nulls, doubles, & logicals are
227+
!! printed all on one line.
228+
!! [Note: `no_whitespace` will
229+
!! override this option if necessary]
230+
225231
contains
226232

227233
private
@@ -757,7 +763,8 @@ function initialize_json_core(verbose,compact_reals,&
757763
unescape_strings,&
758764
comment_char,&
759765
path_mode,&
760-
path_separator) result(json_core_object)
766+
path_separator,&
767+
compress_vectors) result(json_core_object)
761768

762769
implicit none
763770

@@ -773,7 +780,8 @@ function initialize_json_core(verbose,compact_reals,&
773780
unescape_strings,&
774781
comment_char,&
775782
path_mode,&
776-
path_separator)
783+
path_separator,&
784+
compress_vectors)
777785

778786
end function initialize_json_core
779787
!*****************************************************************************************
@@ -806,7 +814,8 @@ subroutine json_initialize(json,verbose,compact_reals,&
806814
unescape_strings,&
807815
comment_char,&
808816
path_mode,&
809-
path_separator)
817+
path_separator,&
818+
compress_vectors)
810819

811820
implicit none
812821

@@ -873,6 +882,11 @@ subroutine json_initialize(json,verbose,compact_reals,&
873882
json%path_separator = path_separator
874883
end if
875884

885+
! printing vectors in compressed form:
886+
if (present(compress_vectors)) then
887+
json%compress_vectors = compress_vectors
888+
end if
889+
876890
!Set the format for real numbers:
877891
! [if not changing it, then it remains the same]
878892

@@ -4759,7 +4773,8 @@ end subroutine json_print_2
47594773
! bug in v4.9 of the gfortran compiler.
47604774

47614775
recursive subroutine json_value_print(json,p,iunit,str,indent,&
4762-
need_comma,colon,is_array_element)
4776+
need_comma,colon,is_array_element,&
4777+
is_compressed_vector)
47634778

47644779
implicit none
47654780

@@ -4775,17 +4790,29 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
47754790
!! printed to this string rather than
47764791
!! a file. This mode is used by
47774792
!! [[json_value_to_string]].
4793+
logical(LK),intent(in),optional :: is_compressed_vector !! if True, this is an element
4794+
!! from an array being printed
4795+
!! on one line [default is False]
47784796

4779-
character(kind=CK,len=max_numeric_str_len) :: tmp !for val to string conversions
4797+
character(kind=CK,len=max_numeric_str_len) :: tmp !! for val to string conversions
47804798
character(kind=CK,len=:),allocatable :: s
47814799
type(json_value),pointer :: element
47824800
integer(IK) :: tab, i, count, spaces
47834801
logical(LK) :: print_comma
47844802
logical(LK) :: write_file, write_string
47854803
logical(LK) :: is_array
4804+
integer(IK) :: var_type,var_type_prev
4805+
logical(LK) :: is_vector !! if all elements of a vector
4806+
!! are scalars of the same type
47864807

47874808
if (.not. json%exception_thrown) then
47884809

4810+
if (present(is_compressed_vector)) then
4811+
is_vector = is_compressed_vector
4812+
else
4813+
is_vector = .false.
4814+
end if
4815+
47894816
!whether to write a string or a file (one or the other):
47904817
write_string = (iunit==unit2str)
47914818
write_file = .not. write_string
@@ -4890,13 +4917,42 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
48904917

48914918
count = json%count(p)
48924919

4920+
if (json%compress_vectors) then
4921+
! check to see if every child is the same type,
4922+
! and a scalar:
4923+
is_vector = .true.
4924+
var_type_prev = -1 ! an invalid value
4925+
nullify(element)
4926+
element => p%children
4927+
do i = 1, count
4928+
if (.not. associated(element)) then
4929+
call json%throw_exception('Error in json_value_print: '//&
4930+
'Malformed JSON linked list')
4931+
return
4932+
end if
4933+
! check variable type of all the children.
4934+
! They must all be the same, and a scalar.
4935+
call json%info(element,var_type=var_type)
4936+
if (i>1 .and. (var_type/=var_type_prev .or. &
4937+
any(var_type==[json_object,json_array]))) then
4938+
is_vector = .false.
4939+
exit
4940+
end if
4941+
var_type_prev = var_type
4942+
! get the next child the list:
4943+
element => element%next
4944+
end do
4945+
else
4946+
is_vector = .false.
4947+
end if
4948+
48934949
if (count==0) then !special case for empty array
48944950

48954951
call write_it( s//start_array//end_array, comma=print_comma )
48964952

48974953
else
48984954

4899-
call write_it( s//start_array )
4955+
call write_it( s//start_array, advance=(.not. is_vector) )
49004956

49014957
!if an array is in an array, there is an extra tab:
49024958
if (is_array) then
@@ -4915,30 +4971,44 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49154971
end if
49164972

49174973
! recursive print of the element
4918-
call json%json_value_print(element, iunit=iunit, indent=tab,&
4919-
need_comma=i<count, is_array_element=.true., str=str)
4920-
4974+
if (is_vector) then
4975+
call json%json_value_print(element, iunit=iunit, indent=0,&
4976+
need_comma=i<count, is_array_element=.false., str=str,&
4977+
is_compressed_vector = .true.)
4978+
else
4979+
call json%json_value_print(element, iunit=iunit, indent=tab,&
4980+
need_comma=i<count, is_array_element=.true., str=str)
4981+
end if
49214982
! get the next child the list:
49224983
element => element%next
49234984

49244985
end do
49254986

49264987
!indent the closing array character:
4927-
call write_it( repeat(space, max(0,spaces-json%spaces_per_tab))//end_array,&
4928-
comma=print_comma )
4988+
if (is_vector) then
4989+
call write_it( end_array,comma=print_comma )
4990+
else
4991+
call write_it( repeat(space, max(0,spaces-json%spaces_per_tab))//end_array,&
4992+
comma=print_comma )
4993+
end if
49294994
nullify(element)
49304995

49314996
end if
49324997

49334998
case (json_null)
49344999

4935-
call write_it( s//null_str, comma=print_comma )
5000+
call write_it( s//null_str, comma=print_comma, &
5001+
advance=(.not. is_vector),&
5002+
space_after_comma=is_vector )
49365003

49375004
case (json_string)
49385005

49395006
if (allocated(p%str_value)) then
49405007
call write_it( s//quotation_mark// &
4941-
p%str_value//quotation_mark, comma=print_comma )
5008+
p%str_value//quotation_mark, &
5009+
comma=print_comma, &
5010+
advance=(.not. is_vector),&
5011+
space_after_comma=is_vector )
49425012
else
49435013
call json%throw_exception('Error in json_value_print:'//&
49445014
' p%value_string not allocated')
@@ -4948,16 +5018,22 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49485018
case (json_logical)
49495019

49505020
if (p%log_value) then
4951-
call write_it( s//true_str, comma=print_comma )
5021+
call write_it( s//true_str, comma=print_comma, &
5022+
advance=(.not. is_vector),&
5023+
space_after_comma=is_vector )
49525024
else
4953-
call write_it( s//false_str, comma=print_comma )
5025+
call write_it( s//false_str, comma=print_comma, &
5026+
advance=(.not. is_vector),&
5027+
space_after_comma=is_vector )
49545028
end if
49555029

49565030
case (json_integer)
49575031

49585032
call integer_to_string(p%int_value,int_fmt,tmp)
49595033

4960-
call write_it( s//trim(tmp), comma=print_comma )
5034+
call write_it( s//trim(tmp), comma=print_comma, &
5035+
advance=(.not. is_vector),&
5036+
space_after_comma=is_vector )
49615037

49625038
case (json_double)
49635039

@@ -4968,7 +5044,9 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49685044
call real_to_string(p%dbl_value,default_real_fmt,json%compact_real,tmp)
49695045
end if
49705046

4971-
call write_it( s//trim(tmp), comma=print_comma )
5047+
call write_it( s//trim(tmp), comma=print_comma, &
5048+
advance=(.not. is_vector),&
5049+
space_after_comma=is_vector )
49725050

49735051
case default
49745052

@@ -4983,26 +5061,36 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49835061

49845062
contains
49855063

4986-
subroutine write_it(s,advance,comma)
5064+
subroutine write_it(s,advance,comma,space_after_comma)
49875065

49885066
!! write the string to the file (or the output string)
49895067

49905068
implicit none
49915069

4992-
character(kind=CK,len=*),intent(in) :: s !! string to print
4993-
logical(LK),intent(in),optional :: advance !! to add line break or not
4994-
logical(LK),intent(in),optional :: comma !! print comma after the string
5070+
character(kind=CK,len=*),intent(in) :: s !! string to print
5071+
logical(LK),intent(in),optional :: advance !! to add line break or not
5072+
logical(LK),intent(in),optional :: comma !! print comma after the string
5073+
logical(LK),intent(in),optional :: space_after_comma !! print a space after the comma
49955074

49965075
logical(LK) :: add_comma !! if a delimiter is to be added after string
49975076
logical(LK) :: add_line_break !! if a line break is to be added after string
5077+
logical(LK) :: add_space !! if a space is to be added after the comma
49985078
character(kind=CK,len=:),allocatable :: s2 !! temporary string
49995079

50005080
if (present(comma)) then
50015081
add_comma = comma
50025082
else
50035083
add_comma = .false. !default is not to add comma
50045084
end if
5005-
5085+
if (json%no_whitespace) then
5086+
add_space = .false.
5087+
else
5088+
if (present(space_after_comma)) then
5089+
add_space = space_after_comma
5090+
else
5091+
add_space = .false. !default is not to add space
5092+
end if
5093+
end if
50065094
if (present(advance)) then
50075095
add_line_break = advance
50085096
else
@@ -5012,7 +5100,10 @@ subroutine write_it(s,advance,comma)
50125100

50135101
!string to print:
50145102
s2 = s
5015-
if (add_comma) s2 = s2 // delimiter
5103+
if (add_comma) then
5104+
s2 = s2 // delimiter
5105+
if (add_space) s2 = s2 // space
5106+
end if
50165107

50175108
if (write_file) then
50185109

0 commit comments

Comments
 (0)