Move evaluation class into own file (#165)

And use `output_type()` in print method

R/eval.R

@@ -252,41 +252,3 @@ reset_call <- function(cnd) {
   }
   cnd
 }
-
-new_evaluation <- function(x) {
-  # Needs explicit list for backwards compatibility
-  structure(x, class = c("evaluate_evaluation", "list"))
-}
-
-#' @export
-print.evaluate_evaluation <- function(x, ...) {
-  cat_line("<evaluation>")
-  for (component in x) {
-    if (inherits(component, "source")) {
-      cat_line("Source code: ")
-      cat_line(indent(component$src))
-    } else if (is.character(component)) {
-      cat_line("Text output: ")
-      cat_line(indent(component))
-    } else if (inherits(component, "condition")) {
-      cat_line("Condition: ")
-      cat_line(indent(format_condition(component)))
-    } else if (inherits(component, "recordedplot")) {
-      dl <- component[[1]]
-      cat_line("Plot [", length(dl), "]:")
-      for (call in dl) {
-        fun_call <- call[[2]][[1]]
-        if (hasName(fun_call, "name")) {
-          cat_line("  <base> ", fun_call$name, "()")
-        } else {
-          cat_line("  <grid> ", deparse(fun_call))
-        }
-      }
-    } else {
-      cat_line("Other: ")
-      cat(" "); str(component, indent.str = "  ")
-    }
-  }
-
-  invisible(x)
-}

R/evaluation.R

@@ -0,0 +1,56 @@
+new_evaluation <- function(x) {
+  # Needs explicit list for backwards compatibility
+  structure(x, class = c("evaluate_evaluation", "list"))
+}
+
+#' @export
+print.evaluate_evaluation <- function(x, ...) {
+  cat_line("<evaluation>")
+  for (component in x) {
+    type <- output_type(component)
+    if (type == "source") {
+      cat_line("Source code: ")
+      cat_line(indent(component$src))
+    } else if (type == "text") {
+      cat_line("Text output: ")
+      cat_line(indent(component))
+    } else if (type %in% c("message", "warning", "error")) {
+      cat_line("Condition: ")
+      cat_line(indent(format_condition(component)))
+    } else if (type == "plot") {
+      dl <- component[[1]]
+      cat_line("Plot [", length(dl), "]:")
+      for (call in dl) {
+        fun_call <- call[[2]][[1]]
+        if (hasName(fun_call, "name")) {
+          cat_line("  <base> ", fun_call$name, "()")
+        } else {
+          cat_line("  <grid> ", deparse(fun_call))
+        }
+      }
+    } else {
+      cat_line("Other: ")
+      cat(" "); str(component, indent.str = "  ")
+    }
+  }
+
+  invisible(x)
+}
+
+output_type <- function(x) {
+  if (is.character(x)) {
+    "text"
+  } else if (inherits(x, "error")) {
+    "error"
+  } else if (inherits(x, "warning")) {
+    "warning"
+  } else if (inherits(x, "message")) {
+    "message"
+  } else if (inherits(x, "recordedplot")) {
+    "plot"
+  } else if (inherits(x, "source")) {
+    "source"
+  } else {
+    class(x)[[1]]
+  }
+}

tests/testthat/helper.R

@@ -7,25 +7,7 @@ evaluate_ <- function(text, ..., envir = parent.frame()) {
   evaluate(text, ..., envir = envir)
 }
 
-output_type <- function(x) {
-  if (is.character(x)) {
-    "text"
-  } else if (inherits(x, "error")) {
-    "error"
-  } else if (inherits(x, "warning")) {
-    "warning"
-  } else if (inherits(x, "message")) {
-    "message"
-  } else if (inherits(x, "recordedplot")) {
-    "plot"
-  } else if (inherits(x, "source")) {
-    "source"
-  } else {
-    class(x)[[1]]
-  }
-}
-output_types <- function(x) vapply(x, output_type, character(1))
-
 expect_output_types <- function(x, types) {
-  expect_equal(output_types(x), types)
+  output_types <- vapply(x, output_type, character(1))
+  expect_equal(output_types, types)
 }

tests/testthat/test-eval.R

@@ -84,18 +84,3 @@ test_that("multiple lines of comments do not lose the terminating \\n", {
   expect_output_types(ev, c("source", "source"))
   expect_equal(ev[[1]]$src, "# foo\n")
 })
-
-
-test_that("has a reasonable print method", {
-  f <- function() {
-    print("1")
-    message("2")
-    warning("3")
-    stop("4")
-  }
-
-  expect_snapshot({
-    evaluate("f()")
-    evaluate("plot(1:3)")
-  })  
-})

tests/testthat/test-evaluation.R

@@ -0,0 +1,13 @@
+test_that("has a reasonable print method", {
+  f <- function() {
+    print("1")
+    message("2")
+    warning("3")
+    stop("4")
+  }
+
+  expect_snapshot({
+    evaluate("f()")
+    evaluate("plot(1:3)")
+  })  
+})