Merge pull request #206 from jacobwilliams/json-file-traverse

JSON file traverse

Author: jacobwilliams

src/json_file_module.F90

@@ -61,13 +61,15 @@ module json_file_module
 
         private
 
-        type(json_core) :: json !! the instance of the [[json_core]] factory used for this file
-
+        type(json_core) :: core !! The instance of the [[json_core]] factory used for this file.
         type(json_value),pointer :: p => null()  !! the JSON structure read from the file
 
     contains
 
-        procedure,public :: initialize => initialize_json_core_in_file
+        generic,public :: initialize => initialize_json_core_in_file,&
+                                        set_json_core_in_file
+
+        procedure,public :: get_core => get_json_core_in_file
 
         procedure,public :: load_file => json_file_load
 
@@ -109,9 +111,20 @@ module json_file_module
                                     json_file_update_string_val_ascii
 #endif
 
+        !traverse
+        procedure,public :: traverse => json_file_traverse
+
+        ! ***************************************************
+        ! private routines
+        ! ***************************************************
+
         !load from string:
         procedure :: MAYBEWRAP(json_file_load_from_string)
 
+        !initialize
+        procedure :: initialize_json_core_in_file
+        procedure :: set_json_core_in_file
+
         !git info:
         procedure :: MAYBEWRAP(json_file_variable_info)
 
@@ -188,7 +201,7 @@ pure function json_file_failed(me) result(failed)
     class(json_file),intent(in) :: me
     logical(LK)                 :: failed  !! will be true if there has been an error.
 
-    failed = me%json%failed()
+    failed = me%core%failed()
 
     end function json_file_failed
 !*****************************************************************************************
@@ -205,7 +218,7 @@ subroutine json_file_check_for_errors(me,status_ok,error_msg)
     logical(LK),intent(out) :: status_ok !! true if there were no errors
     character(kind=CK,len=:),allocatable,intent(out) :: error_msg !! the error message (if there were errors)
 
-    call me%json%check_for_errors(status_ok,error_msg)
+    call me%core%check_for_errors(status_ok,error_msg)
 
     end subroutine json_file_check_for_errors
 !*****************************************************************************************
@@ -220,7 +233,7 @@ pure subroutine json_file_clear_exceptions(me)
 
     class(json_file),intent(inout) :: me
 
-    call me%json%clear_exceptions()
+    call me%core%clear_exceptions()
 
     end subroutine json_file_clear_exceptions
 !*****************************************************************************************
@@ -236,7 +249,7 @@ subroutine json_file_print_error_message(me,io_unit)
     class(json_file),intent(inout) :: me
     integer, intent(in), optional  :: io_unit
 
-    call me%json%print_error_message(io_unit)
+    call me%core%print_error_message(io_unit)
 
     end subroutine json_file_print_error_message
 !*****************************************************************************************
@@ -274,7 +287,7 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
     logical(LK),intent(in),optional :: case_sensitive_keys  !! for name and path comparisons, are they
                                                             !! case sensitive.
 
