router POC

[DivadNojnarg]

Following Colin's idea, we may adapt the code to shinyMobile. shinyMobile has its own internal router so it's easier:

Modified f7Navbar with left link:

f7Navbar <- function(..., subNavbar = NULL, title = NULL, subtitle = NULL, hairline = TRUE,
                     shadow = TRUE, bigger = FALSE, transparent = FALSE, left_panel = FALSE,
                     right_panel = FALSE) {
  
  navbarClass <- "navbar"
  # bigger and transparent work together
  if (bigger) {
    if (transparent) {
      navbarClass <- paste0(navbarClass, " navbar-large navbar-large-transparent")
    } else {
      navbarClass <- paste0(navbarClass, " navbar-large")
    }
  }
  if (!hairline) navbarClass <- paste0(navbarClass, " no-hairline")
  if (!shadow) navbarClass <- paste0(navbarClass, " no-shadow")
  
  leftNav <- shiny::tags$div(
    class = "left",
    a(
      href = "#", 
      class= "back link icon-only",
      f7Icon("chevron_left"),
      `data-transition` = "f7-cover",
      "Back"
    ),
    if (left_panel) {
      shiny::tags$a(
        class = "link icon-only panel-open",
        `data-panel` = "left",
        f7Icon("bars")
      )
    }
  )
  
  rightNav <- if (right_panel) {
    shiny::tags$div(
      class = "right",
      shiny::tags$a(
        class = "link icon-only panel-open",
        `data-panel` = "right",
        f7Icon("bars")
      )
    )
  }
  
  innerCl <- "navbar-inner sliding"
  if (bigger) innerCl <- paste0(innerCl, " navbar-inner-large")
  
  shiny::tags$div(
    class = navbarClass,
    shiny::tags$div(class = "navbar-bg"),
    shiny::tags$div(
      class = innerCl,
      leftNav,
      if (bigger) {
        shiny::tagList(
          shiny::tags$div(
            class = "title",
            title,
            # add style to prevent title from
            # being black. Bug in Framework7?
            style = "color: white;"
          ),
          rightNav,
          shiny::tags$div(
            class = "title-large",
            shiny::tags$div(class = "title-large-text", title)
          )
        )
      } else {
        shiny::tagList(
          shiny::tags$div(
            class = "title",
            title,
            if (!is.null(subtitle)) shiny::tags$span(class = "subtitle", subtitle)
          ),
          rightNav
        )
      },
      ...,
      subNavbar
    )
  )
}

...multipage <- new.env()

f7ListItem <- function(..., title = NULL, subtitle = NULL, header = NULL, footer = NULL,
                       url = NULL, media = NULL, right = NULL) {
  
  # avoid to have crazy large images
  if (!is.null(media)) {
    if (media$name == "img") media$attribs$width <- "50"
  }
  
  itemContent <- shiny::tagList(
    # left media
    if (!is.null(media)) {
      shiny::tags$div(
        class = "item-media",
        media
      )
    },
    
    # center content
    shiny::tags$div(
      class = "item-inner",
      
      if (is.null(title)) {
        shiny::tagList(
          shiny::tags$div(
            class = "item-title",
            if (!is.null(header)) {
              shiny::tags$div(
                class = "item-header",
                header
              )
            },
            ...,
            if (!is.null(footer)) {
              shiny::tags$div(
                class = "item-footer",
                footer
              )
            }
          ),
          
          # right content
          if (!is.null(right)) {
            shiny::tags$div(
              class = "item-after",
              right
            )
          }
        )
      } else {
        shiny::tagList(
          shiny::tags$div(
            class = "item-title-row",
            shiny::tags$div(
              class = "item-title",
              if (!is.null(header)) {
                shiny::tags$div(
                  class = "item-header",
                  header
                )
              },
              title,
              if (!is.null(footer)) {
                shiny::tags$div(
                  class = "item-footer",
                  footer
                )
              }
            ),
            # right content
            if (!is.null(right)) {
              shiny::tags$div(
                class = "item-after",
                right
              )
            }
          ),
          
          # subtitle
          if (!is.null(subtitle)) {
            shiny::tags$div(
              class = "item-subtitle",
              subtitle
            )
          },
          
          # text
          shiny::tags$div(
            class = "item-text",
            ...
          )
        )
      }
    )
  )
  
  itemContentWrapper <- if (is.null(url)) {
    shiny::tags$div(
      class = "item-content",
      itemContent
    )
  } else {
    shiny::tags$a(
      class = "item-link item-content",
      href = url,
      `data-transition` = "f7-cover",
      itemContent
    )
  }
  
  shiny::tags$li(itemContentWrapper)
}



f7Link <- function(href = NULL, label = NULL, icon = NULL, external = FALSE, ...) {
  
  linkCl <- "link"
  if (external) linkCl <- paste0(linkCl, " external")

  
  shiny::a(
    href = href,
    class = linkCl,
    ...,
    if (!is.null(icon)) {
      shiny::tagList(
        shiny::tags$i(class = "icon", icon),
        shiny::span(label)
      )
    } else {
      label
    }
  )
}



#' Create a shinyApp
#'
#' @inheritParams shiny::shinyApp
#'
#' @return A shiny.appobj
#' @export
f7App <- function(
  ui,
  server,
  onStart = NULL,
  options = list(),
  enableBookmarking = NULL
){
  ...multipage$enabled <- TRUE
  shinyApp(
    ui = ui,
    server = server,
    onStart = onStart,
    options = options,
    uiPattern = ".*",
    enableBookmarking = enableBookmarking
  )
}

