test-utils.R
In EDCimport: Import Data from EDC Software

skip_on_cran()
edc_options(edc_lookup_overwrite_warn=FALSE)


test_that("no exports", {
  skip_if(is_checking())
  testthat::test_path("../../R/utils.R") %>% 
    readLines() %>% str_subset("@export") %>% expect_length(0)
})




# load_list() ---------------------------------------------------------------------------------

test_that("load_list() works", {
  x=list(a=1, b=mtcars)
  load_list(x, remove=TRUE)
  expect_equal(a,1)
  expect_length(b,11)
  expect_false(exists("x", inherits=FALSE))
})

test_that("load_list() works without remove", {
  x=list(a=1, b=mtcars)
  load_list(x, remove=FALSE)
  expect_equal(a,1)
  expect_length(b,11)
  expect_true(exists("x", inherits=FALSE))
})

test_that("load_list() errors", {
  x=list(a=1, 5, b=8, 9)
  expect_error(load_list(x),
               class="load_list_unnamed_error")
})


test_that("save_list() works", {
  x=list(a=1, b=mtcars)
  save_list(x, "test.RData")
  load("test.RData")
  file.remove("test.RData")
  expect_equal(a,1)
  expect_length(b,11)
})

test_that("get_folder_datetime() works", {
  folder = paste0(tempdir(), "/test_get_datetime")
  fs::dir_create(folder)
  fs::file_create(paste0(folder, "/f", 1:5, ".R"))
  dir(folder, full.names=TRUE)[1:3] %>% purrr::walk(~Sys.setFileTime(.x, "1975-01-01 CET"))
  # dir(folder, full.names=TRUE) %>% file.info() %>% select(mtime)
  x = get_folder_datetime(folder) %>% 
    expect_classed_conditions(warning_class="get_folder_datetime_modiftime_warning")
  expect_equal(as.character(x), "1975-01-01")
})


# build_lookup() & find_keyword() ---------------------------------------------------------------

test_that("build_lookup() works", {
  
  x = edc_example()
  x$.lookup=NULL
  lookup = build_lookup(x)
  expect_equal(lengths(lookup$names), c(db0=5,db2=5,db3=6,db1=6))
  expect_true(all(nzchar(lookup$labels$i)))
  expect_false(any(nzchar(lookup$labels$m)))
  # lookup %>% unnest(everything())
  
  x = list(i=iris, mtcars)
  build_lookup(x) %>% 
    expect_error(class="edc_lookup_unnamed")
  x = list(date_extraction=1, datetime_extraction=1, .lookup=mtcars)
  build_lookup(x) %>% 
    expect_error(class="edc_lookup_empty")
})

test_that("find_keyword() works", {
  x = edc_example()
  # x$.lookup %>% unnest() %>% v
  x1=find_keyword("visit", data=x$.lookup)
  expect_setequal(x1$names, paste0("date", 1:10))
  x2=find_keyword("id|\\(", data=x$.lookup)
  expect_equal(unique(x2$names), c("SUBJID", "age"))
  x3=find_keyword("id|\\(", data=x$.lookup, ignore_case=FALSE)
  expect_equal(unique(x3$names), "age")
})


test_that("find_keyword() works with read_trialmaster()", {
  clean_cache()
  w = read_trialmaster(filename, use_cache=FALSE, verbose=0)
  local_options(edc_lookup=w$.lookup)
  x1=find_keyword("sex")
  expect_equal(x1$names, "SEX")
})





# 7-zip ---------------------------------------------------------------------------------------

test_that("Extract zip without password", {
  #This would actually work as well with a random password
  target = temp_target("test_7z1")
  extract_7z(filename, target)
  expect_true("procformat.sas" %in% dir(target))
})


## 7z Errors ----

test_that("7zip not in the path", {
  withr::local_envvar(list(PATH = ""))
  cur_path = Sys.getenv("PATH")
  expect_false(str_detect(cur_path, "7-Zip"))
  target = temp_target("test_7z_path")
  
  #manual path: wrong
  extract_7z(filename, target, path_7zip="foobar")  %>%
    expect_error(class="edc_7z_cmd_error")
  #manual path: correct
  x=extract_7z(filename, target, password="0", path_7zip="C:/Program Files/7-Zip/")
  expect_true("procformat.sas" %in% dir(target))
})



