# define server function
shinyServer(function(input, output, session) {
# initialization of data cv.
# If the cv has been saved previously,
# load the last saved state instead
datas <- "www/cv_datas.rds"
if (file.exists(datas) == TRUE) {
# old df is not reactive
old_df <- readRDS(datas)
# create a new reactive df based on old values
df <- reactiveValues(
my_profile = old_df$my_profile,
about = old_df$about,
skills = old_df$skills,
languages = old_df$languages,
users = old_df$users,
formations = old_df$formations,
tasks = old_df$tasks,
projects = old_df$projects,
publications = old_df$publications,
publications_screenshots = old_df$publications_screenshots,
talks = old_df$talks,
courses = old_df$courses,
internships = old_df$internships
)
} else {
df <- reactiveValues(
my_profile = list(),
about = data.frame(),
skills = data.frame(),
languages = data.frame(),
users = data.frame(),
formations = data.frame(),
tasks = list(),
projects = data.frame(),
publications = data.frame(),
publications_screenshots = list(),
talks = data.frame(),
courses = data.frame(),
internships = data.frame()
)
}
# useful for temporary storage
temp <- reactiveValues(tasks = data.frame())
#-------------------------------------------------------------------------
#
# Profil section ...
#
#-------------------------------------------------------------------------
# generate the user image if any
output$image <- renderImage({
my_image <- df$my_profile$my_image
if (!is_empty(my_image)) {
path <- paste0(my_image$datapath, "0.png")
list(src = path,
# very important to keep the adminLTE image border
class = "profile-user-img img-responsive img-circle",
alt = "User profile picture"
)
}
}, deleteFile = FALSE)
# each time submit profile is pressed
# replace the profile data frame with the
# current new one
observeEvent(input$submit_profile,{
temp_profile <- list(
my_name = input$name,
my_position = input$position,
my_age = input$age,
my_interests = input$interests,
my_website = input$website_url,
my_teaser = input$teaser,
my_image = input$my_picture
)
# copy the uploaded image in the www folder of the application
temp_path <- input$my_picture$datapath
copy_path <- "www/Profile_img_saved/"
file.copy(from = temp_path, to = copy_path, overwrite = TRUE)
temp_profile$my_image$datapath <- copy_path
df$my_profile <- temp_profile
})
# generate the profile box
output$profilebox <- renderUI({
input$submit_profile
my_profile <- df$my_profile
my_name <- my_profile$my_name
my_position <- my_profile$my_position
my_age <- my_profile$my_age
my_interests <- my_profile$my_interests
my_website <- my_profile$my_website
my_teaser <- my_profile$my_teaser
my_image <- my_profile$my_image
profile_box(name = my_name, position = my_position, age = my_age,
interests = my_interests, website_url = my_website,
teaser = my_teaser, image = my_image, color = col)
})
#-------------------------------------------------------------------------
#
# About section ...
#
#-------------------------------------------------------------------------
# each time submit about is pressed
# replace the about data frame with the
# current new one
observeEvent(input$submit_about,{
temp_about <- data.frame(
my_phone = input$phone_number,
my_mail = input$mail,
my_location = input$location,
my_linkedin = input$linkedinlink,
my_twitter = input$twitterlink,
my_facebook = input$facebooklink,
my_github = input$githublink
)
df$about <- temp_about
})
# generate the about box
output$aboutbox <- renderUI({
input$submit_about
about <- df$about
my_phone <- about$my_phone
my_mail <- about$my_mail
my_location <- about$my_location
my_linkedin <- about$my_linkedin
my_twitter <- about$my_twitter
my_facebook <- about$my_facebook
my_github <- about$my_github
# call the about_box function
about_box(phone = my_phone, mail = my_mail, location = my_location,
linkedin_link = my_linkedin, twitter_link = my_twitter,
facebook_link = my_facebook, github_link = my_github)
})
#-------------------------------------------------------------------------
#
# skills section ...
#
#-------------------------------------------------------------------------
# Generate the skills UI
# if and only if the editor
# switchInput is on TRUE
output$skillsUI <- renderUI({
if (input$skills == "skills") {
tagList(
textInput(inputId = "skill_name", label = "Competence:"),
knobInput(inputId = "skill_value",
label = tags$span("Value:", style = "color: #FFF;"),
min = 0,
max = 100,
value = 50,
width = "75px",
height = "75px",
fgColor = "#ffec03",
inputColor = "#ffec03",
skin = "tron"),
fluidRow(
column(6,
actionBttn(inputId = "submit_skill", "Add Skill",
color = "success", style = "fill", size = "md")
),
column(6,
actionBttn(inputId = "remove_skill", "Remove Skill",
color = "danger", style = "fill", size = "md")
)
),
textInput("skill_id", "Skill to remove")
)
}
})
# each time submit skill is pressed
# add the new skill name and its value
# to the skills dataframe
observeEvent(input$submit_skill,{
req(input$skill_name, input$skill_value)
temp_skills <- data.frame(
variable = input$skill_name,
value = input$skill_value
)
df$skills <- rbind(df$skills, temp_skills)
})
# remove a skills
observeEvent(input$remove_skill,{
req(input$skill_id)
name <- input$skill_id
skills <- df$skills
idx <- match(name, skills$variable)
if (!is.na(idx)) {
df$skills <- df$skills[-idx, ]
} else {
if (nrow(skills) > 0) {
sendSweetAlert(session, title = "", text = "Please select a
skill in the list!", type = "error")
} else {
sendSweetAlert(session, title = "",
text = "No more skill to remove!", type = "error")
}
}
})
# generate the radar plot of skills
# Secure if skill dataframe is empty
output$skillsradar <- renderPlot({
req(input$skill_name, input$skill_value)
skills <- df$skills
if (!is_empty(skills)) {
ggplot(data = skills, aes(x = variable, y = value, fill = value)) +
geom_bar(stat = "identity") +
coord_polar() +
scale_fill_viridis_c() + xlab("") + ylab("") + theme_bw()
}
})
# Generate the language UI
output$languagesUI <- renderUI({
if (input$skills == "languages") {
tagList(
textInput(inputId = "language_name", label = "Language:"),
knobInput(inputId = "language_value",
label = tags$span("Level:", style = "color: #FFF;"),
min = 0,
max = 100,
value = 50,
width = "75px",
height = "75px",
fgColor = "#ffec03",
inputColor = "#ffec03",
skin = "tron"),
fluidRow(
column(6,
actionBttn(inputId = "submit_language", "Add Language",
color = "success", style = "fill", size = "md")
),
column(6,
actionBttn(inputId = "remove_language", "Remove Language",
color = "danger", style = "fill", size = "md")
)
),
textInput("language_id", "Language to remove")
)
}
})
# each time submit language is pressed
# add the new language name and its value
# to the language dataframe
observeEvent(input$submit_language,{
req(input$language_name, input$language_value)
temp_language <- data.frame(
variable = input$language_name,
value = input$language_value
)
df$languages <- rbind(df$languages, temp_language)
})
# remove a language
observeEvent(input$remove_language,{
req(input$language_id)
name <- input$language_id
languages <- df$languages
idx <- match(name, languages$variable)
if (!is.na(idx)) {
df$languages <- df$languages[-idx, ]
} else {
if (nrow(languages) > 0) {
sendSweetAlert(session, title = "", text = "Please select a
language in the list!", type = "error")
} else {
sendSweetAlert(session, title = "",
text = "No more language to remove!", type = "error")
}
}
})
# Github part
output$github_username <- renderUI({
if (input$allow_github_calendar == TRUE) {
tagList(
textInput("github_name", "Your Github username", "")
)
}
})
# send github_name to javascript
# using sendCustomMessage
# Shiny will need Shiny.addCustomMessageHandler("myCallbackHandler"
# in the UI part to receive this value in javascript
observeEvent(input$github_name,{
github_name <- input$github_name
session$sendCustomMessage(type = "myCallbackHandler", github_name)
})
# generate the skills box
output$skillsbox <- renderUI({
input$submit_project
input$submit_publication
input$submit_talk
input$submit_course
input$submit_internship
input$submit_user
# skills and languages to pass to the box function
my_skills <- df$skills
my_languages <- df$languages
my_github_name <- input$github_name
github_calendar_state <- input$allow_github_calendar
# global statistics
total_projects <- nrow(df$projects)
total_publications <- nrow(df$publications)
total_conferences <- nrow(df$talks)
total_courses <- sum(nrow(df$courses), nrow(df$internships))
total_users <- nrow(df$users)
# call the skill_box function
skills_box(languages = my_languages,
github_name = my_github_name, allow_github_calendar = github_calendar_state,
nb_projects = total_projects, nb_publications = total_publications,
nb_conferences = total_conferences, nb_courses = total_courses,
nb_users = total_users)
})
#-------------------------------------------------------------------------
#
# network section ...
#
#-------------------------------------------------------------------------
# Generate the skills UI
# if and only if the editor
# switchInput is on TRUE
output$networkUI <- renderUI({
tagList(
selectInput("user_title", label = "Title:", choices = c("", "Dr.", "Pr.")),
selectInput(inputId = "user_sex",
label = "Sex:", choices = c("male", "female")),
textInput(inputId = "user_name", label = "Name:"),
textInput(inputId = "user_mail", label = "Mail:"),
textInput(inputId = "user_phone", label = "Phone Number:"),
fluidRow(
column(6,
actionBttn(inputId = "submit_user", "Add User",
color = "success", style = "fill", size = "md")
),
column(6,
actionBttn(inputId = "remove_user", "Remove User",
color = "danger", style = "fill", size = "md")
)
),
textInput("user_id", "User to remove")
)
})
# each time submit user is pressed
# add the new user name as well as
# other informations
observeEvent(input$submit_user,{
req(input$user_name)
temp_user <- data.frame(
title = input$user_title,
sex = input$user_sex,
name = input$user_name,
mail = input$user_mail,
phone = input$user_phone
)
df$users <- rbind(df$users, temp_user)
})
# remove a user
observeEvent(input$remove_user,{
req(input$user_id)
name <- input$user_id
users <- df$users
idx <- match(name, users$name)
if (!is.na(idx)) {
df$users <- df$users[-idx, ]
} else {
if (nrow(users) > 0) {
sendSweetAlert(session, title = "", text = "Please select a
user in the list!", type = "error")
} else {
sendSweetAlert(session, title = "",
text = "No more user to remove!", type = "error")
}
}
})
# generate the user box
output$networkbox <- renderUI({
users <- df$users
if (input$enable_network_box == TRUE) {
# call the network_box function
network_box(data = users, nb_users = nrow(users))
}
})
#-------------------------------------------------------------------------
#
# formation section ...
#
#-------------------------------------------------------------------------
# Generate the formation UI
# if and only if the formation part is selected
output$formationUI <- renderUI({
if (input$section == "formation") {
tagList(
tags$h3("Formation Section"),
textInput("formation_title", label = "Title:"),
pickerInput(
inputId = "formation_topic",
label = "Main Topic:",
choices = c(
"Industry" = "industry",
"Law" = "balance-scale",
"Computer Sciences" = "database",
"Lab work" = "eyedropper",
"health Sciences" = "heartbeat",
"Singing" = "music",
"Economy" = "money",
"Veterinarian" = "paw",
"Art" = "paint-brush",
"Game development" = "gamepad"),
choicesOpt = list(
icon = c(
"fa fa-industry",
"fa fa-balance-scale",
"fa fa-database",
"fa fa-eyedropper",
"fa fa-heartbeat",
"fa fa-music",
"fa fa-money",
"fa fa-paw",
"fa fa-paint-brush",
"fa fa-gamepad")
),
options = list(`icon-base` = "font-awesome")
),
dateRangeInput("formation_date", "Date range:",
min = "1900-01-01",
max = Sys.Date(),
format = "mm/dd/yy",
separator = " - "),
textAreaInput("formation_summary", "Formation descirption",
"Describe your formation here", width = "200px"),
textInput("formation_location", "Place/Lab"),
textInput("formation_supervisors", "Supervisor(s):"),
textInput("formation_extra", label = "More details here", "Put a web link"),
sliderInput("formation_grade", label = "Add a grade", min = 0, max = 5, value = 1),
fluidRow(
column(6,
actionBttn(inputId = "submit_formation", "Add Formation",
color = "success", style = "fill", size = "sm")
),
column(6,
actionBttn(inputId = "remove_formation", "Remove Formation",
color = "danger", style = "fill", size = "sm")
)
),
numericInput("formation_id", "Formation to remove", value = 1)
)
}
})
# each time submit formation is pressed
# add the new formation name and its value
# to the formations dataframe
observeEvent(input$submit_formation,{
req(input$formation_date, input$formation_topic, input$formation_title,
input$formation_summary, input$formation_location)
temp_formation <- data.frame(
title = input$formation_title,
topic = input$formation_topic,
from = input$formation_date[1],
to = input$formation_date[2],
summary = input$formation_summary,
place = input$formation_location,
supervisor = input$formation_supervisors,
grade = input$formation_grade,
extra = input$formation_extra
)
df$formations <- rbind(df$formations, temp_formation)
})
# remove a formation
observeEvent(input$remove_formation,{
req(input$formation_id)
idx <- input$formation_id
if (nrow(df$formations) > 0) {
if (idx > nrow(df$formations)) {
sendSweetAlert(session, title = "", text = "Please select a
formation in the list!", type = "error")
} else {
df$formations <- df$formations[-idx, ]
}
} else {
sendSweetAlert(session, title = "", text = "There is no formation to
delete", type = "error")
}
})
# Render the formation timeLine
output$formation_timeline <- renderUI({
formations <- df$formations
if (!is_empty(formations)) {
tagList(
timelineBox(
lapply(seq_along(formations$title), FUN = function(i) {
title <- formations$title[i]
topic <- formations$topic[i]
from <- formations$from[i]
to <- if (is.na(formations$to[i])) "Now" else formations$to[i]
summary <- formations$summary[i]
place <- formations$place[i]
supervisor <- formations$supervisor[i]
grade <- formations$grade[i]
extra <- formations$extra[i]
list(
timelineLabel(
text = HTML(paste0("<b>", from, "//", "<br/>", to, "</b>")), color = col[i]
),
timelineItem(
icon = icon(name = topic, class = paste0("bg-", col[i])),
header = if (length(grade) > 0) {
HTML(
paste0(
title,
tags$td(class = "mailbox-star",
tags$a(href = "#",
if (grade < 5) {
empty_star <- lapply(1:(5 - grade), FUN = function(i) {
tags$i(class = "fa fa-star-o text-yellow pull-right")
})
},
if (grade > 0) {
full_star <- lapply(1:grade, FUN = function(i) {
tags$i(class = "fa fa-star text-yellow pull-right")
})
}
)
)
)
)
} else {
title
},
body = if (length(supervisor) > 0) {
HTML(paste0(summary, tags$br(), tags$br(), "<u>", "Advisors: ",
"</u>", "<b>", supervisor, "</b>"))
} else {
summary
},
itemIcon = shiny::icon("street-view"),
footer = tags$a(class = "btn btn-primary btn-xs", href = extra, "Read more"),
itemText = place
)
)
})
)
)
}
})
#-------------------------------------------------------------------------
#
# experience section ...
#
#-------------------------------------------------------------------------
# Generate the projects UI
# if and only if the experience
# section is selected
output$projectsUI <- renderUI({
if (input$section == "experience") {
tagList(
tags$h3("Experience Section"),
textInput(inputId = "project_title", label = "Project Title:"),
textInput(inputId = "project_position", label = "Position in the project:"),
textAreaInput(inputId = "project_overview", label = "Overview"),
textInput(inputId = "project_supervisors", label = "Advisors:"),
textInput(inputId = "project_place", label = "Place/Lab:"),
br(),
br(),
h5(class = "text-center", "Task submenu"),
textInput(inputId = "task_name", label = "Task Name:"),
selectInput(inputId = "task_status", label = "Task Status:",
choices = c("Work in progress" = "wip",
"Completed" = "completed")),
actionBttn(inputId = "submit_task", "Add Task",
color = "success", style = "fill", size = "md"),
br(),
br(),
h5(class = "text-center", "Project submenu"),
fluidRow(
column(6,
actionBttn(inputId = "submit_project", "Add Project",
color = "success", style = "fill", size = "sm")
),
column(6,
actionBttn(inputId = "remove_project", "Remove Project",
color = "danger", style = "fill", size = "sm")
)
),
numericInput("project_id", "Project to remove", value = 1)
)
}
})
#each time submit task is pressed
# add the new task name as well as
# other informations
observeEvent(input$submit_task,{
req(input$task_name, input$task_status)
current_task <- data.frame(
name = input$task_name,
status = input$task_status
)
temp$tasks <- rbind(temp$tasks, current_task)
})
# each time submit project is pressed
# add the new project name as well as
# other informations
observeEvent(input$submit_project,{
req(input$project_title, input$project_position, input$project_overview,
input$project_supervisors, input$project_place)
temp_project <- data.frame(
title = input$project_title,
position = input$project_position,
overview = input$project_overview,
supervisors = input$project_supervisors,
place = input$project_place
)
df$projects <- rbind(df$projects, temp_project)
df$tasks[[length(df$tasks) + 1]] <- temp$tasks
temp$tasks <- data.frame()
})
# remove a project
observeEvent(input$remove_project,{
req(input$project_id)
idx <- input$project_id
if (nrow(df$projects) > 0) {
if (idx > nrow(df$projects)) {
sendSweetAlert(session, title = "", text = "Please select a
project in the list!", type = "error")
} else {
df$projects <- df$projects[-idx, ]
# remove the tasks element(s) related to
# the deleted project
df$tasks[[idx]] <- NULL
}
} else {
sendSweetAlert(session, title = "", text = "There is no project to
delete", type = "error")
}
})
# render the project section
output$experience <- renderUI({
projects <- df$projects
if (!is_empty(projects)) {
tagList(
lapply(seq_along(projects$title), FUN = function(i) {
title <- projects$title[i]
position <- projects$position[i]
overview <- projects$overview[i]
supervisors <- projects$supervisors[i]
place <- projects$place[i]
# call the project_box function and pass it all
# the previous arguments
project_box(title = title, position = position, overview = overview,
supervisors = supervisors, place = place, tasks = df$tasks[[i]],
images = project_images[i], background_color = col[i],
box_index = i)
})
)
}
})
#-------------------------------------------------------------------------
#
# publications section ...
#
#-------------------------------------------------------------------------
# Generate the publications UI
# if and only if the publications
# section is selected
output$publicationsUI <- renderUI({
if (input$section == "publications") {
tagList(
tags$h3("Publications Section"),
textInput(inputId = "publication_reference", label = "Short Reference:"),
fileInput(inputId = "publication_screenshot", label = "Screenshot:"),
textAreaInput(inputId = "publication_abstract", label = "Abstract",
"Write your abstract here"),
textInput(inputId = "publication_pubmed", label = "Link to pubmed:"),
fluidRow(
column(6,
actionBttn(inputId = "submit_publication", "Add Publication",
color = "success", style = "fill", size = "sm")
),
column(6,
actionBttn(inputId = "remove_publication", "Remove publication",
color = "danger", style = "fill", size = "sm")
)
),
numericInput("publication_id", "Publication to remove", value = 1)
)
}
})
# render the uploaded images (works but not really nice)
observe({
screenshots <- df$publications_screenshots
lapply(seq_along(screenshots), FUN = function(i) {
output[[paste0("screenshot", i)]] <- renderImage({
path <- screenshots[[i]]$src
list(
src = path,
class = "img-responsive pad"
)
}, deleteFile = FALSE)
})
})
# each time submit publication is pressed
# add the new publication name as well as
# other informations
observeEvent(input$submit_publication,{
req(input$publication_reference, input$publication_pubmed,
input$publication_screenshot)
temp_publication <- data.frame(
reference = input$publication_reference,
abstract = input$publication_abstract,
pubmed_link = input$publication_pubmed
)
df$publications <- rbind(df$publications, temp_publication)
# add the new publication screenshot if any
# copy the uploaded image in its proper www folder of the application
temp_inFile <- input$publication_screenshot
len <- length(df$publications_screenshots)
copy_path <- "www/Publications_img_saved/"
if (!is.null(temp_inFile)) {
if (len > 0) {
# if there is 0.png in the www folder
# create a 1.png file, then 2.png ... until n.png
temp_path <- str_replace(temp_inFile$datapath, "0.png", "")
old_name <- "0.png"
new_name <- paste0(len, ".png")
# rename 0.png to len.png
file.rename(from = paste0(temp_path, "/", old_name),
to = paste0(temp_path, "/", new_name))
# copy it to the shiny app folder (where images are saved)
file.copy(from = paste0(temp_path, new_name), to = copy_path)
new_path <- paste0(copy_path, "/", new_name)
temp_screenshot <- list(
src = new_path,
class = "img-responsive pad"
)
} else {
# if df$publications_sreenshot was empty, create 0.png file
temp_path <- temp_inFile$datapath
file.copy(from = temp_path, to = copy_path)
temp_path <- paste0(copy_path, "/", "0.png")
temp_screenshot <- list(
src = temp_path,
class = "img-responsive pad"
)
}
# does not work once input$publication_screenshot is not null
# since its value is only reset when the new file is uploaded
# shinyjs::reset() does not solve the problem.
} else {
temp_screenshot <- list(
src = NULL,
class = NULL
)
}
df$publications_screenshots[[len + 1]] <- temp_screenshot
})
# remove a publication
observeEvent(input$remove_publication,{
req(input$publication_id)
idx <- input$publication_id
if (nrow(df$publications) > 0) {
if (idx > nrow(df$publications)) {
sendSweetAlert(session, title = "", text = "Please select a
publication in the list!", type = "error")
} else {
df$publications <- df$publications[-idx, ]
df$publications_screenshots[[idx]] <- NULL
file.remove(
dir(
"www/Publications_img_saved/",
pattern = paste0(idx - 1, ".png"),
full.names = TRUE
)
)
}
} else {
sendSweetAlert(session, title = "", text = "There is no publication to
delete", type = "error")
}
})
# render the project section
output$publications <- renderUI({
publications <- df$publications
screenshots <- df$publications_screenshots
if (!is_empty(publications)) {
tagList(
lapply(seq_along(publications$reference), FUN = function(i) {
reference <- publications$reference[i]
abstract <- publications$abstract[i]
pubmed_link <- publications$pubmed_link[i]
screenshot <- if (!is.null(screenshots[[i]]$src)) screenshots[[i]]$src else NULL
# call the publication_box function and pass it all
# the previous arguments
publication_box(reference, abstract, pubmed_link, screenshot,
box_index = i)
})
)
}
})
#-------------------------------------------------------------------------
#
# talks section ...
#
#-------------------------------------------------------------------------
# Generate the talks UI
# if and only if the talk
# section is selected
output$talksUI <- renderUI({
if (input$section == "conferences") {
tagList(
tags$h3("Conferences Section"),
textInput("talk_title", label = "Title:"),
prettyRadioButtons(inputId = "talk_price", label = "Award:",
choices = c("yes", "no"), animation = "pulse",
thick = TRUE, bigger = TRUE, inline = TRUE),
dateRangeInput("talk_date", "Date range:",
min = "1900-01-01",
max = Sys.Date(),
format = "mm/dd/yy",
separator = " - "),
textAreaInput("talk_summary", "Talks description",
"Describe your conference here", width = "200px"),
textInput("talk_location", "Place"),
textInput("talk_website", "Conference Website"),
fluidRow(
column(6,
actionBttn(inputId = "submit_talk", "Add Talk",
color = "success", style = "fill", size = "sm")
),
column(6,
actionBttn(inputId = "remove_talk", "Remove Talk",
color = "danger", style = "fill", size = "sm")
)
),
numericInput("talk_id", "Talk to remove", value = 1)
)
}
})
# each time submit talk is pressed
# add the new talk name and its value
# to the talks dataframe
observeEvent(input$submit_talk,{
req(input$talk_title, input$talk_summary, input$talk_date, input$talk_location)
temp_talk <- data.frame(
title = input$talk_title,
from = input$talk_date[1],
to = input$talk_date[2],
summary = input$talk_summary,
place = input$talk_location,
price = input$talk_price,
website = input$talk_website
)
df$talks <- rbind(df$talks, temp_talk)
})
# remove a talk
observeEvent(input$remove_talk,{
req(input$talk_id)
idx <- input$talk_id
if (nrow(df$talks) > 0) {
if (idx > nrow(df$talks)) {
sendSweetAlert(session, title = "", text = "Please select a
talk in the list!", type = "error")
} else {
df$talks <- df$talks[-idx, ]
}
} else {
sendSweetAlert(session, title = "", text = "There is no talk to
delete", type = "error")
}
})
# Render the conference timeLine
output$talk_timeline <- renderUI({
talks <- df$talks
if (!is_empty(talks)) {
tagList(
timelineBox(
lapply(seq_along(talks$title), FUN = function(i) {
title <- talks$title[i]
from <- talks$from[i]
to <- if (is.na(talks$to[i])) "Now" else talks$to[i]
summary <- talks$summary[i]
place <- talks$place[i]
price <- talks$price[i]
website <- talks$website[i]
list(
timelineLabel(
text = HTML(paste0("<b>", from, "//", "<br/>", to, "</b>")), color = "light-blue"
),
timelineItem(
icon = icon(name = "microphone", class = paste0("bg-", "light-blue")),
header = if (length(price) > 0) {
HTML(paste0(title, tags$p(class = "pull-right", icon("trophy"))))
} else {
title
},
body = summary,
itemIcon = shiny::icon("street-view"),
footer = tags$a(class = "btn btn-primary btn-xs",
href = website, target = "_blank", "Read more"),
itemText = place
)
)
})
)
)
}
})
#-------------------------------------------------------------------------
#
# Teaching section ...
#
#-------------------------------------------------------------------------
# Generate the teaching UI
# if and only if the teaching
# section is selected
output$teachingType <- renderUI({
if (input$section == "teaching") {
prettyRadioButtons(inputId = "teaching_type", label = "Teaching Type",
choices = c("course", "internship"), inline = TRUE,
animation = "pulse", bigger = TRUE)
}
})
output$teachingUI <- renderUI({
req(input$teaching_type)
if (input$section == "teaching") {
if (input$teaching_type == "course") {
tagList(
textInput(inputId = "course_title", label = "Title:"),
textInput(inputId = "course_topic", label = "Topic:"),
textInput(inputId = "course_location", label = "Location:"),
numericInput(inputId = "course_nbstudents", label = "Students number:", value = 1),
numericInput(inputId = "course_nbhours", label = "Hours number:", value = 1),
dateRangeInput("course_date", "Date range:",
min = "1900-01-01",
max = Sys.Date(),
format = "mm/dd/yy",
separator = " - "),
textInput(inputId = "course_supervisor", label = "Main Advisor:"),
textInput(inputId = "course_syllabus", label = "Syllabus:"),
fluidRow(
column(6,
actionBttn(inputId = "submit_course", "Add course",
color = "success", style = "fill", size = "sm")
),
column(6,
actionBttn(inputId = "remove_course", "Remove course",
color = "danger", style = "fill", size = "sm")
)
),
numericInput("course_id", "Course to remove", value = 1)
)
} else {
tagList(
textInput(inputId = "internship_title", label = "Title:"),
textInput(inputId = "internship_topic", label = "Topic:"),
textInput(inputId = "internship_location", label = "Location:"),
dateRangeInput("internship_date", "Date range:",
min = "1900-01-01",
max = Sys.Date(),
format = "mm/dd/yy",
separator = " - "),
textInput(inputId = "internship_supervisor", label = "Main Advisor:"),
selectInput(inputId = "internship_level", label = "Internship Level:",
choices = c("bachelor", "master", "PhD", "PostDoc")),
textInput(inputId = "internship_advert", label = "Advert:"),
fluidRow(
column(6,
actionBttn(inputId = "submit_internship", "Add internship",
color = "success", style = "fill", size = "sm")
),
column(6,
actionBttn(inputId = "remove_internship", "Remove internship",
color = "danger", style = "fill", size = "sm")
)
),
numericInput("internship_id", "internship to remove", value = 1)
)
}
}
})
# each time submit course is pressed
# add the new course name and its value
# to the courses dataframe
observeEvent(input$submit_course,{
req(input$course_title, input$course_topic, input$course_location,
input$course_nbstudents, input$course_nbhours,
input$course_date, input$course_supervisor)
temp_course <- data.frame(
title = input$course_title,
topic = input$course_topic,
nb_students = input$course_nbstudents,
nb_hours = input$course_nbhours,
from = input$course_date[1],
to = input$course_date[2],
place = input$course_location,
supervisor = input$course_supervisor,
syllabus = input$course_syllabus
)
df$courses <- rbind(df$courses, temp_course)
})
# remove a course
observeEvent(input$remove_course,{
req(input$course_id)
idx <- input$course_id
if (nrow(df$courses) > 0) {
if (idx > nrow(df$courses)) {
sendSweetAlert(session, title = "", text = "Please select a
course in the list!", type = "error")
} else {
df$courses <- df$courses[-idx, ]
}
} else {
sendSweetAlert(session, title = "", text = "There is no course to
delete", type = "error")
}
})
# each time submit internship is pressed
# add the new course name and its value
# to the internships dataframe
observeEvent(input$submit_internship,{
req(input$internship_title, input$internship_topic, input$internship_location,
input$internship_date, input$internship_supervisor, input$internship_level)
temp_internship <- data.frame(
title = input$internship_title,
topic = input$internship_topic,
from = input$internship_date[1],
to = input$internship_date[2],
place = input$internship_location,
supervisor = input$internship_supervisor,
level = input$internship_level,
advert = input$internship_advert
)
df$internships <- rbind(df$internships, temp_internship)
})
# remove a course
observeEvent(input$remove_internship,{
req(input$internship_id)
idx <- input$internship_id
if (nrow(df$internships) > 0) {
if (idx > nrow(df$internships)) {
sendSweetAlert(session, title = "", text = "Please select an
internship in the list!", type = "error")
} else {
df$internships <- df$internships[-idx, ]
}
} else {
sendSweetAlert(session, title = "", text = "There is no internship to
delete", type = "error")
}
})
# render the teaching course boxes
output$teaching_courses <- renderUI({
courses <- df$courses
if (!is_empty(courses)) {
tagList(
lapply(seq_along(courses$title), FUN = function(i) {
title <- courses$title[i]
topic <- courses$topic[i]
nb_students <- courses$nb_students[i]
nb_hours <- courses$nb_hours[i]
from <- courses$from[i]
to <- if (is.na(courses$to[i])) "Now" else courses$to[i]
place <- courses$place[i]
supervisor <- courses$supervisor[i]
syllabus <- if (is.na(courses$syllabus[i])) NULL else courses$syllabus[i]
# call the course_box function and pass it all
# the previous arguments
course_box(title, topic, nb_students, nb_hours, from, to,
place, supervisor, syllabus, box_index = i)
})
)
}
})
# render the teaching internships boxes
output$teaching_internships <- renderUI({
internships <- df$internships
if (!is_empty(internships)) {
tagList(
lapply(seq_along(internships$title), FUN = function(i) {
title <- internships$title[i]
topic <- internships$topic[i]
from <- internships$from[i]
to <- if (is.na(internships$to[i])) "Now" else internships$to[i]
place <- internships$place[i]
supervisor <- internships$supervisor[i]
level <- internships$level[i]
advert <- if (is.na(internships$advert[i])) NULL else internships$advert[i]
# call the internship_box function and pass it all
# the previous arguments
internship_box(title, topic, from , to, place,
supervisor, level, advert, box_index = i)
})
)
}
})
#-------------------------------------------------------------------------
#
# main_box section ...
#
#-------------------------------------------------------------------------
# need to enable/disable several tabPanels
# Some users probably do not need
# awards, talks and publications panels
output$main_box <- renderUI({
main_box(input)
})
#-------------------------------------------------------------------------
#
# Useful tasks such as save, reset, load ...
#
#-------------------------------------------------------------------------
# save the cv
observeEvent(input$save,{
saveRDS(object = reactiveValuesToList(df), file = "www/cv_datas.rds")
})
# erase the whole cv and the associated data
observeEvent(input$reset,{
file.remove("www/cv_datas.rds")
file.remove(dir("www/Publications_img_saved/", pattern = "[0-9]\\.png$",
full.names = TRUE))
file.remove(dir("www/Profile_img_saved/", pattern = "0.png",
full.names = TRUE))
})
# Custom footer
output$dynamicFooter <- renderFooter({
dashboardFooter(
mainText = h5(
"2017, David Granjon, Zurich.",
"Built with",
img(src = "https://www.rstudio.com/wp-content/uploads/2014/04/shiny.png", height = "30"),
"by",
img(src = "https://www.rstudio.com/wp-content/uploads/2014/07/RStudio-Logo-Blue-Gray.png", height = "30"),
"and with", img(src = "love.png", height = "30")),
subText = HTML("<b>Version</b> 0.1")
)
})
# Set this to "force" instead of TRUE for testing locally (without Shiny Server)
# Only works with shiny server > 1.4.7
session$allowReconnect(TRUE)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.