#' A shinyMobile route
#'
#' @param href The endpoint to serve the UI on
#' @param ui Content served at `/href`
#'
#' @return A list
#' @export
#'
#' @examples
#' f7Roite(
#'  href = "/page2",
#'  ui =  tagList(
#'    h1("This is my second page"),
#'    plotOutput("plotb")
#'  )
#' )
#'
f7Route <- function(
  href,
  ui
){
  list(
    href = href,
    ui = tagList(ui)
  )
}

#' Create the UI for a shinyMobile multipage layout
#'
#' @param ... a list of `Page()`
#' @param wrapped A UI function wrapping the Brochure UI.
#' Default is `shinyMobile::f7Page`.
#'
#' @return
#' @export
#' @importFrom shiny uiOutput renderUI
#' @examples
f7MultiPage <- function(
  ...,
  wrapped = f7Page
){
  content <- list(...)
  
  all_href <- vapply(
    content, function(x){
      x$href
    }, FUN.VALUE = character(1)
  )
  
  #if (
  #  ! "/" %in% all_href
  #){
  #  stop("You must specify a root page (one with `href = '/')`.")
  #}
  
  x <- lapply(
    content,
    function(x){
      ...multipage[[x$href]]$ui <- tagList(
        tags$head(
          tags$script(
            HTML("$(function() {
              var currentPath = mainView.router.currentRoute.path;
              if (!(router_history.indexOf(currentPath) > -1)) {
                router_history.push(currentPath);
              }
              
              console.log(router_history);
              
              if (mainView.router.currentRoute.path === '/') {
                $('.back').hide();
              } else {
                $('.back').show();
                var prevPath;
                if (router_history.length === 1) {
                  prevPath = router_history[0];
                } else {
                  prevPath = router_history[router_history.length - 2];
                }
                $('.back').attr('href', prevPath);
              }
              
              // when click on back, remove old history;
              $('.back').on('click', function() {
                router_history.pop(mainView.router.currentRoute.path);
              });
            
              mainView = app.views.create('.view-main', {
                url: mainView.router.currentRoute.url,
              });
              
              mainView.router.on('routeChanged', function(newRoute, previousRoute, router) {
                Shiny.setInputValue('current_route', mainView.router.currentRoute.path, {priority: 'event'});
              });
            });
            "
          ))
        ),
        x$ui
      )
    }
  )
  
  wrapped(
    tags$head(
      tags$script(
        HTML("$(function() {
          $('.back').hide();
        
          mainView.router.on('routeChange', function(router) {
            $('.page-content').hide();
          });
          // routeChanged is needed since we need the transition time!
          mainView.router.on('routeChanged', function(newRoute, previousRoute, router) {
            Shiny.setInputValue('current_route', mainView.router.currentRoute.path, {priority: 'event'});
          });
        });
        "
      ))
    ), 
    content[[1]]$ui
  )
  
}

#' Enable Multipage via shinyMobile
#'
#' @return Used for sided effect
#'
#' @importFrom shiny getDefaultReactiveDomain renderUI tagList h1
#' @export
enable_multipage <- function(){
  if (
    is.null(...multipage$enabled) ||
    !...multipage$enabled
  ){
    stop("Brochure not enabled. \nHave you used `brochureApp()` to run your app?")
  }
  
  input <- get("input", envir = parent.frame())
  
  observeEvent(input$current_route, {
    
    url_hash <- input$current_route

    removeUI(".view.view-main")
    insertUI(
      "#app",
      where = "beforeEnd",
      ui = ...multipage[[url_hash]]$ui
    )
  })
}

Add routes to the shinyMobile app instance:

var app = new Framework7({
  routes: [
                {
                  name: '1',
                  path: '/',
                  url: '/',
                },
                {
                  name: '2',
                  path: '/3',
                  url: '/2',
                },
                {
                  name: '3',
                  path: '/3',
                  url: '/3',
                }
             ]
});

Demo app:

f7App(
  f7MultiPage(
    f7Route(
      href = "/",
      ui = f7SingleLayout(
        navbar = f7Navbar(
          title = "Welcome Page",
          hairline = FALSE,
          shadow = TRUE
        ),
        toolbar = f7Toolbar(
          position = "bottom",
          f7Link(label = "Next Page", href = "/2", `data-transition` = "f7-cover")
        ),
        f7Slider(
          inputId = "obs",
          label = "Range values",
          max = 500,
          min = 0,
          value = c(50, 100),
          scale = FALSE
        ),
        verbatimTextOutput("test"),
        f7List(
          lapply(1:3, function(j) {
            f7ListItem(
              sprintf("Go to Page %s", j),
              url = sprintf("/%s", j)
            )
          })
        )
      )
    ),
    f7Route(
      href = "/2",
      ui =  f7SingleLayout(
        navbar = f7Navbar(
          title = "Test Page",
          hairline = FALSE,
          shadow = TRUE
        ),
        toolbar = f7Toolbar(
          position = "bottom",
          f7Link(label = "Previous Page", href = "/", `data-transition` = "f7-cover"),
          f7Link(label = "Next Page", href = "/3", `data-transition` = "f7-cover")
        ),
        br(),
        f7Stepper(
          inputId = "stepper2",
          label = "My stepper",
          min = 0,
          max = 10,
          value = 4
        ),
        verbatimTextOutput("test2")
      )
    ),
    f7Route(
      href = "/3",
      ui =  f7SingleLayout(
        navbar = f7Navbar(
          title = "Test Page 2",
          hairline = FALSE,
          shadow = TRUE
        ),
        toolbar = f7Toolbar(
          position = "bottom",
          f7Link(label = "Previous Page", href = "/2", `data-transition` = "f7-cover")
        )
      )
    )
  ),
  server = function(input, output, session) {
    enable_multipage()
    observeEvent(input$current_route, {
      print(input$current_route)
    })
    output$test <- renderPrint({input$obs})
    output$test2 <- renderPrint(input$stepper2)
  }
)