#' BrowserViz:  a base class providing simple, extensible message passing between
#' your R session and your web browser, for interactive data visualization.
#'
#' @docType package
#'
#' @name BrowserViz-class
#' @rdname BrowserViz-class
#' @aliases BrowserViz-class
#'
#' @import BiocGenerics
#' @import methods
#' @importFrom utils browseURL
#'
#' @import httpuv
#' @import jsonlite
#'
#' @exportClass BrowserViz
#'
#----------------------------------------------------------------------------------------------------
#' @description
#' Many of the best interactive graphics capabilities available today are written in Javascript and
#' run in a web browser.  BrowserViz makes these capabilities available in R, using websockets
#' for message passing back and forth between R and the browser. This class connects your R session
#' to your web browser via websockets, using the R httpuv library, which in turn uses the Rook webserver.
#'
#' BrowserViz is a concrete base class, in that instances can be constructed and run - which we do for testing.
#' The primary use of this BrowserViz is to be subclassed: to facilitate the creation of new
#' browser-based, R-connected interactive graphics capabilities embodied in R packages, written by
#' programmers with some skill in both R and Javascript.  Two examples of this can
#' be found in these Bioconductor packages \url{https://bioconductor.org/packages/devel/bioc/html/igvR.html}
#' and \url{https://bioconductor.org/packages/devel/bioc/html/RCyjs.html}.
#' @seealso \code{\link{BrowserViz}}
#'
#----------------------------------------------------------------------------------------------------

#' An S4 class to create and manage a modest webserver for websocket message passing  between R and Javascript
#' running in your web browser
#'
#' @slot uri The http location at which this modest webserver runs
#' @slot port An integer port number for the http connection
#' @slot websocketConnection An environment managed by the httpuv library on our behalf
#' @slot quiet Logical varaible controlling verbosity during execution
#'
.BrowserViz <- setClass("BrowserViz",
                         representation = representation(
                                               uri = "character",
                                               port = "numeric",
                                               websocketConnection = "environment",
                                               quiet = "logical"),
                         prototype = prototype(uri = "http://localhost", 9000)
                         )

#----------------------------------------------------------------------------------------------------
setGeneric('wait', signature = 'obj', function(obj, msecs) standardGeneric('wait'))
setGeneric('port', signature = 'obj', function(obj) standardGeneric('port'))
setGeneric('ready', signature = 'obj', function(obj) standardGeneric('ready'))
setGeneric('getBrowserInfo', signature = 'obj', function(obj) standardGeneric('getBrowserInfo'))
setGeneric('send', signature = 'obj', function(obj, msg) standardGeneric('send'))
setGeneric('browserResponseReady', signature = 'obj', function(obj) standardGeneric('browserResponseReady'))
setGeneric('getBrowserResponse', signature = 'obj', function(obj) standardGeneric('getBrowserResponse'))
setGeneric('closeWebSocket', signature = 'obj', function(obj) standardGeneric('closeWebSocket'))
setGeneric('getBrowserWindowTitle', signature = 'obj', function(obj) standardGeneric('getBrowserWindowTitle'))
setGeneric('setBrowserWindowTitle', signature = 'obj', function(obj, newTitle) standardGeneric('setBrowserWindowTitle'))
setGeneric('roundTripTest', signature = 'obj', function(obj, ...) standardGeneric('roundTripTest'))
setGeneric('getBrowserWindowSize', signature = 'obj', function(obj) standardGeneric('getBrowserWindowSize'))
setGeneric('displayHTMLInDiv', signature = 'obj', function(obj, htmlText, div.id) standardGeneric('displayHTMLInDiv'))
#----------------------------------------------------------------------------------------------------
# some global variables:
BrowserViz.state <- new.env(parent = emptyenv())
BrowserViz.state$onOpenCall <- 0
BrowserViz.state$quiet <- TRUE

# this maps from incoming json commands to function calls
dispatchMap <- new.env(parent = emptyenv())

# status is global variable at file scope, invisible outside the package.
# it keeps track of web sockect connection state, and -- crucially --
# holds the result variable.  this solves the latency problem: when we make
# a request to the code running in the browser, the browser later (though
# often very quickly) sends a JSON message back to R.  If we are, for instance,
# asking for the current browser window title (see 'getBrowserWindowTitle' below), that
# result is sent to the  call back we have registered, "handleResponse")
# to make this seem like a synchronous call, the caller sits in a tight sleep loop,
# waiting until status$result is no longer NULL.  getBrowserWindowTitle will then
# parse that JSON response into an R variable.
# the checking of status$result, and its retrieval when ready (no longer null)
# is accomplished by exported methods browserResponseReady and getBrowserResponse,
# to be used by subclasses as well.

