module m_dom_error

  use pxf, only: pxfabort

  use m_common_error, only: error_stack, add_error, in_error, destroy_error_stack

  implicit none
  private

  type DOMException
    private
    type(error_stack) :: stack
  end type DOMException

  integer, parameter, public :: INDEX_SIZE_ERR              = 1
  integer, parameter, public :: DOMSTRING_SIZE_ERR          = 2
  integer, parameter, public :: HIERARCHY_REQUEST_ERR       = 3
  integer, parameter, public :: WRONG_DOCUMENT_ERR          = 4
  integer, parameter, public :: INVALID_CHARACTER_ERR       = 5
  integer, parameter, public :: NO_DATA_ALLOWED_ERR         = 6
  integer, parameter, public :: NO_MODIFICATION_ALLOWED_ERR = 7
  integer, parameter, public :: NOT_FOUND_ERR               = 8
  integer, parameter, public :: NOT_SUPPORTED_ERR           = 9
  integer, parameter, public :: INUSE_ATTRIBUTE_ERR         = 10
  integer, parameter, public :: INVALID_STATE_ERR           = 11
  integer, parameter, public :: SYNTAX_ERR                  = 12
  integer, parameter, public :: INVALID_MODIFICATION_ERR    = 13
  integer, parameter, public :: NAMESPACE_ERR               = 14
  integer, parameter, public :: INVALID_ACCESS_ERR          = 15
  integer, parameter, public :: VALIDATION_ERR              = 16
  integer, parameter, public :: TYPE_MISMATCH_ERR           = 17

  integer, parameter, public :: INVALID_EXPRESSION_ERR      = 51
  integer, parameter, public :: TYPE_ERR                    = 52

  integer, parameter, public :: PARSE_ERR                   = 81
  integer, parameter, public :: SERIALIZE_ERR               = 82

  integer, parameter, public :: FoX_INVALID_NODE            = 201
  integer, parameter, public :: FoX_INVALID_CHARACTER       = 202
  integer, parameter, public :: FoX_NO_SUCH_ENTITY          = 203
  integer, parameter, public :: FoX_INVALID_PI_DATA         = 204
  integer, parameter, public :: FoX_INVALID_CDATA_SECTION   = 205
  integer, parameter, public :: FoX_HIERARCHY_REQUEST_ERR   = 206
  integer, parameter, public :: FoX_INVALID_PUBLIC_ID       = 207
  integer, parameter, public :: FoX_INVALID_SYSTEM_ID       = 208
  integer, parameter, public :: FoX_INVALID_COMMENT         = 209
  integer, parameter, public :: FoX_NODE_IS_NULL            = 210
  integer, parameter, public :: FoX_INVALID_ENTITY          = 211
!  integer, parameter, public :: FoX_NO_DOCTYPE              = 212
  integer, parameter, public :: FoX_IMPL_IS_NULL            = 213
  integer, parameter, public :: FoX_MAP_IS_NULL             = 214
  integer, parameter, public :: FoX_LIST_IS_NULL            = 215

  integer, parameter, public :: FoX_INTERNAL_ERROR          = 999


  public :: DOMException
  public :: getExceptionCode
  public :: throw_exception
  public :: inException
  public :: dom_error
  public :: internal_error

contains

  pure function errorString(code) result(s)
    integer, intent(in) :: code
    character(len=27) :: s

    select case(code)
    case(1)
      s = "INDEX_SIZE_ERR"
    case(2)
      s = "DOMSTRING_SIZE_ERR"
    case(3)
      s = "HIERARCHY_REQUEST_ERR"
    case(4)
      s = "WRONG_DOCUMENT_ERR"
    case(5)
      s = "INVALID_CHARACTER_ERR"
    case(6)
      s = "NO_DATA_ALLOWED_ERR"
    case(7)
      s = "NO_MODIFICATION_ALLOWED_ERR"
    case(8)
      s = "NOT_FOUND_ERR"
    case(9)
      s = "NOT_SUPPORTED_ERR"
    case(10)
      s = "INUSE_ATTRIBUTE_ERR"
    case(11)
      s = "INVALID_STATE_ERR"
    case(12)
      s = "SYNTAX_ERR"
    case(13)
      s = "INVALID_MODIFICATION_ERR"
    case(14)
      s = "NAMESPACE_ERR"
    case(15)
      s = "INVALID_ACCESS_ERR"
    case(16)
      s = "VALIDATION_ERR"
    case(18)
      s = "TYPE_MISMATCH_ERR"
    case(51)
      s = "INVALID_EXPRESSION_ERR"
    case(52)
      s = "TYPE_ERR"
    case(81)
      s = "PARSE_ERR"
    case(82)
      s = "SERIALIZE_ERR"
    case(201)
      s = "FoX_INVALID_NODE"
    case(202)
      s = "FoX_INVALID_CHARACTER"
    case(203)
      s = "FoX_NO_SUCH_ENTITY"
    case(204)
      s = "FoX_INVALID_PI_DATA"
    case(205)
      s = "FoX_INVALID_CDATA_SECTION"
    case(206)
      s = "FoX_HIERARCHY_REQUEST_ERR"
    case(207)
      s = "FoX_INVALID_PUBLIC_ID"
    case(208)
      s = "FoX_INVALID_SYSTEM_ID"
    case(209)
      s = "FoX_INVALID_COMMENT"
    case(210)
      s = "FoX_NODE_IS_NULL"
    case(211)
      s = "FoX_INVALID_ENTITY"
    case(212)
      s = "FoX_NO_DOCTYPE"
    case(213)
      s = "FoX_IMPL_IS_NULL"
    case(214)
      s = "FoX_MAP_IS_NULL"
    case(215)
      s = "FoX_LIST_IS_NULL"
    case default
      s = "INTERNAL ERROR!!!!"
    end select

  end function errorString

  function getExceptionCode(ex) result(n)
    type(DOMException), intent(inout) :: ex
    integer :: n

    if (in_error(ex%stack)) then
      n = ex%stack%stack(size(ex%stack%stack))%error_code
      call destroy_error_stack(ex%stack)
    else
      n = 0
    endif
  end function getExceptionCode

  subroutine throw_exception(code, msg, ex)
    integer, intent(in) :: code
    character(len=*), intent(in) :: msg
    type(DOMException), intent(inout), optional :: ex

    if (present(ex)) then
      call add_error(ex%stack, msg, error_code=code) ! FIXME
    else
      write(0,'(a)') errorString(code)
      write(0,'(i0,a)') code, " "//msg
      call pxfabort()
    endif
      
  end subroutine throw_exception


  subroutine dom_error(name,code,msg)
    character(len=*), intent(in) :: name, msg
    integer, intent(in)          :: code

    write(0,'(4a)') "Routine ", name, ":", msg
    write(0,'(a)') errorString(code)
    call pxfabort()

  end subroutine dom_error

  
  subroutine destroyDOMException(ex)
    type(DOMException), intent(inout) :: ex

    call destroy_error_stack(ex%stack)
  end subroutine destroyDOMException


  subroutine internal_error(name,msg)
    character(len=*), intent(in) :: name, msg

    write(0,'(4a)') "Internal error in ", name, ":", msg
    call pxfabort()

  end subroutine internal_error

  function inException(ex) result(p)
    type(DOMException), intent(in) :: ex
    logical :: p

    p = in_error(ex%stack)
  end function inException

end module m_dom_error
