Merge pull request #183 from thekangaroofactory/173-beta-code-coverag…

…e-server

Beta convergence

tests/testthat/_snaps/kitemsManager_Server.md

@@ -0,0 +1,56 @@
+# kitemsManager_Server works
+
+    Code
+      output$date_slider
+    Output
+      $html
+      <div class="form-group shiny-input-container">
+        <label class="control-label" id="data-date_slider-label" for="data-date_slider">Date</label>
+        <input class="js-range-slider" id="data-date_slider" data-skin="shiny" data-type="double" data-min="1705190400000" data-max="1705449600000" data-from="1705190400000" data-to="1705449600000" data-step="86400000" data-grid="true" data-grid-num="3" data-grid-snap="false" data-prettify-separator="," data-prettify-enabled="true" data-keyboard="true" data-drag-interval="true" data-data-type="date" data-time-format="%F"/>
+      </div>
+      
+      $deps
+      $deps[[1]]
+      List of 9
+       $ name      : chr "ionrangeslider-javascript"
+       $ version   : chr "2.3.1"
+       $ src       :List of 1
+        ..$ href: chr "ionrangeslider-javascript-2.3.1"
+       $ meta      : NULL
+       $ script    : chr "js/ion.rangeSlider.min.js"
+       $ stylesheet: NULL
+       $ head      : NULL
+       $ attachment: NULL
+       $ all_files : logi TRUE
+       - attr(*, "class")= chr "html_dependency"
+      
+      $deps[[2]]
+      List of 9
+       $ name      : chr "strftime"
+       $ version   : chr "0.9.2"
+       $ src       :List of 1
+        ..$ href: chr "strftime-0.9.2"
+       $ meta      : NULL
+       $ script    : chr "strftime-min.js"
+       $ stylesheet: NULL
+       $ head      : NULL
+       $ attachment: NULL
+       $ all_files : logi TRUE
+       - attr(*, "class")= chr "html_dependency"
+      
+      $deps[[3]]
+      List of 9
+       $ name      : chr "ionrangeslider-css"
+       $ version   : chr "2.3.1"
+       $ src       :List of 1
+        ..$ href: chr "ionrangeslider-css-2.3.1"
+       $ meta      : NULL
+       $ script    : NULL
+       $ stylesheet: chr "css/ion.rangeSlider.css"
+       $ head      : NULL
+       $ attachment: NULL
+       $ all_files : logi TRUE
+       - attr(*, "class")= chr "html_dependency"
+      
+      
+

tests/testthat/setup.R

@@ -32,7 +32,8 @@ ns <- shiny::NS("id")
 module_id <- "data"
 
 # -- data path
-path <- list(data = system.file("shiny-examples", "demo", "data", package = "kitems"))
+path <- list(data = system.file("shiny-examples", "demo", "data", package = "kitems"),
+             resource = system.file("shiny-examples", "demo", "data", package = "kitems"))
 path_test_output <- file.path(system.file("tests", "testthat", package = "kitems"), "testdata")
 
 # -- test file

tests/testthat/test-kitemsManager_Server.R

@@ -0,0 +1,50 @@
+
+
+test_that("kitemsManager_Server works", {
+
+  # -- declare arguments
+  params <- list(id = module_id,
+                 r = r,
+                 file = test_file,
+                 path = path,
+                 data.model = dm_test_file,
+                 create = FALSE,
+                 autosave = FALSE)
+
+  # -- module server call
+  testServer(kitemsManager_Server, args = params, {
+
+    # -- test output: date_slider
+    expect_snapshot(output$date_slider)
+
+    # --------------------------------------------------------------------------
+    # Data model
+    # --------------------------------------------------------------------------
+
+    r_data_model <- dm_name(module_id)
+    x <- r[[r_data_model]]()
+
+    # -- test class
+    expect_s3_class(x, "data.frame")
+
+    # -- test dim
+    expect_equal(dim(x), c(5,6))
+
+
+    # --------------------------------------------------------------------------
+    # Items
+    # --------------------------------------------------------------------------
+
+    r_items <- items_name(module_id)
+    x <- r[[r_items]]()
+
+    # -- test class
+    expect_s3_class(x, "data.frame")
+
+    # -- test dim
+    expect_equal(dim(x), c(4,5))
+
+  })
+
+
+})