Extract map option types

eoda-dev · Oct 4, 2024 · be2251a · be2251a
1 parent 8343dad
commit be2251a
Show file tree

Hide file tree

Showing 4 changed files with 56 additions and 33 deletions.
diff --git a/R/maplibre.R b/R/maplibre.R
@@ -90,34 +90,7 @@ mapOptions <- function(style = basemaps$carto$dark_matter,
                        scroll_zoom = NULL,
                        zoom = NULL,
                        ...) {
-
-  types <- list(
-    style = function(x) {is.list(x) | is.character(x)},
-    antialias = is.logical,
-    attributionControl = is.logical,
-    bearing = function(x) {is.integer(x) | is.numeric(x)},
-    bearingSnap = is.integer,
-    bounds = is.list,
-    boxZoom = is.logical,
-    center = is.list,
-    clickTolerance = function(x) {is.integer(x) | x==round(x,0)},
-    customAttribution = is.logical,
-    doubleClickZoom = is.logical,
-    fadeDuration = function(x) {is.integer(x) | x==round(x,0)},
-    fitBoundsOptions = is.list,
-    hash = is.logical,
-    interactive = is.logical,
-    keyword = is.logical,
-    maxBounds = is.list,
-    maxPitch = function(x) {is.integer(x) | x==round(x,0)},
-    maxZoom = function(x) {is.integer(x) | x==round(x,0)},
-    minPitch = function(x) {is.integer(x) | x==round(x,0)},
-    minZoom = function(x) {is.integer(x) | x==round(x,0)},
-    pitch = function(x) {is.integer(x) | x==round(x,0)},
-    scrollZoom = is.logical,
-    zoom = function(x) {is.integer(x) | is.numeric(x)}
-
-  )
+  # BODY
   purrr::compact(
     rdantic(
       list(
@@ -144,8 +117,11 @@ mapOptions <- function(style = basemaps$carto$dark_matter,
         pitch = pitch,
         scrollZoom = scroll_zoom,
         style = style,
-        zoom = zoom), types),
-    ...)
+        zoom = zoom
+      ), TYPES_MAP_OPTIONS
+    ),
+    ...
+  )
 }
 
 

diff --git a/R/marker.R b/R/marker.R
@@ -30,7 +30,7 @@ Marker <- function(lngLat, popup = NULL, ...) {
 #'
 #' @example examples/markers.R
 MarkerOptions <- function(anchor = NULL, color = NULL, pitchAlignment = NULL, rotationAlignment = NULL,
-                          draggable = NULL, rotation = NULL, scale = NULL,...){
+                          draggable = NULL, rotation = NULL, scale = NULL, ...) {
   marker_options <- list(...)
   stopifnot(sapply(marker_options[c("anchor", "color", "pitchAlignment", "rotationAlignment")], function(x) {
     is.null(x) | is.character(x)

diff --git a/R/types.R b/R/types.R
@@ -14,3 +14,50 @@ TYPES_LAYER <- list(
   paint = is.list,
   layout = is.list
 )
+
+TYPES_MAP_OPTIONS <- list(
+  style = function(x) {
+    is.list(x) | is.character(x)
+  },
+  antialias = is.logical,
+  attributionControl = is.logical,
+  bearing = function(x) {
+    is.integer(x) | is.numeric(x)
+  },
+  bearingSnap = is.integer,
+  bounds = is.list,
+  boxZoom = is.logical,
+  center = is.list,
+  clickTolerance = function(x) {
+    is.integer(x) | x == round(x, 0)
+  },
+  customAttribution = is.logical,
+  doubleClickZoom = is.logical,
+  fadeDuration = function(x) {
+    is.integer(x) | x == round(x, 0)
+  },
+  fitBoundsOptions = is.list,
+  hash = is.logical,
+  interactive = is.logical,
+  keyword = is.logical,
+  maxBounds = is.list,
+  maxPitch = function(x) {
+    is.integer(x) | x == round(x, 0)
+  },
+  maxZoom = function(x) {
+    is.integer(x) | x == round(x, 0)
+  },
+  minPitch = function(x) {
+    is.integer(x) | x == round(x, 0)
+  },
+  minZoom = function(x) {
+    is.integer(x) | x == round(x, 0)
+  },
+  pitch = function(x) {
+    is.integer(x) | x == round(x, 0)
+  },
+  scrollZoom = is.logical,
+  zoom = function(x) {
+    is.integer(x) | is.numeric(x)
+  }
+)
diff --git a/R/utils.R b/R/utils.R
@@ -7,9 +7,9 @@ rdantic <- function(.obj, types, test = 1L) {
   for (k in names(.obj)) {
     type_check <- types[[k]]
     value <- .obj[[k]]
-    if(!is.null(value)){
+    if (!is.null(value)) {
       if (!type_check(value)) {
-        stop(value, " is not ", deparse(substitute(type_check)) , call.=FALSE)
+        stop(value, " is not ", deparse(substitute(type_check)), call. = FALSE)
       }
     }
   }