library(rhdf5client)
context("indexing infrastructure")

test_that("sproc/isplit work", {
 if (check_hsds()) {
    expect_true(length(isplit(c(1,2,3,4,5,10,15,20,30:40)))==3)

    ii = isplit(c(1,2,3,4,5,10,15,20,30:40))
    ss = structure(c("0:5:1", "9:20:5", "29:40:1"), .Names = c("1", 
   "2", "3"))

    expect_true(identical(ss, unlist(sproc(ii))))
    ii = isplit(c(1:10, seq(50,25,-5), seq(80,100,2)))
    ss = structure(c("0:10:1", "50:24:-5", "79:100:2"), 
      .Names = c("1", "2", "3"))
    expect_true(identical(ss, unlist(sproc(ii))))
    ii = isplit(c(1, 3, 5, 200000, 300000))
    ss = structure(c("0:5:2", "199999:300000:100000"), 
      .Names = c("1", "2"))
    expect_true(identical(ss, unlist(sproc(ii))))
    }
  else TRUE
})

context("HSDSSource")
test_that("Server found", {
 if (check_hsds()) {
  src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
  doms <- listDomains(src.hsds, '/shared/bioconductor')
  expect_true('/shared/bioconductor/patelGBMSC.h5' %in% doms) 
  # catch exception: non-existent source
  src.fake <- HSDSSource('https://alserglab-nonex.wustl.edu/hsds/')
  expect_warning(listDomains(src.fake, '/shared/bioconductor/'), "bad http request")
 } else TRUE
})

context("HSDSFile")
test_that("Files can be opened for reading", {
 if (check_hsds()) {
  src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
  f1 <- HSDSFile(src.hsds, '/shared/bioconductor/patelGBMSC.h5')
  expect_equal(f1@type, "domain")
  dsts <- listDatasets(f1)
  expect_true('/assay001' %in% dsts)
  # catch exception: non-existent or empty file
  expect_error(HSDSFile(src.hsds, '/shared/bioconductor/patelGBMSC-nonex.h5'), "Not Found")
  } else TRUE
})

test_that("HSDSFile can be a directory", {
  if (check_hsds()) {
    src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
    expect_no_warning(f1 <- HSDSFile(src.hsds, '/shared/bioconductor'))
    expect_equal(f1@type, "folder")
    subdomains <- listDomains(f1@src, f1@domain)
    expect_true("/shared/bioconductor/patelGBMSC.h5" %in% subdomains)
  } else TRUE
})

context("HSDSDataset")
test_that("Data can be retrieved from Datasets", {
 if (!check_hsds()) return(TRUE) else {
  src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
  f2 <- HSDSFile(src.hsds, '/shared/bioconductor/patelGBMSC.h5')
  d2 <- HSDSDataset(f2, '/assay001')
  R <- c(1964617,1266834,1627203,1338108)
  A <- apply(round(getData(d2, c('1:4', '1:65218'), transfermode='JSON')), 1, sum)
  clRA = function(R,A) max(abs(R-A))<1e-6
  expect_true(clRA(R,A))
  A <- apply(round(getData(d2, c('1:4', '1:65218'), transfermode='binary')), 1, sum)
  expect_true(clRA(R,A))
  A <- apply(round(d2[1:4, 1:65218]), 1, sum)
  expect_true(clRA(R,A))
 }
})

context("DelayedArray subclass HSDSArray")
test_that("DelayedArray can be instantiated and accessed",  {
 if (!check_hsds()) return(TRUE) else {
  R <- c(1964617,1266834,1627203,1338108)
  da <- HSDSArray('https://alserglab.wustl.edu/hsds/', 'hsds', 
        '/shared/bioconductor/patelGBMSC.h5', '/assay001')
  A <- apply(round(da[,1:4]),2,sum)
  clRA = function(R,A) max(abs(R-A))<1e-6
  expect_true(clRA(R,A))
 }
})

#context("Four-dimensional datasets")
#test_that("Higher-dimensional dataset access works correctly",  {
# if (!check_hsds()) return(TRUE) else {
#  src <- HSDSSource('http://hsdshdflab.hdfgroup.org')
#  rd <- HSDSDataset(HSDSFile(src, '/home/spollack/testone.h5'), '/group0/group1/group2/data4d')
#  A <- getData(rd, list(3:4, 8:9, 5:6, 2:3))
#  expect_true(sum(A) == 697)
#  dt <- HSDSDataset(HSDSFile(src, '/home/spollack/testone.h5'), '/group0/group1/dataR')
#  B <- getData(dt, list(c(4), c(2, 3, 5, 6), c(5), 1:3))
#  R <- array(c(3140, 3240, 3440, 3540, 3141, 3241, 3441, 3541, 3142, 
#      3242, 3442, 3542), dim=c(4,3))
#  expect_true(all(B == R))
# }
#})

