Add some ggplotly() support

NAMESPACE

@@ -203,6 +203,13 @@ export(set_graph_style)
 export(square)
 export(th_foreground)
 export(theme_graph)
+export(to_basic.GeomEdgeBezier)
+export(to_basic.GeomEdgeBspline)
+export(to_basic.GeomEdgeDensity)
+export(to_basic.GeomEdgePath)
+export(to_basic.GeomEdgePoint)
+export(to_basic.GeomEdgeSegment)
+export(to_basic.GeomNodeTile)
 export(treeApply)
 export(tree_apply)
 export(unset_graph_style)

R/ggplotly.R

@@ -0,0 +1,59 @@
+# ---------------------------------------------------------------------------
+# Translations for R/geom_axis_hive.R
+# ---------------------------------------------------------------------------
+
+# TODO: waiting for an example
+
+# ---------------------------------------------------------------------------
+# Translations for custom Edge geoms
+# ---------------------------------------------------------------------------
+
+toEdgePath <- function(data, prestats_data, layout, params, p, ...) {
+  names(data) <- sub("^edge_", "", names(data))
+  prefix_class(data, "GeomPath")
+}
+
+#' @rawNamespace export(to_basic.GeomEdgeBezier)
+to_basic.GeomEdgeBezier <- toEdgePath
+
+#' @rawNamespace export(to_basic.GeomEdgeBspline)
+to_basic.GeomEdgeBspline <- toEdgePath
+
+#' @rawNamespace export(to_basic.GeomEdgeDensity)
+to_basic.GeomEdgeDensity <- function(data, prestats_data, layout, params, p, ...) {
+  # avoid a weird precision issue
+  data$density[data$density < 0.005] <- 0
+  data$fill_plotlyDomain <- data$density
+  data$fill <- toRGB(
+    data$edge_fill, scales::rescale(data$density)
+  )
+  prefix_class(data, "GeomTile")
+}
+
+#' @rawNamespace export(to_basic.GeomEdgePath)
+to_basic.GeomEdgePath <- toEdgePath
+
+#' @rawNamespace export(to_basic.GeomEdgeSegment)
+to_basic.GeomEdgeSegment <- toEdgePath
+
+#' @rawNamespace export(to_basic.GeomEdgePoint)
+to_basic.GeomEdgePoint <- function(data, prestats_data, layout, params, p, ...) {
+  prefix_class(data, "GeomPoint")
+}
+
+# ---------------------------------------------------------------------------
+# Translations for custom Node geoms
+# ---------------------------------------------------------------------------
+
+#' @rawNamespace export(to_basic.GeomNodeTile)
+to_basic.GeomNodeTile <- getFromNamespace("to_basic.GeomTile", asNamespace("plotly"))
+
+
+# ---------------------------------------------------------------------------
+# Helper functions
+# ---------------------------------------------------------------------------
+
+prefix_class <- function(x, y) {
+  structure(x, class = unique(c(y, class(x))))
+}
+