!>
!! Provides array-based, self-extending reference vectors of arbitrary type.
!!
module self_map

    use self_object
    use self_vector
    use self_vector_ref

    implicit none

    private

    type, extends(object) :: item
        class(*), allocatable :: key
        class(*), allocatable :: value
    contains
        procedure :: is_equal => is_equal_item
        procedure :: to_string => to_string_item
    end type

    type, extends(vector), public :: map
    contains
        procedure :: add_keyed_item
        generic :: add => add_keyed_item
        procedure :: get
        procedure :: keys
        procedure :: values
        procedure :: has
        procedure :: has_key
        procedure :: has_value
    end type
    interface map
        module procedure new_empty
    end interface map

contains

    !
    ! type(vector)
    !

    ! constructors

    function new_empty(verbose, initial_size) result(this)
        logical, optional, intent(in) :: verbose
        integer, optional, intent(in) :: initial_size
        type(map) :: this
        if(present(verbose) .and. verbose) print *, 'map%new_empty begin'
        this%vector = vector(verbose, initial_size)
        if(this%get_verbose()) print *, 'map%new_empty end'
    end function new_empty

    subroutine add_keyed_item(this, key, new_stuff)
        class(map),intent(inout) :: this
        class(*), intent(in) :: key
        class(*), intent(in) :: new_stuff
        integer :: idx
        class(*), pointer :: my_item_ptr
        type(item) :: my_item

        if(this%get_verbose()) print *, 'map%add_keyed_item begin'

        allocate(my_item%key, source=key)
        allocate(my_item%value, source=new_stuff)

        idx = this%find(my_item)
        if(idx > 0) then
            my_item_ptr => this%at(idx)
            select type(my_item_ptr)
                type is (item)
                    if(allocated(my_item_ptr%value)) then
                        deallocate(my_item_ptr%value)
                    end if
                    allocate(my_item_ptr%value, source=new_stuff)
#ifndef NDEBUG
                class default
                    write(0, '(*(g0))') 'Danger: invalid item in map'
#endif
            end select
        else
            call this%vector%add(my_item)
        end if

        if(this%get_verbose()) then
            print *, 'added to map (', this%length(), '/', &
                     this%capacity(), ' elements)'
        end if

        if(this%get_verbose()) print *, 'map%add_keyed_item end'
    end subroutine add_keyed_item

    function get(this, key)
        class(map), intent(inout) :: this
        class(*), intent(in) :: key
        class(*), pointer :: get
        class(*), pointer :: my_item_ptr
        type(item) :: my_item
        integer :: idx
        get => null()
        allocate(my_item%key, source=key)
        idx = this%find(my_item)
        if(idx > 0) then
            my_item_ptr => this%at(idx)
            select type(my_item_ptr)
                class is(item)
                    get => my_item_ptr%value
#ifndef NDEBUG
                class default
                    write(0, '(*(g0))') 'Danger: invalid item in map'
#endif
            end select
        end if
    end function get

    logical function is_equal_item(this, that) result(equal)
        class(item), intent(in) :: this
        class(*), intent(in) :: that
        select type(that)
            class is (item)
                equal = object_equal(this%key, that%key)
            class default
                equal = .false.
        end select
    end function is_equal_item

    function to_string_item(this)
        class(item), intent(in) :: this
        character(:), allocatable :: to_string_item
        to_string_item = "("//object_string(this%key)//","//object_string(this%value)//")"
    end function to_string_item

    function keys(this)
        class(map), intent(in)     :: this
        type(vector), allocatable :: keys

        type(vector_iterator) :: i
        class(*), pointer :: my_stuff

        allocate(keys, source=vector())

        i = this%iter()
        do while(i%next(my_stuff))
            select type(my_stuff)
            class is (item)
                call keys%add(my_stuff%key)
#ifndef NDEBUG
            class default
                write(0, '(*(g0))') 'Danger: invalid item in map'
#endif
            end select
        end do
    end function keys

    function values(this)
        class(map), intent(in) :: this
        type(vector), allocatable :: values

        type(vector_iterator) :: i
        class(*), pointer :: my_stuff

        allocate(values,source=vector())

        i = this%iter()
        do while(i%next(my_stuff))
            select type(my_stuff)
            class is (item)
                call values%add(my_stuff%value)
#ifndef NDEBUG
            class default
                write(0, '(*(g0))') 'Danger: invalid item in map'
#endif
            end select
        end do
    end function values

    logical function has(this,tag, tagType)
        class(map), intent(in) :: this
        class(*), intent(in) :: tag
        character(len=3), optional :: tagType ! key or val

        type(vector), allocatable :: tags
        character(len=3) :: myType

        if (present(tagType)) then
          myType = tagType
        else
          myType = 'key'
        endif

        if ('key' .eq. myType) then
          tags = this%keys()
        else
          tags = this%values()
        endif

        has = tags%includes(tag)
    end function has
    logical function has_key(this,tag)
        class(map), intent(in) :: this
        class(*), intent(in) :: tag

        has_key = this%has(tag,tagType='key')
    end function has_key
    logical function has_value(this, tag)
        class(map), intent(in) :: this
        class(*), intent(in) :: tag

        has_value = this%has(tag,tagType='val')
    end function has_value

end module self_map