init

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(protomapr)
+
+test_check("protomapr")

tests/testthat/test-addProtomaps.R

@@ -0,0 +1,74 @@
+test_that("protomaps_url requires API key", {
+  # Clear any existing env var
+
+  old_key <- Sys.getenv("PROTOMAPS_API_KEY")
+  Sys.unsetenv("PROTOMAPS_API_KEY")
+  on.exit(Sys.setenv(PROTOMAPS_API_KEY = old_key))
+
+  expect_error(protomaps_url(), "API key required")
+})
+
+test_that("protomaps_url accepts direct API key", {
+  url <- protomaps_url(api_key = "test-key")
+  expect_true(grepl("api.protomaps.com", url))
+  expect_true(grepl("\\{z\\}/\\{x\\}/\\{y\\}", url))
+  expect_true(grepl("key=test-key", url))
+})
+
+test_that("protomaps_url uses environment variable", {
+  old_key <- Sys.getenv("PROTOMAPS_API_KEY")
+  Sys.setenv(PROTOMAPS_API_KEY = "env-test-key")
+  on.exit(Sys.setenv(PROTOMAPS_API_KEY = old_key))
+
+  url <- protomaps_url()
+  expect_true(grepl("key=env-test-key", url))
+})
+
+test_that("set_protomaps_key sets environment variable", {
+  old_key <- Sys.getenv("PROTOMAPS_API_KEY")
+  on.exit(Sys.setenv(PROTOMAPS_API_KEY = old_key))
+
+  expect_message(set_protomaps_key("my-key"), "API key set")
+  expect_equal(Sys.getenv("PROTOMAPS_API_KEY"), "my-key")
+})
+
+test_that("protomaps_demo_url is deprecated", {
+  expect_warning(protomaps_demo_url(api_key = "test"), "deprecated")
+})
+
+test_that("protomapsOptions creates correct structure", {
+  opts <- protomapsOptions(maxDataZoom = 14, tileSize = 512)
+  expect_equal(opts$maxDataZoom, 14)
+  expect_equal(opts$tileSize, 512)
+})
+
+test_that("protomapsOptions handles debug mode", {
+  opts <- protomapsOptions(debug = TRUE)
+  expect_true(opts$debug)
+})
+
+test_that("protomapsDependency returns htmlDependency", {
+  dep <- protomapsDependency()
+  expect_s3_class(dep, "html_dependency")
+  expect_equal(dep$name, "protomaps-leaflet")
+})
+
+test_that("addProtomaps returns modified leaflet map", {
+  skip_if_not_installed("leaflet")
+
+  map <- leaflet::leaflet()
+  # Use mock URL to avoid API key requirement
+  result <- addProtomaps(map, url = "https://example.com/tiles.pmtiles")
+
+  expect_s3_class(result, "leaflet")
+})
+
+test_that("addProtomaps validates flavor argument", {
+  skip_if_not_installed("leaflet")
+
+  map <- leaflet::leaflet()
+  expect_error(
+    addProtomaps(map, url = "https://example.com/tiles.pmtiles", flavor = "invalid"),
+    "should be one of"
+  )
+})

tests/testthat/test-colors.R

@@ -0,0 +1,34 @@
+test_that("pmColors creates correct structure", {
+  colors <- pmColors(earth = "#d3d3d3", water = "#1a3a5c")
+
+  expect_equal(colors$earth, "#d3d3d3")
+  expect_equal(colors$water, "#1a3a5c")
+})
+
+test_that("pmColors expands park to park_a and park_b", {
+  colors <- pmColors(park = "#00ff00")
+
+  expect_equal(colors$park_a, "#00ff00")
+  expect_equal(colors$park_b, "#00ff00")
+})
+
+test_that("pmColors expands wood to wood_a and wood_b", {
+  colors <- pmColors(wood = "#228b22")
+
+  expect_equal(colors$wood_a, "#228b22")
+  expect_equal(colors$wood_b, "#228b22")
+})
+
+test_that("pmColors expands minor to minor_a and minor_b", {
+  colors <- pmColors(minor = "#ffffff")
+
+  expect_equal(colors$minor_a, "#ffffff")
+  expect_equal(colors$minor_b, "#ffffff")
+})
+
+test_that("pmColors passes through additional properties", {
+  colors <- pmColors(earth = "#ccc", custom_prop = "#abc")
+
+  expect_equal(colors$earth, "#ccc")
+  expect_equal(colors$custom_prop, "#abc")
+})

