fdoc

subroutineentity_jsonrecursiveprivate

recursive subroutine entity_json(json, p, id, key, module_index, node)

The JSON form of entity id, for modules.json.

Arguments

NameTypeIntentAttributesDescription
jsontype(json_core)inout

the JSON handler

ptype(project_t)in

the project

idintegerin

the entity

keycharacter(len=*)in

its key in the parent's JSON

module_indexintegerin

position in p%modules, or 0 if not a module

nodetype(json_value)outpointer

the result

Calls

Source

Show the code
recursive subroutine entity_json(json, p, id, key, module_index, node)
    type(json_core), intent(inout) :: json          !! the JSON handler
    type(project_t), intent(in) :: p                !! the project
    integer, intent(in) :: id                       !! the entity
    character(len=*), intent(in) :: key             !! its key in the parent's JSON
    integer, intent(in) :: module_index             !! position in `p%modules`, or 0 if not a module
    type(json_value), pointer, intent(out) :: node  !! the result
    character(len=:), allocatable :: word, url
    type(json_value), pointer :: array

    call json%create_object(node, key)
    associate (e => p%list%box(id)%e)
        call object_word(e, word)
        call entity_url(p%list, id, url)
        call json%add(node, 'name', e%name)
        call json%add(node, 'external_url', './'//url)
        call json%add(node, 'obj', word)
        select case (e%kind)
        case (E_SUBROUTINE, E_FUNCTION, E_MODPROC)
            if (e%iface /= IFACE_NONE) then
                call json%add(node, 'proctype', 'Interface')
                call json%add(node, 'generic', 'False')
                call empty_array('variables')
            else
                call json%add(node, 'proctype', trim(merge('Function  ', 'Subroutine', e%kind == E_FUNCTION)))
                call children('functions', [E_FUNCTION], .false.)
                call children('subroutines', [E_SUBROUTINE], .false.)
                call children_iface('interfaces', .false.)
                call children_iface('absinterfaces', .true.)
                call children('types', [E_TYPE], .false.)
                call children('variables', [E_VARIABLE], .false.)
                call strings('attribs', e%attribs)
            end if
        case (E_MODULE, E_SUBMODULE)
            if (module_index > 0) call public_dicts(module_index)
            call children('functions', [E_FUNCTION], .false.)
            call children('subroutines', [E_SUBROUTINE], .false.)
            call children_iface('interfaces', .false.)
            call children_iface('absinterfaces', .true.)
            call children('types', [E_TYPE], .false.)
            call children('variables', [E_VARIABLE], .false.)
        case (E_INTERFACE)
            call json%add(node, 'proctype', 'Interface')
            call json%add(node, 'generic', 'True')
            call children('functions', [E_FUNCTION], .true.)
            call children('subroutines', [E_SUBROUTINE], .true.)
            call empty_array('variables')
        case (E_TYPE)
            call strings('attribs', e%attribs)
            call children('variables', [E_VARIABLE], .false.)
            call children('boundprocs', [E_BOUNDPROC], .false.)
        case (E_BOUNDPROC)
            call strings('attribs', e%attribs)
            call json%add(node, 'deferred', trim(merge('True ', 'False', e%deferred)))
            call json%add(node, 'generic', trim(merge('True ', 'False', e%generic)))
        case (E_VARIABLE)
            call strings('attribs', e%attribs)
            call json%add(node, 'vartype', e%vartype)
        end select
        call json%add(node, 'permission', e%permission)
    end associate

contains

    !> Add an empty array.
    subroutine empty_array(name)
        character(len=*), intent(in) :: name    !! its key
        call json%create_array(array, name)
        call json%add(node, array)
    end subroutine empty_array

    !> Add an array of strings.
    subroutine strings(name, list)
        character(len=*), intent(in) :: name    !! its key
        type(string_t), intent(in) :: list(:)   !! the strings
        integer :: j
        type(json_value), pointer :: a
        call json%create_array(a, name)
        call json%add(node, a)
        do j = 1, size(list)
            call json%add(a, '', list(j)%s)
        end do
    end subroutine strings

    !> Add an array of the visible children of the kinds given.
    recursive subroutine children(name, kinds, all)
        character(len=*), intent(in) :: name    !! its key
        integer, intent(in) :: kinds(:)         !! the `E_*` constants
        logical, intent(in) :: all              !! true to include those of interfaces
        type(json_value), pointer :: a, item
        integer :: j, child
        call json%create_array(a, name)
        call json%add(node, a)
        do j = 1, size(p%list%box(id)%e%children)
            child = p%list%box(id)%e%children(j)
            associate (c => p%list%box(child)%e)
                if (.not. any(c%kind == kinds)) cycle
                if (.not. c%visible) cycle
                if (c%kind == E_VARIABLE .and. c%var_role /= VAR_PLAIN) cycle
                if (c%iface /= IFACE_NONE .and. .not. all) cycle
                call entity_json(json, p, child, '', 0, item)
                call json%add(a, item)
            end associate
        end do
        if (.not. allocated(p%list%box(id)%e%more%inherited)) return
        do j = 1, size(p%list%box(id)%e%more%inherited)
            child = p%list%box(id)%e%more%inherited(j)
            if (.not. any(p%list%box(child)%e%kind == kinds)) cycle
            if (.not. contains_string(p%list%box(id)%e%display, p%list%box(child)%e%permission)) cycle
            call entity_json(json, p, child, '', 0, item)
            call json%add(a, item)
        end do
    end subroutine children

    !> Add an array of the visible interfaces.
    recursive subroutine children_iface(name, abstract)
        character(len=*), intent(in) :: name    !! its key
        logical, intent(in) :: abstract         !! true for abstract interfaces
        type(json_value), pointer :: a, item
        integer :: j, child
        logical :: wanted
        call json%create_array(a, name)
        call json%add(node, a)
        do j = 1, size(p%list%box(id)%e%children)
            child = p%list%box(id)%e%children(j)
            associate (c => p%list%box(child)%e)
                if (.not. c%visible) cycle
                wanted = (abstract .and. c%iface == IFACE_ABSTRACT) .or. &
                         (.not. abstract .and. (c%iface == IFACE_EXPLICIT .or. c%kind == E_INTERFACE))
                if (.not. wanted) cycle
                call entity_json(json, p, child, '', 0, item)
                call json%add(a, item)
            end associate
        end do
    end subroutine children_iface

    !> Add the public names of the module.
    recursive subroutine public_dicts(which)
        integer, intent(in) :: which    !! position in `p%modules`
        call dict('pub_procs', public_symbols(p, which, 1))
        call dict('pub_absints', public_symbols(p, which, 2))
        call dict('pub_types', public_symbols(p, which, 3))
        call dict('pub_vars', public_symbols(p, which, 4))
    end subroutine public_dicts

    !> Add an object of `symbols`.
    recursive subroutine dict(name, symbols)
        character(len=*), intent(in) :: name        !! its key
        type(symbol_t), intent(in) :: symbols(:)    !! the names
        type(json_value), pointer :: object, item
        integer :: j
        call json%create_object(object, name)
        call json%add(node, object)
        do j = 1, size(symbols)
            if (allocated(p%list%box(symbols(j)%id)%e%external_url)) cycle
            call entity_json(json, p, symbols(j)%id, symbols(j)%name, 0, item)
            call json%add(object, item)
        end do
    end subroutine dict

end subroutine entity_json

Graphs

Calls

Called by