#' @describeIn H5IdComponent Print details of the object to screen.
#'
#' @export
setMethod("show", signature = "H5IdComponent", function(object) {
  res <- .Call("_handleInfo", object@ID, PACKAGE = "rhdf5")
  res$type <- h5const2String("H5I_TYPE", res$type)
  res$type <- substr(res$type, 5, 1000)
  cat(sprintf("HDF5 %s", res$type), if (object@native) "(native)", "\n")
  if (res$type == "DATASPACE") {
    res2 <- H5Sget_simple_extent_dims(object)
    res$info <- c(
      res$info,
      rank = res2$rank,
      size = paste(res2$size, collapse = " x "),
      maxsize = paste(res2$maxsize, collapse = " x ")
    )
  }
  if (res$type == "DATASET") {
    s <- H5Dget_space(object)
    on.exit(H5Sclose(s))
    res2 <- H5Sget_simple_extent_dims(s)
    res$info <- c(
      res$info,
      type = .Call("_getDatatypeName", H5Dget_type(object), PACKAGE = "rhdf5"),
      rank = res2$rank,
      size = paste(res2$size, collapse = " x "),
      maxsize = paste(res2$maxsize, collapse = " x ")
    )
  }
  if (res$type == "ATTR") {
    s <- H5Aget_space(object)
    on.exit(H5Sclose(s))
    res2 <- H5Sget_simple_extent_dims(s)
    names(res$info)[names(res$info) == "name"] <- "objName"
    res$info <- c(
      res$info,
      attrName = H5Aget_name(object),
      type = .Call("_getDatatypeName", H5Aget_type(object), PACKAGE = "rhdf5"),
      rank = res2$rank,
      size = paste(res2$size, collapse = " x "),
      maxsize = paste(res2$maxsize, collapse = " x ")
    )
  }
  if (res$type == "DATATYPE") {
    res$info <- c(
      res$info,
      type = .Call("_getDatatypeName", object@ID, PACKAGE = "rhdf5")
    )
  }
  if (!is.null(res$info)) {
    cat(paste(sprintf("%12s %s\n", names(res$info), res$info), collapse = ""))
  }
  if (res$type %in% c("FILE", "GROUP")) {
    cat("\n")
    x <- h5ls(object, recursive = FALSE)
    x <- format(x, justify = "left")
    x <- x[, -1]
    print(x)
  }
  if (!res$isvalid) {
    cat("\nNo valid identifier.\n")
  }
})


#' @describeIn H5IdComponent Returns a group handle or dataset handle for the
#'   group or dataset `name` in the HDF5 location `h5loc`. `h5loc` can either be a file handle
#'   as returned by [H5Fopen] or a group handle as e.g. returned by `h5f$g1` or
#'   `h5f$'/g1/g2'`.
#'
#' @param e1 An `H5IdComponent` object representing an H5 file or group.
#' @param e2 Character giving the path to an HDF5 group or dataset relative to `e1`.
#'
#' @export
setMethod(`&`, signature = c("H5IdComponent", "character"), function(e1, e2) {
  H5Oopen(e1, e2)
})

#' @describeIn H5IdComponent Reads the HDF5 object `name` in the HDF5 location `x`. `x` can either be
#'   a file handle as returned by [H5Fopen()] or a group handle as e.g. returned by
#'   `h5f$g1` or `h5f$'/g1/g2'`.
#'
#' @param x An `H5IdComponent` object representing an H5 file or group.
#' @param name Character giving the path to an HDF5 group or dataset relative to `x`.
#'
#' @export
setMethod(`$`, signature = "H5IdComponent", function(x, name) {
  h5id <- x
  isvalid <- H5Iis_valid(h5id)
  if (!isvalid) {
    stop("Bad HDF5 ID. File, group, or dataset closed?", call. = FALSE)
  }
  truetype <- H5Iget_type(h5id)
  #   par = list(file=h5id, name=name)
  #   if ( .hasSlot(h5id, "par") ) {
  #     par = c(par, h5id@par[names(h5id@par) %in% c("compoundAsDataFrame","read.attributes")])
  #   }
  if (!truetype %in% c("H5I_FILE", "H5I_GROUP")) {
    stop(
      "The provided H5Identifier is not a location identifier.",
      call. = FALSE
    )
  }
  h5read(file = h5id, name = name)

  #
  #   else {
  #     if (truetype == "H5I_DATASET") {
  #       h5a = H5Aopen(h5obj = h5id, name=)
  #       res = h5readAttributes(h5id, name = name)
  #     } else {
  #       stop("The provided H5Identifier is neither a location identifier nor a dataset identifier.",
  #            call. = FALSE)
  #     }
  #   }
})

#' @describeIn H5IdComponent Writes the assigned object to to the HDF5 file at
#'   location e1. e1 can either be a file handle as returned by [H5Fopen()] or a
#'   group handle as e.g. returned by h5f$g1 or h5f$'/g1/g2's. The storage.mode
#'   of the assigned object has to be compatible to the datatype of the HDF5
#'   dataset. The dimension of the assigned object have to be identical the
#'   dimensions of the HDF5 dataset. To create a new HDF5 dataset with specific
#'   properties (e.g. compression level or chunk size), please use the function
#'   [h5createDataset()] first.
#'
#' @export
setMethod(`$<-`, signature = "H5IdComponent", function(x, name, value) {
  h5id <- x
  isvalid <- H5Iis_valid(h5id)
  if (!isvalid) {
    stop("Bad HDF5 ID. File, group, or dataset closed?", call. = FALSE)
  }
  truetype <- H5Iget_type(h5id)
  if (!truetype %in% c("H5I_FILE", "H5I_GROUP")) {
    stop(
      "The provided H5Identifier is not a location identifier.",
      call. = FALSE
    )
  }
  h5write(value, file = h5id, name = name)
  h5id
})


