In CoEDL/yinarlingi: Validation Functions for the Warlpiri Dictionary

library(yinarlingi)
library(purrr)
library(furrr)
library(DT)
library(htmltools)

# Set true/false flag for whether test is being run inside a GitLab pipeline
in_gitlab <- Sys.getenv("CI_ENV") == "GITLAB"

# Set global knitr options
knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE)

# Helper functions
prettify_data_col <- . %>%
    mutate_at(vars(matches("data")), funs(str_trunc(., width = 35, ellipsis = "\t...")))

badge_test <- function(is_passing) ifelse(is_passing, '<span class="badge value build-passing">passing</span>', '<span class="badge value build-failing">failing</span>')

# Get all 'test_*' functions from yinarlingi package
yinarlingi_tests <- 
    help.search("test_", package = "yinarlingi") %>%
    .$matches %>%
    select(Title, f_name = Name)

# Run these tests in parallel with future_map()
plan(multiprocess)

yinarlingi_tests$results <-
    future_map(.x = yinarlingi_tests$f_name,
               .f = ~ do.call(what = ., args = list(wlp_lexicon = params$lexicon_path))
    )

yinarlingi_tests$passing <- map_lgl(yinarlingi_tests$results, ~ nrow(.) == 0)

tests_failing <- sum(!yinarlingi_tests$passing) > 0

# Note that file paths are relative to where test-suite.Rmd is being run!
skeletonise_df(params$lexicon_path) %>%
    .$data %>%
    str_trim() %>% 
    writeLines("wlp-skeleton.txt")

# Write out file so pipeline knows whether or not it should exit 0 or exit 1
ifelse(tests_failing, "failing", "passing") %>% 
    writeLines("tests_status.txt")

Tests summary

Full description of all tests available on https://coedl.github.io/yinarlingi/reference, and the Warlpiri dictionary structures (e.g. parts of speech values, code definitions) on https://coedl.github.io/yinarlingi/articles/wlp-structures.html.

yinarlingi_tests %>%
    mutate(
        Title = ifelse(passing, Title, paste('<a href="#', f_name, '">', Title, '</a>', sep = '')),
        Status = badge_test(passing)
    ) %>% 
    select(-results, -f_name, -passing) %>% 
    knitr::kable()

Failing tests

r if(tests_failing == FALSE) "None! \U1F389\U1F389\U1F389"

yinarlingi_tests %>%
    filter(!passing) %>%
    split(.$f_name) %>%
    map(function(failing_table) {

        ref_link <- paste0("https://coedl.github.io/yinarlingi/reference/", failing_table$f_name, ".html", collapse = "")

        tags$div(
            # This exact class attribute should not be changed without planning
            # It is how other scripts know whether the tests are failing (by grepping for 'class="failing-test-block"')
            class = "failing-test-block",
            tags$h3(
                id = failing_table$f_name,
                failing_table$Title,
                tags$a(href=ref_link, target = "_blank", '(see full description)')
            ),
            tags$div(
                failing_table$results[[1]] %>% ungroup() %>% prettify_data_col() %>%
                    datatable()
            )
        )
    }) %>%
    tagList()