#' TidyModule R6 Class, parent of all modules
#'
#' @description
#' This is the main class provided by tidymodules and should be the parent of all tidymodules modules.
#' It provides methods for defining input and output communication ports, managing module namespace and many other useful features.
#'
#' @import R6
#' @import shiny
#'
#' @export
<- R6::R6Class(
"TidyModule",
public = (
#' @field id ID of the module.
id = ,
#' @field name Name of the module as generated or provided by the user.
= ,
#' @field module_ns Module namespace, unique identifier for the module.
module_ns = ,
#' @field parent_ns Parent module namespace in case of nested modules.
parent_ns = ,
#' @field parent_mod Reference to parent module in case of nested modules.
parent_mod = ,
#' @field pass_ports logical value indicating if the module should pass its ports to any nested modules. This is initialized with the `inherit` argument of `new()`.
pass_ports = ,
#' @field group Group name of the module.
= ,
#' @field created Initialization time of the module.
created = ,
#' @field order Initialization order.
= ,
#' @field i reactive list of input ports.
i = ,
#' @field o reactive list of output ports.
o = ,
#' @field port_names list of input and output port names.
port_names = ,
#' @field react list of reactive objects used by the module.
react = (),
#' @field obser list of observers used by the module.
obser = (),
#' @field suspended boolean indicating whether the module observers are suspended.
suspended = ,
#' @description
#' Create a new tidymodules module.
#' @param id Unique Id to assign to the module. Default to a generated Id using module's class and order of initialization.
#' @param inherit logical value indicating if a nested module should inherits the parent's input ports. Default to TRUE
#' @param group Module group name. Added to module's Id to make it unique. Optional
#' @param parent Parent module. Need to be specified when creating a dynamic nested module. Optional
#' @param collision Allow module id collision. Default to false.
#' Id collision happens when you try to creating the same module (same Id) twice at the same time. Optional
#' @return A new `TidyModule` object.
= (id = , inherit = , = , parent = , collision = ) {
#### Initialize ModStore #######
if ((private$shared$store)) {
private$shared$store <- $()
}
self$pass_ports <- inherit
ses <- self$getSession()
isolate({
ses$count <- ses$count + 1
self$ <- ses$count
})
onStop(() {
# reset session module count and edge table when app stop
ses$count <- 0
ses$edges <- private$emtpy_edges
})
self$ <- (
(id),
((self)[1]], "-", isolate({
ses$count
})),
private$sanitizeID(id, "Id")
)
if (!()) {
g <- private$sanitizeID(, "Group")
self$id <- (g, "-", self$)
self$ <- g
} {
self$id <- self$
}
################# Handle nested module here ################
############### Find and set the parent module #############
# case 1 : if parent module is specified.
if (!(parent) && (parent, "TidyModule")) {
self$parent_mod <- parent
}
# case 2 : nested module directly initialized in attribute definition of parent
# This type of initialization should trigger an error
# Because the parent module need to be initialized first
# TODO : Find a way to prevent this....
# if(class(sys.frame(9)$inherit) == "R6ClassGenerator")
# stop(paste0("Error in definition of module ",sys.frame(9)$classname,
# "! Nested module ",self$id," should be defined either in initialize() or server() of parent!"))
# case 3 :
# for n = 2:3 => nested module initialized in initialze() or server() functions of parent
# for n = 4:10 => same as before but support nested functions or module inheritance
if ((self$parent_mod)) {
for (n 2:10) {
self$parent_mod <- ((n))$self
if (!(self$parent_mod) && (self$parent_mod, "TidyModule")) {
}
}
}
# case 4 : Dynamically created module in an observe function of server()
if ((self$parent_mod) || !(self$parent_mod, "TidyModule")) {
self$parent_mod <- (((3)))$self
}
# At the end we save the parent ns & server arguments if any
if (!(self$parent_mod) &&
(self$parent_mod, "TidyModule")) {
self$parent_ns <- self$parent_mod$module_ns
} {
self$parent_mod <-
}
self$module_ns <- (
(self$parent_ns),
self$id,
(self$parent_ns, "-", self$id)
)
#### Capture ShinySession #######
private$shiny_session <- shiny::getDefaultReactiveDomain()
self$created <- ()
# check that the module namespace is unique in the current session
if (self$isStored() &&
((self$module_ns)$created) == (self$created) &&
!collision) {
((
"Module namespace collision!\n",
"Make sure that the namespace Id ", self$module_ns, " is only used once."
))
}
private$shared$store$addMod(self)
private$initFields()
# Only transfer parent ports in dynamic mode
# i.e. when the child module is initialized on the server
if (!self$isGlobal() &&
!(self$parent_mod) &&
(self$parent_mod, "TidyModule") &&
self$pass_ports) {
self$parent_mod %:pi:% self
}
# Handle debug mode
(
!(("TM_DEBUG")) &&
!((("TM_DEBUG"))) &&
(("TM_DEBUG"))
){
private$ <- ("debug-",10e7*(1))
}
# Rewrite ui function and add a debug button
(!(private$)){
("ui",self$.__enclos_env__$self)
ui_function <- self$ui
self$ui <- (){
<- ui_function()
<- actionButton(
self$(private$),
label = "",
icon = icon("bug","fa-small",style = "color:red;"),
= "btn-sm",
= (self$()))
# Don't break tab-panel
(!($attribs$) &&
$attribs$ == "tab-pane"){
$ <- ((),$)
$attribs$style <- (
($attribs$style),
"outline: 1px solid red;",
($attribs$style,";outline: 1px solid red;")
)
}
<- tags$div(tagList(, ),style ="outline: 1px solid red;")
}
("ui",self$.__enclos_env__$self)
}
},
#' @description
#' namespace function used to generate unique Id for HTML elements.
#' @param id Id of HTML element / shiny input.
#' @return A unique string Id.
= (id) {
NS(self$module_ns, id)
},
#' @description
#' Get module session Id. This function rely on a shiny output object to find the right session Id.
#' @return The Session Id of the module.
= () {
((private$shiny_session))
},
#' @description
#' Alias to the `ui` function.
#' @param ... arguments passed to the ui function.
render = () {
self$ui()
},
#' @description
#' UI function generating the module HTML elements.
#' This function is eventually implemented in the child module to give the module a visual representation.
#' Please note that a module can have many visual representations.
#' @param ... arguments passed to ui
#' @return Empty tagList()
ui = () {
(tagList())
},
#' @description
#' server function to be overwritten and called by child module.
#' @param input shiny input.
#' @param output shiny output.
#' @param session shiny session.
#' @param ... extra arguments to passed to the server function.
server = (input,
output,
session,
) {
# Need to isolate this block to avoid unecessary triggers
isolate({
private$shiny_session <- session
private$shiny_input <- input
private$shiny_output <- output
})
# Handle debug
(!(private$))
self$obser$tm_debug <- observeEvent(input[private$]],{
()
},ignoreInit = )
},
#' @description
#' Preview the module in a gadget.
#' @param ... extra arguments to passed to the server function.
view = () {
s <- (input, output, session) {
self$server(input, output, session, )
}
app <- shinyApp(ui = miniUI::miniPage(self$ui()), server = s)
# viewer <- dialogViewer(paste0("Preview of ",self$module_ns))
viewer <- paneViewer()
runGadget(app, viewer = viewer, stopOnCancel = )
},
#' @description
#' Function wrapper for port definition expression.
#' @param x expression
definePort = (x) {
isolate(x)
},
#' @description
#' Function wrapper for port assignment expression.
#' @param x expression
assignPort = (x) {
# TODO: There must be a better way to do that
# Only add observe in non-reactive context
if ((shiny:::.getReactiveEnvironment()$.currentContext)) {
observe({
isolate(x)
})
} {
isolate(x)
}
},
#' @description
#' Add input port function. To be called within `definePort` function
#' @param name port name. must be a unique input port name.
#' @param description port description.
#' @param sample sample dataset consumed by this port. Mandatory!
#' @param is_parent Is the port inherited from the parent module.
#' @param inherit Should the port be passed to nested module. default to TRUE.
#' @param input This argument should be ignored. Only here for backward compatibility.
addInputPort = ( = ,
description = ,
= ,
input = ,
is_parent = ,
inherit = ) {
private$addPort(
= "input",
= ,
description = description,
= ,
is_parent = is_parent,
inherit = inherit
)
},
#' @description
#' Function for filling an input port.
#' Called within the `assignPort` function
#' @param id Port name or Id .
#' @param input The reacive object.
updateInputPort = (id = ,
input = ) {
private$updatePort(id = id, = input, = "input")
},
#' @description
#' This function add a set of input ports to the module.
#' @param inputs reactivevalues with the input ports.
#' @param is_parent Are the ports from a parent module. Default to FALSE.
updateInputPorts = (inputs = ,
is_parent = ) {
private$updatePorts(ports = inputs, = "input", is_parent = is_parent)
},
#' @description
#' Get an input port from the module.
#' @param id Name or Id of the port.
#' @return A module input port. A reactivevalues object with name, description, sample, is_parent and port elements.
getInputPort = (id = 1) {
(private$getPort(id, "input"))
},
#' @description
#' Alias to the `getInputPort()` function.
#' @param id Name or Id of the port.
#' @return A module input port. A reactivevalues object with name, description, sample, is_parent and port elements.
= (id = 1) {
(self$getInputPort(id))
},
#' @description
#' Get all the input ports as a reactivevalues object.
#' @return A reactivevalues object.
getInputPorts = () {
(private$getPorts("input"))
},
#' @description
#' Get a input port slot.
#' @param id Name or Id of the port.
#' @param w boolean to enable module session check. default to TRUE.
#' @return A reactive function.
getInput = (id = 1, w = ) {
if (w && self$isGlobal() && !$()$isGlobal()) {
cmd <- ('mod("', self$module_ns, '")$getInput(', ((id), ('"', id, '"'), id), ")")
((
"You are trying to access a global session module port from a user session.",
"Is this intended? If not, use the code below instead.",
cmd,
sep = "\n"
))
}
r <- private$(id)
# special handling for inherited input ports
# since they are wraped in a reactive
if (private$getPort(id)$parent) {
r <- r()
}
(r)
},
#' @description
#' Execute an input port slot, that is, the reactive function stored in the port.
#' The `require` argument which is `TRUE` by default allows you disable checking if the port is Truthy.
#' See `shiny::req` function.
#' @param id Name or Id of the port.
#' @param require Check that the port is available.
#' @return Output of the reacive function execution.
execInput = (id = 1, = ) {
<- (self$module_ns)
r <- $getInput(id)
if () {
req(r)
}
(r())
},
#' @description
#' Function for filling an output port.
#' Called within the `assignPort` function
#' @param id Port name or Id .
#' @param output The reacive object.
updateOutputPort = (id = ,
output = ) {
private$updatePort(id = id, = output, = "output")
},
#' @description
#' This function add a set of output ports to the module.
#' @param outputs reactivevalues with the output ports.
#' @param is_parent Are the ports from a parent module. Default to FALSE.
updateOutputPorts = (outputs = ,
is_parent = ) {
private$updatePorts(ports = outputs, = "output", is_parent = is_parent)
},
#' @description
#' Add output port function. To be called within `definePort` function
#' @param name port name. must be a unique output port name.
#' @param description port description.
#' @param sample sample dataset returned by this port. Mandatory!
#' @param is_parent Is the port inherited from the parent module.
#' @param output This argument should be ignored. Only here for backward compatibility.
addOutputPort = ( = ,
description = ,
= ,
output = ,
is_parent = ) {
private$addPort(
= "output",
= ,
description = description,
= ,
is_parent = is_parent
)
},
#' @description
#' Utility function that returns a port name from the Id.
#' @param id Port Id
#' @param type Port type, input or output.
#' @return Port name.
getPortName = (id = , = "input") {
<- private$getPort(id, )
($)
},
#' @description
#' Get an output port from the module.
#' @param id Name or Id of the port.
#' @return A module output port. A reactivevalues object with name, description, sample, is_parent and port elements.
getOutputPort = (id = 1) {
(private$getPort(id, "output"))
},
#' @description
#' Alias to the `getOutputPort()` function.
#' @param id Name or Id of the port.
#' @return A module output port. A reactivevalues object with name, description, sample, is_parent and port elements.
= (id = 1) {
(self$getOutputPort(id))
},
#' @description
#' Get all the output ports as a reactivevalues object.
#' @return A reactivevalues object.
getOutputPorts = () {
(private$getPorts("output"))
},
#' @description
#' Get a output port slot.
#' @param id Name or Id of the port.
#' @param w boolean to enable module session check. default to TRUE.
#' @return A reactive function.
getOutput = (id = 1, w = ) {
if (w && self$isGlobal() && !$()$isGlobal()) {
cmd <- ('mod("', self$module_ns, '")$getOutput(', ((id), ('"', id, '"'), id), ")")
((
"You are trying to access a global session module port from a user session.",
"Is this intended? If not, use the code below instead.",
cmd,
sep = "\n"
))
}
(private$(id, "output"))
},
#' @description
#' Execute an output port slot, that is, the reactive function stored in the port.
#' The `require` argument which is `TRUE` by default allows you disable checking if the port is Truthy.
#' See `shiny::req` function.
#' @param id Name or Id of the port.
#' @param require Check that the port is available.
#' @return Output of the reacive function execution.
execOutput = (id = 1, = ) {
<- (self$module_ns)
r <- $getOutput(id)
if () {
req(r)
}
(r())
},
#' @description
#' Function for retrieving the central ModStore.
#' @return The `ModStore` object.
getStore = () {
(private$shared$store)
},
#' @description
#' Utility function that counts the number of input ports.
#' @return The input ports count.
countInputPort = () {
(private$countPort("input"))
},
#' @description
#' Utility function that counts the number of output ports.
#' @return The output ports count.
countOutputPort = () {
(private$countPort("output"))
},
#' @description
#' Alias to the `callModule` function.
#' @param ... arguments passed to the `server` function of the module.
use = () {
self$callModule()
},
#' @description
#' callModule function. Similar to shiny callModule. Used to inject the server logic into the application.
#' This function don't need the user to provide a namespace Id as a module already knows its identity.
#' Options provided as arguments will be passed to the server function of the module.
#' Note that the module reference `self` might not be the one injected.
#' @param ... arguments passed to the `server` function of the module.
callModule = () {
# arguments from server environment
output <- ()$output
input <- ()$output
session <- ()$session
if ((session)) {
session <- shiny::getDefaultReactiveDomain()
}
disable_cache <- ()
if (!self$isGlobal()) {
self$doServer()
} {
isolate({
currentSession <- $()$getSession()
globalSession <- $()$getGlobalSession()
currentSession$edges <- private$emtpy_edges
currentSession$count <- globalSession$count
cloneMod <- (currentSession$collection[self$module_ns]])
})
if (cloneMod || disable_cache) {
<- self$deepClone(output, input, session)
$doServer()
} {
(self$module_ns)$doServer()
}
}
},
#' @description
#' Function to check if the module is store in the current session.
#' @return logical value.
isStored = () {
(self$getStore()$isStored(self))
},
#' @description
#' Check if the session attached to the module is the `global_session`.
#' @return logical value.
isGlobal = () {
if (self$() == "global_session") {
()
} {
()
}
},
#' @description
#' Get the current session.
#' @return A reactivevalues object with the following elements.
#' aid = application Id
#' path = application path
#' sid = session Id
#' count = current module count
#' created = session creation time
#' updated = session update time
#' collection = list of session modules
#' edges = list of connection edges
getSession = () {
(self$getStore()$getSession(self))
},
#' @description
#' Get the global session.
#' @return A reactivevalues object with the following elements.
#' aid = application Id
#' path = application path
#' sid = "global_session"
#' count = session module count
#' created = session creation time
#' updated = session update time
#' collection = list of session modules
#' edges = empty data.frame
getGlobalSession = () {
(self$getStore()$getGlobalSession())
},
#' @description
#' Function interfacing with shiny's callModule.
#' @param ... arguments passed to the `server` function of the module.
doServer = () {
callModule(self$server, self$id, )
},
#' @description
#' Utility function to retrieve a port definition in the form of a list.
#' This is a useful function to learn about a specific port.
#' @param type Port type, input or output.
#' @param id Name or Id of port.
#' @return List of the port definition.
getPortDef = ( = , id = 1) {
<-
if (() || ! %in% ("input", "output")) {
("type must be one of input/output")
}
isolate({
<- private$getPort(id, )
reactiveValuesToList()
})
},
#' @description
#' Module printing function.
#' Print the structure of a module.
#' @examples
#' MyModule <- R6::R6Class("MyModule", inherit = tidymodules::TidyModule)
#' m <- MyModule$new()
#' m
= () {
isolate({
(("Module Namespace ", self$module_ns, "\n"))
if (!(self$)) {
(("Module Group ", self$, "\n"))
}
(("Module Session ", self$(), "\n"))
(("- Class ", ((self), collapse = " << "), "\n"))
(("- Input [", self$countInputPort(), "]\n"))
private$printPorts("input")
(("- Output [", self$countOutputPort(), "]\n"))
private$printPorts("output")
})
},
#' @description
#' Module cloning function.
#' Take care of ports (cloning reactive objects) and nested modules.
#' Note that the Ids/namespace are not changed.
#' @param o Optional shiny output.
#' @param i Optional shiny input
#' @param s Optional shiny input
#' @return A cloned module.
deepClone = (o = , i = , s = ) {
isolate({
<- self$clone()
$reset(o, i, s)
for ( ("input", "output")) {
if (private$countPort() > 0) {
for (idx 1:private$countPort()) {
po <- private$getPort(idx, )
# Don't add port inherited from parent module
# They will be added by parent, see below...
if (po$parent) {
}
if ( == "input") {
$addInputPort(
= po$,
description = po$description,
= po$,
inherit = po$inherit
)
} {
$addOutputPort(
= po$,
description = po$description,
= po$
)
}
}
}
}
$created <- ()
self$getStore()$addMod()
# Now deep clone the module attributes (also check list) that are TidyModules, i.e. nested modules
for (at (self)) {
if ((self[at]], "TidyModule") &&
at != "parent_mod") { # When module attribute is a nested module
[at]] <- self[at]]$deepClone(o, i, s)
[at]]$parent_mod <-
self$getStore()$addMod([at]])
# Now add ports to child if any
if ([at]]$pass_ports) {
%:pi:% [at]]
}
} if ((self[at]]) &&
([at]]) > 0 &&
!at %in% ("port_names", "i", "o")) { # Check list for modules
l <- self[at]]
for (k ((l))) {
if ((l[k]], "TidyModule")) {
l[k]] <- l[k]]$deepClone(o, i, s)
l[k]]$parent_mod <-
self$getStore()$addMod(l[k]])
# Now add ports to child if any
if (l[k]]$pass_ports) {
%:pi:% l[k]]
}
}
}
[at]] <- l
}
}
})
()
},
#' @description
#' This function reset the ports.
#' @param o Optional shiny output.
#' @param i Optional shiny input
#' @param s Optional shiny input
reset = (o = , i = , s = ) {
private$initFields()
if (!(o)) {
private$shiny_output <- o
}
if (!(i)) {
private$shiny_input <- i
}
if (!(s)) {
private$shiny_session <- s
}
},
#' @description
#' This function destroys the module by removing it from the `ModStore`
#' and by destroying all its observers. Please note that this function
#' works properly only if the observers created and used by the module are
#' added to `self$obser`.
#' @param deep optional logical indicating whether to destroy the
#' child modules as well. default to FALSE.
destroy = (deep = ){
private$shared$store$delMod(self)
(self$obser,(x) x$destroy())
(deep){
(m self$getSession()$collection)
# Child module namespace always starts with parent's namespace
((("^",self$module_ns),m$module_ns))
m$destroy()
}
},
#' @description
#' This function suspends the module's observers.
#' Please note that this function works properly only if the observers
#' created and used by the module are added to `self$obser`.
suspend = (){
(self$obser,(x) x$suspend())
self$suspended <-
},
#' @description
#' This function resumes the module's observers.
#' Please note that this function works properly only if the observers
#' created and used by the module are added to `self$obser`.
resume = (){
(self$obser,(x) x$resume())
self$suspended <-
},
#' @description
#' Retrieve the shiny input.
#' @return Shiny input object.
getShinyInput = () {
(private$shiny_input)
},
#' @description
#' Retrieve the shiny output.
#' @return Shiny output object.
getShinyOutput = () {
(private$shiny_output)
},
#' @description
#' Retrieve the shiny output.
#' @return Shiny session object.
getShinySession = () {
(private$shiny_session)
}
),
private = (
shared = {
e <- ()
e$store <-
e
},
shiny_input = ,
shiny_output = ,
shiny_session = ,
emtpy_edges = (
from = ,
fclass = ,
fport = ,
ftype = ,
fname = ,
to = ,
tclass = ,
tport = ,
ttype = ,
tname = ,
= ,
=
)[numeric(0), ],
= ,
initFields = () {
self$i <- reactiveValues()
self$o <- reactiveValues()
self$port_names <- reactiveValues()
},
sanitizeID = (id, ) {
if (!("[a-z][\\w-]*", id, ignore.case = , perl = ) ||
('[>~!@\\$%\\^&\\*\\(\\)\\+=,./\';:"\\?><\\[\\]\\\\{}\\|`#]', id, ignore.case = , perl = )) {
((("The provided ", , " must begin with a letter `[A-Za-z]` and may be followed by any number of letters, digits `[0-9]`, hyphens `-`, underscores `_`."),
"You should not use the following characters as they have a special meaning on the UI ( CSS / jQuery ).",
"> ~ ! @ $ % ^ & * ( ) + = , . / ' ; : \" ? > < [ ] \ { } | ` #",
sep = "\n"
))
}
(id)
},
countPort = ( = "input") {
key <- ( == "input", "i", "o")
(((self[key]])))
},
addPort = ( = "input",
= ,
description = ("Short description for this module's ", ),
= ,
= ,
is_parent = ,
inherit = ) {
(!() && !())
rv <- reactiveValues(
= ,
description = description,
= ,
parent = is_parent,
inherit = inherit
)
p <-
(rv, "tidymodules") <-
(rv, "tidymodules_port_def") <-
(rv, "tidymodules_port_type") <-
(rv, "tidymodules_port_id") <- private$countPort() + 1
(rv, "tidymodules_port_name") <-
(rv, "tidymodules_port_description") <- description
(rv, "tidymodules_port_sample") <-
(rv, "tidymodules_is_parent") <- is_parent
(rv, "tidymodules_inherit") <- inherit
(rv, "tidymodules_module_ns") <- self$module_ns
# Only add attributes to port at definition
if ((p)) {
(p, "tidymodules") <-
(p, "tidymodules_port_slot") <-
(p, "tidymodules_port_type") <-
(p, "tidymodules_port_id") <- private$countPort() + 1
(p, "tidymodules_port_name") <-
(p, "tidymodules_port_description") <- description
(p, "tidymodules_port_sample") <-
(p, "tidymodules_is_parent") <- is_parent
(p, "tidymodules_inherit") <- inherit
(p, "tidymodules_module_ns") <- self$module_ns
}
rv"port"]] <- p
key <- ( == "input", "i", "o")
existing_port <- self[key]][name]]
if (!(existing_port) && is.reactivevalues(existing_port)) {
((
"Skip adding ", , " port '", , "' to ", self$module_ns,
" ! Port already defined ",
(existing_port$parent,
("and inherited from parent ", self$parent_ns),
"!"
)
))
} {
self[key]][name]] <- rv
nv <- self$port_names[type]]
self$port_names[type]] <- (nv, )
}
},
updatePort = (id = , = , = "input") {
((!(id)))
if (!()) {
if (is.reactivevalues()) {
if (!((, "tidymodules_operation")) &&
(, "tidymodules_operation") == "combine") {
# We need to modify the combined reactive list here to remove the port sctructure
isolate({
p <- reactiveValues()
for (k ()) {
p[k]] <- [k]]$
}
<- p
})
} if (!((, "tidymodules_port_def")) &&
(, "tidymodules_port_def")) {
<- $
} {
(((()), " is reactive list (reactiveValues). Provide a reactive function instead."))
}
} if (!is.reactive()) {
(((()), " is not reactive"))
}
key <- ( == "input", "i", "o")
if ((id)) {
if (!id %in% (1, private$countPort())) {
(("Port Update Failure: Numeric ", , " port [", id, "] not found in Module definition"))
} {
id <- self$port_names[type]][id]
}
}
if ((id) && !id %in% (self[key]])) {
(("Port Update Failure: Character ", , " port [", id, "] not found in Module definition"))
}
# Attach module information to the output port
# This will facilitate storage of module edges
isolate({
# Don't allow update of inherited port
if (self[key]][id]]"parent"]]) {
(("Updating ", , " port '", id, "' inherited from parent ", self$parent_ns, " is not permitted!"))
}
attrs <- (self[key]][id]]"port"]])
if ( == "output") {
for (a (attrs)) {
if (("tidymodules", a)) {
(, a) <- attrs[a]]
}
}
}
self[key]][id]]"port"]] <-
})
}
},
updatePorts = (ports = , = "input", is_parent = ) {
(!(ports))
if (!is.reactivevalues(ports)) {
((((ports)), " is not a reactive list"))
}
key <- ( == "input", "i", "o")
isolate({
for (p (ports)) {
if (p %in% self$port_names[type]]) {
(("Adding port name ", p, " to module ", self$module_ns, " failed, it already exist in ", , " port definition."))
} {
<- ports[p]]
rport <- $
# couple of functions for managing inherited ports
getParentReactive <- (p) {
parent_mod_ns <- (p, "tidymodules_module_ns")
r <- reactive({
(p)
(self)
(parent_mod_ns)
m <- self$parent_mod
if (!(parent_mod_ns)) {
m <- (parent_mod_ns)
} {
(("Couldn't find parent module while passing input ports to ", self$module_ns))
}
if ( == "input") {
m$getInput(p$)
} {
m$getOutput(p$)
}
})
# copy tm attributes
attrs <- (p$)
for (a (attrs)) {
if (("tidymodules", a)) {
(r, a) <- attrs[a]]
}
}
r
}
if (is_parent) {
rport <- getParentReactive()
}
if (!(is_parent && !$inherit)) {
private$addPort(
= ,
= $,
description = $description,
= $,
= rport,
is_parent = is_parent,
inherit = $inherit
)
}
}
}
})
},
= (id = 1, = "input") {
data.port <- private$getPort(id, )
req(data.port)
(data.port"port"]])
},
getPort = (id = 1, = "input") {
key <- ( == "input", "i", "o")
if (private$countPort() == 0) {
(("Module ", self$module_ns, " has no ", , " ports"))
()
}
if ((id)) {
if (!id %in% (1, private$countPort())) {
(("Numeric ", , " port [", id, "] not found in Module definition"))
()
} {
id <- self$port_names[type]][id]
}
}
if ((id) && !id %in% (self[key]])) {
(("Character ", , " port [", id, "] not found in Module definition"))
()
}
(self[key]][id]])
},
getPorts = ( = "input") {
key <- ( == "input", "i", "o")
if (private$countPort() == 0) {
()
}
(self[key]])
},
printPorts = ( = "input") {
if (private$countPort() > 0) {
for (p 1:private$countPort()) {
<- private$getPort(p, )
pport <-
if ($parent) {
if ( == "input") {
pport <- self$parent_mod$getInputPort($)
} {
pport <- self$parent_mod$getOutputPort($)
}
}
(
(
"(", p, ") ",
(
$parent,
"(Inherit) ",
""
),
$,
" => ",
($parent,
(is.reactive(pport$) || is.reactivevalues(pport$), "OK", "Empty"),
(is.reactive($) || is.reactivevalues($), "OK", "Empty")
),
"\n"
)
)
}
}
},
trimParentNS = () {
if (!(self$parent_ns)) {
(
(
(self$parent_ns, "-"),
"",
self$module_ns
)
)
} {
(self$module_ns)
}
}
)
)