# Expect --------------------------------------------------------------------------------------


test_that("expect_classed_conditions()", {
  fun1 = function(){
    inform("I am a message", class="message1")
    inform("I am a message too", class="message2")
    inform("I am a message three", class="message3")
    warn("Beware, I am a warning", class="warn1")
    warn("Beware, I am a warning 2", class="warn2")
    abort("STOP, I am the error!", class="error1")
    999
  }
  fun2 = function(){
    inform("I am a message", class="message1")
    inform("I am a message too", class="message2")
    inform("I am a message three", class="message3")
    warn("Beware, I am a warning", class="warn1")
    warn("Beware, I am a warning 2", class="warn2")
    999
  }
  
  a = expect_classed_conditions(fun1(), 
                                message_class=c("message1", "message2", "message3"),
                                warning_class=c("warn1", "warn2"), 
                                error_class="error1")
  expect_equal(a, "expect_classed_conditions__error")
  
  b = expect_classed_conditions(fun2(), 
                                message_class=c("message1", "message2", "message3"),
                                warning_class=c("warn1", "warn2"))
  expect_equal(b, 999)
  
  expect_classed_conditions(fun1(), 
                            message_class=c("message1", "message2", "xxxx"),
                            warning_class=c("warn1", "xxxx"), 
                            error_class="xxxx") %>% 
    expect_error("xxxx.*error1")
  expect_classed_conditions(fun1(), 
                            message_class=c("message1", "message2", "xxxx"),
                            warning_class=c("warn1", "xxxx"), 
                            error_class="error1") %>% 
    expect_error("xxxx.*warn2")
  expect_classed_conditions(fun1(), 
                            message_class=c("message1", "message2", "xxxx"),
                            warning_class=c("warn1", "warn2"), 
                            error_class="error1") %>% 
    expect_error("xxxx.*message3")
})



# Misc ----------------------------------------------------------------------------------------


test_that("fct_yesno() works", {
  
  set.seed(42)
  N=20
  x = tibble(
    eng=sample(c("Yes", "No"), size=N, replace=TRUE),
    fra=sample(c("Oui", "Non"), size=N, replace=TRUE),
    bin=sample(0:1, size=N, replace=TRUE),
    log=sample(c(TRUE, FALSE), size=N, replace=TRUE),
    eng2=sample(c("1-Yes", "0-No"), size=N, replace=TRUE),

    chr=sample(c("aaa", "bbb", "ccc"), size=N, replace=TRUE),
    num=1:N,
  )
  x[10:11,] = NA
  
  
  expect_snapshot({
    
    fct_yesno("Yes")
    fct_yesno(c("No", "Yes"))
    
    mutate_all(x, fct_yesno, fail=FALSE)
    mutate_all(x, fct_yesno, fail=FALSE, strict=TRUE)
    mutate_all(x, fct_yesno, fail=FALSE, input=list(yes="Ja", no="Nein"))
  })
  
  mutate_all(x, fct_yesno, fail=TRUE) %>% expect_error(class="fct_yesno_unparsed_error")
  fct_yesno(x$chr) %>% expect_error(class="fct_yesno_unparsed_error")
  # fct_yesno(x$num) %>% expect_error(class="fct_yesno_unparsed_error") #TODO?
  fct_yesno("YesNo") %>% expect_error(class="fct_yesno_both_error")
  fct_yesno("foobar") %>% expect_error(class="fct_yesno_unparsed_error")
  
})


test_that("cli_menu() is not in package cli yet", {
  # exists('cli_menu', where='package:cli', mode='function') %>% expect_false()
  expect_false("package:cli" %in% find("cli_menu"))
})


test_that("edc_db_to_excel() works", {
  tm = edc_example()
  load_list(tm)
  filename=tempfile(fileext=".xlsx")
  edc_db_to_excel(filename=filename, datasets=get_datasets(), open=FALSE) %>% expect_message()
  expect_true(file.exists(filename))
  file.remove(filename)
})