#' @describeIn H5IdComponent Subsetting of an HDF5 dataset. The function reads a
#'   subset of an HDF5 dataset. The given dimensions have to fit the dimensions
#'   of the HDF5 dataset.
#'
#' @param x Object of class `H5IdComponent` representing the HDF5 dataset from
#'   which to extract element(s) or in which to replace element(s).
#' @param i,j,\dots Indices specifying elements to extract or replace. Indices
#'   are `numeric` vectors or empty (missing) or `NULL`.  Numeric
#'   values are coerced to integer as by [base::as.integer()] (and
#'   hence truncated towards zero).
#' @param drop If `TRUE` the result is coerced to the lowest possible dimension
#'   (see the examples).  This only works for extracting elements, not for the
#'   replacement.  See [base::drop()] for further details.
#'
#' @export
setMethod(
  "[",
  signature = c("H5IdComponent", "ANY", "ANY", "ANY"),
  function(x, i, j, ..., drop = TRUE) {
    h5id <- x
    index <- extract_Nindex_from_syscall(sys.call(), parent.frame())

    isvalid <- H5Iis_valid(h5id)
    if (!isvalid) {
      stop("Bad HDF5 ID. Dataset closed?", call. = FALSE)
    }
    truetype <- H5Iget_type(h5id)
    if (truetype != "H5I_DATASET") {
      stop(
        "The provided H5Identifier is not a dataset identifier and can not be subsetted.",
        call. = FALSE
      )
    }
    res <- h5readDataset(h5dataset = h5id, index = index)
    if (drop) {
      res <- drop(res)
    }
    res
  }
)

#' @describeIn H5IdComponent Subsetting of an HDF5 dataset. The function writes
#'   an R data object to a subset of an HDF5 dataset. The given dimensions have
#'   to fit the dimensions of the HDF5 dataset. The HDF5 dataset has to be
#'   created beforehand, e.g. by [h5createDataset()].
#'
#' @param value Array-like \R object containing value to be inserted into
#' the HDF5 dataset.
#'
#' @export
setMethod(
  `[<-`,
  signature = c("H5IdComponent", "ANY", "ANY", "ANY"),
  function(x, i, j, ..., value) {
    h5id <- x
    index <- extract_Nindex_from_syscall(sys.call(), parent.frame())

    isvalid <- H5Iis_valid(h5id)
    if (!isvalid) {
      stop("Bad HDF5 ID. Dataset closed?", call. = FALSE)
    }
    truetype <- H5Iget_type(h5id)
    if (truetype != "H5I_DATASET") {
      stop(
        "The provided H5Identifier is not a dataset identifier and can not be subsetted.",
        call. = FALSE
      )
    }
    h5writeDatasetHelper(obj = value, h5dataset = h5id, index = index)
    h5id
  }
)


#' @describeIn H5Ref Print details of the object to screen.
#'
#' @export
setMethod("show", signature = "H5Ref", definition = function(object) {
  cat("HDF5 REFERENCE\n")
  cat("Type:", h5const2String("H5R_TYPE", object@type), "\n")
  cat("Length:", length(object), "\n")
})

#' @describeIn H5Ref Return the number of references stored in an `H5Ref`
#' object.
#'
#' @export
setMethod("length", signature = "H5Ref", definition = function(x) {
  if (h5const2String("H5R_TYPE", x@type) == "H5R_OBJECT") {
    div <- 8L
  } else {
    div <- 12L
  }
  return(length(x@val) / div)
})

#' @describeIn H5Ref Combine two or more `H5Ref` objects.  Objects must all
#' contain the same type of reference, either `H5R_OBJECT` or
#' `H5R_DATASET_REFERENCE`.
#'
#' @param x An `H5Ref` object.
#' @param ... Additional `H5Ref` objects to be combined with `x`.
#'
#' @export
setMethod(f = "c", signature = "H5Ref", definition = function(x, ...) {
  elements <- list(x, ...)
  if (length(elements) != 0) {
    ## test all objects are H5Ref class
    valid <- vapply(
      elements,
      FUN = function(x) {
        inherits(x, "H5Ref")
      },
      FUN.VALUE = logical(1L)
    )
    if (!all(valid)) {
      stop("All objects must be of class 'H5Ref'.", call. = FALSE)
    }

    ## test all references are of same type
    types <- vapply(
      elements,
      FUN = function(x) {
        x@type
      },
      FUN.VALUE = integer(1L)
    )
    if (length(unique(types)) != 1) {
      stop("All references must be of the same type.", call. = FALSE)
    }

    items <- unlist(lapply(
      elements,
      FUN = function(x) {
        x@val
      }
    ))
    object <- new("H5Ref", val = items, type = x@type)
  }
  return(object)
})

#' @describeIn H5Ref Subset an `H5Ref` object.
#'
#' @param x An `H5Ref` object.
#' @param i Integer vector giving the indices of references to select.
#'
#' @export
setMethod(f = "[", signature = c("H5Ref", "ANY"), definition = function(x, i) {
  if (h5const2String("H5R_TYPE", x@type) == "H5R_OBJECT") {
    div <- 8L
  } else {
    div <- 12L
  }

  i <- as.integer(i)
  idx <- c(vapply(
    i,
    function(x) ((x - 1L) * div) + (1L:div),
    FUN.VALUE = integer(length = div)
  ))

  object <- new("H5Ref", val = x@val[idx], type = x@type)
  return(object)
})