tests/testthat/test-palette.R

@@ -0,0 +1,71 @@
+test_that("pmPalette creates color mapping", {
+  colors <- pmPalette(c("#ff0000", "#00ff00", "#0000ff"))
+
+  expect_true("water" %in% names(colors))
+  expect_true("background" %in% names(colors))
+})
+
+test_that("pmPalette expands paired colors", {
+  colors <- pmPalette(c("#ff0000", "#00ff00"), categories = c("water", "park"))
+
+  expect_equal(colors$park_a, "#00ff00")
+  expect_equal(colors$park_b, "#00ff00")
+})
+
+test_that("pmPalette handles custom categories", {
+  colors <- pmPalette(
+    c("#111", "#222", "#333"),
+    categories = c("water", "buildings", "highway")
+  )
+
+  expect_equal(colors$water, "#111")
+  expect_equal(colors$buildings, "#222")
+  expect_equal(colors$highway, "#333")
+})
+
+test_that("pmPalette recycles colors if needed", {
+  colors <- pmPalette(c("#aaa", "#bbb"), categories = c("a", "b", "c", "d"))
+
+  expect_equal(length(colors), 6)  # 4 categories + background + earth
+})
+
+test_that("pmPalette handles palette functions", {
+  skip_if_not_installed("viridisLite")
+
+  colors <- pmPalette(viridisLite::viridis, n = 5)
+  expect_true("water" %in% names(colors))
+})
+
+test_that("pmPaletteStyle creates pm_style", {
+  style <- pmPaletteStyle(c("#1a1a2e", "#16213e", "#0f3460", "#e94560", "#533483"))
+
+  expect_s3_class(style, "pm_style")
+  expect_true(length(style$labelRules) > 0)
+})
+
+test_that("pmPaletteStyle respects labels parameter", {
+  style_with <- pmPaletteStyle(c("#000", "#fff"), labels = TRUE)
+  style_without <- pmPaletteStyle(c("#000", "#fff"), labels = FALSE)
+
+  expect_true(length(style_with$labelRules) > 0)
+  expect_equal(length(style_without$labelRules), 0)
+})
+
+test_that("pmPaletteStyle uses water_color parameter", {
+  style <- pmPaletteStyle(
+    c("#aaa", "#bbb", "#ccc"),
+    water_color = "#123456"
+  )
+
+  expect_equal(style$colors$water, "#123456")
+})
+
+test_that("pmPaletteStyle uses land_color parameter", {
+  style <- pmPaletteStyle(
+    c("#aaa", "#bbb", "#ccc"),
+    land_color = "#fedcba"
+  )
+
+  expect_equal(style$colors$background, "#fedcba")
+  expect_equal(style$colors$earth, "#fedcba")
+})

tests/testthat/test-rules.R

@@ -0,0 +1,37 @@
+test_that("pmPaintRule creates correct structure", {
+  sym <- pmPolygonSymbolizer(fill = "blue")
+  rule <- pmPaintRule("water", sym)
+
+  expect_equal(rule$dataLayer, "water")
+  expect_equal(rule$symbolizer$type, "polygon")
+})
+
+test_that("pmPaintRule handles zoom constraints", {
+  sym <- pmPolygonSymbolizer(fill = "gray")
+  rule <- pmPaintRule("buildings", sym, minzoom = 14, maxzoom = 18)
+
+  expect_equal(rule$minzoom, 14)
+  expect_equal(rule$maxzoom, 18)
+})
+
+test_that("pmPaintRule handles filters", {
+  sym <- pmLineSymbolizer(color = "orange")
+  rule <- pmPaintRule("roads", sym, filter = "feature.props.kind === 'highway'")
+
+  expect_equal(rule$filter, "feature.props.kind === 'highway'")
+})
+
+test_that("pmLabelRule creates correct structure", {
+  sym <- pmCenteredTextSymbolizer(font = "14px Arial", fill = "black")
+  rule <- pmLabelRule("places", sym)
+
+  expect_equal(rule$dataLayer, "places")
+  expect_equal(rule$symbolizer$type, "centeredText")
+})
+
+test_that("pmLabelRule handles filters", {
+  sym <- pmCenteredTextSymbolizer(font = "14px Arial", fill = "black")
+  rule <- pmLabelRule("places", sym, filter = "feature.props.kind === 'locality'")
+
+  expect_equal(rule$filter, "feature.props.kind === 'locality'")
+})

