shiny-ui-base.R

## Copyright (C) 2020,2021 by University of Luxembourg

## Licensed under the Apache License, Version 2.0 (the "License");
## you may not use this file except in compliance with the License.
## You may obtain a copy of the License at

##     http://www.apache.org/licenses/LICENSE-2.0

## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.

##' @importFrom shiny validate
##' @importFrom promises future_promise
##' @importFrom promises %...>%
react_v = shiny::reactiveValues
react_f = shiny::reactive
react_e = shiny::eventReactive
obsrv = shiny::observe
obsrv_e = shiny::observeEvent
isol = shiny::isolate

celledit_values <- function(col,values,labels=NULL,addna=T) {
    if (is.null(labels)) labels = values
    if (length(values)==0 || nchar(values)==0) return(character(0))

    
    part1 = mapply(function (v,l) {
        sprintf("{value: '%s', display: '%s'},",v,l)
    },
    head(values,-1),
    head(labels,-1),
    USE.NAMES = F)
    
    part2 = sprintf("{value: '%s', display: '%s'}",tail(values,1),tail(labels,1))

    res = if (length(part1)>0 || length(part2)>0) {
               a1 = c("{",sprintf("column: %s, ",col),
                       "type: 'list', ",
                       "options: [")
               a2 = c(part1,part2,"]","}")
               if (addna) c(a1,"{value: 'NA', display: 'NA'},",a2) else c(a1,a2)
                       
           } else character(0)

    as.character(res)
    
}

shinymsg <- function(ui,duration=NULL,type="message",...) showNotification(ui=paste(ui,
                                                                                    Sys.time(),
                                                                                    sep="\n"),
                                                                           duration=duration,
                                                                           type=type,...)
# volumes <- function() c(wd=getwd(), shinyFiles::getVolumes()())
validate1 <- function(expr,msg) shiny::validate(shiny::need(expr,msg))


path2vol <- function(path) {
    ## This function returns shinyFiles compatible volumes.
    splits = split_path(path)
    file.path(tail(splits,1),'')
}


prim_box<-function(...) {shinydashboard::box(...,
                                             status="primary",
                                             solidHeader=T)}