From 53dd647420ed3e9a357b36b420486d78f6a3f38a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kirill=20M=C3=BCller?= <krlmlr@users.noreply.github.com>
Date: Tue, 21 Feb 2023 14:53:17 +0100
Subject: [PATCH] Proper display of control characters (#589)

---
 DESCRIPTION                              |  3 ++-
 R/labelled-pillar.R                      |  8 +++---
 tests/testthat/_snaps/labelled-pillar.md | 32 ++++++++++++++++++++++++
 tests/testthat/test-labelled-pillar.R    | 31 +++++++++++++++++++++++
 4 files changed, 70 insertions(+), 4 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index a9cf2d73..0aa4d4d2 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -34,7 +34,8 @@ Suggests:
     knitr,
     pillar (>= 1.4.0),
     rmarkdown,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    utf8
 LinkingTo: 
     cpp11
 VignetteBuilder: 
diff --git a/R/labelled-pillar.R b/R/labelled-pillar.R
index ec923e99..a13999aa 100644
--- a/R/labelled-pillar.R
+++ b/R/labelled-pillar.R
@@ -101,7 +101,8 @@ lbl_pillar_info <- function(x) {
   MIN_LBL_DISPLAY <- 6
   labels <- attr(x, "labels")
   if (length(labels) > 0) {
-    names(labels) <- pillar::style_subtle(paste0(" [", names(labels), "]"))
+    encoded <- utf8::utf8_encode(names(labels))
+    names(labels) <- pillar::style_subtle(paste0(" [", encoded, "]"))
     attr(x, "labels") <- labels
     label_display <- as.character(as_factor(x, "labels"))
     label_display[is.na(label_display)] <- ""
@@ -203,6 +204,7 @@ paste_with_align <- function(x, y, lhs_ws, rhs_ws) {
 }
 
 pillar_print_pkgs_available <- function() {
-  requireNamespace("crayon", quietly = TRUE) &
-    requireNamespace("cli", quietly = TRUE)
+  requireNamespace("crayon", quietly = TRUE) &&
+    requireNamespace("cli", quietly = TRUE) &&
+    requireNamespace("utf8", quietly = TRUE)
 }
diff --git a/tests/testthat/_snaps/labelled-pillar.md b/tests/testthat/_snaps/labelled-pillar.md
index a3e35142..be1279fb 100644
--- a/tests/testthat/_snaps/labelled-pillar.md
+++ b/tests/testthat/_snaps/labelled-pillar.md
@@ -123,3 +123,35 @@
       10 10 (NA) [Refused]
       11 NA               
 
+---
+
+    Code
+      x <- labelled(c("spaces", "tabs", "newlines", "c0", "quote", "backslash"), c(
+        `a b` = "spaces", `a\tb` = "tabs", `a\nb` = "newlines", `a\001b` = "c0",
+        `a"b` = "quote", `a\\b` = "backslash"))
+      tibble::tibble(x)
+    Output
+      # A tibble: 6 x 1
+        x               
+        <chr+lbl>       
+      1 spaces [a b]    
+      2 tabs [a\tb]     
+      3 newlines [a\nb] 
+      4 c0 [a\u0001b]   
+      5 quote [a"b]     
+      6 backslash [a\\b]
+
+---
+
+    Code
+      x <- "c1"
+      label <- x
+      names(label) <- "a\u0080b"
+      x <- labelled(x, label)
+      tibble::tibble(x)
+    Output
+      # A tibble: 1 x 1
+        x            
+        <chr+lbl>    
+      1 c1 [a\u0080b]
+
diff --git a/tests/testthat/test-labelled-pillar.R b/tests/testthat/test-labelled-pillar.R
index 3c798e29..09815ffb 100644
--- a/tests/testthat/test-labelled-pillar.R
+++ b/tests/testthat/test-labelled-pillar.R
@@ -46,4 +46,35 @@ test_that("pillar", {
     )
     tibble::tibble(x)
   })
+
+  expect_snapshot({
+    x <- labelled(
+      c(
+        "spaces",
+        "tabs",
+        "newlines",
+        "c0",
+        "quote",
+        "backslash"
+      ),
+      c(
+        "a b" = "spaces",
+        "a\tb" = "tabs",
+        "a\nb" = "newlines",
+        "a\u0001b" = "c0",
+        'a"b' = "quote",
+        "a\\b" = "backslash"
+      )
+    )
+    tibble::tibble(x)
+  })
+
+  skip_on_os("windows")
+  expect_snapshot({
+    x <- "c1"
+    label <- x
+    names(label) <- "a\u0080b"
+    x <- labelled(x, label)
+    tibble::tibble(x)
+  })
 })