tests/testthat/test-sample-tiles.R

@@ -0,0 +1,65 @@
+test_that("protomaps_sample_tiles validates region", {
+  expect_error(
+    protomaps_sample_tiles(region = "invalid"),
+    "sf-bay"
+  )
+})
+
+test_that("protomaps_sample_tiles uses cached file", {
+  temp_dir <- tempdir()
+  temp_file <- file.path(temp_dir, "protomapr-sample-sf-bay.pmtiles")
+
+  # Create fake cached file
+  writeLines("test", temp_file)
+
+  expect_message(
+    result <- protomaps_sample_tiles(cache_dir = temp_dir),
+    "Using cached"
+  )
+  expect_equal(result, temp_file)
+
+  # Cleanup
+  unlink(temp_file)
+})
+
+test_that("protomaps_clear_cache handles missing directory", {
+  expect_message(
+    protomaps_clear_cache(cache_dir = "/nonexistent/path/12345"),
+    "does not exist"
+  )
+})
+
+test_that("protomaps_clear_cache handles empty cache", {
+  temp_dir <- tempdir()
+  cache_subdir <- file.path(temp_dir, "protomapr_test_cache")
+  dir.create(cache_subdir, showWarnings = FALSE)
+
+  expect_message(
+    protomaps_clear_cache(cache_dir = cache_subdir),
+    "No cached tiles"
+  )
+
+  unlink(cache_subdir, recursive = TRUE)
+})
+
+test_that("protomaps_clear_cache removes pmtiles files", {
+  temp_dir <- tempdir()
+  cache_subdir <- file.path(temp_dir, "protomapr_test_cache2")
+  dir.create(cache_subdir, showWarnings = FALSE)
+
+  # Create fake cached files
+  writeLines("test1", file.path(cache_subdir, "test1.pmtiles"))
+  writeLines("test2", file.path(cache_subdir, "test2.pmtiles"))
+  writeLines("keep", file.path(cache_subdir, "other.txt"))
+
+  result <- expect_message(
+    protomaps_clear_cache(cache_dir = cache_subdir),
+    "Removed 2"
+  )
+
+  # Check pmtiles removed but other file kept
+  expect_false(file.exists(file.path(cache_subdir, "test1.pmtiles")))
+  expect_true(file.exists(file.path(cache_subdir, "other.txt")))
+
+  unlink(cache_subdir, recursive = TRUE)
+})

tests/testthat/test-styles.R

