Skip to content

Commit 044baf7

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #221 from jacobwilliams/insert
Insert routine
2 parents 0570381 + f86df6b commit 044baf7

File tree

2 files changed

+376
-3
lines changed

2 files changed

+376
-3
lines changed

‎src/json_value_module.F90‎

Lines changed: 162 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -148,7 +148,6 @@ module json_value_module
148148
! call json%print(p,'test.json') !write it to a file
149149
! call json%destroy(p) !cleanup
150150
! end program test
151-
! type,public :: json_core
152151
!````
153152
type,public :: json_core
154153

@@ -503,6 +502,14 @@ module json_value_module
503502
procedure :: json_matrix_info
504503
procedure :: MAYBEWRAP(json_matrix_info_by_path)
505504

505+
!>
506+
! insert a new element after an existing one,
507+
! updating the JSON structure accordingly
508+
generic,public :: insert_after => json_value_insert_after, &
509+
json_value_insert_after_child_by_index
510+
procedure :: json_value_insert_after
511+
procedure :: json_value_insert_after_child_by_index
512+
506513
procedure,public :: remove => json_value_remove !! Remove a [[json_value]] from a linked-list structure.
507514
procedure,public :: check_for_errors => json_check_for_errors !! check for error and get error message
508515
procedure,public :: clear_exceptions => json_clear_exceptions !! clear exceptions
@@ -518,7 +525,7 @@ module json_value_module
518525
procedure,public :: print_error_message => json_print_error_message !! simply routine to print error messages
519526
procedure,public :: swap => json_value_swap !! Swap two [[json_value]] pointers
520527
!! in a structure (or two different structures).
521-
procedure,public :: is_child_of => json_value_is_child_of !! Check if a [[json_value]] is a child of another.
528+
procedure,public :: is_child_of => json_value_is_child_of !! Check if a [[json_value]] is a descendant of another.
522529
procedure,public :: validate => json_value_validate !! Check that a [[json_value]] linked list is valid
523530
!! (i.e., is properly constructed). This may be
524531
!! useful if it has been constructed externally.
@@ -2375,7 +2382,7 @@ subroutine json_update_string(json,p,name,val,found)
23752382
case default
23762383
found = .false.
23772384
call json%throw_exception('Error in json_update_string: '//&
2378-
'the variable is not a scalar value')
2385+
'the variable is not a scalar value')
23792386
end select
23802387

23812388
else
@@ -2481,6 +2488,158 @@ subroutine json_value_add_member(json,p,member)
24812488
end subroutine json_value_add_member
24822489
!*****************************************************************************************
24832490

