Add files to improve the display of licenses information

.Rbuildignore

@@ -10,5 +10,5 @@ inst/source/*
 inst/source/Library
 inst/source/*Rcheck
 inst/source/*tar.gz
-inst/*.rds = = = = =
-=
+inst/*.rds
+.github

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: riskreports
 Title: Package Validation Reports
-Version: 0.0.0.9004
+Version: 0.0.0.9005
 Authors@R: c(
     person("Lluís", "Revilla Sancho", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9747-2570")),

NAMESPACE

@@ -3,6 +3,8 @@
 export(assessment)
 export(check_reporter)
 export(environ_report)
+export(license_url)
+export(licensing_match)
 export(options_report)
 export(package_report)
 importFrom(methods,is)

inst/choosealicense.R

@@ -0,0 +1,33 @@
+# Script to extract a table with the permissions each license allows
+
+library("xml2")
+url <- "https://choosealicense.com/appendix/"
+license_table <- url |>
+  read_html() |>
+  xml_find_all("//table")
+
+cols <- license_table |>
+  xml_find_all("//th[@scope='col']/a") |>
+  xml_text()
+
+rows <- license_table |>
+  xml_find_all("//th[@scope='row']/a") |>
+  xml_text()
+
+licenses_url <- license_table |>
+  xml_find_all("//th[@scope='row']/a") |>
+  xml_attr("href")
+acronym <- licenses_url |>
+  basename() |>
+  toupper()
+
+
+
+legend <- license_table |> xml_find_all("//td") |> xml_attr("class")
+legend <- gsub("license-", replacement = "", x = legend, fixed = TRUE)
+legend[legend == "permissions"] <- "permisive"
+dim(legend) <- c(length(cols), length(rows))
+rownames(legend) <- cols
+legendary <- t(legend)
+df <- cbind(name = rows, acronym = acronym, legendary, url = file.path(dirname(url), licenses_url))
+View(df)

inst/report/pkg_template.qmd

@@ -31,6 +31,7 @@ knitr::opts_chunk$set(
     cache = FALSE
 )
 library("tools")
+library("riskreports")
 ```
 
 # Context
@@ -117,18 +118,26 @@ Overall the package has `r length(d_riskmetric$exported_namespace)` exported obj
 d_riskmetric$export_help[sort(d_riskmetric$exported_namespace)]
 ```
 
-### Examples
+## Examples
 
 There are `r if (!is_na["has_examples"]) sum(d_riskmetric$has_examples)` help pages with examples, from `r if (!is_na["has_examples"]) {length(d_riskmetric$has_examples)}` (`r if (!is_na["has_examples"]) {sprintf("%0.2f", sum(d_riskmetric$has_examples)/length(d_riskmetric$has_examples)*100)} else {"?"} ` %).
 
-### NEWS
+## NEWS
 
 The package has `r if ("has_news" %in% names(d_riskmetric) && !is.null(d_riskmetric$has_news)) print(d_riskmetric$has_news)` NEWS file and it is `r if (is.null(d_riskmetric$news_current) && !d_riskmetric$news_current) "not"` current.
 
-### License
+## License
 
-The package uses `r if ("license" %in% names(d_riskmetric) && !is.null(d_riskmetric$license)) print(d_riskmetric$license)`.
+The package uses `r if ("license" %in% names(d_riskmetric) && !is.null(d_riskmetric$license)) {d_riskmetric$license}`.
 
+```{r license, eval="license" %in% names(d_riskmetric) && !is.null(d_riskmetric$license)}
+license <- licensing_match(d_riskmetric$license)
+options(knitr.kable.NA = '')
+knitr::kable(t(license[, -c(1:2, ncol(license)), drop = FALSE]), row.names = TRUE, col.names = "What is possible")
+```
+
+
+Check the full license terms for `r if ("license" %in% names(d_riskmetric) && !is.null(d_riskmetric$license)) {license_url(license)}` `r if ("license" %in% names(d_riskmetric) && !is.null(d_riskmetric$license) && grepl(" file " , d_riskmetric$license)) {"but check the license file too"}`.
 
 
 # Installation environment