From 1cb4a4a733c3be6b718df05e1c26d32f1f081ae8 Mon Sep 17 00:00:00 2001
From: chainsawriot <chainsawtiney@gmail.com>
Date: Fri, 15 Mar 2024 18:32:02 +0100
Subject: [PATCH] Fix #17 and fix #4

---
 DESCRIPTION        |   5 +-
 NAMESPACE          |   8 ----
 R/parser.R         | 115 +++++----------------------------------------
 R/type_convert.R   |  14 +-----
 README.Rmd         |   3 +-
 README.md          |  23 ++-------
 man/parse_guess.Rd |  22 +--------
 7 files changed, 23 insertions(+), 167 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 83c8890..1665dfa 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -22,7 +22,6 @@ Language: en-US
 Roxygen: list(markdown = TRUE, r6 = FALSE)
 RoxygenNote: 7.3.1
 Imports: 
-    cli,
     rlang,
     tzdb
 Suggests: 
@@ -30,4 +29,6 @@ Suggests:
     stringi,
     testthat,
     withr,
-    hms
+    hms,
+    readr
+
diff --git a/NAMESPACE b/NAMESPACE
index 09eb0a9..439c817 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,18 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(as.character,col_spec)
 S3method(as.col_spec,"NULL")
 S3method(as.col_spec,character)
 S3method(as.col_spec,col_spec)
 S3method(as.col_spec,data.frame)
 S3method(as.col_spec,default)
 S3method(as.col_spec,list)
-S3method(format,col_spec)
-S3method(print,col_spec)
-S3method(print,collector)
-S3method(print,date_names)
-S3method(print,locale)
-S3method(str,col_spec)
 S3method(type_to_col,Date)
 S3method(type_to_col,POSIXct)
 S3method(type_to_col,default)
@@ -39,7 +32,6 @@ export(date_names)
 export(date_names_lang)
 export(date_names_langs)
 export(default_locale)
-export(guess_parser)
 export(locale)
 export(parse_character)
 export(parse_date)
