Merge pull request #5 from mrc-ide/mrc-5524

Add unique codes for each error message

.Rbuildignore

@@ -16,8 +16,11 @@
 \.gcda$
 \.gcno$
 ^pkgdown$
+^_pkgdown\.yml$
 ^LICENSE\.md$
 ^buildkite$
 ^\.covrignore$
 ^\.github$
 \.*gcov$
+^.*\.Rproj$
+^\.Rproj\.user$

DESCRIPTION

@@ -10,15 +10,20 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
-URL: https://github.com/mrc-ide/odin2
+URL: https://mrc-ide.github.io/odin2, https://github.com/mrc-ide/odin2
 BugReports: https://github.com/mrc-ide/odin2/issues
 Imports:
     cli,
     mcstate2,
     rlang
 Suggests:
+    knitr,
+    rmarkdown,
+    mockery,
     testthat (>= 3.0.0),
     withr
 Config/testthat/edition: 3
 Remotes:
     mrc-ide/mcstate2
+VignetteBuilder: knitr
+Language: en-GB

NAMESPACE

@@ -1,4 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(cnd_footer,odin_parse_error)
+export(odin_error_explain)
 importFrom(rlang,cnd_footer)

R/parse_error.R

@@ -1,10 +1,12 @@
-odin_parse_error <- function(msg, src, call, ...,
+odin_parse_error <- function(msg, code, src, call, ...,
                              .envir = parent.frame()) {
+  stopifnot(grepl("^E[0-9]{4}$", code))
   if (!is.null(names(src))) {
     src <- list(src)
   }
   cli::cli_abort(msg,
                  class = "odin_parse_error",
+                 code = code,
                  src = src,
                  call = call,
                  ...,
@@ -26,5 +28,56 @@ cnd_footer.odin_parse_error <- function(cnd, ...) {
     src <- unlist(lapply(src, "[[", "str"))
     context <- sprintf("%s| %s", gsub(" ", "\u00a0", format(line)), src)
   }
-  c(">" = "Context:", context)
+
+  code <- cnd$code
+  ## See https://cli.r-lib.org/reference/links.html#click-to-run-code
+  ## RStudio will only run code in namespaced form
+  explain <- cli::format_inline(
+    "For more information, run {.run odin2::odin_error_explain(\"{code}\")}")
+
+  c(">" = "Context:", context,
+    "i" = explain)
+}
+
+
+##' Explain error codes produced by odin.  This is a work in progress,
+##' and we would like feedback on what is useful as we improve it.
+##' The idea is that if you see an error you can link through to get
+##' more information on what it means and how to resolve it.  The
+##' current implementation of this will send you to the rendered
+##' vignettes, but in future we will arrange for offline rendering
+##' too.
+##'
+##' @title Explain odin error
+##'
+##' @param code The error code, as a string, in the form `Exxxx` (a
+##'   capital "E" followed by four numbers)
+##'
+##' @return Nothing, this is called for its side effect only
+##'
+##' @export
+odin_error_explain <- function(code) {
+  ## There are a couple of options here that we can explore:
+
+  ## * We might write out html and read that in as html
+  ## * We might render the markdown using cli
+  ## * We might page the file with page()
+  ## * We might send the user to the web page version
+
+  assert_scalar_character(code)
+  if (!grepl("^E[0-9]{4}$", code)) {
+    cli::cli_abort("Invalid code '{code}', should match 'Exxxx'",
+                   arg = "code")
+  }
+  txt <- errors[[code]]
+  if (is.null(txt)) {
+    cli::cli_abort(
+      c("Error '{code}' is undocumented",
+        i = paste("If you were directed here from an error message, please",
+                  "let us know (e.g., file an issue or send us a message)")),
+      arg = "code")
+  }
+  url <- sprintf("https://mrc-ide.github.io/odin2/articles/errors.html#%s",
+                 tolower(code))
+  utils::browseURL(url)
 }

R/parse_expr.R

@@ -9,7 +9,7 @@ parse_expr <- function(expr, src, call) {
     odin_parse_error(
       c("Unclassifiable expression",
         i = "Expected an assignment (with '<-') or a relationship (with '~')"),
-      src, call)
+      "E1001", src, call)
   }
 }
 
@@ -24,9 +24,16 @@ parse_expr_assignment <- function(expr, src, call) {
     if (!is.null(special)) {
       odin_parse_error(
         "Calls to 'data()' must be assigned to a symbol",
-        src, call)
+        "E1002", src, call)
     }
     special <- "data"
