toml.f90 Source File

!># Interface to TOML processing library
!>
!> This module acts as a proxy to the `toml-f` public Fortran API and allows
!> to selectively expose components from the library to `fpm`.
!> The interaction with `toml-f` data types outside of this module should be
!> limited to tables, arrays and key-lists, most of the necessary interactions
!> are implemented in the building interface with the `get_value` and `set_value`
!> procedures.
!>
!> This module allows to implement features necessary for `fpm`, which are
!> not yet available in upstream `toml-f`.
!>
!> For more details on the library used see the
!> [TOML-Fortran](https://toml-f.github.io/toml-f) developer pages.
module fpm_toml
    use fpm_error, only: error_t, fatal_error, file_not_found_error
    use fpm_strings, only: string_t
    use tomlf, only: toml_table, toml_array, toml_key, toml_stat, get_value, &
        & set_value, toml_parse, toml_error, new_table, add_table, add_array, &
        & toml_serialize, len, toml_load
    implicit none
    private

    public :: read_package_file, toml_table, toml_array, toml_key, toml_stat, &
              get_value, set_value, get_list, new_table, add_table, add_array, len, &
              toml_error, toml_serialize, toml_load, check_keys

contains

    !> Process the configuration file to a TOML data structure
    subroutine read_package_file(table, manifest, error)

        !> TOML data structure
        type(toml_table), allocatable, intent(out) :: table

        !> Name of the package configuration file
        character(len=*), intent(in) :: manifest

        !> Error status of the operation
        type(error_t), allocatable, intent(out) :: error

        type(toml_error), allocatable :: parse_error
        integer :: unit
        logical :: exist

        inquire (file=manifest, exist=exist)

        if (.not. exist) then
            call file_not_found_error(error, manifest)
            return
        end if

        open(file=manifest, newunit=unit)
        call toml_load(table, unit, error=parse_error)
        close(unit)

        if (allocated(parse_error)) then
            allocate (error)
            call move_alloc(parse_error%message, error%message)
            return
        end if

    end subroutine read_package_file

    subroutine get_list(table, key, list, error)

        !> Instance of the TOML data structure
        type(toml_table), intent(inout) :: table

        !> Key to read from
        character(len=*), intent(in) :: key

        !> List of strings to read
        type(string_t), allocatable, intent(out) :: list(:)

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        integer :: stat, ilist, nlist
        type(toml_array), pointer :: children
        character(len=:), allocatable :: str

        if (.not.table%has_key(key)) return

        call get_value(table, key, children, requested=.false.)
        if (associated(children)) then
            nlist = len(children)
            allocate (list(nlist))
            do ilist = 1, nlist
                call get_value(children, ilist, str, stat=stat)
                if (stat /= toml_stat%success) then
                    call fatal_error(error, "Entry in "//key//" field cannot be read")
                    exit
                end if
                call move_alloc(str, list(ilist)%s)
            end do
            if (allocated(error)) return
        else
            call get_value(table, key, str, stat=stat)
            if (stat /= toml_stat%success) then
                call fatal_error(error, "Entry in "//key//" field cannot be read")
                return
            end if
            if (allocated(str)) then
                allocate (list(1))
                call move_alloc(str, list(1)%s)
            end if
        end if

    end subroutine get_list

    !> Check if table contains only keys that are part of the list. If a key is
    !> found that is not part of the list, an error is allocated.
    subroutine check_keys(table, valid_keys, error)

        !> Instance of the TOML data structure
        type(toml_table), intent(inout) :: table

        !> List of keys to check.
        character(len=*), intent(in) :: valid_keys(:)

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        type(toml_key), allocatable :: keys(:)
        type(toml_table), pointer :: child
        character(:), allocatable :: name, value, valid_keys_string
        integer :: ikey, ivalid

        call table%get_key(name)
        call table%get_keys(keys)

        do ikey = 1, size(keys)
            if (.not. any(keys(ikey)%key == valid_keys)) then
                ! Generate error message
                valid_keys_string = new_line('a')//new_line('a')
                do ivalid = 1, size(valid_keys)
                    valid_keys_string = valid_keys_string//trim(valid_keys(ivalid))//new_line('a')
                end do
                allocate (error)
                error%message = "Key '"//keys(ikey)%key//"' not allowed in the '"// &
                & name//"' table."//new_line('a')//new_line('a')//'Valid keys: '//valid_keys_string
                return
            end if

            ! Check if value can be mapped or else (wrong type) show error message with the error location.
            ! Right now, it can only be mapped to a string or to a child node, but this can be extended in the future.
            call get_value(table, keys(ikey)%key, value)
            if (.not. allocated(value)) then

                ! If value is not a string, check if it is a child node
                call get_value(table, keys(ikey)%key, child)

                if (.not.associated(child)) then
                    allocate (error)
                    error%message = "'"//name//"' has an invalid '"//keys(ikey)%key//"' entry."
                    return
                endif
            end if
        end do

    end subroutine check_keys

end module fpm_toml