module cubelist_find
  use cubetools_parameters
  use cubelist_types
  use cubelist_object_advanced_class
  use cubelist_messaging
  !---------------------------------------------------------------------
  ! Support module for generic find filters
  !---------------------------------------------------------------------
  !
  public :: find_filter_t
  public :: find_filter_list_t
  private
  !
  ! Support for 1 filter
  type, abstract, extends(list_object_t) :: find_filter_t
    logical, public :: enabled = .false.  ! Is this filter enabled?
  ! type(?)         :: refvalue  ! Desired value. Can be anything, to be
                                 ! added with an extension of this type.
                                 ! Unknown by the generic tool.
  contains
    procedure(basic_interface), deferred :: reset  ! [private]
    procedure(basic_interface), deferred :: check  ! [private]
    procedure(match_interface), deferred :: match  ! [private]
  end type find_filter_t
  !
  ! Post-filtering selection by entry range. This is not a filter
  ! as this is to be applied AFTER the selection is done with the
  ! filters (a la LAS\FIND /ENTRY 1 to 10).
  type :: find_range_t
    logical,              private :: enabled = .false.
    integer(kind=entr_k), private :: first,last
  contains
    procedure, public  :: set   => find_range_set
    procedure, private :: reset => find_range_reset
  end type find_range_t
  !
  ! The collection of filters
  type, extends(list_t) :: find_filter_list_t
    ! Collection of filters:
    !   under %list(:)%p => find_filter_t
    ! Entry range selector:
    type(find_range_t), public :: range
  contains
    procedure, public :: reset     => cubelist_find_reset
    procedure, public :: list2list => cubelist_find_list2list
  end type find_filter_list_t
  !