@@ -0,0 +1,173 @@
+test_that("pmMinimal creates correct structure", {
+  style <- pmMinimal()
+
+  expect_s3_class(style, "pm_style")
+  expect_true("colors" %in% names(style))
+  expect_true("labelRules" %in% names(style))
+  expect_equal(length(style$labelRules), 0)
+})
+
+test_that("pmMinimal with labels creates label rules", {
+  style <- pmMinimal(labels = TRUE)
+
+  expect_equal(length(style$labelRules), 1)
+  expect_equal(style$labelRules[[1]]$dataLayer, "places")
+})
+
+test_that("pmMinimal uses custom colors", {
+  style <- pmMinimal(land = "#ffffff", water = "#000000")
+
+  expect_equal(style$colors$earth, "#ffffff")
+  expect_equal(style$colors$water, "#000000")
+  expect_equal(style$colors$background, "#ffffff")
+})
+
+test_that("pmStyle returns valid presets", {
+  minimal <- pmStyle("minimal")
+  expect_s3_class(minimal, "pm_style")
+
+  dark <- pmStyle("minimal-dark")
+  expect_s3_class(dark, "pm_style")
+  expect_equal(dark$colors$earth, "#1a1a1a")
+
+  muted <- pmStyle("muted")
+  expect_s3_class(muted, "pm_style")
+  expect_true(length(muted$labelRules) > 0)
+
+ watercolor <- pmStyle("watercolor")
+  expect_s3_class(watercolor, "pm_style")
+})
+
+test_that("pmStyle validates name argument", {
+  expect_error(pmStyle("invalid"), "should be one of")
+})
+
+test_that("pmHideFeatures hides roads", {
+  hidden <- pmHideFeatures("roads", background = "#fff")
+
+  expect_equal(hidden$highway, "#fff")
+  expect_equal(hidden$major, "#fff")
+  expect_equal(hidden$minor, "#fff")
+})
+
+test_that("pmHideFeatures hides buildings", {
+  hidden <- pmHideFeatures("buildings", background = "#eee")
+
+  expect_equal(hidden$buildings, "#eee")
+})
+
+test_that("pmHideFeatures hides multiple categories", {
+  hidden <- pmHideFeatures(c("roads", "buildings", "landuse"), background = "#ccc")
+
+  expect_equal(hidden$highway, "#ccc")
+  expect_equal(hidden$buildings, "#ccc")
+  expect_equal(hidden$park_a, "#ccc")
+})
+
+test_that("pmCityLabels creates hierarchical labels", {
+  labels <- pmCityLabels("hierarchical")
+
+  expect_true(length(labels) >= 4)  # 4 size levels + optional region
+  expect_equal(labels[[1]]$dataLayer, "places")
+})
+test_that("pmCityLabels creates major-only labels", {
+  labels <- pmCityLabels("major-only", include_regions = FALSE)
+
+  expect_equal(length(labels), 1)
+})
+
+test_that("pmCityLabels respects include_regions", {
+  with_regions <- pmCityLabels("major-only", include_regions = TRUE)
+  without_regions <- pmCityLabels("major-only", include_regions = FALSE)
+
+  expect_equal(length(with_regions), length(without_regions) + 1)
+})
+
+test_that("addProtomaps accepts style parameter", {
+  skip_if_not_installed("leaflet")
+
+  map <- leaflet::leaflet()
+  # Use a mock URL since we're just testing the R code, not actual tile loading
+  result <- addProtomaps(map, url = "https://example.com/tiles.pmtiles", style = pmStyle("minimal"))
+
+  expect_s3_class(result, "leaflet")
+})
+
+# New style presets
+test_that("pmStyle returns ink preset", {
+  ink <- pmStyle("ink")
+  expect_s3_class(ink, "pm_style")
+  expect_equal(ink$colors$background, "#ffffff")
+  expect_equal(ink$colors$highway, "#000000")
+})
+
+test_that("pmStyle returns terrain preset", {
+  terrain <- pmStyle("terrain")
+  expect_s3_class(terrain, "pm_style")
+  expect_true(length(terrain$labelRules) >= 1)
+})
+
+test_that("pmStyle returns transit preset", {
+  transit <- pmStyle("transit")
+  expect_s3_class(transit, "pm_style")
+  expect_equal(transit$colors$railway, "#e63946")
+})
+
+# print.pm_style
+test_that("print.pm_style outputs formatted text", {
+  style <- pmMinimal(land = "#ffffff", water = "#000000", labels = TRUE)
+
+  output <- capture.output(print(style))
+  expect_true(any(grepl("<pm_style>", output)))
+  expect_true(any(grepl("Colors:", output)))
+  expect_true(any(grepl("Label Rules:", output)))
+})
+
+test_that("print.pm_style handles style with no labels", {
+  style <- pmMinimal()
+
+  output <- capture.output(print(style))
+  expect_true(any(grepl("Label Rules: none", output)))
+})
+
+test_that("print.pm_style summarizes uniform colors", {
+  style <- pmMinimal()
+
+  output <- capture.output(print(style))
+  expect_true(any(grepl("uniform", output)))
+})
+
+# pmModifyStyle
+test_that("pmModifyStyle preserves class", {
+  modified <- pmModifyStyle(pmMinimal(), water = "#000000")
+  expect_s3_class(modified, "pm_style")
+})
+
+test_that("pmModifyStyle merges colors", {
+  original <- pmMinimal(land = "#ffffff", water = "#aaaaaa")
+  modified <- pmModifyStyle(original, water = "#000000")
+
+  expect_equal(modified$colors$water, "#000000")
+  expect_equal(modified$colors$earth, "#ffffff")
+})
+
+test_that("pmModifyStyle appends label rules by default", {
+  original <- pmMinimal(labels = TRUE)
+  new_rules <- list(pmLabelRule("water", pmCenteredTextSymbolizer()))
+
+  modified <- pmModifyStyle(original, labelRules = new_rules)
+  expect_equal(length(modified$labelRules), 2)
+})
+
+test_that("pmModifyStyle replaces labels when requested", {
+  original <- pmMinimal(labels = TRUE)
+  new_rules <- list(pmLabelRule("water", pmCenteredTextSymbolizer()))
+
+  modified <- pmModifyStyle(original, labelRules = new_rules, replace_labels = TRUE)
+  expect_equal(length(modified$labelRules), 1)
+  expect_equal(modified$labelRules[[1]]$dataLayer, "water")
+})
+
+test_that("pmModifyStyle requires pm_style input", {
+  expect_error(pmModifyStyle(list()), "must be a pm_style")
+})