status <- new.env(parent = emptyenv())
status$result <- NULL
#----------------------------------------------------------------------------------------------------
log <- function(...)
{
   if (!BrowserViz.state$quiet) {
      params <- list(...)
      arg.count <- length(params)
      if (arg.count == 0) return(invisible())
      if (arg.count == 1) {
         print(params[[1]])
         return(invisible())
         }
      if (arg.count > 1 && is.character(params[[1]])) {
         print(noquote(sprintf(...)))
         }
      } # if !quiet

} # log
#----------------------------------------------------------------------------------------------------
setupMessageHandlers <- function()
{
   log("--- BrowserViz-class, setupMessageHanlders")
   addRMessageHandler("handleResponse", "handleResponse")

} # setupMessageHandlers
#----------------------------------------------------------------------------------------------------
#' Constructor for BrowserViz
#'
#' @name BrowserViz constructor
#' @rdname BrowserViz
#'
#' @description
#'
#' This constructor function:
#'
#' \itemize{
#'   \item creates the BrowserViz object
#'   \item initializes the httpuv web server
#'   \item prepares that web server to additionally handle websocket traffic
#'   \item loads a "browserFile" - an html/javascript/css web page to communicate with in your web browser
#'   \item opens websocket communication between your R session and your browser
#'   \item installs an optional "httpQueryProcessingFunction" to handle http (non-websocket) requests.
#' }
#'
#'
#' @param host character The constructor will open an http/websocket port here for web browsers to connect to.
#'   localhost by default
#' @param portRange The constructor looks for a free websocket port in this range.  10000:10100 by default
#' @param title Used for the web browser window, "igvR" by default
#' @param browserFile The full path to the bundled html, js and libraries, and css which constitute the browser app
#' @param quiet A logical variable controlling verbosity during execution
#' @param httpQueryProcessingFunction a function, default NULL, provides subclasses with the
#'   opportunity to execute code on the http server created here.
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   data <- list(lowercase = letters, uppercase = LETTERS)
#'   json.returned <- roundTripTest(bvApp, data)
#'   data.returned <- fromJSON(json.returned)
#'   stopifnot(identical(data, data.returned))
#'   html <- sprintf("<h3>round trip of json-encoded data, %d chars</h3>",
#'                   nchar(json.returned))
#'   displayHTMLInDiv(bvApp, html, "bvDemoDiv")
#'   closeWebSocket(bvApp)
#'   }
#'
#' @return An object of the BrowserViZ class
#'
#' @export
#'
#'

BrowserViz = function(host = "localhost", portRange = 10000:10100, title = "BrowserViz", browserFile, quiet = TRUE,
                      httpQueryProcessingFunction = NULL)
{
  BrowserViz.state$quiet <- quiet
  log("BrowserViz constructor starting with html file '%s'", browserFile)
  log("   html file exists? %s", file.exists(browserFile))

  stopifnot(file.exists(browserFile))

  wsCon <- new.env(parent = emptyenv())
  wsCon <- .setupWebSocketHandlers(wsCon, browserFile, quiet)
  result <- .startServerOnFirstAvailableLocalHostPort(portRange, wsCon)
  actualPort <- result$port
  wsCon$server <- result$server

  if (is.null(actualPort))
    stop(sprintf("no available ports in range %d:%d", min(portRange), max(portRange)))

  uri = sprintf("http://%s:%s", host, actualPort)

  log("summoning default browser to get %s", uri)

  sleepTime <- 2
  Sys.sleep(sleepTime);
  browseURL(uri, browser = .getBrowser())

  log("starting daemonized server on port %s", actualPort)

  setupMessageHandlers()

  obj <- .BrowserViz(uri = uri, websocketConnection = wsCon, port = actualPort, quiet = quiet)

  BrowserViz.state[["httpQueryProcessingFunction"]] <- httpQueryProcessingFunction

  totalWait <- 0.0
  sleepTime <- 100

  while (!wsCon$open) {
     wait(obj, sleepTime)
     totalWait <- totalWait + (sleepTime / 1000)
     }

  log("BrowserViz websocket ready after %6.2f seconds", totalWait);

  obj

} # BrowserViz: constructor
#----------------------------------------------------------------------------------------------------
.startServerOnFirstAvailableLocalHostPort <- function(portRange, wsCon)
{
   done <- FALSE

   port <- portRange[1]
   server <- NULL

   while (!done) {
     if (port > max(portRange))
        done <- TRUE
     else {
        log("attempting to open websocket connection on port %d", port)
        server <- tryCatch(startServer("0.0.0.0", port, wsCon),
                         error = function(m) {sprintf("port not available: %d", port)})
        }
     if ("WebServer" %in% class(server)) # will be character if the port is already claimed
        done <- TRUE
     else
        port <- port + 1;
     } # while

   actualPort <- server$getPort()

   list(server = server, port = actualPort)

} # .startServerOnFirstAvailableLocalHostPort
#----------------------------------------------------------------------------------------------------
#' Pause for the specified number of milliseconds
#'
#' @rdname wait
#' @aliases wait
#'
#' @param obj An object of class BrowserViz
#' @param msecs Numeric
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   wait(bvApp, 100)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'