+  } else if (rhs$type == "parameter") {
+    if (!is.null(special)) {
+      odin_parse_error(
+        "Calls to 'parameter()' must be assigned to a symbol",
+        "E1014", src, call)
+    }
+    special <- "parameter"
   }
 
   list(special = special,
@@ -47,7 +54,7 @@ parse_expr_assignment_lhs <- function(lhs, src, call) {
       odin_parse_error(
         c("Invalid special function call",
           i = "Expected a single unnamed argument to '{special}()'"),
-        src, call)
+        "E1003", src, call)
     }
     if (special == "compare") {
       ## TODO: a good candidate for pointing at the source location of
@@ -58,15 +65,15 @@ parse_expr_assignment_lhs <- function(lhs, src, call) {
                     "relationships, which we emphasise by using '~'.  This",
                     "also keeps the syntax close to that for the prior",
                     "specification in mcstate2")),
-        src, call)
+        "E1004", src, call)
     }
     lhs <- lhs[[2]]
   }
 
   is_array <- rlang::is_call(lhs, "[")
   if (is_array) {
     odin_parse_error(
-      "Arrays are not supported yet", src, call)
+      "Arrays are not supported yet", "E0001", src, call)
   }
 
   name <- parse_expr_check_lhs_name(lhs, src, call)
@@ -79,13 +86,15 @@ parse_expr_assignment_lhs <- function(lhs, src, call) {
 
 parse_expr_assignment_rhs <- function(rhs, src, call) {
   if (rlang::is_call(rhs, "delay")) {
-    odin_parse_error("'delay()' is not implemented yet", src, call)
+    odin_parse_error("'delay()' is not implemented yet",
+                     "E0001", src, call)
   } else if (rlang::is_call(rhs, "parameter")) {
     parse_expr_assignment_rhs_parameter(rhs, src, call)
   } else if (rlang::is_call(rhs, "data")) {
     parse_expr_assignment_rhs_data(rhs, src, call)
   } else if (rlang::is_call(rhs, "interpolate")) {
-    odin_parse_error("'interpolate()' is not implemented yet", src, call)
+    odin_parse_error("'interpolate()' is not implemented yet",
+                     "E0001", src, call)
   } else {
     parse_expr_assignment_rhs_expression(rhs, src, call)
   }
@@ -112,7 +121,7 @@ parse_expr_check_lhs_name <- function(lhs, src, call) {
   ## anything reserved.  Add these in later, see
   ## "ir_parse_expr_check_lhs_name" for details.
   if (!rlang::is_symbol(lhs)) {
-    odin_parse_error("Expected a symbol on the lhs", src, call)
+    odin_parse_error("Expected a symbol on the lhs", "E1005", src, call)
   }
   name <- deparse1(lhs)
   name
@@ -130,8 +139,9 @@ parse_expr_assignment_rhs_parameter <- function(rhs, src, call) {
     odin_parse_error(
       c("Invalid call to 'parameter()'",
         x = conditionMessage(result$error)),
-      src, call)
+      "E1006", src, call)
   }
+  ## TODO: also error if any unnamed argument is not `default`
   args <- as.list(result$value)[-1]
   if (is.language(args$default)) {
     deps <- find_dependencies(args$default)
@@ -142,7 +152,7 @@ parse_expr_assignment_rhs_parameter <- function(rhs, src, call) {
           i = paste("Default arguments can only perform basic arithmetic",
                     "operations on numbers, and may not reference any",
                     "other parameter or variable")),
-        src, call)
+        "E1007", src, call)
     }
     ## TODO: validate the functions used at some point, once we do
     ## that generally.
@@ -152,7 +162,7 @@ parse_expr_assignment_rhs_parameter <- function(rhs, src, call) {
     str <- deparse1(args$differentiate)
     odin_parse_error(
       "'differentiate' must be a scalar logical, but was '{str}'",
-      src, call)
+      "E1008", src, call)
   }
   ## constant has a different default
   if (is.null(args$constant)) {
@@ -161,7 +171,7 @@ parse_expr_assignment_rhs_parameter <- function(rhs, src, call) {
     str <- deparse1(args$constant)
     odin_parse_error(
       "'constant' must be a scalar logical if given, but was '{str}'",
-      src, call)
+      "E1009", src, call)
   }
   list(type = "parameter",
        args = args)