context("Decomposition into slices")
test_that("Bad slices rejected",  {
 if (!check_hsds()) return(TRUE) else {
  tf <- rhdf5client:::checkSlices(c(10, 20, 30), c('5:', ':', ':8'))
  ok <- c('4:10:1', '0:20:1', '0:8:1')
  expect_true(all(unlist(tf) == ok))
  expect_error(rhdf5client:::checkSlices(c(10, 20, 30), c('5:20', ':', ':8'),
    regexp='stop out of range'))
  expect_error(rhdf5client:::checkSlices(c(10, 20, 30), c('10:5', ':', ':8'),
    regexp='slice stop less than slice start'))
  expect_error(rhdf5client:::checkSlices(c(10, 20, 30), c('5:10,0.5', ':', ':8'),
    regexp='malformed slice'))
  }
})


context("String support")
test_that("Basic string support",  {
    src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
    f <- HSDSFile(src.hsds, "/shared/bioconductor/test_string.h5")
    d <- HSDSDataset(f, "/d")
    expect_true(d@type$class == "H5T_STRING")
    
    v1 <- d[1:10]
    expect_equal(class(v1), "character")
    
    v2 <- d[1]
    expect_equal(class(d[1]), "character")
    expect_equal(v1[1], v2)
})

context("Compound support")
test_that("Basic compound support", {
  src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
  f <- HSDSFile(src.hsds, "/shared/bioconductor/test_compound.h5")
  d <- HSDSDataset(f, "/d")
  
  expect_equal(d@type$class, "H5T_COMPOUND")
  expect_equal(d@type$fields[[1]]$name, "intCol")
  expect_equal(d@type$fields[[1]]$type$class, "H5T_INTEGER")
  expect_equal(d@type$fields[[2]]$name, "strCol")
  expect_equal(d@type$fields[[2]]$type$class, "H5T_STRING")

  v1 <- d[1]  
  expect_true(is(v1, "data.frame")) # data.table inherits data.frame
  expect_equal(nrow(v1), 1)
  expect_equal(v1$intCol, 1)
  expect_equal(v1$strCol, "a")
  
  v2 <- d[1:2]  
  expect_equal(nrow(v2), 2)
  expect_equal(v2$intCol[1], v1$intCol)
  expect_equal(v2$strCol[1], v1$strCol)
  
  typ <- list(class="H5T_COMPOUND", 
              fields=list(
                list(name="f1", type=list(class="H5T_STRING")),
                list(name="f2", type=list(class="H5T_STRING")),
                list(name="f3", type=list(class="H5T_STRING"))
              ))
  # JSON arrays are used when all columns are strings
  str <- c('[["asd", "qwe", "zxc"], ["a", "b", "c"]]')
  dt <- extractCompoundJSON(type = typ, rjson::fromJSON(str))
  expect_true(is(dt, "data.frame"))
})

context("Scalar support")
test_that("Support of scalar values", {
  src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
  f <- HSDSFile(src.hsds, "/shared/bioconductor/test_scalar.h5")
  d <- HSDSDataset(f, "/d")
  v <- d[1] 
  expect_true(is(v, "character"))
  expect_identical(v, "I'm scalar")
})

context("Integer type support")
test_that("Integer types are supported properly", {
  src.hsds <- HSDSSource('https://alserglab.wustl.edu/hsds/')
  f <- HSDSFile(src.hsds, "/shared/bioconductor/test_numbers.h5")
  # not checking the actual values!
  
  d <- HSDSDataset(f, "/d_u32")
  v <- d[1:d@shape] 
  expect_equal(length(v), 4)
  expect_equal(v[2], 2**31 - 1)
  
  d <- HSDSDataset(f, "/d_i64")
  v <- d[1:d@shape] 
  expect_equal(length(v), 5)
  expect_equal(v[2], 2**31 - 1)
  
  d <- HSDSDataset(f, "/d_u64")
  v <- d[1:d@shape] 
  expect_equal(length(v), 6)
  expect_equal(v[2], 2**31 - 1)
  
})


test_that("Request errors are reported", {
  skip_if_not(check_hsds())
  
  src.hsds <- HSDSSource("https://developer.nlr.gov/api/hsds")
  expect_error(HSDSFile(src.hsds, "/shared/NASA/NCEP3/ncep3.h5"), "api_key")
})

test_that("Files on a directory on HSDS server can be listed", {
  skip_if_not(check_hsds())
  
  url <- 'https://alserglab.wustl.edu/hsds/?domain=/counts'
  expect_true(!is.null(getHSDSFileList(url)))
})

