TakeCareApp/app/profil_module.R

library(shiny)
library(magrittr)
library(ggplot2)
library(plotly)
library(DT)

profilUI <- function(id) {
  ns <- NS(id)
  fluidPage(
    useShinyjs(),
  tags$head(
    tags$script(src="js.cookie.js"),
    tags$script('Shiny.addCustomMessageHandler("tokenHandlerUpdate",     
    function(token) {
     sessionStorage.setItem(\'token\', token);
     Shiny.onInputChange("token", token);
    }
);'),
    
    
    tags$style(HTML("
      @import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700');
      @import url('//fonts.googleapis.com/css2?family=Fjalla+One');
      
                    ")),
    tags$link(rel = "stylesheet", type = "text/css", href = "profile.css")
    ),
  
  # theme = "style.css",
  

  # App title ----
  
  uiOutput("afterLogin"),
  
  
  
  
  fluidRow(
    column(12,
           tags$span("© Copyright Wszystkie prawa zastrzeżone."))%>% tagAppendAttributes(id = 'column-copyright'),
    
  )%>% tagAppendAttributes(id = 'row-footer')
  
  
)}

profilServer <- function(input, output,session) {
  
  
  
  getEditStatus <- eventReactive(input$editSubmit, {
    editedPersonalData<-data.frame(name<-input$editName,
    surname<-input$editSurname,
    mail<-input$editMail,
    datebirth<-input$editAge,
    gender<-input$editGender)
    
    reg<-c(grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",editedPersonalData$name),
           grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",editedPersonalData$surname),
           grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",editedPersonalData$mail))
    if(all(reg)){
      # status$status = register(result)
      
      # status$first = FALSE
      
      

      to_send = list(name = editedPersonalData$name,
                     surname = editedPersonalData$surname,
                     email = editedPersonalData$mail,
                     datebirth = editedPersonalData$datebirth,
                     gender = editedPersonalData$gender)
      
      r<-httr::PUT("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" ")),body=to_send,encode = 'json')
      
      if (r$status_code==200){
        TRUE
      }else{
        FALSE
      }
    }else{
      
      FALSE
    }
    
    

  })
  
  
  

  observe({
    session$sendCustomMessage(type='tokenHandlerAccess',(session$clientData)$url_hash)


  })
  
  output$profileData<-renderUI({

    
    r<-httr::GET("http://localhost:8080/api/profile",add_headers(Authorization=paste("Bearer",input$token,sep=" ")))
    
    if(r$status_code==200){
      
      response<-(content(r))
      
      session$sendCustomMessage(type='tokenHandlerUpdate', response$token)
      
      
      fluidRow(column(12,
                      wellPanel(
                        textInput("editName", label = strong("Imie"),value=response$profil$name),
                        uiOutput("editName"),
                        textInput("editSurname", label = strong("Nazwisko"),value=response$profil$surname),
                        uiOutput("editSurname"),
                        textInput("editMail", label = strong("Adres email"),value=response$profil$email),
                        uiOutput("editMail"),
                        dateInput("editAge", label = strong("Data urodzenia") ,value=response$profil$datebirth),
                        
                        selectInput("editGender", label = strong("Plec"),
                                    choices = list("Żenska" = 0, "Meska" = 1), 
                                    selected = as.numeric(response$profil$gender)),
                      
                        ),
                        
                        actionButton("editSubmit","Zapisz"),
                        uiOutput("btnEditProfile",style="color:red;")
                        
                      ))

      
    }
    
  })
  output$btnEditProfile<-renderUI({
    
    if (getEditStatus()==TRUE){
      p("OK",style="color:green;text-align:center;")
    }else{
      p("Uzytkownik istnieje lub wprowadzono bledne dane",style="color:red;text-align:center;")
    }
    
    
  })
  
  
  output$afterLogin<-renderUI({
    if(!is.null(input$token) & length(input$token)>0 ){

      
    
      fluidRow(
        column(3,
               tags$div("Panel sterowania") %>% tagAppendAttributes(class="panel-title")
               
        )%>% tagAppendAttributes(id = 'column-panel'),
        column(9,
               tabsetPanel(type = "tabs",
                           tabPanel("Dane profilowe", tags$div(uiOutput("profileData")
                           )%>% tagAppendAttributes(class = 'content-wrapper')),
                           tabPanel("Zakładka 2", tags$div(plotlyOutput("plot2",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')),
                           tabPanel("Zakładka 3", tags$div(plotlyOutput("plot3",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')),
                           tabPanel("Zakładka 4", tags$div(plotlyOutput("plot4",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')),
                           tabPanel("Zakładka 5", tags$div(DT::dataTableOutput("table1",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper'))
                           
               ))%>% tagAppendAttributes(id = 'column-content')
      ) %>% tagAppendAttributes(id = 'row-content')
    }else{
      
    }

    
  })
  
  output$plot1 <- renderPlotly({
    
    g<-ggplot(mpg) + 
      geom_point(mapping = aes(x = displ, y = hwy))
    
    gg<-ggplotly(g)
    
    gg
    
  })
  
  output$plot2 <- renderPlotly({
    
    g<-ggplot(data = mpg, mapping = aes(x = cty, y = hwy)) + 
      geom_jitter()
    
    gg<-ggplotly(g)
    
    gg
    
  })
  
  output$plot3 <- renderPlotly({
    
    g<-ggplot(data = mpg, mapping = aes(x = displ, y = hwy, color = drv)) + 
      geom_point() + 
      geom_smooth(se = FALSE)
    
    gg<-ggplotly(g)
    
    gg
    
  })
  
  output$plot4 <- renderPlotly({
    
    g<-ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 
      geom_point(mapping = aes(color=drv)) + 
      geom_smooth(se = FALSE)
    
    gg<-ggplotly(g)
    
    gg
    
  })
  
  pl <- list(
    sSearch = "Szukaj",
    sInfo="Wyniki od _START_ do _END_ z _TOTAL_ rekordów",
    sZeroRecords="Brak rekordów",
    sEmptyTable="Pusta tabela",
    oPaginate= list(
      sFirst="Pierwsza", sPrevious="Poprzednia",sLast="Ostatnia", sNext="Następna"
    ),
    sLengthMenu = "Pokaż _MENU_ rekordów na stronie"
  )
  
  output$table1 <- DT::renderDataTable(iris,options = list(scrollX = TRUE,language=pl))
  
  
  output$btnResponse<-renderUI({
    
    if (getStatus()==TRUE){
      p("OK",style="color:white;text-align:center;")
    }else{
      p("Uzytkownik istnieje lub wprowadzono bledne dane",style="color:yellow;text-align:center;")
    }
    
    
  })
  
  output$editName<-renderUI({
    s<-toString(input$editName)
    
    if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",s)==TRUE){
      return()
    }else{
      p("Bład: Imie powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znaków",style="color:yellow")
    }
    
  })
  
  output$editSurname<-renderUI({
    s<-toString(input$editSurname)
    
    if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",s)==TRUE){
      return()
    }else{
      p("Bład: Nazwisko powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znaków",style="color:yellow")
      
      
    }
    
  })
  
  output$editMail<-renderUI({
    s<-toString(input$editMail)
    
    if (s=="" | grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",s)==TRUE){
      return()
    }else{
      p("Bład: Mail powinien miec budowe adres@nazwa.domena",style="color:yellow")
      
      
    }
    
  })
  
  
  
  
}