tests/testthat/test-symbolizers.R

@@ -0,0 +1,56 @@
+test_that("pmPolygonSymbolizer creates correct structure", {
+  sym <- pmPolygonSymbolizer(fill = "blue")
+  expect_equal(sym$type, "polygon")
+  expect_equal(sym$options$fill, "blue")
+})
+
+test_that("pmPolygonSymbolizer handles optional parameters", {
+  sym <- pmPolygonSymbolizer(fill = "red", stroke = "black", width = 2, opacity = 0.5)
+  expect_equal(sym$options$fill, "red")
+  expect_equal(sym$options$stroke, "black")
+  expect_equal(sym$options$width, 2)
+  expect_equal(sym$options$opacity, 0.5)
+})
+
+test_that("pmLineSymbolizer creates correct structure", {
+  sym <- pmLineSymbolizer(color = "gray", width = 3)
+  expect_equal(sym$type, "line")
+  expect_equal(sym$options$color, "gray")
+  expect_equal(sym$options$width, 3)
+})
+
+test_that("pmLineSymbolizer handles dash patterns", {
+  sym <- pmLineSymbolizer(color = "black", dash = c(4, 2))
+  expect_equal(sym$options$dash, c(4, 2))
+})
+
+test_that("pmCircleSymbolizer creates correct structure", {
+  sym <- pmCircleSymbolizer(radius = 8, fill = "red")
+  expect_equal(sym$type, "circle")
+  expect_equal(sym$options$radius, 8)
+  expect_equal(sym$options$fill, "red")
+})
+
+test_that("pmCenteredTextSymbolizer creates correct structure", {
+  sym <- pmCenteredTextSymbolizer(font = "14px Arial", fill = "black")
+  expect_equal(sym$type, "centeredText")
+  expect_equal(sym$options$font, "14px Arial")
+  expect_equal(sym$options$fill, "black")
+})
+
+test_that("pmCenteredTextSymbolizer handles lineHeight", {
+  sym <- pmCenteredTextSymbolizer(font = "12px sans-serif", lineHeight = 1.5)
+  expect_equal(sym$options$lineHeight, 1.5)
+})
+
+test_that("pmLineLabelSymbolizer creates correct structure", {
+  sym <- pmLineLabelSymbolizer(font = "11px Arial", fill = "#333")
+  expect_equal(sym$type, "lineLabel")
+  expect_equal(sym$options$font, "11px Arial")
+})
+
+test_that("pmShieldSymbolizer creates correct structure", {
+  sym <- pmShieldSymbolizer(font = "10px Arial", background = "yellow")
+  expect_equal(sym$type, "shield")
+  expect_equal(sym$options$background, "yellow")
+})