Added DB classes
This commit is contained in:
@@ -1,2 +1,3 @@
|
||||
^LICENSE\.md$
|
||||
^README\.Rmd$
|
||||
^\.lintr$
|
||||
|
||||
2
.lintr
Normal file
2
.lintr
Normal file
@@ -0,0 +1,2 @@
|
||||
linters: linters_with_defaults(pipe_consistency_linter=pipe_consistency_linter("%>%"), object_name_linter=object_name_linter(c("camelCase", "snake_case", "symbols"), c(enum = "^E_[A-Z_]+$",sf_object_camelCase = "^(?:\\.)?[[:lower:]](?:[[:alnum:]])*(?:\\.sf|\\.sfc|\\.sfproj)(?:[0-9]*)$", sf_object_snake_case = "^(?:\\.)?[[:lower:][:digit:]]+[_[:lower:][:digit:]]*(?:\\.sf|\\.sfc|\\.sfproj)(?:[0-9]*)$"))) # see vignette("lintr")
|
||||
encoding: "UTF-8"
|
||||
@@ -9,3 +9,8 @@ License: GPL (>= 3)
|
||||
Encoding: UTF-8
|
||||
Roxygen: list(markdown = TRUE)
|
||||
RoxygenNote: 7.3.3
|
||||
Imports:
|
||||
AVSDevR.DBClient,
|
||||
dplyr,
|
||||
magrittr,
|
||||
R6
|
||||
|
||||
12
NAMESPACE
12
NAMESPACE
@@ -1,2 +1,14 @@
|
||||
# Generated by roxygen2: do not edit by hand
|
||||
|
||||
export("%>%")
|
||||
export(MNR.DB)
|
||||
export(MNR.DB.Actuals)
|
||||
export(MNR.DB.Applications)
|
||||
export(MNR.DB.Geometries)
|
||||
export(MNR.DB.Organisations)
|
||||
export(MNR.DB.Users)
|
||||
import(dplyr)
|
||||
importFrom(AVSDevR.DBClient,DBClient)
|
||||
importFrom(AVSDevR.DBClient,DBConnection)
|
||||
importFrom(R6,R6Class)
|
||||
importFrom(magrittr,"%>%")
|
||||
|
||||
6
R/aaa.R
Normal file
6
R/aaa.R
Normal file
@@ -0,0 +1,6 @@
|
||||
|
||||
#' @importFrom AVSDevR.DBClient DBConnection
|
||||
#' @importFrom AVSDevR.DBClient DBClient
|
||||
#' @importFrom R6 R6Class
|
||||
#' @import dplyr
|
||||
NULL
|
||||
21
R/db.R
Normal file
21
R/db.R
Normal file
@@ -0,0 +1,21 @@
|
||||
#' @export
|
||||
# nolint next: object_name_linter. R6Class
|
||||
MNR.DB <- R6::R6Class(
|
||||
"MNR.DB",
|
||||
public = list(
|
||||
initialize = function(db_client) {
|
||||
if (is.null(db_client) || !inherits(db_client, "DBClient")) {
|
||||
rlang::abort(
|
||||
"db_client is not an instance of AVSDevR.DBClient::DBClient!"
|
||||
)
|
||||
}
|
||||
private$db_client <- db_client
|
||||
},
|
||||
getDBClient = function() {
|
||||
private$db_client
|
||||
}
|
||||
),
|
||||
private = list(
|
||||
db_client = NULL
|
||||
)
|
||||
)
|
||||
200
R/db_actuals.R
Normal file
200
R/db_actuals.R
Normal file
@@ -0,0 +1,200 @@
|
||||
#' @export
|
||||
# nolint next: object_name_linter. R6Class
|
||||
MNR.DB.Actuals <- R6::R6Class(
|
||||
"MNR.DB.Actuals",
|
||||
inherit = MNR.DB,
|
||||
public = list(
|
||||
selectActuals = function(refs) {
|
||||
cat("Actuals:\n")
|
||||
private$db_client$table("actual_activities") %>%
|
||||
dplyr::filter(proposed_activity_ref %in% !!refs) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("locations"), by = c(location_id = "id")
|
||||
) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("location_blocks"), by = "location_id"
|
||||
) %>%
|
||||
dplyr::select(
|
||||
proposed_activity_ref,
|
||||
location_id,
|
||||
block = block_ref,
|
||||
geom,
|
||||
date = occurrence_date
|
||||
) %>%
|
||||
dplyr::collect() %>%
|
||||
dplyr::glimpse()
|
||||
},
|
||||
selectProposedActuals = function(refs) {
|
||||
partA <- private$db_client$table("proposed_activities") %>%
|
||||
dplyr::filter(ref %in% !!refs) %>%
|
||||
dplyr::select(ref, application_id) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("applications") %>%
|
||||
dplyr::select(id, location_id),
|
||||
by = c(application_id = "id")
|
||||
) %>%
|
||||
dplyr::inner_join(
|
||||
private$db_client$table("locations") %>%
|
||||
dplyr::filter(
|
||||
(area_type == "Coordinates") | (area_type == "O&G Blocks")
|
||||
),
|
||||
by = c(`location_id` = "id")
|
||||
) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("location_blocks") %>%
|
||||
dplyr::mutate(area_type = "O&G Blocks"),
|
||||
by = c("location_id", "area_type")
|
||||
) %>%
|
||||
dplyr::select(
|
||||
proposed_activity_ref = ref, location_id, block = block_ref, geom
|
||||
) %>%
|
||||
dplyr::collect() %>%
|
||||
dplyr::transmute(
|
||||
proposed_activity_ref,
|
||||
location_id,
|
||||
block,
|
||||
date = lubridate::ymd(NA_character_),
|
||||
geom = geom
|
||||
)
|
||||
partB <- private$db_client$table("proposed_activities") %>%
|
||||
dplyr::filter(ref %in% !!refs) %>%
|
||||
dplyr::select(ref, application_id) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("applications") %>%
|
||||
dplyr::select(id, location_id),
|
||||
by = c(application_id = "id")
|
||||
) %>%
|
||||
dplyr::inner_join(
|
||||
private$db_client$table("locations") %>%
|
||||
dplyr::filter(area_type == "Shapefile"),
|
||||
by = c(`location_id` = "id")
|
||||
) %>%
|
||||
dplyr::select(proposed_activity_ref = ref, location_id, geom) %>%
|
||||
dplyr::collect() %>%
|
||||
dplyr::mutate(
|
||||
geom.sf = sf::st_as_sfc(geom, crs = 4326, EWKB = TRUE)
|
||||
) %>%
|
||||
dplyr::filter(
|
||||
sf::st_is(geom.sf, "POINT")
|
||||
| sf::st_is(geom.sf, "MULTIPOINT")
|
||||
| sf::st_is(geom.sf, "LINESTRING")
|
||||
) %>%
|
||||
dplyr::mutate(
|
||||
geom = tolower(
|
||||
sf::st_as_binary(geom.sf, EWKB = TRUE, hex = TRUE, srid = 4326)
|
||||
),
|
||||
geom = set_class(geom, "pq_geometry"),
|
||||
geom.sf = NULL
|
||||
) %>%
|
||||
dplyr::transmute(
|
||||
proposed_activity_ref,
|
||||
location_id,
|
||||
block = NA_character_,
|
||||
date = lubridate::ymd(NA_character_),
|
||||
geom
|
||||
)
|
||||
|
||||
cat("Proposed:\n")
|
||||
dplyr::bind_rows(partA, partB) %>%
|
||||
dplyr::glimpse()
|
||||
},
|
||||
upsertActuals = function(actuals.sf, geometries) {
|
||||
if (length(actuals.sf) == 0 || (nrow(actuals.sf) == 0)) {
|
||||
return(TRUE)
|
||||
}
|
||||
|
||||
self$deleteActuals(unique(actuals.sf$ref))
|
||||
|
||||
actuals <- actuals.sf %>%
|
||||
tibble::as_tibble() %>%
|
||||
dplyr::mutate(
|
||||
area_type = dplyr::if_else(
|
||||
sf::st_is_empty(geom), "O&G Blocks", "Coordinates"
|
||||
),
|
||||
geom = sf::st_as_binary(geom, EWKB = TRUE, hex = TRUE)
|
||||
)
|
||||
|
||||
cat("## Inserting locations for actuals\n")
|
||||
location_rows <- actuals %>%
|
||||
dplyr::select(area_type, geom) %>%
|
||||
dplyr::mutate(
|
||||
geom = dplyr::if_else(area_type == "O&G Blocks", NA_character_, geom)
|
||||
)
|
||||
location_ids <- private$db_client$appendRows(
|
||||
"locations", location_rows, key_name = "id"
|
||||
)
|
||||
cat("NEW LOCATION ID(s):", paste(location_ids$id, collapse = ","), "\n")
|
||||
|
||||
actuals_w_ids <- location_ids %>%
|
||||
dplyr::bind_cols(actuals) %>%
|
||||
dplyr::rename(location_id = id)
|
||||
|
||||
location_blocks <- actuals_w_ids %>%
|
||||
dplyr::select(location_id, block_ref)
|
||||
private$db_client$appendRows("location_blocks", location_blocks)
|
||||
|
||||
cat("## Inserting actuals\n")
|
||||
actuals_rows <- actuals_w_ids %>%
|
||||
tidyr::unnest(dates) %>%
|
||||
dplyr::filter(!is.na(dates)) %>%
|
||||
dplyr::transmute(
|
||||
proposed_activity_ref = ref,
|
||||
location_id,
|
||||
occurrence_date = dates
|
||||
) %>%
|
||||
dplyr::glimpse()
|
||||
private$db_client$appendRows("actual_activities", actuals_rows)
|
||||
|
||||
cat("## Inserting marine regions\n")
|
||||
marine_region_rows <- actuals_w_ids %>%
|
||||
tidyr::unnest(marine_region_ids) %>%
|
||||
dplyr::select(location_id, marine_region_id) %>%
|
||||
dplyr::glimpse()
|
||||
private$db_client$appendRows(
|
||||
"location_marine_regions", marine_region_rows
|
||||
)
|
||||
|
||||
cat("## Inserting location conservation distances\n")
|
||||
sac_distance_rows <- actuals_w_ids %>%
|
||||
tidyr::unnest(conservation_area_distances) %>%
|
||||
dplyr::select(location_id, conservation_area_id, distance_km) %>%
|
||||
dplyr::mutate(
|
||||
distance_km = units::drop_units(distance_km),
|
||||
flag_actual = TRUE
|
||||
) %>%
|
||||
dplyr::glimpse()
|
||||
private$db_client$appendRows(
|
||||
"location_conservation_area_distances", sac_distance_rows
|
||||
)
|
||||
|
||||
TRUE
|
||||
},
|
||||
deleteActuals = function(refs) {
|
||||
cat("## Deleting old actuals for", paste(refs, collapse = ","), "\n")
|
||||
old_references <- private$db_client$table("actual_activities") %>%
|
||||
dplyr::filter(proposed_activity_ref %in% !!refs) %>%
|
||||
dplyr::select(map_id, location_id) %>%
|
||||
dplyr::collect()
|
||||
|
||||
if (nrow(old_references) > 0) {
|
||||
old_locations <- old_references %>%
|
||||
dplyr::select(location_id) %>%
|
||||
dplyr::distinct()
|
||||
|
||||
old_actuals <- old_references %>%
|
||||
dplyr::select(map_id) %>%
|
||||
dplyr::distinct()
|
||||
|
||||
private$db_client$deleteRows("actual_activities", old_actuals)
|
||||
private$db_client$deleteRows("location_marine_regions", old_locations)
|
||||
private$db_client$deleteRows(
|
||||
"location_conservation_area_distances", old_locations
|
||||
)
|
||||
private$db_client$deleteRows("location_blocks", old_locations)
|
||||
private$db_client$deleteRows(
|
||||
"locations", old_locations %>% dplyr::rename(id = location_id)
|
||||
)
|
||||
}
|
||||
}
|
||||
)
|
||||
)
|
||||
386
R/db_applications.R
Normal file
386
R/db_applications.R
Normal file
@@ -0,0 +1,386 @@
|
||||
#' @export
|
||||
# nolint next: object_name_linter. R6Class
|
||||
MNR.DB.Applications <- R6::R6Class(
|
||||
"MNR.DB.Applications",
|
||||
inherit = MNR.DB,
|
||||
public = list(
|
||||
initialize = function(db_client) {
|
||||
super$initialize(db_client)
|
||||
private$db_users <- MNR.DB.Users$new(db_client)
|
||||
private$db_orgs <- MNR.DB.Organisations$new(db_client)
|
||||
},
|
||||
|
||||
collectFromPermissions = function(perm_query, collect = TRUE) {
|
||||
# nolint end
|
||||
if (getOption("debug", FALSE)) {
|
||||
cat("collectFromPermissions\n")
|
||||
}
|
||||
|
||||
private$getFromPermissions(perm_query) %>%
|
||||
private$joinInfoColumns() %>%
|
||||
private$joinCloseoutColumns() %>%
|
||||
private$db_client$collectOrReturn()
|
||||
},
|
||||
|
||||
getUnfilteredApplications = function(
|
||||
as_permissions = FALSE, collect = TRUE
|
||||
) {
|
||||
warning("This method should not be used for production!")
|
||||
|
||||
perm_qry <- private$db_client$table("application_permissions") %>%
|
||||
dplyr::filter(organisation_id == -1) %>%
|
||||
dplyr::mutate(is_admin = FALSE)
|
||||
|
||||
class(perm_qry) <- unique(c(class(perm_qry), "permissions_query"))
|
||||
|
||||
if (as_permissions) {
|
||||
res <- perm_qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
return(res)
|
||||
}
|
||||
|
||||
self$collectFromPermissions(perm_qry, collect)
|
||||
},
|
||||
|
||||
getAdminApplications = function(
|
||||
user_id = -1, as_permissions = FALSE, collect = TRUE
|
||||
) {
|
||||
if (getOption("debug", FALSE)) {
|
||||
cat("getPublicOnlyApplications\n")
|
||||
}
|
||||
|
||||
perm_qry <- private$getApplicationPermissions(user_id) %>%
|
||||
dplyr::filter(is_admin)
|
||||
|
||||
if (as_permissions) {
|
||||
res <- perm_qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
return(res)
|
||||
}
|
||||
|
||||
self$collectFromPermissions(perm_qry, collect)
|
||||
},
|
||||
|
||||
getPublicOnlyApplications = function(
|
||||
user_id = -1, as_permissions = FALSE, collect = TRUE
|
||||
) {
|
||||
if (getOption("debug", FALSE)) {
|
||||
cat("getPublicOnlyApplications\n")
|
||||
}
|
||||
|
||||
perm_qry <- private$getApplicationPermissions(user_id) %>%
|
||||
dplyr::filter(state_public)
|
||||
|
||||
if (as_permissions) {
|
||||
res <- perm_qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
return(res)
|
||||
}
|
||||
|
||||
self$collectFromPermissions(perm_qry, collect)
|
||||
},
|
||||
|
||||
getRelatedApplications = function(
|
||||
user_id, as_permissions = FALSE, collect = TRUE
|
||||
) {
|
||||
if (getOption("debug", FALSE)) {
|
||||
cat("getRelatedApplications :: user_id ==", user_id, "\n")
|
||||
}
|
||||
|
||||
perm_qry <- private$getApplicationPermissions(user_id) %>%
|
||||
dplyr::filter(organisation_match) %>%
|
||||
dplyr::filter(
|
||||
app_lead | app_agent | app_shared | (app_regulator & state_public)
|
||||
)
|
||||
|
||||
if (as_permissions) {
|
||||
res <- perm_qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
return(res)
|
||||
}
|
||||
|
||||
self$collectFromPermissions(perm_qry, collect)
|
||||
},
|
||||
|
||||
# nolint next: object_length_linter. Descriptive function name
|
||||
getUserOrganisationApplications = function(
|
||||
user_id, as_permissions = FALSE, collect = TRUE
|
||||
) {
|
||||
if (getOption("debug", FALSE)) {
|
||||
cat("getUserOrganisationApplications :: user_id ==", user_id, "\n")
|
||||
}
|
||||
|
||||
perm_qry <- private$getApplicationPermissions(user_id) %>%
|
||||
dplyr::filter(organisation_match) %>%
|
||||
dplyr::filter(app_submitter)
|
||||
|
||||
if (as_permissions) {
|
||||
res <- perm_qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
return(res)
|
||||
}
|
||||
|
||||
self$collectFromPermissions(perm_qry, collect)
|
||||
},
|
||||
|
||||
getUserApplications = function(
|
||||
user_id, as_permissions = FALSE, collect = TRUE
|
||||
) {
|
||||
if (getOption("debug", FALSE)) {
|
||||
cat("getUserApplications :: user_id ==", user_id, "\n")
|
||||
}
|
||||
|
||||
perm_qry <- private$getApplicationPermissions(user_id) %>%
|
||||
dplyr::filter(
|
||||
submitting_user_id == !!user_id
|
||||
& (state_whatif | organisation_id != -1)
|
||||
)
|
||||
|
||||
if (as_permissions) {
|
||||
res <- perm_qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
return(res)
|
||||
}
|
||||
|
||||
self$collectFromPermissions(perm_qry, collect)
|
||||
},
|
||||
|
||||
getApplicationState = function(application_id, collect = TRUE) {
|
||||
if (length(application_id) == 0) {
|
||||
application_id <- -1
|
||||
}
|
||||
state <- private$db_client$table("application_states") %>%
|
||||
dplyr::filter(application_id == !!application_id) %>%
|
||||
dplyr::collect() %>%
|
||||
as.list()
|
||||
if (sum(lengths(state)) == 0) {
|
||||
state <- list(
|
||||
application_id = application_id,
|
||||
workflow_status = "new",
|
||||
status = "new",
|
||||
new = TRUE,
|
||||
draft = FALSE,
|
||||
submitted = FALSE,
|
||||
approved = FALSE,
|
||||
in_progress = FALSE,
|
||||
closed = FALSE,
|
||||
cancelled = FALSE,
|
||||
deleted = FALSE,
|
||||
whatif = FALSE,
|
||||
voluntary = FALSE,
|
||||
consented = FALSE,
|
||||
multiyear = FALSE,
|
||||
public = FALSE
|
||||
)
|
||||
}
|
||||
state
|
||||
}
|
||||
),
|
||||
private = list(
|
||||
db_users = NULL,
|
||||
db_orgs = NULL,
|
||||
|
||||
getApplicationPermissions = function(user_id = -1) {
|
||||
org_id <- c(private$db_orgs$getUserOrganisation(user_id), -1)[[1]]
|
||||
|
||||
flag_admin <- private$db_users$isApplicationsAdmin(user_id)
|
||||
|
||||
perm_query <- private$db_client$table("application_permissions") %>%
|
||||
dplyr::mutate(
|
||||
organisation_match = organisation_id == !!org_id,
|
||||
user_match = submitting_user_id == !!user_id,
|
||||
is_admin = flag_admin
|
||||
) %>%
|
||||
dplyr::filter(
|
||||
# If organisation is null:
|
||||
# only get public matches
|
||||
# else
|
||||
# get org matches where not what-if
|
||||
dplyr::if_else(
|
||||
!!org_id == -1,
|
||||
(organisation_match & state_public),
|
||||
(organisation_match & !state_whatif)
|
||||
)
|
||||
# Include user what-ifs
|
||||
| (user_match & organisation_id == -1 & state_whatif)
|
||||
# Admin override
|
||||
| (!!flag_admin & organisation_id == -1)
|
||||
) %>%
|
||||
dplyr::filter(
|
||||
# Either user is admin or the application is not deleted
|
||||
!!flag_admin | !state_deleted
|
||||
)
|
||||
|
||||
class(perm_query) <- unique(c(class(perm_query), "permissions_query"))
|
||||
|
||||
perm_query
|
||||
},
|
||||
|
||||
mutatePermissionsColumns = function(perm_query) {
|
||||
stopifnot(
|
||||
"object is not a permissions query" = inherits(
|
||||
perm_query, "permissions_query"
|
||||
)
|
||||
)
|
||||
|
||||
# NOTE: can_edit assumes a later check for close-out allowance on closed
|
||||
# applications
|
||||
perm_query %>%
|
||||
dplyr::group_by(application_id) %>%
|
||||
dplyr::filter(organisation_id == max(organisation_id, -1)) %>%
|
||||
dplyr::ungroup() %>%
|
||||
dplyr::transmute(
|
||||
application_id,
|
||||
can_admin = is_admin,
|
||||
can_regulate = app_regulator & state_public,
|
||||
can_edit = app_submitter
|
||||
| app_lead
|
||||
| app_agent
|
||||
| app_shared
|
||||
| state_whatif,
|
||||
can_edit = ((can_edit | can_regulate) & !state_cancelled) | can_admin,
|
||||
can_read = can_admin | can_edit | state_public,
|
||||
is_public = state_public,
|
||||
is_closed = state_closed,
|
||||
is_whatif = state_whatif
|
||||
) %>%
|
||||
dplyr::distinct() %>%
|
||||
dplyr::collapse()
|
||||
},
|
||||
|
||||
getFromPermissions = function(perm_query) {
|
||||
# nolint end
|
||||
stopifnot(
|
||||
"object is not a permissions query" = inherits(
|
||||
perm_query, "permissions_query"
|
||||
)
|
||||
)
|
||||
|
||||
private$db_client$table("application_timestamps") %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("application_states") %>%
|
||||
dplyr::select(application_id, status),
|
||||
by = c(id = "application_id")
|
||||
) %>%
|
||||
dplyr::inner_join(
|
||||
perm_query %>%
|
||||
private$mutatePermissionsColumns(),
|
||||
by = c(id = "application_id")
|
||||
)
|
||||
},
|
||||
|
||||
getCloseoutDates = function() {
|
||||
private$db_client$table("application_timestamps") %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("regulator_closeout_periods") %>%
|
||||
dplyr::filter(regulator_organisation_id != 7) %>%
|
||||
dplyr::select(-map_id),
|
||||
by = c("regulator_organisation_id")
|
||||
) %>%
|
||||
# Work out what the closeout closeout year should be
|
||||
dplyr::mutate(
|
||||
closeout_year = as.Date(paste(
|
||||
lubridate::year(pmax(start_date, closed_at, na.rm = TRUE)),
|
||||
12L,
|
||||
31L,
|
||||
sep = "-"
|
||||
)) + year_closeout_period,
|
||||
closeout_final = end_date + closeout_period
|
||||
) %>%
|
||||
# If periods are null, set date to the distant future (Inf)
|
||||
dplyr::transmute(
|
||||
id,
|
||||
closeout_period,
|
||||
year_closeout_period,
|
||||
closeout_year = dplyr::if_else(
|
||||
is.null(year_closeout_period), as.Date("2200-01-01"), closeout_year
|
||||
),
|
||||
closeout_final = dplyr::if_else(
|
||||
is.null(closeout_period), as.Date("2200-01-01"), closeout_final
|
||||
)
|
||||
) %>%
|
||||
# If periods are null, set date to the distant future (Inf)
|
||||
dplyr::transmute(
|
||||
id,
|
||||
closeout_due = dplyr::if_else(
|
||||
closeout_year < closeout_final, closeout_year, closeout_final
|
||||
)
|
||||
) %>%
|
||||
dplyr::collapse()
|
||||
},
|
||||
|
||||
joinInfoColumns = function(app_query) {
|
||||
app_query %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("users") %>%
|
||||
dplyr::transmute(
|
||||
id, submitter_name = paste(first_name, last_name)
|
||||
) %>%
|
||||
dplyr::collapse(),
|
||||
by = c(submitting_user_id = "id")
|
||||
) %>%
|
||||
dplyr::relocate(submitter_name, .after = submitting_user_id) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("organisations") %>%
|
||||
dplyr::select(id, submitting_organisation_name = name) %>%
|
||||
dplyr::collapse(),
|
||||
by = c(submitting_organisation_id = "id")
|
||||
) %>%
|
||||
dplyr::relocate(
|
||||
submitting_organisation_name, .after = submitting_organisation_id
|
||||
) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("organisations") %>%
|
||||
dplyr::select(id, lead_organisation_name = name) %>%
|
||||
dplyr::collapse(),
|
||||
by = c(lead_organisation_id = "id")
|
||||
) %>%
|
||||
dplyr::relocate(
|
||||
lead_organisation_name, .after = lead_organisation_id
|
||||
) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("organisations") %>%
|
||||
dplyr::select(id, regulator_name = name) %>%
|
||||
dplyr::collapse(),
|
||||
by = c(regulator_organisation_id = "id")
|
||||
) %>%
|
||||
dplyr::relocate(regulator_name, .after = regulator_organisation_id)
|
||||
},
|
||||
|
||||
joinCloseoutColumns = function(app_query) {
|
||||
closeout_edit_cutoff <- lubridate::make_date(
|
||||
lubridate::year(lubridate::today()), 3, 31
|
||||
)
|
||||
if (lubridate::today() > closeout_edit_cutoff) {
|
||||
closeout_edit_cutoff <- closeout_edit_cutoff + lubridate::years(1)
|
||||
}
|
||||
|
||||
app_query %>%
|
||||
dplyr::left_join(private$getCloseoutDates(), by = "id") %>%
|
||||
# Work out what the closeout closeout year should be
|
||||
dplyr::mutate(
|
||||
closeout_due = dplyr::if_else(
|
||||
is_closed, as.Date(closed_at), closeout_due
|
||||
)
|
||||
) %>%
|
||||
# Work out if the closed application is beyond the edit date
|
||||
dplyr::mutate(
|
||||
edit_cutoff_date = as.Date(paste(
|
||||
lubridate::year(closeout_due), 3L, 31L, sep = "-"
|
||||
)),
|
||||
edit_cutoff_next = as.Date(paste(
|
||||
lubridate::year(closeout_due) + 1L, 3L, 31L, sep = "-"
|
||||
)),
|
||||
edit_cutoff = dplyr::if_else(
|
||||
edit_cutoff_date < closeout_due, edit_cutoff_next, edit_cutoff_date
|
||||
),
|
||||
can_edit_closed = dplyr::if_else(
|
||||
is_closed & (edit_cutoff <= lubridate::now()), can_admin, can_edit
|
||||
)
|
||||
) %>%
|
||||
dplyr::select(
|
||||
-edit_cutoff_date, -edit_cutoff_next, -edit_cutoff
|
||||
)
|
||||
}
|
||||
)
|
||||
)
|
||||
89
R/db_geometries.R
Normal file
89
R/db_geometries.R
Normal file
@@ -0,0 +1,89 @@
|
||||
#' @export
|
||||
# nolint next: object_name_linter. R6Class
|
||||
MNR.DB.Geometries <- R6::R6Class(
|
||||
"MNR.DB.Geometries",
|
||||
inherit = MNR.DB,
|
||||
public = list(
|
||||
getBlocks = function(
|
||||
with_geometries = TRUE, ordered = FALSE, collect = TRUE
|
||||
) {
|
||||
qry <- private$db_client$table("blocks")
|
||||
|
||||
if (ordered) {
|
||||
qry <- qry %>%
|
||||
dplyr::mutate(
|
||||
block_ref_num = stringr::str_replace_all(
|
||||
block_ref, "[A-Z]+/", "999/"
|
||||
),
|
||||
block_ref_let = stringr::str_replace_all(
|
||||
block_ref, "[0-9]+/", "A/"
|
||||
),
|
||||
block_order_A = as.integer(stringr::str_replace_all(
|
||||
block_ref_num, "/[0-9]+", ""
|
||||
)),
|
||||
block_order_B = stringr::str_replace_all(
|
||||
block_ref_let, "/[0-9]+", ""
|
||||
),
|
||||
block_order_C = as.integer(stringr::str_replace_all(
|
||||
block_ref, "[A-Z0-9]+/", ""
|
||||
))
|
||||
) %>%
|
||||
dplyr::collapse() %>%
|
||||
dbplyr::window_order(block_order_A, block_order_B, block_order_C) %>%
|
||||
dplyr::collapse()
|
||||
}
|
||||
|
||||
if (!with_geometries) {
|
||||
qry <- qry %>%
|
||||
dplyr::select(-dplyr::any_of(c("geometry", "proj", "geom"))) %>%
|
||||
private$db_client$collectOrReturn()
|
||||
} else if (collect) {
|
||||
qry <- qry %>%
|
||||
private$db_client$collectGeometries()
|
||||
}
|
||||
|
||||
qry
|
||||
},
|
||||
|
||||
getConservationAreas = function(with_geometries = TRUE, collect = TRUE) {
|
||||
qry <- private$db_client$table("conservation_areas")
|
||||
|
||||
if (!with_geometries) {
|
||||
qry <- qry %>%
|
||||
dplyr::select(-dplyr::any_of(c("geometry", "proj", "geom"))) %>%
|
||||
private$db_client$collectOrReturn()
|
||||
} else if (collect) {
|
||||
qry <- qry %>%
|
||||
private$db_client$collectGeometries()
|
||||
}
|
||||
|
||||
qry
|
||||
},
|
||||
|
||||
getMarineRegions = function(with_geometries = TRUE, collect = TRUE) {
|
||||
qry <- private$db_client$table("marine_regions")
|
||||
|
||||
if (!with_geometries) {
|
||||
qry <- qry %>%
|
||||
dplyr::select(-dplyr::any_of(c("geometry", "proj", "geom"))) %>%
|
||||
private$db_client$collectOrReturn()
|
||||
} else if (collect) {
|
||||
qry <- qry %>%
|
||||
private$db_client$collectGeometries()
|
||||
}
|
||||
|
||||
qry
|
||||
},
|
||||
|
||||
getBlockMarineRegions = function(collect = TRUE) {
|
||||
qry <- private$db_client$table("block_marine_regions")
|
||||
private$db_client$collectOrReturn(qry)
|
||||
},
|
||||
|
||||
# nolint next: object_length_linter. Descriptive function name required
|
||||
getBlockConservationAreaDistances = function(collect = TRUE) {
|
||||
qry <- private$db_client$table("block_conservation_area_distances")
|
||||
private$db_client$collectOrReturn(qry)
|
||||
}
|
||||
)
|
||||
)
|
||||
191
R/db_organisations.R
Normal file
191
R/db_organisations.R
Normal file
@@ -0,0 +1,191 @@
|
||||
#' @export
|
||||
# nolint next: object_name_linter. R6Class
|
||||
MNR.DB.Organisations <- R6::R6Class(
|
||||
"MNR.DB.Organisations",
|
||||
inherit = MNR.DB,
|
||||
public = list(
|
||||
getOrganisation = function(org_id, collect = TRUE) {
|
||||
private$db_client$table("organisations") %>%
|
||||
dplyr::filter(id == !!org_id) %>%
|
||||
private$db_client$collectOrReturn()
|
||||
},
|
||||
|
||||
getAllOrganisations = function(
|
||||
as_int = FALSE, name_only = TRUE, collect = TRUE
|
||||
) {
|
||||
qry <- private$db_client$table("organisations") %>%
|
||||
dplyr::filter(flag_approved == TRUE)
|
||||
|
||||
if (as_int) {
|
||||
qry %>%
|
||||
dplyr::pull(id)
|
||||
} else if (name_only) {
|
||||
qry %>%
|
||||
dplyr::pull(name)
|
||||
} else {
|
||||
qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
}
|
||||
},
|
||||
|
||||
isRegulator = function(org_id) {
|
||||
private$db_client$table("organisations") %>%
|
||||
dplyr::filter(flag_approved == TRUE) %>%
|
||||
dplyr::filter(flag_regulator == TRUE) %>%
|
||||
dplyr::filter(id == !!org_id) %>%
|
||||
dplyr::count() %>%
|
||||
dplyr::pull() %>%
|
||||
magrittr::is_greater_than(0)
|
||||
},
|
||||
|
||||
getRegulators = function(as_int = FALSE, name_only = TRUE, collect = TRUE) {
|
||||
qry <- private$db_client$table("organisations") %>%
|
||||
dplyr::filter(flag_approved == TRUE) %>%
|
||||
dplyr::filter(flag_regulator == TRUE)
|
||||
|
||||
if (as_int) {
|
||||
qry %>%
|
||||
dplyr::pull(id)
|
||||
} else if (name_only) {
|
||||
qry %>%
|
||||
dplyr::pull(name)
|
||||
} else {
|
||||
qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
}
|
||||
},
|
||||
|
||||
getUsersFromOrg = function(org_name = "", org_id = -1, collect = TRUE) {
|
||||
private$db_client$table("users") %>%
|
||||
dplyr::filter(flag_enabled == TRUE, flag_verified == TRUE) %>%
|
||||
dplyr::mutate(known_as = paste(first_name, last_name)) %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("organisation_members") %>%
|
||||
dplyr::select(user_id, organisation_id),
|
||||
by = c(id = "user_id")
|
||||
) %>%
|
||||
dplyr::inner_join(
|
||||
private$db_client$table("organisations") %>%
|
||||
dplyr::filter((id == !!org_id) | (name == !!org_name)) %>%
|
||||
dplyr::select(id),
|
||||
by = c(organisation_id = "id")
|
||||
) %>%
|
||||
dplyr::select(-organisation_id) %>%
|
||||
private$db_client$collectOrReturn()
|
||||
},
|
||||
|
||||
isAgent = function(user_id) {
|
||||
private$db_client$table("organisation_members") %>%
|
||||
dplyr::filter(user_id == !!user_id) %>%
|
||||
dplyr::inner_join(
|
||||
private$db_client$table("organisation_agents") %>%
|
||||
dplyr::filter(flag_approved == TRUE),
|
||||
by = c(organisation_id = "agent_id")
|
||||
) %>%
|
||||
dplyr::count() %>%
|
||||
dplyr::pull() %>%
|
||||
magrittr::is_greater_than(0)
|
||||
},
|
||||
|
||||
getAgentForOrganisations = function(
|
||||
org_ids, as_int = FALSE, name_only = TRUE, collect = TRUE
|
||||
) {
|
||||
qry <- private$db_client$table("organisations") %>%
|
||||
dplyr::filter(flag_approved == TRUE) %>%
|
||||
dplyr::inner_join(
|
||||
private$db_client$table("organisation_agents") %>%
|
||||
dplyr::filter(organisation_id %in% !!org_ids) %>%
|
||||
dplyr::select(agent_id) %>%
|
||||
dplyr::collapse(),
|
||||
by = c(id = "agent_id")
|
||||
) %>%
|
||||
dplyr::distinct()
|
||||
|
||||
if (as_int) {
|
||||
qry %>%
|
||||
dplyr::pull(id)
|
||||
} else if (name_only) {
|
||||
qry %>%
|
||||
dplyr::pull(name)
|
||||
} else {
|
||||
qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
}
|
||||
},
|
||||
|
||||
getRecipientOrganisations = function(
|
||||
org_id, as_int = FALSE, name_only = TRUE, collect = TRUE
|
||||
) {
|
||||
qry <- private$db_client$table("organisations") %>%
|
||||
dplyr::filter(flag_approved == TRUE) %>%
|
||||
dplyr::inner_join(
|
||||
private$db_client$table("organisation_agents") %>%
|
||||
dplyr::filter(agent_id %in% !!org_id) %>%
|
||||
dplyr::select(organisation_id) %>%
|
||||
dplyr::collapse(),
|
||||
by = c(id = "organisation_id")
|
||||
) %>%
|
||||
dplyr::distinct()
|
||||
|
||||
if (as_int) {
|
||||
qry %>%
|
||||
dplyr::pull(id)
|
||||
} else if (name_only) {
|
||||
qry %>%
|
||||
dplyr::pull(name)
|
||||
} else {
|
||||
qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
}
|
||||
},
|
||||
|
||||
getUserOrgs = function(
|
||||
user_id, as_int = TRUE, name_only = TRUE, collect = TRUE
|
||||
) {
|
||||
qry <- private$db_client$table("organisations") %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("organisation_members") %>%
|
||||
dplyr::select(user_id, organisation_id),
|
||||
by = c(id = "organisation_id")
|
||||
) %>%
|
||||
dplyr::filter(flag_approved == TRUE) %>%
|
||||
dplyr::filter(user_id == !!user_id)
|
||||
|
||||
if (as_int) {
|
||||
qry %>%
|
||||
dplyr::pull(id)
|
||||
} else if (name_only) {
|
||||
qry %>%
|
||||
dplyr::pull(name)
|
||||
} else {
|
||||
qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
}
|
||||
},
|
||||
|
||||
getUserOrganisation = function(
|
||||
user_id, as_int = TRUE, name_only = TRUE, collect = TRUE
|
||||
) {
|
||||
qry <- private$db_client$table("organisations") %>%
|
||||
dplyr::left_join(
|
||||
private$db_client$table("organisation_members") %>%
|
||||
dplyr::select(user_id, organisation_id),
|
||||
by = c(id = "organisation_id")
|
||||
) %>%
|
||||
dplyr::filter(flag_approved == TRUE) %>%
|
||||
dplyr::filter(user_id == !!user_id) %>%
|
||||
dplyr::slice_min(user_id, n = 1)
|
||||
|
||||
if (as_int) {
|
||||
qry %>%
|
||||
dplyr::pull(id)
|
||||
} else if (name_only) {
|
||||
qry %>%
|
||||
dplyr::pull(name)
|
||||
} else {
|
||||
qry %>%
|
||||
private$db_client$collectOrReturn()
|
||||
}
|
||||
}
|
||||
)
|
||||
)
|
||||
38
R/db_users.R
Normal file
38
R/db_users.R
Normal file
@@ -0,0 +1,38 @@
|
||||
#' @export
|
||||
# nolint next: object_name_linter. R6Class
|
||||
MNR.DB.Users <- R6::R6Class(
|
||||
"MNR.DB.Users",
|
||||
inherit = MNR.DB,
|
||||
public = list(
|
||||
initialize = function(db_client, admin_role_slug = NULL) {
|
||||
super$initialize(db_client)
|
||||
private$db_uf <- AVSDevR.UserFrosting::UFDatabase$new(db_client)
|
||||
|
||||
if (!is.null(admin_role_slug)) {
|
||||
private$admin_role_slug <- admin_role_slug
|
||||
}
|
||||
},
|
||||
|
||||
getUser = function(user_id, collect = TRUE) {
|
||||
db_uf$getUser(user_id, collect)
|
||||
},
|
||||
getUserName = function(user_id) {
|
||||
db_uf$getUserName(user_id)
|
||||
},
|
||||
getUserRoles = function(user_id, collect = TRUE) {
|
||||
db_uf$getUserRoles(user_id, collect)
|
||||
},
|
||||
|
||||
isApplicationsAdmin = function(user_id) {
|
||||
self$getUserRoles(user_id, collect = FALSE) %>%
|
||||
dplyr::filter(slug == !!private$admin_role_slug) %>%
|
||||
dplyr::count() %>%
|
||||
dplyr::pull(n) %>%
|
||||
magrittr::is_greater_than(0)
|
||||
}
|
||||
),
|
||||
private = list(
|
||||
db_uf = NULL,
|
||||
admin_role_slug = "application-admin"
|
||||
)
|
||||
)
|
||||
14
R/utils-pipe.R
Normal file
14
R/utils-pipe.R
Normal file
@@ -0,0 +1,14 @@
|
||||
#' Pipe operator
|
||||
#'
|
||||
#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.
|
||||
#'
|
||||
#' @name %>%
|
||||
#' @rdname pipe
|
||||
#' @keywords internal
|
||||
#' @export
|
||||
#' @importFrom magrittr %>%
|
||||
#' @usage lhs \%>\% rhs
|
||||
#' @param lhs A value or the magrittr placeholder.
|
||||
#' @param rhs A function call using the magrittr semantics.
|
||||
#' @return The result of calling `rhs(lhs)`.
|
||||
NULL
|
||||
20
man/pipe.Rd
Normal file
20
man/pipe.Rd
Normal file
@@ -0,0 +1,20 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/utils-pipe.R
|
||||
\name{\%>\%}
|
||||
\alias{\%>\%}
|
||||
\title{Pipe operator}
|
||||
\usage{
|
||||
lhs \%>\% rhs
|
||||
}
|
||||
\arguments{
|
||||
\item{lhs}{A value or the magrittr placeholder.}
|
||||
|
||||
\item{rhs}{A function call using the magrittr semantics.}
|
||||
}
|
||||
\value{
|
||||
The result of calling \code{rhs(lhs)}.
|
||||
}
|
||||
\description{
|
||||
See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.
|
||||
}
|
||||
\keyword{internal}
|
||||
Reference in New Issue
Block a user