2491+
!*****************************************************************************************
2492+
!>
2493+
! Inserts `element` after `p`, and updates the JSON structure accordingly.
2494+
!
2495+
!### Example
2496+
!
2497+
!````fortran
2498+
! program test
2499+
! use json_module
2500+
! implicit none
2501+
! logical(json_LK) :: found
2502+
! type(json_core) :: json
2503+
! type(json_value),pointer :: p,new,element
2504+
! call json%parse(file='myfile.json', p=p)
2505+
! call json%get(p,'x(3)',element,found) ! get pointer to an array element in the file
2506+
! call json%create_integer(new,1,'') ! create a new element
2507+
! call json%insert_after(element,new) ! insert new element after x(3)
2508+
! call json%print(p,'myfile2.json') ! write it to a file
2509+
! call json%destroy(p) ! cleanup
2510+
! end program test
2511+
!````
2512+
!
2513+
!### Details
2514+
!
2515+
! * This routine can be used to insert a new element (or set of elements)
2516+
! into an array or object at a specific index.
2517+
! See [[json_value_insert_after_child_by_index]]
2518+
! * Children and subsequent elements of `element` are carried along.
2519+
! * If the inserted elements are part of an existing list, then
2520+
! they are removed from that list.
2521+
!
2522+
!````
2523+
! p
2524+
! [1] - [2] - [3] - [4]
2525+
! |
2526+
! [5] - [6] - [7] n=3 elements inserted
2527+
! element last
2528+
!
2529+
! Result is:
2530+
!
2531+
! [1] - [2] - [5] - [6] - [7] - [3] - [4]
2532+
!
2533+
!````
2534+
2535+
subroutine json_value_insert_after(json,p,element)
2536+
2537+
implicit none
2538+
2539+
class(json_core),intent(inout) :: json
2540+
type(json_value),pointer :: p !! a value from a JSON structure
2541+
!! (presumably, this is a child of
2542+
!! an object or array).
2543+
type(json_value),pointer :: element !! the element to insert after `p`
2544+
2545+
type(json_value),pointer :: parent !! the parent of `p`
2546+
type(json_value),pointer :: next !! temp pointer for traversing structure
2547+
type(json_value),pointer :: last !! the last of the items being inserted
2548+
integer :: n !! number of items being inserted
2549+
2550+
if (.not. json%exception_thrown) then
2551+
2552+
parent => p%parent
2553+
2554+
! set first parent of inserted list:
2555+
element%parent => parent
2556+
2557+
! Count the number of inserted elements.
2558+
! and set their parents.
2559+
n = 1 ! initialize counter
2560+
next => element%next
2561+
last => element
2562+
do
2563+
if (.not. associated(next)) exit
2564+
n = n + 1
2565+
next%parent => parent
2566+
last => next
2567+
next => next%next
2568+
end do
2569+
2570+
if (associated(parent)) then
2571+
! update parent's child counter:
2572+
parent%n_children = parent%n_children + n
2573+
! if p is last of parents children then
2574+
! also have to update parent tail pointer:
2575+
if (associated(parent%tail,p)) then
2576+
parent%tail => last
2577+
end if
2578+
end if
2579+
2580+
if (associated(element%previous)) then
2581+
! element is apparently part of an existing list,
2582+
! so have to update that as well.
2583+
if (associated(element%previous%parent)) then
2584+
element%previous%parent%n_children = &
2585+
element%previous%parent%n_children - n
2586+
element%previous%parent%tail => &
2587+
element%previous ! now the last one in the list
2588+
else
2589+
! this would be a memory leak if the previous entries
2590+
! are not otherwise being pointed too
2591+
! [throw an error in this case???]
2592+
end if
2593+
!remove element from the other list:
2594+
element%previous%next => null()
2595+
end if
2596+
element%previous => p
2597+
2598+
if (associated(p%next)) then
2599+
! if there are any in the list after p:
2600+
last%next => p%next
2601+
last%next%previous => element
2602+
else
2603+
last%next => null()
2604+
end if
2605+
p%next => element
2606+
2607+
end if
2608+
2609+
end subroutine json_value_insert_after
2610+
!*****************************************************************************************
2611+
2612+
!*****************************************************************************************
2613+
!>
2614+
! Inserts `element` after the `idx`-th child of `p`,
2615+
! and updates the JSON structure accordingly. This is just
2616+
! a wrapper for [[json_value_insert_after]].
2617+
2618+
subroutine json_value_insert_after_child_by_index(json,p,idx,element)
2619+
2620+
implicit none
2621+
2622+
class(json_core),intent(inout) :: json
2623+
type(json_value),pointer :: p !! a JSON object or array.
2624+
integer(IK),intent(in) :: idx !! the index of the child of `p` to
2625+
!! insert the new element after
2626+
type(json_value),pointer :: element !! the element to insert
2627+
2628+
type(json_value),pointer :: tmp !! for getting the `idx`-th child of `p`
2629+
2630+
if (.not. json%exception_thrown) then
2631+
2632+
! get the idx-th child of p:
2633+
call json%get_child(p,idx,tmp)
2634+
2635+
! call json_value_insert_after:
2636+
if (.not. json%failed()) call json%insert_after(tmp,element)
2637+
2638+
end if
2639+
2640+
end subroutine json_value_insert_after_child_by_index
2641+
!*****************************************************************************************
2642+
24842643
!*****************************************************************************************
24852644
!> author: Jacob Williams
24862645
! date: 1/19/2014

0 commit comments

Comments
 (0)