diff --git a/R/parser.R b/R/parser.R
index 19ea4e1..522f676 100644
--- a/R/parser.R
+++ b/R/parser.R
@@ -13,11 +13,6 @@ collector <- function(type, ...) {
 
 is.collector <- function(x) inherits(x, "collector")
 
-#' @export
-print.collector <- function(x, ...) {
-  cat("<", class(x)[1], ">\n", sep = "")
-}
-
 collector_find <- function(name) {
   if (is.na(name)) {
     return(col_character())
@@ -186,13 +181,14 @@ col_number <- function() {
 
 #' Parse using the "best" type
 #'
-#' `parse_guess()` returns the parser vector; `guess_parser()`
-#' returns the name of the parser. These functions use a number of heuristics
+#' `parse_guess()` returns the parser vector. This function uses a number of heuristics
 #' to determine which type of vector is "best". Generally they try to err of
 #' the side of safety, as it's straightforward to override the parsing choice
 #' if needed.
 #'
 #' @inheritParams parse_atomic
+#' @param guess_integer If `TRUE`, guess integer types for whole numbers, if
+#'   `FALSE` guess numeric type for all numbers.
 #' @family parsers
 #' @export
 #' @examples
@@ -204,11 +200,9 @@ col_number <- function() {
 #' parse_guess(c("1.6", "2.6", "3.4"))
 #'
 #' # Numbers containing grouping mark
-#' guess_parser("1,234,566")
 #' parse_guess("1,234,566")
 #'
 #' # ISO 8601 date times
-#' guess_parser(c("2010-10-10"))
 #' parse_guess(c("2010-10-10"))
 parse_guess <- function(x, na = c("", "NA"), locale = default_locale(), trim_ws = TRUE, guess_integer = FALSE, .return_problems = FALSE) {
     parse_vector(x, guess_parser(x, locale, guess_integer = guess_integer, na = na), na = na, locale = locale, trim_ws = trim_ws,
@@ -221,10 +215,6 @@ col_guess <- function() {
   collector("guess")
 }
 
-#' @rdname parse_guess
-#' @param guess_integer If `TRUE`, guess integer types for whole numbers, if
-#'   `FALSE` guess numeric type for all numbers.
-#' @export
 guess_parser <- function(x, locale = default_locale(), guess_integer = FALSE, na = c("", "NA")) {
   x[x %in% na] <- NA_character_
 
@@ -534,19 +524,6 @@ locale <- function(date_names = "en",
 
 is.locale <- function(x) inherits(x, "locale")
 
-#' @export
-print.locale <- function(x, ...) {
-  cat("<locale>\n")
-  cat("Numbers:  ", prettyNum(123456.78,
-    big.mark = x$grouping_mark,
-    decimal.mark = x$decimal_mark, digits = 8
-  ), "\n", sep = "")
-  cat("Formats:  ", x$date_format, " / ", x$time_format, "\n", sep = "")
-  cat("Timezone: ", x$tz, "\n", sep = "")
-  cat("Encoding: ", x$encoding, "\n", sep = "")
-  print(x$date_names)
-}
-
 #' @export
 #' @rdname locale
 default_locale <- function() {
@@ -645,28 +622,6 @@ date_names_langs <- function() {
   names(date_symbols)
 }
 
-#' @export
-print.date_names <- function(x, ...) {
-  cat("<date_names>\n")
-
-  if (identical(x$day, x$day_ab)) {
-    day <- paste0(x$day, collapse = ", ")
-  } else {
-    day <- paste0(x$day, " (", x$day_ab, ")", collapse = ", ")
-  }
-
-  if (identical(x$mon, x$mon_ab)) {
-    mon <- paste0(x$mon, collapse = ", ")
-  } else {
-    mon <- paste0(x$mon, " (", x$mon_ab, ")", collapse = ", ")
-  }
-  am_pm <- paste0(x$am_pm, collapse = "/")
-
-  cat_wrap("Days:   ", day)
-  cat_wrap("Months: ", mon)
-  cat_wrap("AM/PM:  ", am_pm)
-}
-
 is.date_names <- function(x) inherits(x, "date_names")
 
 cat_wrap <- function(header, body) {
@@ -877,21 +832,6 @@ col_to_short <- function(x, ...) {
   )
 }
 
-#' @export
-as.character.col_spec <- function(x, ...) {
-  paste0(
-    collapse = "",
-    vapply(x$cols, col_to_short, character(1))
-  )
-}
-
-#' @export
-print.col_spec <- function(x, n = Inf, condense = NULL, ...) {
-  cat(format.col_spec(x, n = n, condense = condense, ...))
-
-  invisible(x)
-}
-
 cols_condense <- function(x) {
   types <- vapply(x$cols, function(xx) class(xx)[[1]], character(1))
   counts <- table(types)
@@ -902,8 +842,8 @@ cols_condense <- function(x) {
   x
 }
 
-#' @export
-format.col_spec <- function(x, n = Inf, condense = NULL, ...) {
+## Change from S3
+format_col_spec <- function(x, n = Inf, condense = NULL, ...) {
   if (n == 0) {
     return("")
   }
@@ -971,32 +911,13 @@ format.col_spec <- function(x, n = Inf, condense = NULL, ...) {
 
 # Used in read_delim(), read_fwf() and type_convert()
 show_cols_spec <- function(spec, n = getOption("readr.num_columns", 20)) {
-  if (n > 0) {
-    cli_block(class = "readr_spec_message", {
-      cli::cli_h1("Column specification")
-      txt <- strsplit(format(spec, n = n, condense = NULL), "\n")[[1]]
-      cli::cli_verbatim(txt)
-      if (length(spec$cols) >= n) {
-        cli::cli_alert_info("Use {.fn spec} for the full column specifications.")
-      }
-    })
-  }
-}
-
-# This allows str() on a tibble object to print a little nicer.
-#' @export
-str.col_spec <- function(object, ..., indent.str = "") {
-
-  # Split the formatted column spec into strings
-  specs <- strsplit(format(object), "\n")[[1]]
-  cat(
-    sep = "",
-    "\n",
-
-    # Append the current indentation string to the specs
-    paste(indent.str, specs, collapse = "\n"),
-    "\n"
-  )
+    if (n > 0) {
+        message("Column specification: ")
+        message(strsplit(format_col_spec(spec, n = n, condense = NULL), "\n")[[1]])
+        if (length(spec$cols) >= n) {
+            message("Only the first ", n, " columns are printed.", "\n")
+      }        
+    }
 }
 
 col_concise <- function(x) {
@@ -1222,18 +1143,6 @@ check_string <- function(x, nm = deparse(substitute(x)), optional = FALSE) {
   stop("`", nm, "` must be a string.", call. = FALSE)
 }
 
-cli_block <- function(expr, class = NULL, type = rlang::inform) {
-  msg <- ""
-  withCallingHandlers(
-    expr,
-    message = function(x) {
-      msg <<- paste0(msg, x$message)
-      invokeRestart("muffleMessage")
-    }
-  )
-  type(msg, class = class)
-}
-
 `%||%` <- function(a, b) if (is.null(a)) b else a
 
 deparse2 <- function(expr, ..., sep = "\n") {
diff --git a/R/type_convert.R b/R/type_convert.R
index 469e977..533fcba 100644
--- a/R/type_convert.R
+++ b/R/type_convert.R
@@ -11,7 +11,7 @@
 #'
 #'   If `NULL`, column types will be imputed using all rows.
 #' @param verbose whether to print messages
-#' @inheritParams guess_parser
+#' @inheritParams parse_guess
 #' @note `type_convert()` removes a 'spec' attribute,
 #' because it likely modifies the column data types.
 #' (see [spec()] for more information about column specifications).
@@ -100,15 +100,3 @@ keep_character_col_types <- function(df, col_types) {
 
   col_types
 }
-
-#' @rdname parse_guess
-#' @param guess_integer If `TRUE`, guess integer types for whole numbers, if
-#'   `FALSE` guess numeric type for all numbers.
-#' @export
-guess_parser <- function(x, locale = default_locale(), guess_integer = FALSE, na = c("", "NA")) {
-  x[x %in% na] <- NA_character_
-
-  stopifnot(is.locale(locale))
-
-  collectorGuess(x, locale, guessInteger = guess_integer)
-}
diff --git a/README.Rmd b/README.Rmd
index 66b1ba8..bd20d04 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -122,7 +122,7 @@ data <- readr::type_convert(text_only)
 data
 ```
 
-`verbose` option is added if you like those messages, default to `FALSE`.
+`verbose` option is added if you like those messages, default to `FALSE`. To keep this package as minimal as possible, these optional messages are printed with base R (not `cli`).
 
 ```{r}
 data <- minty::type_convert(text_only, verbose = TRUE)
@@ -145,4 +145,3 @@ For parsing ambiguous date(time)
 * [timeless](https://github.com/schochastics/timeless)
 * [anytime](https://github.com/eddelbuettel/anytime)
 
-
diff --git a/README.md b/README.md
index 841ea9a..675729e 100644
--- a/README.md
+++ b/README.md
@@ -158,15 +158,6 @@ data
 
 ``` r
 data <- readr::type_convert(text_only)
-#> Registered S3 methods overwritten by 'readr':
-#>   method                from 
-#>   as.character.col_spec minty
-#>   format.col_spec       minty
-#>   print.col_spec        minty
-#>   print.collector       minty
-#>   print.date_names      minty
-#>   print.locale          minty
-#>   str.col_spec          minty
 #> 
 #> ── Column specification ────────────────────────────────────────────────────────
 #> cols(
@@ -184,19 +175,13 @@ data
 ```
 
 `verbose` option is added if you like those messages, default to
-`FALSE`.
+`FALSE`. To keep this package as minimal as possible, these optional
+messages are printed with base R (not `cli`).
 
 ``` r
 data <- minty::type_convert(text_only, verbose = TRUE)
-#> 
-#> ── Column specification ────────────────────────────────────────────────────────
-#> cols(
-#>   maybe_age = col_character(),
-#>   maybe_male = col_logical(),
-#>   maybe_name = col_character(),
-#>   some_na = col_character(),
-#>   dob = col_date(format = "")
-#> )
+#> Column specification:
+#> cols(  maybe_age = col_character(),  maybe_male = col_logical(),  maybe_name = col_character(),  some_na = col_character(),  dob = col_date(format = ""))
 ```
 
 At the moment, `minty` does not use [the `problems`
diff --git a/man/parse_guess.Rd b/man/parse_guess.Rd
index 58cac9a..396e31e 100644
--- a/man/parse_guess.Rd
+++ b/man/parse_guess.Rd
@@ -1,9 +1,8 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/parser.R, R/type_convert.R
+% Please edit documentation in R/parser.R
 \name{parse_guess}
 \alias{parse_guess}
 \alias{col_guess}
-\alias{guess_parser}
 \title{Parse using the "best" type}
 \usage{
 parse_guess(
@@ -16,20 +15,6 @@ parse_guess(
 )
 
 col_guess()
-
-guess_parser(
-  x,
-  locale = default_locale(),
-  guess_integer = FALSE,
-  na = c("", "NA")
-)
-
-guess_parser(
-  x,
-  locale = default_locale(),
-  guess_integer = FALSE,
-  na = c("", "NA")
-)
 }
 \arguments{
 \item{x}{Character vector of values to parse.}
@@ -52,8 +37,7 @@ each field before parsing it?}
 \item{.return_problems}{Whether to hide the \code{problems} tibble from the output}
 }
 \description{
-\code{parse_guess()} returns the parser vector; \code{guess_parser()}
-returns the name of the parser. These functions use a number of heuristics
+\code{parse_guess()} returns the parser vector. This function uses a number of heuristics
 to determine which type of vector is "best". Generally they try to err of
 the side of safety, as it's straightforward to override the parsing choice
 if needed.
@@ -67,11 +51,9 @@ parse_guess(c("1", "2", "3"))
 parse_guess(c("1.6", "2.6", "3.4"))
 
 # Numbers containing grouping mark
-guess_parser("1,234,566")
 parse_guess("1,234,566")
 
 # ISO 8601 date times
-guess_parser(c("2010-10-10"))
 parse_guess(c("2010-10-10"))
 }
 \seealso{