setMethod('wait', 'BrowserViz',

  function(obj, msecs) {
     service(msecs) # an httpuv function
     }) # wait

#----------------------------------------------------------------------------------------------------
#' Display the core attributes of the BrowserViz object to stdout
#'
#' @rdname show
#' @aliases show
#'
#' @param object An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   show(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export

setMethod('show', 'BrowserViz',

  function(object) {
     msg <- sprintf("BrowserViz object");
     cat(msg, '\n', sep = '')
     msg <- sprintf("ready? %s", ready(object))
     cat(msg, '\n', sep = '')
     msg <- sprintf("port: %d", port(object))
     cat(msg, '\n', sep = '')
     }) # show

#----------------------------------------------------------------------------------------------------
#' Get the port number
#'
#' @rdname port
#' @aliases port
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   port(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @return the port number use in the websocket connection, a numeric value.
#'
#' @export
#'
setMethod('port', 'BrowserViz',

  function(obj) {
     obj@port
     })

#----------------------------------------------------------------------------------------------------
#' Close the websocket connection - between your R session and your web browser.
#'
#' @rdname closeWebSocket
#' @aliases closeWebSocket
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   show(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('closeWebSocket', 'BrowserViz',

  function(obj) {
     if (!obj@websocketConnection$open) {
        warning("websocket server is not open, cannot close");
        return()
        }
     obj@websocketConnection$open <- FALSE
     obj@websocketConnection$server$stop()
     obj@websocketConnection$ws <- NULL
     obj@websocketConnection$ws <- -1

     invisible(obj)
     })

#----------------------------------------------------------------------------------------------------
#' Is the websocket connection to the browser ready for use?
#'
#' @rdname ready
#' @aliases ready
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   ready(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('ready', 'BrowserViz',

  function(obj) {

     if (!is.environment(obj@websocketConnection)) {
        log("--- obj@websocketConnection not an environment")
        return(FALSE)
        }

     if (!obj@websocketConnection$open) {
       log("--- obj@websocketConnection not open")
       return(FALSE)
       }
   TRUE;
   })

#----------------------------------------------------------------------------------------------------
#' browserResponseReady
#'
#' @rdname browserResponseReady
#' @aliases browserResponseReady
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   browserResponseReady(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('browserResponseReady', 'BrowserViz',

  function(obj) {
     return(!is.null(status$result))
     })

#----------------------------------------------------------------------------------------------------
#' Retrieve the response sent by the browser
#'
#' @rdname getBrowserResponse
#' @aliases getBrowserResponse
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   data <- list(lowercase = letters, uppercase = LETTERS)
#'   json.returned <- roundTripTest(bvApp, data)
#'   data.returned <- fromJSON(json.returned)
#'   stopifnot(identical(data, data.returned))
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('getBrowserResponse', 'BrowserViz',

  function(obj) {
    log("BrowserViz getBrowserResponse, length %d", length(status$result))
    x <- status$result
    return(x)
    })

#----------------------------------------------------------------------------------------------------
.setupWebSocketHandlers <- function(wsCon, browserFile, quiet)
{
   log("--- entering BrowserViz .setupWebSocketHandlers");
   log("    browserFile: %s (%s)", browserFile, file.exists(browserFile));

   wsCon$open <- FALSE
   wsCon$ws <- NULL
   wsCon$result <- NULL
     # process http requests
   wsCon$call = function(req) {
      qs <- req$QUERY_STRING
      if (nchar(qs) > 0) {
         log("--- bv$call, about to call dynamically assigned queryProcessor");
         fields <- ls(req)
         queryProcessorFunction <- BrowserViz.state[["httpQueryProcessingFunction"]]
         if (!is.null(queryProcessorFunction)) {
            queryResult <- queryProcessorFunction(qs)
            body <- queryResult$body
            contentType <- queryResult$contentType
            }
         else {
            body <- "no query processor registered"
            contentType <- "text/html"
            }
         return(list(status = 200L, headers = list('Content-Type' = contentType), body = body))
         } # the request had a query string
      wsUrl = paste(sep = '', '"', "ws://",
                   ifelse(is.null(req$HTTP_HOST), req$SERVER_NAME, req$HTTP_HOST),
                   '"')
     list(
       status = 200L,
       headers = list('Content-Type' = 'text/html'),
       body = c(file = browserFile))
       }

      # called whenever a websocket connection is opened
   wsCon$onWSOpen = function(ws) {
      BrowserViz.state$onOpenCall <- BrowserViz.state$onOpenCall + 1
      log("BrowserViz.setupWebSocketHandlers, wsCon$onWSOpen");
      wsCon$ws <- ws # crucial assignment: this provides later calls to e.g.,  wsCon$ws$send
      ws$onMessage(function(binary, rawMessage) {
         log("BrowserViz.setupWebSocketHandlers, onMessage, message received");
         message <- as.list(fromJSON(rawMessage))
         status$message <- message
         wsCon$lastMessage <- message
         if (!is(message, "list")) {
            message("message: new websocket message is not a list");
            return;
            }
         if (!"cmd" %in% names(message)) {
            message("error: new websocket message has no 'cmd' field");
            return;
            }
         cmd <- message$cmd
         log("BrowserViz dispatching on msg$cmd: %s", message$cmd);
         dispatchMessage(ws, message, quiet);
         }) # onMessage
       wsCon$open <- TRUE
       } # onWSOpen

   wsCon

} # .setupWebSocketHandlers
#--------------------------------------------------------------------------------
#' Supply the name of a function to call, identified by its key
#'
#' @rdname addRMessageHandler
#' @aliases addRMessageHandler
#'
#' @param key A character string
#' @param functionName A character string
#'
#' @export
#'
addRMessageHandler <- function(key, functionName)
{
   dispatchMap[[key]] <- functionName
   log("--- added new R message handler: %s", key)

} # addRMessagHandler
#---------------------------------------------------------------------------------------------------
#' Route the message coming in from the browser to the appropriate R function.
#'
#' @rdname dispatchMessage
#' @aliases dispatchMessage
#'
#' @param ws   a websocket connectin
#' @param msg  the JSON-encoded message from the browser
#' @param quiet logical TRUE or FALSE
#'
#'

dispatchMessage <- function(ws, msg, quiet)
{
   if (!msg$cmd %in% ls(dispatchMap)) {
       log("dispatchMessage error!  the incoming cmd '%s' is not recognized", msg$cmd)
       return()
       }

   function.name <- dispatchMap[[msg$cmd]]
   success <- TRUE

   if (is.null(function.name)) {
       log("dispatchMessage error!  cmd ('%s') not recognized", msg$cmd)
       success <- FALSE
       return()
       }

   tryCatch(func <- get(function.name), error = function(m) func <<- NULL)

   if (is.null(func)) {
       log("dispatchMessage error!  cmd ('%s' recognized but no corresponding function", msg$cmd)
       success <- FALSE
       }

   if (success) {
      log("BrowserViz.dispatchMessage calling function '%s'", function.name)
      do.call(func, list(ws, msg))
      }

} # dispatchMessage
#---------------------------------------------------------------------------------------------------
#' Send the specified message to the browser
#'
#' @rdname send
#' @aliases send
#'
#' @param obj An object of class BrowserViz
#' @param msg A list with four fields: cmd, status, callback, payload
#'   e.g. list(cmd="someCommand", status="request", callback="someFunction", payload="someData")
#' @export
#'
setMethod('send', 'BrowserViz',

    function(obj, msg) {
      msg.json <- toJSON(msg)
      log("BrowserViz-class send, msg: ")
      log(msg.json)
      log(toJSON(msg))
      obj@websocketConnection$ws$send(toJSON(msg))
      status$result <- NULL
      })

#--------------------------------------------------------------------------------
#' Retrieve basic attributes of the attached web browser.
#'
#' @rdname getBrowserInfo
#' @aliases getBrowserInfo
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   getBrowserInfo(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('getBrowserInfo', 'BrowserViz',

  function(obj) {
     send(obj, list(cmd = "getBrowserInfo", callback = "handleResponse", status = "request", payload = ""))
     while (!browserResponseReady(obj)) {
        wait(obj, 100)
        }
     getBrowserResponse(obj);
     })

#--------------------------------------------------------------------------------
#' Send data to the browser, ensure that it is returned accurately.
#'
#' @rdname roundTripTest
#' @aliases roundTripTest
#'
#' @param obj An object of class BrowserViz
#' @param ... other arguments
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   data <- list(lowercase = letters, uppercase = LETTERS)
#'   json.returned <- roundTripTest(bvApp, data)
#'   data.returned <- fromJSON(json.returned)
#'   stopifnot(identical(data, data.returned))
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('roundTripTest', 'BrowserViz',

  function(obj, ...) {
     payload <- toJSON(...)
     send(obj, list(cmd = "roundTripTest", callback = "handleResponse", status = "request", payload = payload))
     while (!browserResponseReady(obj)) {
        wait(obj, 100)
        }
     getBrowserResponse(obj);
     })

#----------------------------------------------------------------------------------------------------
#' Supply the name of a function to call, identified by its key
#'
#' @rdname getBrowserWindowTitle
#' @aliases getBrowserWindowTitle
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   getBrowserWindowTitle(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('getBrowserWindowTitle', 'BrowserViz',

  function(obj) {
     send(obj, list(cmd = "getWindowTitle", callback = "handleResponse", status = "request", payload = ""))
     # browser()
     while (!browserResponseReady(obj)) {
        wait(obj, 100)
        }
     getBrowserResponse(obj);
     })

#----------------------------------------------------------------------------------------------------
#' Supply the name of a function to call, identified by its key
#'
#' @rdname setBrowserWindowTitle
#' @aliases setBrowserWindowTitle
#'
#' @param obj An object of class BrowserViz
#' @param newTitle A character string
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   getBrowserWindowTitle(bvApp)
#'   setBrowserWindowTitle(bvApp, "testBrowser")
#'   getBrowserWindowTitle(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('setBrowserWindowTitle', 'BrowserViz',

  function(obj, newTitle) {
     payload = list(title = newTitle)
     log("setBrowserWindow, new title: %s", newTitle)
     send(obj, list(cmd = "setWindowTitle", callback = "handleResponse", status = "request",
                    payload = payload))
     while (!browserResponseReady(obj)) {
        wait(obj, 100)
        }
     invisible(getBrowserResponse(obj))
     })

#----------------------------------------------------------------------------------------------------
#' Supply the name of a function to call, identified by its key
#'
#' @rdname getBrowserWindowSize
#' @aliases getBrowserWindowSize
#'
#' @param obj An object of class BrowserViz
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   getBrowserWindowSize(bvApp)
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('getBrowserWindowSize', 'BrowserViz',

  function(obj) {
     send(obj, list(cmd = "getWindowSize", callback = "handleResponse", status = "request", payload = ""))
     while (!browserResponseReady(obj)) {
        wait(obj, 100)
        }
     as.list(fromJSON(getBrowserResponse(obj)))
     })

#----------------------------------------------------------------------------------------------------
#' Ask the browser to display html markup in the specified div
#'
#' @rdname displayHTMLInDiv
#' @aliases displayHTMLInDiv
#'
#' @param obj An object of class BrowserViz
#' @param htmlText A character string with HTML markup
#' @param div.id  A character string
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   data <- list(lowercase = letters, uppercase = LETTERS)
#'   json.returned <- roundTripTest(bvApp, data)
#'   html <- sprintf("<h3>round trip of json-encoded data, %d chars</h3>",
#'                   nchar(json.returned))
#'   displayHTMLInDiv(bvApp, html, "bvDemoDiv")
#'   closeWebSocket(bvApp)
#'   }
#'
#' @export
#'
setMethod('displayHTMLInDiv', 'BrowserViz',

  function(obj, htmlText, div.id) {
     payload = list(htmlText = htmlText, divID = div.id)
     send(obj, list(cmd = "displayHTMLInDiv", callback = "handleResponse", status = "request", payload = payload))
     while (!browserResponseReady(obj)) {
        wait(obj, 100)
        }
     # as.list(fromJSON(getBrowserResponse(obj)))
     })

#----------------------------------------------------------------------------------------------------
#' Is there a web browser available for testing?
#'
#' @description
#' This package's unit tests require a web browser to connect to.  our heuristic, though not bullet
#'  proof, is that one of three conditions must be met
#' Supply the name of a function to call, identified by its key
#'
#' @name webBrowserAvailableForTesting
#' @rdname webBrowserAvailableForTesting
#' @aliases webBrowserAvailableForTesting
#'
#' @examples
#' library(BrowserViz)
#' browserVizBrowserFile <- system.file(package = "BrowserViz", "browserCode", "dist", "bvDemoApp.html")
#' if (BrowserViz::webBrowserAvailableForTesting()) {
#'   bvApp <- BrowserViz(browserFile = browserVizBrowserFile, quiet = TRUE)
#'   data <- list(lowercase = letters, uppercase = LETTERS)
#'   json.returned <- roundTripTest(bvApp, data)
#'   html <- sprintf("<h3>round trip of json-encoded data, %d chars</h3>",
#'                   nchar(json.returned))
#'   displayHTMLInDiv(bvApp, html, "bvDemoDiv")
#'   closeWebSocket(bvApp)
#'   }
#'
#' @return Logical TRUE or FALSE
#'
#' @export
#'
webBrowserAvailableForTesting <- function()
{
  authorsDevelopmentMachine <- grepl("hagfish", Sys.info()["nodename"])

  bioconductorBuildSystem.linux <- with(as.list(Sys.info()), sysname == "Linux")
  interactiveUse <- interactive()

  return(authorsDevelopmentMachine || interactiveUse)

} # webBrowserAvailableForTesting
#----------------------------------------------------------------------------------------------------
#' handleResponse
#'
#' @rdname handleResponse
#' @aliases handleResponse
#'
#' @param ws websocket connection
#' @param msg the JSON-encoded character string returned by the browser
#'
#' @return NULL
#'
#' @export
#'
handleResponse <- function(ws, msg)
{
   if (msg$status == "success" || msg$status == "failure") {
      log("-------- BrowserViz handleResponse")
      # log(msg$payload)
      status$result <- msg$payload
      # log("         status$result: ")
      # log(status$result)
      }
   else {
     # log(msg$payload)
     status$result <- NULL
     }

   NULL

} # handleResponse
#----------------------------------------------------------------------------------------------------
.getBrowser <- function()
{
  getOption("browser")
}
#----------------------------------------------------------------------------------------------------
#' Transform an R data structure into JSON
#'
#' @description
#'
#' The semantics of toJSON changed between RJSONIO and jsonlite: in the latter, scalars are
#' promoted to arrays of length 1.  rather than change our javascript code, and since such
#' promotion -- while sensible in the context of R -- strikes me as gratuitous, I follow
#' jeroen ooms suggestion, creating this wrapper
#'
#' @rdname toJSON
#'
#' @param ... Extra arguments passed to this function
#' @param auto_unbox Logical
#'
#' @return a character string with the JSON representation of the R object
#'
#' @export
#'
#' @examples
#'
#' toJSON(data.frame(a = 8:10, b = LETTERS[8:10], stringsAsFactors = FALSE))
#'
toJSON <- function(..., auto_unbox = TRUE)
{
  jsonlite::toJSON(..., auto_unbox = auto_unbox)
}
#----------------------------------------------------------------------------------------------------
#' Transform JSON string into a native R object
#'
#' @rdname fromJSON
#'
#' @param ... Extra arguments passed to this function
#'
#' @return a native R data structure
#'
#' @export
#'
#' @examples
#'
#' fromJSON(toJSON(data.frame(a = 8:10, b = LETTERS[8:10], stringsAsFactors = FALSE)))
#'
fromJSON <- function(...)
{
  jsonlite::fromJSON(...)
}
#----------------------------------------------------------------------------------------------------