-    call me%json%initialize(verbose,compact_reals,&
+    call me%core%initialize(verbose,compact_reals,&
                             print_signs,real_format,spaces_per_tab,&
                             strict_type_checking,&
                             trailing_spaces_significant,&
@@ -283,6 +296,44 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
     end subroutine initialize_json_core_in_file
 !*****************************************************************************************
 
+!*****************************************************************************************
+!>
+!  Set the [[json_core]] for this [[json_file]].
+!
+!@note: This does not destroy the data in the file.
+!
+!@note: This one is used if you want to initialize the file with
+!       an already-existing [[json_core]] (presumably, this was already
+!       initialized by a call to [[initialize_json_core]] or similar).
+
+    subroutine set_json_core_in_file(me,core)
+
+    implicit none
+
+    class(json_file),intent(inout) :: me
+    type(json_core),intent(in)     :: core
+
+    me%core = core
+
+    end subroutine set_json_core_in_file
+!*****************************************************************************************
+
+!*****************************************************************************************
+!>
+!  Get a copy of the [[json_core]] in this [[json_file]].
+
+    subroutine get_json_core_in_file(me,core)
+
+    implicit none
+
+    class(json_file),intent(in) :: me
+    type(json_core),intent(out) :: core
+
+    core = me%core
+
+    end subroutine get_json_core_in_file
+!*****************************************************************************************
+
 !*****************************************************************************************
 !> author: Izaak Beekman
 !  date: 07/23/2015
@@ -346,7 +397,7 @@ function initialize_json_file_v2(json_value_object, json_core_object) &
     type(json_core),intent(in)          :: json_core_object
 
     file_object%p    => json_value_object
-    file_object%json = json_core_object
+    file_object%core = json_core_object
 
     end function initialize_json_file_v2
 !*****************************************************************************************
@@ -375,10 +426,10 @@ subroutine json_file_destroy(me,destroy_core)
     logical,intent(in),optional :: destroy_core  !! to also destroy the [[json_core]].
                                                  !! default is to leave it as is.
 
-    if (associated(me%p)) call me%json%destroy(me%p)
+    if (associated(me%p)) call me%core%destroy(me%p)
 
     if (present(destroy_core)) then
-        if (destroy_core) call me%json%destroy()
+        if (destroy_core) call me%core%destroy()
     end if
 
     end subroutine json_file_destroy
@@ -405,7 +456,7 @@ subroutine json_file_move_pointer(to,from)
         if (from%failed()) then
             !Don't get the data if the FROM file has an
             !active exception, since it may not be valid.
-            call to%json%throw_exception('Error in json_file_move_pointer: '//&
+            call to%core%throw_exception('Error in json_file_move_pointer: '//&
                                          'error exception in FROM file.')
         else
             call to%initialize()  !initialize and clear any exceptions that may be present
@@ -414,7 +465,7 @@ subroutine json_file_move_pointer(to,from)
         end if
 
     else
-        call to%json%throw_exception('Error in json_file_move_pointer: '//&
+        call to%core%throw_exception('Error in json_file_move_pointer: '//&
                                      'pointer is not associated.')
     end if
 
@@ -448,7 +499,7 @@ subroutine json_file_load(me, filename, unit)
     character(kind=CDK,len=*),intent(in) :: filename  !! the filename to open
     integer(IK),intent(in),optional      :: unit      !! the unit number to use (if not present, a newunit is used)
 
-    call me%json%parse(file=filename, p=me%p, unit=unit)
+    call me%core%parse(file=filename, p=me%p, unit=unit)
 
     end subroutine json_file_load
 !*****************************************************************************************
@@ -474,7 +525,7 @@ subroutine json_file_load_from_string(me, str)
     class(json_file),intent(inout)      :: me
     character(kind=CK,len=*),intent(in) :: str  !! string to load JSON data from
 
-    call me%json%parse(str=str, p=me%p)
+    call me%core%parse(str=str, p=me%p)
 
     end subroutine json_file_load_from_string
 !*****************************************************************************************
@@ -507,7 +558,7 @@ subroutine json_file_print_to_console(me)
 
     class(json_file),intent(inout)  :: me
 
-    call me%json%print(me%p,iunit=output_unit)
+    call me%core%print(me%p,iunit=output_unit)
 
     end subroutine json_file_print_to_console
 !*****************************************************************************************
@@ -526,9 +577,9 @@ subroutine json_file_print_1(me, iunit)
     integer(IK),intent(in)          :: iunit  !! file unit number (must not be -1)
 
     if (iunit/=unit2str) then
-        call me%json%print(me%p,iunit=iunit)
+        call me%core%print(me%p,iunit=iunit)
     else
-        call me%json%throw_exception('Error in json_file_print_1: iunit must not be -1.')
+        call me%core%throw_exception('Error in json_file_print_1: iunit must not be -1.')
     end if
 
     end subroutine json_file_print_1
@@ -559,7 +610,7 @@ subroutine json_file_print_2(me,filename)
     class(json_file),intent(inout)       :: me
     character(kind=CDK,len=*),intent(in) :: filename  !! filename to print to
 
-    call me%json%print(me%p,filename)
+    call me%core%print(me%p,filename)
 
     end subroutine json_file_print_2
 !*****************************************************************************************
@@ -587,7 +638,7 @@ subroutine json_file_print_to_string(me,str)
     class(json_file),intent(inout)                   :: me
     character(kind=CK,len=:),allocatable,intent(out) :: str  !! string to print JSON data to
 
-    call me%json%print_to_string(me%p,str)
+    call me%core%print_to_string(me%p,str)
 
     end subroutine json_file_print_to_string
 !*****************************************************************************************
@@ -619,7 +670,7 @@ subroutine json_file_variable_info(me,path,found,var_type,n_children)
     if (found) then
 
         !get info:
-        call me%json%info(p,var_type,n_children)
+        call me%core%info(p,var_type,n_children)
 
     else
 
@@ -689,7 +740,7 @@ subroutine json_file_get_object(me, path, p, found)
     type(json_value),pointer,intent(out) :: p      !! pointer to the variable
     logical(LK),intent(out),optional     :: found  !! if it was really found
 
-    call me%json%get(me%p, path=path, p=p, found=found)
+    call me%core%get(me%p, path=path, p=p, found=found)
 
     end subroutine json_file_get_object
 !*****************************************************************************************
@@ -727,7 +778,7 @@ subroutine json_file_get_integer(me, path, val, found)
     integer(IK),intent(out)             :: val    !! value
     logical(LK),intent(out),optional    :: found  !! if it was really found
 
-    call me%json%get(me%p, path=path, value=val, found=found)
+    call me%core%get(me%p, path=path, value=val, found=found)
 
     end subroutine json_file_get_integer
 !*****************************************************************************************
@@ -765,7 +816,7 @@ subroutine json_file_get_integer_vec(me, path, vec, found)
     integer(IK),dimension(:),allocatable,intent(out) :: vec    !! the value vector
     logical(LK),intent(out),optional                 :: found  !! if it was really found
 
-    call me%json%get(me%p, path, vec, found)
+    call me%core%get(me%p, path, vec, found)
 
     end subroutine json_file_get_integer_vec
 !*****************************************************************************************
@@ -803,7 +854,7 @@ subroutine json_file_get_double (me, path, val, found)
     real(RK),intent(out)                :: val
     logical(LK),intent(out),optional    :: found
 
-    call me%json%get(me%p, path=path, value=val, found=found)
+    call me%core%get(me%p, path=path, value=val, found=found)
 
     end subroutine json_file_get_double
 !*****************************************************************************************
@@ -841,7 +892,7 @@ subroutine json_file_get_double_vec(me, path, vec, found)
     real(RK),dimension(:),allocatable,intent(out) :: vec
     logical(LK),intent(out),optional              :: found
 
-    call me%json%get(me%p, path, vec, found)
+    call me%core%get(me%p, path, vec, found)
 
     end subroutine json_file_get_double_vec
 !*****************************************************************************************
@@ -879,7 +930,7 @@ subroutine json_file_get_logical(me,path,val,found)
     logical(LK),intent(out)              :: val
     logical(LK),intent(out),optional     :: found
 
-    call me%json%get(me%p, path=path, value=val, found=found)
+    call me%core%get(me%p, path=path, value=val, found=found)
 
     end subroutine json_file_get_logical
 !*****************************************************************************************
@@ -917,7 +968,7 @@ subroutine json_file_get_logical_vec(me, path, vec, found)
     logical(LK),dimension(:),allocatable,intent(out) :: vec
     logical(LK),intent(out),optional                 :: found
 
-    call me%json%get(me%p, path, vec, found)
+    call me%core%get(me%p, path, vec, found)
 
     end subroutine json_file_get_logical_vec
 !*****************************************************************************************
@@ -956,7 +1007,7 @@ subroutine json_file_get_string(me, path, val, found)
     character(kind=CK,len=:),allocatable,intent(out) :: val
     logical(LK),intent(out),optional                 :: found
 
-    call me%json%get(me%p, path=path, value=val, found=found)
+    call me%core%get(me%p, path=path, value=val, found=found)
 
     end subroutine json_file_get_string
 !*****************************************************************************************
@@ -994,7 +1045,7 @@ subroutine json_file_get_string_vec(me, path, vec, found)
     character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec
     logical(LK),intent(out),optional                              :: found
 
-    call me%json%get(me%p, path, vec, found)
+    call me%core%get(me%p, path, vec, found)
 
     end subroutine json_file_get_string_vec
 !*****************************************************************************************
@@ -1037,7 +1088,7 @@ subroutine json_file_update_integer(me,name,val,found)
     integer(IK),intent(in)              :: val
     logical(LK),intent(out)             :: found
 
-    if (.not. me%json%failed()) call me%json%update(me%p,name,val,found)
+    if (.not. me%core%failed()) call me%core%update(me%p,name,val,found)
 
     end subroutine json_file_update_integer
 !*****************************************************************************************
@@ -1080,7 +1131,7 @@ subroutine json_file_update_logical(me,name,val,found)
     logical(LK),intent(in)              :: val
     logical(LK),intent(out)             :: found
 
-    if (.not. me%json%failed()) call me%json%update(me%p,name,val,found)
+    if (.not. me%core%failed()) call me%core%update(me%p,name,val,found)
 
     end subroutine json_file_update_logical
 !*****************************************************************************************
@@ -1123,7 +1174,7 @@ subroutine json_file_update_real(me,name,val,found)
     real(RK),intent(in)                 :: val
     logical(LK),intent(out)             :: found
 
-    if (.not. me%json%failed()) call me%json%update(me%p,name,val,found)
+    if (.not. me%core%failed()) call me%core%update(me%p,name,val,found)
 
     end subroutine json_file_update_real
 !*****************************************************************************************
@@ -1166,7 +1217,7 @@ subroutine json_file_update_string(me,name,val,found)
     character(kind=CK,len=*),intent(in) :: val
     logical(LK),intent(out)             :: found
 
-    if (.not. me%json%failed()) call me%json%update(me%p,name,val,found)
+    if (.not. me%core%failed()) call me%core%update(me%p,name,val,found)
 
     end subroutine json_file_update_string
 !*****************************************************************************************
@@ -1225,6 +1276,26 @@ subroutine json_file_update_string_val_ascii(me,name,val,found)
     end subroutine json_file_update_string_val_ascii
 !*****************************************************************************************
 
+!*****************************************************************************************
+!> author: Jacob Williams
+!  date: 6/11/2016
+!
+!  Traverse the JSON structure in the file.
+!  This routine calls the user-specified [[json_traverse_callback_func]]
+!  for each element of the structure.
+
+    subroutine json_file_traverse(me,traverse_callback)
+
+    implicit none
+
+    class(json_file),intent(inout)         :: me
+    procedure(json_traverse_callback_func) :: traverse_callback
+
+    call me%core%traverse(me%p,traverse_callback)
+
+    end subroutine json_file_traverse
+!*****************************************************************************************
+
 !*****************************************************************************************
     end module json_file_module
 !*****************************************************************************************