@@ -171,7 +181,7 @@ parse_expr_assignment_rhs_parameter <- function(rhs, src, call) {
 parse_expr_assignment_rhs_data <- function(rhs, src, call) {
   if (length(rhs) != 1) {
     odin_parse_error("Calls to 'data()' must have no arguments",
-                     src, call)
+                     "E1010", src, call)
   }
   list(type = "data")
 }
@@ -200,13 +210,13 @@ parse_expr_compare_lhs <- function(lhs, src, call) {
     odin_parse_error(
       c("Expected the lhs of '~' to be a 'compare()' call",
         i = "Did you mean to use '<-' in place of '~'?"),
-        src, call)
+      "E1011", src, call)
   }
   lhs <- lhs[[2]]
   if (!is.symbol(lhs)) {
     odin_parse_error(
       "Expected the argument of 'compare()' to be a symbol",
-      src, call)
+      "E1012", src, call)
   }
   lhs
 }
@@ -217,9 +227,9 @@ parse_expr_compare_rhs <- function(rhs, src, call) {
   if (!result$success) {
     odin_parse_error(
       result$error,
-      src, call)
+      "E1013", src, call)
   }
-   depends <- find_dependencies(rhs)
+  depends <- find_dependencies(rhs)
   list(type = "compare",
        distribution = result$value$cpp$density,
        args = result$value$args,
@@ -229,5 +239,5 @@ parse_expr_compare_rhs <- function(rhs, src, call) {
 
 parse_expr_print <- function(expr, src, call) {
   odin_parse_error(
-    "'print()' is not implemented yet", src, call)
+    "'print()' is not implemented yet", "E0001", src, call)
 }

_pkgdown.yml

@@ -0,0 +1,17 @@
+url: https://mrc-ide.github.io/dust2
+
+template:
+  bootstrap: 5
+
+reference:
+  - title: All functions
+    desc: >-
+      All functions, until the API starts to develop properly.
+    contents:
+      - odin_error_explain
+
+articles:
+  - title: Details
+    navbar: Details
+    contents:
+      - errors

inst/WORDLIST

@@ -0,0 +1,5 @@
+codecov
+etc
+io
+odin
+odin's

scripts/parse_errors.R

@@ -0,0 +1,34 @@
+#!/usr/bin/env Rscript
+
+read_errors <- function() {
+  path_rmd <- "vignettes/errors.Rmd"
+  txt <- readLines(path_rmd)
+
+  re <- "^# `(E[0-9]{4})`$"
+  i <- grep(re, txt)
+  if (length(setdiff(grep("^# ", txt), i)) > 0) {
+    stop("Some headings don't match expected pattern")
+  }
+
+  f <- function(from, to) {
+    ret <- txt[from:to]
+    while (ret[[1]] == "") {
+      ret <- ret[-1]
+    }
+    while (ret[[length(ret)]] == "") {
+      ret <- ret[-length(ret)]
+    }
+    ret
+  }
+
+  ret <- Map(f, i + 1, c(i[-1] - 1, length(txt)))
+  names(ret) <- sub(re, "\\1", txt[i])
+  ret
+}
+
+
+## We might parse this further, e.g., with commonmark, so that we can
+## render this nicely to the console as cli would make this pretty
+## easy really.
+errors <- read_errors()
+save(list = "errors", file = file.path("R/sysdata.rda"), version = 2)

tests/testthat/test-parse-error.R

@@ -0,0 +1,30 @@
+test_that("can explain an error", {
+  skip_if_not_installed("mockery")
+  mock_browse <- mockery::mock()
+  mockery::stub(odin_error_explain, "utils::browseURL", mock_browse)
+  odin_error_explain("E0001")
+  mockery::expect_called(mock_browse, 1)
+  expect_equal(
+    mockery::mock_args(mock_browse)[[1]],
+    list("https://mrc-ide.github.io/odin2/articles/errors.html#e0001"))
+})
+
+
+test_that("error if given invalid code", {
+  msg <- "Invalid code 'E001', should match 'Exxxx'"
+  expect_error(odin_error_explain("E001"),
+               "Invalid code 'E001', should match 'Exxxx'")
+  expect_error(odin_error_explain("e0001"),
+               "Invalid code 'e0001', should match 'Exxxx'")
+  expect_error(odin_error_explain("E00001"),
+               "Invalid code 'E00001', should match 'Exxxx'")
+  expect_error(odin_error_explain("anything"),
+               "Invalid code 'anything', should match 'Exxxx'")
+})
+
+
+test_that("error if given unknown code", {
+  expect_error(
+    odin_error_explain("E9999"),
+    "Error 'E9999' is undocumented")
+})