contains
  !
  function cubelist_filter_ptr(obj,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of class(find_filter_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    class(find_filter_t), pointer :: cubelist_filter_ptr
    class(list_object_t), pointer       :: obj
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='FILTER>PTR'
    !
    select type(obj)
    class is (find_filter_t)
      cubelist_filter_ptr => obj
    class default
      cubelist_filter_ptr => null()
      call cubelist_message(seve%e,rname,  &
        'Internal error: object is not a find_filter_t type')
      error = .true.
      return
    end select
  end function cubelist_filter_ptr
  !
  subroutine basic_interface(filter)
    !-------------------------------------------------------------------
    ! Interface for basic (1 argument) subroutines
    !-------------------------------------------------------------------
    class(find_filter_t), intent(inout) :: filter
  end subroutine basic_interface
  !
  function match_interface(filter,obj)
    !-------------------------------------------------------------------
    ! Interface for node-matching functions
    !-------------------------------------------------------------------
    logical :: match_interface
    class(find_filter_t),          intent(inout) :: filter  ! inout for find_entry%nfound
    class(list_object_advanced_t), intent(in)    :: obj
  end function match_interface
  !
  subroutine find_range_set(range,e1,e2,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(find_range_t),  intent(inout) :: range
    integer(kind=entr_k), intent(in)    :: e1,e2
    logical,              intent(inout) :: error
    !
    range%enabled = .true.
    ! Entry numbers can be negative i.e. count from the end of the
    ! selection
    if (e1.le.e2) then
      range%first = e1
      range%last  = e2
    else
      range%first = e2
      range%last  = e1
    endif
  end subroutine find_range_set
  !
  subroutine find_range_reset(range,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(find_range_t),  intent(out)   :: range
    logical,              intent(inout) :: error
    !
    ! Done with intent(out)
  end subroutine find_range_reset
  !
  subroutine cubelist_find_reset(filter,error)
    !-------------------------------------------------------------------
    ! Reset all the filters to their default (i.e. inactive value)
    !-------------------------------------------------------------------
    class(find_filter_list_t), intent(inout) :: filter
    logical,                   intent(inout) :: error
    !
    integer(kind=list_k) :: ifilter
    class(find_filter_t), pointer :: onefilter
    !
    ! Reset all the %enabled flags
    do ifilter=1,filter%n
      onefilter => cubelist_filter_ptr(filter%list(ifilter)%p,error)
      if (error)  return
      call onefilter%reset()
    enddo
    call filter%range%reset(error)
    if (error)  return
  end subroutine cubelist_find_reset
  !
  subroutine cubelist_find_list2list(filter,in,out,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(find_filter_list_t), intent(inout) :: filter  !
    class(list_t),             intent(in)    :: in      !
    class(list_t),             intent(inout) :: out     !
    logical,                   intent(inout) :: error   !
    !
    integer(kind=entr_k) :: ient,nfound,first,last
    integer(kind=list_k) :: ifilter
    type(find_filter_list_t) :: enabled
    class(find_filter_t), pointer :: onefilter
    integer(kind=entr_k) :: list(in%n) ! Automatic array (assume in%n>0)
    class(list_object_advanced_t), pointer :: obj
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='FIND'
    !
    call cubelist_find_enabled(filter,enabled,error)
    if (error)  return
    !
    nfound = 0
entries: do ient=1,in%n
      obj => cubelist_object_advanced_ptr(in%list(ient)%p,error)
      if (error)  return
      if (obj%hidden)  cycle
      !
      do ifilter=1,enabled%n
        onefilter => cubelist_filter_ptr(enabled%list(ifilter)%p,error)
        if (error)  return
        if (.not.onefilter%match(obj))  cycle entries
      enddo
      !
      nfound = nfound+1
      list(nfound) = ient
    enddo entries
    !
    if (filter%range%enabled) then
      if (filter%range%first.gt.0) then
        first = filter%range%first
        last = filter%range%last
      else
        first = nfound+filter%range%first
        last = nfound+filter%range%last
      endif
      if (first.le.0 .or. last.gt.nfound) then
        ! Error. Should we truncate instead?
        if (first.eq.last) then
          write(mess,'(a,i0)')  &
            'Invalid position ',filter%range%first
        else
          write(mess,'(2(a,i0))')  &
            'Invalid position range ',filter%range%first,' to ',filter%range%last
        endif
        call cubelist_message(seve%e,rname,mess)
        error = .true.
        return
      endif
      nfound = 0
      do ient=first,last
        nfound = nfound+1
        list(nfound) = list(ient)  ! Overwrite in-place (careful)
      enddo
    endif
    !
    call cubelist_find_byentries(in,list,nfound,out,error)
    if (error)  return
  end subroutine cubelist_find_list2list
  !
  subroutine cubelist_find_enabled(filter,enabled,error)
    !-------------------------------------------------------------------
    ! Return a new find_filter_list_t, which provides only the enabled
    ! filters.
    !
    ! This is a first level of optimization. This avoids calling
    ! cubelist_filter_ptr (i.e. "select type()") in the main find loop
    ! (the loop on -many- entries) on unused filters.
    !
    ! A second level of optimization could be to save directly the list
    ! of enabled %match() methods in a simpler list. However, Fortran
    ! does not allow (C1030 (R1040)) this:
    !   procedure(match_interface), pointer :: match_pointer
    !   match_pointer => onefilter%match
    !-------------------------------------------------------------------
    type(find_filter_list_t), intent(inout) :: filter
    type(find_filter_list_t), intent(out)   :: enabled
    logical,                  intent(inout) :: error
    !
    integer(kind=list_k) :: ifilter
    class(find_filter_t), pointer :: onefilter
    !
    do ifilter=1,filter%n
      onefilter => cubelist_filter_ptr(filter%list(ifilter)%p,error)
      if (error)  return
      call onefilter%check()  ! Compute the %enabled flag
      if (.not.onefilter%enabled)  cycle
      !
      call enabled%associate(onefilter,error)
      if (error)  return
    enddo
  end subroutine cubelist_find_enabled
  !
  subroutine cubelist_find_byentries(in,entries,nentries,out,error)
    !-------------------------------------------------------------------
    ! FIND by list of entry numbers
    !-------------------------------------------------------------------
    class(list_t),        intent(in)    :: in          !
    integer(kind=entr_k), intent(in)    :: entries(:)  ! Entry numbers
    integer(kind=entr_k), intent(in)    :: nentries    !
    class(list_t),        intent(inout) :: out         !
    logical,              intent(inout) :: error       !
    !
    integer(kind=entr_k) :: ient
    !
    call out%final(error)
    if (error)  return
    !
    do ient=1,nentries
      call out%associate(in%list(entries(ient))%p,error)
      if (error)  return
    enddo
  end subroutine cubelist_find_byentries
  !
end module cubelist_find
