Merge pull request #5 from kinto-b/dev

0.0.2

Author: kinto-b

DESCRIPTION

@@ -1,13 +1,16 @@
 Package: piper
 Title: Pipeline Tools Inspired by GNU Make
-Version: 0.0.1
+Version: 0.0.2
 Authors@R: 
     person(given = "Kinto",
            family = "Behr",
            role = c("aut", "cre"),
            email = "[email protected]")
 Description: Tools for constructing simple make-like pipelines. 
 License: GPL (>= 3)
+URL: https://kinto-b.github.io/piper/,
+     https://github.com/kinto-b/piper
+BugReports: https://github.com/kinto-b/piper/issues
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)

NEWS.md

@@ -0,0 +1,9 @@
+# piper 0.0.2
+
+* Pipeline visualisations are now sorted hierarchically, from left to right across the screen.
+* Fixed bug in pipeline invalidation (#4).
+* Added a `NEWS.md` file to track changes to the package.
+
+# piper 0.0.1
+
+* Initial release.

R/Pipeline.R

@@ -113,14 +113,34 @@ Pipeline <- R6::R6Class(classname = "Pipeline", list(
     # Out of date?
     edges$from_mtime <- file.mtime(as.character(edges$from))
     edges$to_mtime <- file.mtime(as.character(edges$to))
-    edges$out_of_date <- edges$from_mtime > edges$to_mtime
-    edges$out_of_date <- ifelse(is.na(edges$out_of_date), FALSE, edges$out_of_date)
-    for (i in seq_along(edges$from)) {
-      x <- edges$out_of_date
-      edges$out_of_date <- (edges$from %in% edges[edges$out_of_date, "to"]) | (edges$out_of_date)
-      if (identical(edges$out_of_date, x)) break
+    edges$out_of_date <- ifelse(edges$.source, FALSE, edges$from_mtime > edges$to_mtime)
+
+    # Propagate out-of-dateness
+    edges_i <- edges
+    for (i in 1:nrow(edges)) {
+      edges_i <- merge(
+          edges_i,
+          edges_i[, c("from", "to", "to_mtime")],
+          by.x = "to",
+          by.y = "from",
+          suffixes = c("", "2")
+        )
+
+      edges_i$to <- edges_i$to2
+      edges_i$to_mtime <- edges_i$to_mtime2
+      edges_i$out_of_date <-
+        ifelse(
+          is.na(edges_i$from_mtime > edges_i$to_mtime),
+          edges_i$out_of_date,
+          edges_i$out_of_date | edges_i$from_mtime > edges_i$to_mtime
+        )
+      outdated <- edges_i[edges_i$out_of_date, "to"]
+      edges$out_of_date <- (edges$to %in% outdated) | (edges$out_of_date)
+
+      edges_i <- edges_i[, names(edges)]
     }
 
+
     # Group
     nodes$group <- ifelse(nodes$id %in% edges[edges$out_of_date, "to"], "Out-of-date", "Up-to-date")
     nodes$group <- ifelse(nodes$id %in% edges[edges$.source, "to"], "Source", nodes$group)
@@ -143,6 +163,7 @@ Pipeline <- R6::R6Class(classname = "Pipeline", list(
     out <- visNetwork::visGroups(out, groupname = "Out-of-date", color = "#ffcaef")
     out <- visNetwork::visGroups(out, groupname = "Up-to-date", color = "#caffda")
     out <- visNetwork::visLegend(out)
+    out <- visNetwork::visHierarchicalLayout(out, sortMethod = "directed", direction = "LR")
     print(out)
     invisible(self)
   },
@@ -156,6 +177,7 @@ Pipeline <- R6::R6Class(classname = "Pipeline", list(
     out <- visNetwork::visGroups(out, groupname = "Out-of-date", color = "#ffcaef")
     out <- visNetwork::visGroups(out, groupname = "Up-to-date", color = "#caffda")
     out <- visNetwork::visLegend(out)
+    out <- visNetwork::visHierarchicalLayout(out, sortMethod = "directed", direction = "LR")
     visNetwork::visSave(out, file, ...)
     invisible(self)
   }

tests/testthat/test-Pipeline.R

@@ -5,6 +5,7 @@ test_that("Nodes correctly categorised as out-of-date", {
   # Simple pipeline:
   # dependency -> source -> target (out-of-date)
   withr::with_tempfile(c("dependency", "target"), code = {
+    set_pipeline(Pipeline$new())
     saveRDS(iris, target)
     Sys.sleep(0.1)
     saveRDS(iris, dependency)
@@ -21,6 +22,7 @@ test_that("Nodes correctly categorised as out-of-date", {
   # multi-stage pipeline:
   # dependency1 -> source -> target1 (out-of-date) --> source + dependency2 --> target2
   withr::with_tempfile(c("dependency1", "dependency2", "target1", "target2"), code = {
+    set_pipeline(Pipeline$new())
     saveRDS(iris, dependency2)
     saveRDS(iris, target1)
     saveRDS(iris, target2)
@@ -40,6 +42,7 @@ test_that("Nodes correctly categorised as out-of-date", {
   # multi-stage pipeline:
   # dependency1 -> source -> target1 (out-of-date) --> recipe + dependency2 --> target2
   withr::with_tempfile(c("dependency1", "dependency2", "target1", "target2"), code = {
+    set_pipeline(Pipeline$new())
     saveRDS(iris, dependency2)
     saveRDS(iris, target1)
     saveRDS(iris, target2)
@@ -57,3 +60,24 @@ test_that("Nodes correctly categorised as out-of-date", {
   })
 })
 
+test_that("source files not invalidated", {
+  # Source older than dependencies
+  withr::with_tempfile(c("dependency", "target"), code = {
+    set_pipeline(Pipeline$new())
+    saveRDS(iris, dependency)
+    Sys.sleep(0.1)
+    source <- withr::local_tempfile(fileext = ".R")
+    writeLines("2+2", source)
+    Sys.sleep(0.1)
+    saveRDS(iris, target)
+
+    make_with_source(source, target, dependency, quiet = TRUE)
+
+    nodes <- get_pipeline()$nodes
+
+    expect(
+      all(nodes[nodes$id %in% target, "group"] %in% "Up-to-date"),
+      "`target` should be up to date but isn't"
+    )
+  })
+})