U:E [tJp2,Rt!R$|]GrĢS>
J1c`g!9'.VD7@l}d@6ltJq-%m sw
m
Mk h
5^=X< /PHgb}>r˾i cљ$uXYI%8xn-!ywʰP+Pq '`QiR/` PT]ahрn~Bp'F"ۇ #0 w}KA ѱ
j`EwkQ!K` YA;c^ ^}xxAwtbcuL ̌h
\clDg@>_p :,.Ҽ rp8:F`/Z XX
{6dGQKPXBg@7VO>:S8IhG ]ԁR;uGHaq<0kK=C{(+ A=; tnzߒ W 뱄=rLV-%UI ЪmHUQj| l8oO6kOˀ,@=64#C kZ݂ը!T ہUCrh3P'Eª$ µ
ŠBT,Pp?pBՁm(;$xGs.~6:UK8J@ɞ~|v=d
x: x~8f4G)&QyP9 ,P~o-J 7lgI{0v* h1/2 ;y =F+*P/Z V{:Ttm>ǡ8TXA *K8`%-1uo(>VXwL e[ʻ}=/l6#p0 !pzQaUEzy.Ӆ ۖ:LaW` 0Z`A֫@*ٻHvۖBRG| N!zQ4E(M[*h+ 0\ͯC *m%C>~bp+ WlT6""C>`3GX|q89H[oh-u VWچzOX[H(2f`BTZxHX
ԧRÀ$^oY
J3GRdK
%tEXtdate:create 2018-11-21T09:42:09-07:00D %tEXtdate:modify 2018-11-21T10:17:04-07:00{*C tEXtSoftware www.inkscape.org< IENDB` pkgcond/man/not-in.Rd 0000644 0001762 0000144 00000001133 14042034363 014142 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/infix.R
\name{not-in}
\alias{not-in}
\alias{\%!in\%}
\title{Not in infix operator}
\usage{
x \%!in\% table
}
\arguments{
\item{x}{vector or \code{NULL}: the values to be matched.
\link[base]{Long vectors} are supported.}
\item{table}{vector or \code{NULL}: the values to be matched against.
\link[base]{Long vectors} are not supported.}
}
\description{
The same as \code{\link{\%in\%}} but negated.
}
\examples{
'A' \%!in\% letters #TRUE letters are lower case.
'A' \%!in\% LETTERS #FALSE LETTERS are upper case.
}
pkgcond/man/assert_that.Rd 0000644 0001762 0000144 00000002053 14042034363 015261 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/assert_that.R
\name{assert_that}
\alias{assert_that}
\title{Scoped Assertions}
\usage{
assert_that(
...,
env = parent.frame(),
msg = NULL,
scope = find_scope(env),
type = "assertion failure"
)
}
\arguments{
\item{...}{unnamed expressions that describe the conditions to be tested.
Rather than combining expressions with \code{&&}, separate them by commas
so that better error messages can be generated.}
\item{env}{(advanced use only) the environment in which to evaluate the
assertions.}
\item{msg}{a custom error message to be printed if one of the conditions is
false.}
\item{scope}{The scope of the error.}
\item{type}{The error type.}
}
\description{
The pkgcond package intentionally overrides the \code{\link[assertthat:assert_that]{assertthat::assert_that()}}
function. It provides the same utility but enhances the original version
by throwing scoped and typed errors. The type is 'assertion failure' and
the scope can be set or inferred from the calling frame.
}
pkgcond/man/find_scope.Rd 0000644 0001762 0000144 00000001236 13401252034 015046 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/find_scope.R
\name{find_scope}
\alias{find_scope}
\title{Find the default scope of a call.}
\usage{
find_scope(frame = NULL, global = FALSE)
}
\arguments{
\item{frame}{The frame to infer scope from.}
\item{global}{Should the global frame be listed in the scope.}
}
\description{
This find the scope of the call.
It includes the package of the call,
the class if called from a method,
and the name of the function called.
}
\examples{
my_function <- function(){
scope <- find_scope()
"You are in" \%<<\% collapse(scope, '::')
}
my_function()
my_sights <- my_function
my_sights()
}
pkgcond/man/comma_list.Rd 0000644 0001762 0000144 00000001544 14042034363 015073 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/comma_list.R
\name{comma_list}
\alias{comma_list}
\title{Construct a comma separated list}
\usage{
comma_list(x, sep = ", ", sep2 = " and ", sep.last = ", and ", terminator = "")
}
\arguments{
\item{x}{a list that can be converted into a character.}
\item{sep}{the typical separator}
\item{sep2}{the separator to use in the case of only two elements.}
\item{sep.last}{the separator to use between the last and next to last elements when
there are at least 3 element in the list.}
\item{terminator}{concatenated to the end after the list is concluded.}
}
\description{
Use this utility to create nicely formatted lists for error messages and the like.
}
\examples{
comma_list(c("you", "I"))
comma_list(c("you", "I"), sep2=" & ")
comma_list(head(letters), sep.last=', ', term=', ...')
}
pkgcond/man/dot-underscore.Rd 0000644 0001762 0000144 00000001467 14042034363 015705 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/translate.R
\name{dot-underscore}
\alias{dot-underscore}
\alias{._}
\title{Format and Translate Strings}
\usage{
._(msg, ..., domain = NULL)
}
\arguments{
\item{msg}{The message to translate.}
\item{...}{
Arguments passed on to \code{\link[base:sprintf]{base::gettextf}}
\describe{
\item{\code{fmt}}{a character vector of format strings, each of up to 8192 bytes.}
}}
\item{domain}{see \code{\link[base:gettext]{base::gettext()}}}
}
\description{
This shortcut provides simple translation and formatting functionality.
Essentially it is a wrapper for \code{\link[base:gettext]{base::gettext()}} and \code{\link[base:sprintf]{base::gettextf()}}.
}
\examples{
loki <- list()
class(loki) <- "puny god"
._("I am a \%s.", class(loki))
}
pkgcond/DESCRIPTION 0000644 0001762 0000144 00000001745 14042171336 013415 0 ustar ligges users Package: pkgcond
Type: Package
Title: Classed Error and Warning Conditions
Version: 0.1.1
Authors@R: c(
person("Andrew", "Redd", email="Andrew.Redd@hsc.utah.edu", role=c("aut", "cre")),
person("R Documentation Task Force", role=c("aut"))
)
Maintainer: Andrew Redd
Description: This provides utilities for creating classed error and warning
conditions based on where the error originated.
License: GPL-2
Encoding: UTF-8
Depends: R(>= 3.5.0)
Imports: assertthat, methods
Suggests: covr, testthat
RoxygenNote: 7.1.1
Language: en-US
Collate: 'assert_that.R' 'conditions.R' 'comma_list.R' 'find_scope.R'
'infix.R' 'skip_scope.R' 'suppress.R' 'translate.R'
URL: https://github.com/RDocTaskForce/pkgcond
BugReports: https://github.com/RDocTaskForce/pkgcond/issues
NeedsCompilation: no
Packaged: 2021-04-27 22:08:14 UTC; u0092104
Author: Andrew Redd [aut, cre],
R Documentation Task Force [aut]
Repository: CRAN
Date/Publication: 2021-04-28 05:30:06 UTC
pkgcond/tests/ 0000755 0001762 0000144 00000000000 13370107773 013051 5 ustar ligges users pkgcond/tests/testthat/ 0000755 0001762 0000144 00000000000 14042171336 014702 5 ustar ligges users pkgcond/tests/testthat/test-assert_that.R 0000644 0001762 0000144 00000001455 13377057443 020344 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `assert_that.R`')
#line 33 "R/assert_that.R"
test_that('.test_assert_that', {#@testing
expect_true(assert_that(1==1))
error <-
tryCatch(.test_assert_that(1==2)
, condition = function(e)e )
expect_is(error, 'condition')
expect_is(error, 'pkgcond-condition')
expect_is(error, 'error')
expect_is(error, 'pkgcond-error')
expect_is(error, 'error-assertion failure')
expect_is(error, 'pkgcond-error-assertion failure')
expect_is(error, 'pkgcond::.test_assert_that-error-assertion failure')
expect_is(error, 'pkgcond::.test_assert_that-error')
expect_is(error, 'pkgcond::.test_assert_that-condition')
})
pkgcond/tests/testthat/test-infix.R 0000644 0001762 0000144 00000003112 13401251614 017110 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `infix.R`')
#line 43 "R/infix.R"
test_that('%<<%', {#! @testing %<<%
a <- 'A vain chalks above the integrated biscuit. '
b <- 'Within the ground burns the leader.'
c <- 'How can the fifteen distress lose?'
expect_equal(a %<<% b, paste(a,b))
expect_equal(a %<<% b %<<% c, paste(a,b,c))
expect_equal(a %<<% NULL, a)
expect_equal(NULL %<<% a, a)
expect_equal(NULL %<<% NULL, "")
})
#line 57 "R/infix.R"
test_that('%<<<%', {#! @testing %<<<%
a <- 'A vain chalks above the integrated biscuit. '
b <- ' Within the ground burns the leader.'
c <- 'How can the fifteen distress lose?'
expect_equal(a %<<<% b, paste0(a,b))
expect_equal(a %<<<% b %<<<% c, paste0(a,b, c, sep=''))
expect_equal(a %<<<% NULL, a)
expect_equal(NULL %<<<% a, a)
expect_equal(NULL %<<<% NULL, '')
})
#line 70 "R/infix.R"
test_that('newline-concatenation', {#! @testing newline-concatenation
a <- 'A vain chalks above the integrated biscuit. '
b <- ' Within the ground burns the leader.'
c <- 'How can the fifteen distress lose?'
expect_equal(a %\% b, paste(a,b, sep='\n'))
expect_equal(a %\% b %\% c, paste(a,b, c, sep='\n'))
})
#line 79 "R/infix.R"
test_that('`%||%`', {#@testing
expect_true( NULL %||% TRUE)
expect_true( TRUE %||% FALSE)
})
#line 98 "R/infix.R"
test_that('`%!in%`', {#@testing
expect_true('A' %!in% letters)
expect_false('a' %!in% letters)
})
pkgcond/tests/testthat/test-comma_list.R 0000644 0001762 0000144 00000000625 13377057443 020150 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `comma_list.R`')
#line 34 "R/comma_list.R"
test_that('comma_list', {#! @testing
expect_is(comma_list(1), 'character')
expect_equal(comma_list(1), '1')
expect_equal(comma_list(1:2), '1 and 2')
expect_equal(comma_list(1:3), '1, 2, and 3')
})
pkgcond/tests/testthat/test-translate.R 0000644 0001762 0000144 00000000702 13377057444 020013 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `translate.R`')
#line 24 "R/translate.R"
test_that('._', {#@testing
expect_identical(._('I am testing the function `._`')
, 'I am testing the function `._`')
expect_identical(._('I am testing the function `%s`', '._')
, 'I am testing the function `._`')
})
pkgcond/tests/testthat/test-suppress.R 0000644 0001762 0000144 00000006610 13401251614 017665 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `suppress.R`')
#line 50 "R/suppress.R"
test_that('suppress_conditions', {#@testing suppress_conditions
do_conditions <- function(){
message('ignore me.')
warning('ignore me.')
message('but not me.')
warning('but not me.')
pkg_message('if the class matches', scope = 'test_ignore')
pkg_warning('if the class matches', scope = 'test_ignore')
}
expect_silent(suppress_conditions(do_conditions()))
capture_conditions <- function(code){
warnings <- capture_warnings(
messages <- capture_messages(code))
list(warnings=warnings, messages=messages)
}
bare <- capture_conditions(do_conditions())
expect_identical( capture_conditions(suppress_warnings(do_conditions()))
, list(warnings=character(0), messages=bare$messages)
)
expect_identical( capture_conditions(suppress_messages(do_conditions()))
, list(warnings=bare$warnings, messages=character(0))
)
expect_identical( capture_conditions(suppress_conditions(do_conditions(), 'ignore'))
, list( warnings=bare$warnings[-1]
, messages=bare$messages[-1]
))
expect_identical( capture_conditions(suppress_conditions(do_conditions(), class='test_ignore-condition'))
, list( warnings=bare$warnings[-3]
, messages=bare$messages[-3]
))
})
#line 91 "R/suppress.R"
test_that('suppress_warnings', {#@testing suppress_warnings
do_warnings <- function(){
warning('ignore me.')
warning('but not me.')
pkg_warning('if the class matches', scope = 'test_ignore')
}
expect_warning(do_warnings(), 'ignore me')
expect_warning(do_warnings(), 'but not me')
expect_warning(do_warnings(), 'if the class matches')
expect_silent(suppress_warnings(do_warnings()))
expect_identical( capture_warnings(suppress_warnings(do_warnings(), 'ignore'))
, c( "but not me."
, "if the class matches"
))
expect_identical( capture_warnings(suppress_warnings(do_warnings(), class='test_ignore-warning'))
, c( "ignore me."
, "but not me."
))
})
#line 119 "R/suppress.R"
test_that('suppress_messages', {#@testing suppress_messages
do_messages <- function(){
message('ignore me.')
message('but not me.')
pkg_message('if the class matches', scope = 'test_ignore')
}
expect_message(do_messages(), 'ignore me')
expect_message(do_messages(), 'but not me')
expect_message(do_messages(), 'if the class matches')
expect_silent(suppress_messages(do_messages()))
expect_identical( capture_messages(suppress_messages(do_messages(), 'ignore'))
, c( "but not me.\n"
, "if the class matches"
))
expect_identical( capture_messages(suppress_messages(do_messages(), class='test_ignore-message'))
, c( "ignore me.\n"
, "but not me.\n"
))
})
pkgcond/tests/testthat/test-find_scope.R 0000644 0001762 0000144 00000003154 13377057443 020132 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `find_scope.R`')
#line 71 "R/find_scope.R"
test_that('.test_find_scope', {#@testing
expect_identical( .test_find_scope()
, c('pkgcond', '.test_find_scope')
)
expect_identical( .test_find_scope('integer')
, c('pkgcond', '.test_find_scope')
)
expect_identical( .test_find_scope('environment')
, c('pkgcond', '.test_find_scope')
)
tc <- methods::setRefClass( 'test-class'
, fields = list(`find_scope::skipscope`='logical')
, methods = list( test_class_scope = function()find_scope()
, initialize = function()`find_scope::skipscope` <<- FALSE
)
, where = globalenv())
obj <- tc()
expect_identical( obj$test_class_scope()
, c('test-class', 'test_class_scope')
)
setGeneric("get_scope", function(object){
stop('not implimented')
}, where = globalenv())
setMethod('get_scope', 'test-class', function(object){
`find_scope::skipscope` = FALSE
find_scope()
}, where = globalenv())
expect_identical(tail(get_scope(obj), 1), 'get_scope,test-class-method')
expect_identical(find_scope(1), character(0))
expect_identical(find_scope(sys.nframe()), character(0))
})
pkgcond/tests/testthat/test-condition.R 0000644 0001762 0000144 00000006024 13373345335 020002 0 ustar ligges users #line 72 "R/conditions.R"
test_that('condition', {#@testing
expect_message( condition('testing', 'message', scope='base'), 'testing')
expect_message( condition('testing', 'message', scope='base', type='testing')
, class = "message-testing"
)
expect_message( condition('testing', 'message', scope='test', type='testing')
, class = "test-message-testing"
)
expect_warning( condition('testing', 'warning', scope='base'), 'testing')
expect_warning( condition('testing', 'warning', scope='base', type='testing')
, class = "warning-testing"
)
expect_warning( condition('testing', 'warning', scope='test', type='testing')
, class = "test-warning-testing"
)
expect_error( condition('testing', 'error', scope='base'), 'testing')
expect_error( condition('testing', 'error', scope='base', type='testing')
, class = "error-testing"
)
expect_error( condition('testing', 'error', scope='test', type='testing')
, class = "test-error-testing"
)
tryCatch( condition('testing', 'error', type='testing'
, scope = c('test', 'my_class', 'my_method')
)
, condition = function(obj){
expect_is(obj, 'test-error-testing')
expect_is(obj, 'test::my_class-error-testing')
expect_is(obj, 'test::my_class::my_method-error-testing')
expect_is(obj, 'test-error')
expect_is(obj, 'test::my_class-error')
expect_is(obj, 'test::my_class::my_method-error')
expect_is(obj, 'error-testing')
expect_is(obj, 'error')
expect_is(obj, 'condition')
})
})
#line 119 "R/conditions.R"
test_that('pkg_error', {#@testing plkg_error
expect_error(.test_pkg_error("A package error."), "A package error.")
x <- tryCatch( .test_pkg_error("A package error.")
, condition= function(e)e
)
expect_is(x, 'pkgcond-error')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'error')
expect_is(x, 'condition')
})
#line 136 "R/conditions.R"
test_that('pkg_warning', {#@testing pkg_warning
expect_warning(.test_pkg_warning("A package warning."), "A package warning.")
x <- tryCatch( .test_pkg_warning("A package warning.")
, condition= function(e)e
)
expect_is(x, 'pkgcond-warning')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'warning')
expect_is(x, 'condition')
})
#line 153 "R/conditions.R"
test_that('pkg_message', {#@testing pkg_message
expect_message(.test_pkg_message("A package message"), "A package message")
x <- tryCatch( .test_pkg_message("A package message")
, condition= function(e)e
)
expect_is(x, 'pkgcond-message')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'message')
expect_is(x, 'condition')
})
pkgcond/tests/testthat/test-skip_scope.R 0000644 0001762 0000144 00000000614 13401251614 020136 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `skip_scope.R`')
#line 34 "R/skip_scope.R"
test_that('skip_scope', {#@testing
fun <- function()find_scope()
environment(fun) <- globalenv()
skip <- skip_scope(fun)
val <- skip()
cat(val)
expect_identical(val, character())
})
pkgcond/tests/testthat/test-conditions.R 0000644 0001762 0000144 00000006570 13401251614 020157 0 ustar ligges users #! This file was automatically produced by the testextra package.
#! Changes will be overwritten.
context('tests extracted from file `conditions.R`')
#line 72 "R/conditions.R"
test_that('condition', {#@testing
expect_silent( condition('testing', 'none', scope='base'))
expect_null( condition('testing', 'none', scope='base'))
expect_message( condition('testing', 'message', scope='base'), 'testing')
expect_message( condition('testing', 'message', scope='base', type='testing')
, class = "message-testing"
)
expect_message( condition('testing', 'message', scope='test', type='testing')
, class = "test-message-testing"
)
expect_warning( condition('testing', 'warning', scope='base'), 'testing')
expect_warning( condition('testing', 'warning', scope='base', type='testing')
, class = "warning-testing"
)
expect_warning( condition('testing', 'warning', scope='test', type='testing')
, class = "test-warning-testing"
)
expect_error( condition('testing', 'error', scope='base'), 'testing')
expect_error( condition('testing', 'error', scope='base', type='testing')
, class = "error-testing"
)
expect_error( condition('testing', 'error', scope='test', type='testing')
, class = "test-error-testing"
)
tryCatch( condition('testing', 'error', type='testing'
, scope = c('test', 'my_class', 'my_method')
)
, condition = function(obj){
expect_is(obj, 'test-error-testing')
expect_is(obj, 'test::my_class-error-testing')
expect_is(obj, 'test::my_class::my_method-error-testing')
expect_is(obj, 'test-error')
expect_is(obj, 'test::my_class-error')
expect_is(obj, 'test::my_class::my_method-error')
expect_is(obj, 'error-testing')
expect_is(obj, 'error')
expect_is(obj, 'condition')
})
})
#line 125 "R/conditions.R"
test_that('pkg_error', {#@testing pkg_error
expect_error(.test_pkg_error("A package error."), "A package error.")
x <- tryCatch( .test_pkg_error("A package error.")
, condition= function(e)e
)
expect_is(x, 'pkgcond-error')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'error')
expect_is(x, 'condition')
})
#line 145 "R/conditions.R"
test_that('pkg_warning', {#@testing pkg_warning
expect_warning(.test_pkg_warning("A package warning."), "A package warning.")
x <- tryCatch( .test_pkg_warning("A package warning.")
, condition= function(e)e
)
expect_is(x, 'pkgcond-warning')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'warning')
expect_is(x, 'condition')
})
#line 165 "R/conditions.R"
test_that('pkg_message', {#@testing pkg_message
expect_message(.test_pkg_message("A package message"), "A package message")
x <- tryCatch( .test_pkg_message("A package message")
, condition= function(e)e
)
expect_is(x, 'pkgcond-message')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'message')
expect_is(x, 'condition')
})
pkgcond/tests/testthat.R 0000644 0001762 0000144 00000000076 13370107773 015037 0 ustar ligges users library(testthat)
library(pkgcond)
test_check("pkgcond")
pkgcond/R/ 0000755 0001762 0000144 00000000000 13401266220 012074 5 ustar ligges users pkgcond/R/suppress.R 0000644 0001762 0000144 00000013242 13401251614 014106 0 ustar ligges users
#' @name suppress
#' @title Selectively suppress warnings and messages
#'
#' @description This collection of functions allow the suppression of condition messages,
#' warnings and messages, through filtering the condition message, the condition
#' class or a combination of the two.
#'
#' @param expr An expression to evaluate.
#' @param pattern A regular expression pattern to match on.
#' @param class The class or classes that you would like to filter.
#' When more that one is given the condition may match any
#' of the classes.
#' @inheritDotParams base::grepl
#'
#' @examples
#' \dontrun{
#' testit <- function(){
#' warning("this function does nothing.")
#' warning("it's pretty useless.")
#' }
#' suppress_warning(testit(), "useless") # Will suppress only the second warning by pattern
#'
#'
#' # If my_pkg used pkgcond for conditions,
#' # This would suppress all messages and warnings originating
#' # in my_pkg functions.
#' suppress_conditions(my_function(), class='my_pkg-condition')
#' }
NULL
#' @describeIn suppress The general case of suppressing both messages and warnings.
#' @export
suppress_conditions <-
function(expr, pattern=NULL, class=NULL, ...){
withCallingHandlers( expr
, warning = function(cond){
# browser()
if ( (is.null(pattern) || grepl(pattern=pattern, x=conditionMessage(cond), ...))
&& (is.null(class) || any(class(cond) %in% class))
) invokeRestart("muffleWarning")
}
, message = function(cond){
if ( (is.null(pattern) || grepl(pattern=pattern, x=conditionMessage(cond), ...))
&& (is.null(class) || any(class(cond) %in% class))
) invokeRestart("muffleMessage")
})
}
suppress_conditions <- skip_scope(suppress_conditions)
if(FALSE){#@testing suppress_conditions
do_conditions <- function(){
message('ignore me.')
warning('ignore me.')
message('but not me.')
warning('but not me.')
pkg_message('if the class matches', scope = 'test_ignore')
pkg_warning('if the class matches', scope = 'test_ignore')
}
expect_silent(suppress_conditions(do_conditions()))
capture_conditions <- function(code){
warnings <- capture_warnings(
messages <- capture_messages(code))
list(warnings=warnings, messages=messages)
}
bare <- capture_conditions(do_conditions())
expect_identical( capture_conditions(suppress_warnings(do_conditions()))
, list(warnings=character(0), messages=bare$messages)
)
expect_identical( capture_conditions(suppress_messages(do_conditions()))
, list(warnings=bare$warnings, messages=character(0))
)
expect_identical( capture_conditions(suppress_conditions(do_conditions(), 'ignore'))
, list( warnings=bare$warnings[-1]
, messages=bare$messages[-1]
))
expect_identical( capture_conditions(suppress_conditions(do_conditions(), class='test_ignore-condition'))
, list( warnings=bare$warnings[-3]
, messages=bare$messages[-3]
))
}
#' @describeIn suppress A convenience wrapper that specifies warning class to suppress.
#' @export
suppress_warnings <- function(expr, pattern=NULL, class='warning', ...)
suppress_conditions( expr, pattern = pattern, class=class)
suppress_warnings <- skip_scope(suppress_warnings)
if(FALSE){#@testing suppress_warnings
do_warnings <- function(){
warning('ignore me.')
warning('but not me.')
pkg_warning('if the class matches', scope = 'test_ignore')
}
expect_warning(do_warnings(), 'ignore me')
expect_warning(do_warnings(), 'but not me')
expect_warning(do_warnings(), 'if the class matches')
expect_silent(suppress_warnings(do_warnings()))
expect_identical( capture_warnings(suppress_warnings(do_warnings(), 'ignore'))
, c( "but not me."
, "if the class matches"
))
expect_identical( capture_warnings(suppress_warnings(do_warnings(), class='test_ignore-warning'))
, c( "ignore me."
, "but not me."
))
}
#' @describeIn suppress A convenience wrapper that specifies warning class to suppress.
#' @export
suppress_messages <- function(expr, pattern=NULL, class='message', ...)
suppress_conditions( expr, pattern = pattern, class=class)
suppress_messages <- skip_scope(suppress_messages)
if(FALSE){#@testing suppress_messages
do_messages <- function(){
message('ignore me.')
message('but not me.')
pkg_message('if the class matches', scope = 'test_ignore')
}
expect_message(do_messages(), 'ignore me')
expect_message(do_messages(), 'but not me')
expect_message(do_messages(), 'if the class matches')
expect_silent(suppress_messages(do_messages()))
expect_identical( capture_messages(suppress_messages(do_messages(), 'ignore'))
, c( "but not me.\n"
, "if the class matches"
))
expect_identical( capture_messages(suppress_messages(do_messages(), class='test_ignore-message'))
, c( "ignore me.\n"
, "but not me.\n"
))
}
pkgcond/R/skip_scope.R 0000644 0001762 0000144 00000002665 13377066143 014405 0 ustar ligges users
#' Exclude a function from find_scope
#'
#' In the course of work it will often be the case that
#' one would like to create a new condition function, such
#' such as for specific errors or warning. These should
#' not be included in the scope when inferred. The natural
#' solution would be to include the scope in every call to
#' condition or have it inferred in each function definition.
#' This however, gets very tedious.
#'
#' The `skip_scope` function tags a function as one that should be
#' excluded from consideration when determining scope via
#' [find_scope()].
#'
#' @param fun a function to tag
#'
#' @return The `fun` function with the `skipscope` attribute set to TRUE.
#' @examples
#' new_msg <- function(where=find_scope()){
#' "Hello from" %<<% where
#' }
#' new_postcard <- function(msg){
#' greeting <- new_msg()
#' paste0(greeting, '\n\n', msg)
#' }
#'
#' cat(new_postcard("Not all is well"), '\n')
#' new_msg <- skip_scope(new_msg)
#'
#' cat(new_postcard("Now all is well"))
#' @export
skip_scope <- function(fun){structure(fun, skipscope=TRUE)}
if(FALSE){#@testing
fun <- function()find_scope()
environment(fun) <- globalenv()
skip <- skip_scope(fun)
val <- skip()
cat(val)
expect_identical(val, character())
}
condition <- skip_scope(condition)
pkg_error <- skip_scope(pkg_error)
pkg_warning <- skip_scope(pkg_warning)
pkg_message <- skip_scope(pkg_message)
find_scope <- skip_scope(find_scope)
pkgcond/R/comma_list.R 0000644 0001762 0000144 00000002752 13377052477 014377 0 ustar ligges users
#' Construct a comma separated list
#'
#' Use this utility to create nicely formatted lists for error messages and the like.
#'
#' @param x a list that can be converted into a character.
#' @param sep the typical separator
#' @param sep2 the separator to use in the case of only two elements.
#' @param sep.last the separator to use between the last and next to last elements when
#' there are at least 3 element in the list.
#' @param terminator concatenated to the end after the list is concluded.
#'
#' @examples
#' comma_list(c("you", "I"))
#' comma_list(c("you", "I"), sep2=" & ")
#' comma_list(head(letters), sep.last=', ', term=', ...')
#'
#' @export
comma_list <-
function( x #< vector to make into a comma list
, sep = ", " #< separator for multiple elements.
, sep2 = " and " #< separator for only two elements.
, sep.last = ", and " #< separator between last and second to last for more than two elements.
, terminator = '' #< ends the list.
){
#! Create a properly formatted comma separated list.
if (length(x) == 1) return(paste(x))
else if (length(x) == 2)
return(paste(x, collapse=sep2))
else
return(paste(x, c(rep(sep, length(x)-2), sep.last, terminator), sep='', collapse=''))
}
if(FALSE){#! @testing
expect_is(comma_list(1), 'character')
expect_equal(comma_list(1), '1')
expect_equal(comma_list(1:2), '1 and 2')
expect_equal(comma_list(1:3), '1, 2, and 3')
}
pkgcond/R/assert_that.R 0000644 0001762 0000144 00000002705 13373615554 014564 0 ustar ligges users
#' Scoped Assertions
#'
#' The pkgcond package intentionally overrides the [assertthat::assert_that()]
#' function. It provides the same utility but enhances the original version
#' by throwing scoped and typed errors. The type is 'assertion failure' and
#' the scope can be set or inferred from the calling frame.
#'
#' @inheritParams assertthat::assert_that
#' @param scope The scope of the error.
#' @param type The error type.
#'
#' @export
assert_that <-
function ( ..., env = parent.frame(), msg = NULL
, scope = find_scope(env)
, type = 'assertion failure'
)
{
res <- assertthat::see_if(..., env = env, msg = msg)
if (res) return(TRUE)
pkg_error( attr(res, "msg")
, type = type
, scope = scope
)
}
.test_assert_that <- function(...){
`find_scope::skipscope` <- FALSE
assert_that(...)
}
if(FALSE){#@testing
expect_true(assert_that(1==1))
error <-
tryCatch(.test_assert_that(1==2)
, condition = function(e)e )
expect_is(error, 'condition')
expect_is(error, 'pkgcond-condition')
expect_is(error, 'error')
expect_is(error, 'pkgcond-error')
expect_is(error, 'error-assertion failure')
expect_is(error, 'pkgcond-error-assertion failure')
expect_is(error, 'pkgcond::.test_assert_that-error-assertion failure')
expect_is(error, 'pkgcond::.test_assert_that-error')
expect_is(error, 'pkgcond::.test_assert_that-condition')
}
pkgcond/R/infix.R 0000644 0001762 0000144 00000005427 13377064724 013365 0 ustar ligges users
#' Collapse character Vectors
#'
#' @param x a character vector
#' @param with character to place between elements of x.
#'
#' @export
collapse <- function(x, with=' '){paste(x, collapse=with)}
#' @rdname collapse
#' @export
collapse0 <- function(x, with=''){paste(x, collapse=with)}
#' @name infix-concatenation
#' @title Infix string concatenation.
#'
#' @param lhs left string
#' @param rhs right string
#'
#' @description
#' The infix operators listed here are three versions of paste.
#' \itemize{
#' \item \code{\%\\\%} is for preserving line breaks
#' \item \code{\%<<\%} is an infix replacement for \code{\link{paste}}
#' \item \code{\%<<<\%} is paste with no space and no break."
#' }
#' @aliases %\\%
#' @export %\% %<<% %<<<%
#' @examples
#'
#' who <- "world"
#' 'hello_' %<<<% who
#'
#' 'Sing with me' %<<% head(letters) %<<% '...'
`%<<%` <- function(lhs, rhs){
if (is.null(rhs)) return(collapse(lhs))
else if (is.null(lhs)) return(collapse(rhs))
else return(paste(collapse(lhs), collapse(rhs), sep=" "))
}
if(FALSE){#! @testing %<<%
a <- 'A vain chalks above the integrated biscuit. '
b <- 'Within the ground burns the leader.'
c <- 'How can the fifteen distress lose?'
expect_equal(a %<<% b, paste(a,b))
expect_equal(a %<<% b %<<% c, paste(a,b,c))
expect_equal(a %<<% NULL, a)
expect_equal(NULL %<<% a, a)
expect_equal(NULL %<<% NULL, "")
}
#' @rdname infix-concatenation
`%<<<%` <- function(lhs, rhs) paste(collapse0(lhs), collapse0(rhs), sep="")
if(FALSE){#! @testing %<<<%
a <- 'A vain chalks above the integrated biscuit. '
b <- ' Within the ground burns the leader.'
c <- 'How can the fifteen distress lose?'
expect_equal(a %<<<% b, paste0(a,b))
expect_equal(a %<<<% b %<<<% c, paste0(a,b, c, sep=''))
expect_equal(a %<<<% NULL, a)
expect_equal(NULL %<<<% a, a)
expect_equal(NULL %<<<% NULL, '')
}
`%\\%` <- function(lhs, rhs) paste(collapse(lhs, '\n'), collapse(rhs, '\n'), sep="\n")
if(FALSE){#! @testing newline-concatenation
a <- 'A vain chalks above the integrated biscuit. '
b <- ' Within the ground burns the leader.'
c <- 'How can the fifteen distress lose?'
expect_equal(a %\% b, paste(a,b, sep='\n'))
expect_equal(a %\% b %\% c, paste(a,b, c, sep='\n'))
}
`%||%` <- function (x, y) if (is.null(x)) y else x
if(FALSE){#@testing
expect_true( NULL %||% TRUE)
expect_true( TRUE %||% FALSE)
}
#' Not in infix operator
#'
#' The same as \code{\link{\%in\%}} but negated.
#'
#' @inheritParams base::match
#' @export
#'
#' @examples
#' 'A' %!in% letters #TRUE letters are lower case.
#' 'A' %!in% LETTERS #FALSE LETTERS are upper case.
#'
#' @name not-in
`%!in%` <- function(x, table){!(`%in%`(x, table))}
if(FALSE){#@testing
expect_true('A' %!in% letters)
expect_false('a' %!in% letters)
}
pkgcond/R/find_scope.R 0000644 0001762 0000144 00000007211 13377057140 014344 0 ustar ligges users #' Find the default scope of a call.
#'
#' This find the scope of the call.
#' It includes the package of the call,
#' the class if called from a method,
#' and the name of the function called.
#'
#' @param frame The frame to infer scope from.
#' @param global Should the global frame be listed in the scope.
#'
#' @export
#'
#' @examples
#'
#' my_function <- function(){
#' scope <- find_scope()
#' "You are in" %<<% collapse(scope, '::')
#' }
#' my_function()
#'
#' my_sights <- my_function
#' my_sights()
#'
find_scope <- function(frame=NULL, global=FALSE){
if (is.null(frame)) n <- sys.parent(1L)
else if (is.numeric(frame)) n <- sys.parent(as.integer(frame))
else if (is.environment(frame))
n <- which(sapply(sys.frames(), identical, frame))
while ( n > 0
&& is.environment(frame <- sys.frame(n))
&& !identical(frame, globalenv())
&& !is.primitive(fun <- sys.function(n))
&& !identical(fun, base::force)
&& ( (attr(fun, 'skipscope') %||% FALSE)
|| ( exists('.Generic', frame) && n > 2
&& is(sys.function(n-1L), 'MethodDefinition')
)
|| (exists('find_scope::skipscope', frame, inherits = TRUE)
&& get('find_scope::skipscope', frame, inherits = TRUE)
)
)
) n <- n - 1L
scope = character()
fun <- sys.function(n)
if (is.primitive(fun)) return(scope)
if (!length(n) || n == 0) return(scope)
pkg <- getPackageName(topenv(frame))
if (global || pkg != ".GlobalEnv")
scope <- pkg
caller <- sys.call(n)[[1]]
if (is(fun, 'refMethodDef')) {
scope <- c(scope, fun@refClassName, fun@name)
} else
if (is(fun, 'MethodDefinition')) {
scope <- unname(c(scope, paste0(fun@generic, ',', paste(fun@target, collapse=','), "-method")))
} else
if (is.name(caller))
scope <- c(scope, as.character(caller))
return(scope)
}
.test_find_scope <- function(method=c('defaults', 'integer', 'environment')){
`find_scope::skipscope` <- FALSE
method = match.arg(method)
switch( method
, defaults = find_scope()
, integer = find_scope(1)
, environment= find_scope(environment())
)
}
if(FALSE){#@testing
expect_identical( .test_find_scope()
, c('pkgcond', '.test_find_scope')
)
expect_identical( .test_find_scope('integer')
, c('pkgcond', '.test_find_scope')
)
expect_identical( .test_find_scope('environment')
, c('pkgcond', '.test_find_scope')
)
tc <- methods::setRefClass( 'test-class'
, fields = list(`find_scope::skipscope`='logical')
, methods = list( test_class_scope = function()find_scope()
, initialize = function()`find_scope::skipscope` <<- FALSE
)
, where = globalenv())
obj <- tc()
expect_identical( obj$test_class_scope()
, c('test-class', 'test_class_scope')
)
setGeneric("get_scope", function(object){
stop('not implimented')
}, where = globalenv())
setMethod('get_scope', 'test-class', function(object){
`find_scope::skipscope` = FALSE
find_scope()
}, where = globalenv())
expect_identical(tail(get_scope(obj), 1), 'get_scope,test-class-method')
expect_identical(find_scope(1), character(0))
expect_identical(find_scope(sys.nframe()), character(0))
}
`%||%` <- function(a,b) if(is.null(a)) b else a
pkgcond/R/conditions.R 0000644 0001762 0000144 00000015200 13401251614 014367 0 ustar ligges users #' @importFrom methods is getPackageName
.conditions <- c('message', 'warning', 'error', 'none')
.paste_scope <- function(...)paste(..., sep='::')
#' Raise a mutable and classed condition.
#'
#' Raising Classed conditions helps with catching errors.
#' These allow for typing errors as they arise and adding scopes
#' to better catch errors from specific locations.
#'
#' @details
#' The `condition()` function alone provides a flexible and dynamic way of
#' producing conditions in code. The functions `pkg_error`, `pkg_warning`,
#' and `pkg_message` do the same as condition except restricted to errors, warnings,
#' and messages respectively.
#'
#' @param msg The message to convey
#' @param cond The severity of the condition, or what to do;
#' give a 'message' (default), a 'warning', an 'error'
#' or do 'none' and ignore.
#' @param ... Attributes to be added to condition object for `condition`,
#' arguments passed to condition for all others.
#' @param scope A character vector of the scope(s) of the signal.
#' Defaults to the package name but could be longer such as
#' package name, a class name, and a method call.
#' This should be used as a where the error occurred.
#' @param type Used with `scope` and `cond` to set the class of the condition object to raise.
#' This should be a type of error; out of bounds, type mismatch, etcetera.
#' @param call The call to use to include in the condition.
#'
#' @export
condition <-
function( msg
, cond = .conditions
, ... #< objects to be added to the condition as attributes.
, scope = find_scope()
, type = NULL #< optional type of the condition, used to create the class.
, call = sys.call(1)
){
cond = match.arg(cond)
if (cond == 'none') return()
throw <- function(ball){
if (is(ball, 'error' )) stop(ball) else
if (is(ball, 'warning')) warning(ball) else
if (is(ball, 'message')) message(ball)
}
while (length(scope) && scope[[1]] %in% c("", "R_GlobalEnv", "base"))
scope <- scope[-1L]
if (length(scope) > 1L)
scope <- Reduce(.paste_scope, scope, accumulate=TRUE)
classes <-{
c( if (length(scope))
c( if (!is.null(type))
paste0(scope, '-', cond, '-', type)
, paste0(scope, '-', cond)
, paste0(scope, '-condition')
)
, if (!is.null(type)) paste0(cond, '-', type)
, cond
, 'condition'
)
}
ball <- structure( list( message = gettext(msg)
, call=call)
, class=classes
, ...)
throw(ball)
}
if(FALSE){#@testing
expect_silent( condition('testing', 'none', scope='base'))
expect_null( condition('testing', 'none', scope='base'))
expect_message( condition('testing', 'message', scope='base'), 'testing')
expect_message( condition('testing', 'message', scope='base', type='testing')
, class = "message-testing"
)
expect_message( condition('testing', 'message', scope='test', type='testing')
, class = "test-message-testing"
)
expect_warning( condition('testing', 'warning', scope='base'), 'testing')
expect_warning( condition('testing', 'warning', scope='base', type='testing')
, class = "warning-testing"
)
expect_warning( condition('testing', 'warning', scope='test', type='testing')
, class = "test-warning-testing"
)
expect_error( condition('testing', 'error', scope='base'), 'testing')
expect_error( condition('testing', 'error', scope='base', type='testing')
, class = "error-testing"
)
expect_error( condition('testing', 'error', scope='test', type='testing')
, class = "test-error-testing"
)
tryCatch( condition('testing', 'error', type='testing'
, scope = c('test', 'my_class', 'my_method')
)
, condition = function(obj){
expect_is(obj, 'test-error-testing')
expect_is(obj, 'test::my_class-error-testing')
expect_is(obj, 'test::my_class::my_method-error-testing')
expect_is(obj, 'test-error')
expect_is(obj, 'test::my_class-error')
expect_is(obj, 'test::my_class::my_method-error')
expect_is(obj, 'error-testing')
expect_is(obj, 'error')
expect_is(obj, 'condition')
})
}
#' @rdname condition
#' @export
pkg_error <- function(msg, ..., scope = find_scope(), call=sys.call(1)){
condition(msg, cond = 'error', ..., scope=scope, call=call)
}
.test_pkg_error <- function(...){
`find_scope::skipscope` <- FALSE
pkg_error(...)
}
if(FALSE){#@testing pkg_error
expect_error(.test_pkg_error("A package error."), "A package error.")
x <- tryCatch( .test_pkg_error("A package error.")
, condition= function(e)e
)
expect_is(x, 'pkgcond-error')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'error')
expect_is(x, 'condition')
}
#' @rdname condition
#' @export
pkg_warning <- function(msg, ..., scope = find_scope(), call=sys.call(1)){
condition(msg, cond = 'warning', ..., scope=scope, call=call)
}
.test_pkg_warning <- function(...){
`find_scope::skipscope` <- FALSE
pkg_warning(...)
}
if(FALSE){#@testing pkg_warning
expect_warning(.test_pkg_warning("A package warning."), "A package warning.")
x <- tryCatch( .test_pkg_warning("A package warning.")
, condition= function(e)e
)
expect_is(x, 'pkgcond-warning')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'warning')
expect_is(x, 'condition')
}
#' @rdname condition
#' @export
pkg_message <- function(msg, ..., scope = find_scope(), call=sys.call(1)){
condition(msg, cond = 'message', ..., scope=scope, call=call)
}
.test_pkg_message <- function(...){
`find_scope::skipscope` <- FALSE
pkg_message(...)
}
if(FALSE){#@testing pkg_message
expect_message(.test_pkg_message("A package message"), "A package message")
x <- tryCatch( .test_pkg_message("A package message")
, condition= function(e)e
)
expect_is(x, 'pkgcond-message')
expect_is(x, 'pkgcond-condition')
expect_is(x, 'message')
expect_is(x, 'condition')
}
pkgcond/R/translate.R 0000644 0001762 0000144 00000001517 13377053040 014226 0 ustar ligges users
#' Format and Translate Strings
#'
#' This shortcut provides simple translation and formatting functionality.
#' Essentially it is a wrapper for [base::gettext()] and [base::gettextf()].
#'
#' @param msg The message to translate.
#' @inheritDotParams base::gettextf
#' @param domain see [base::gettext()]
#' @name dot-underscore
#' @export
#' @examples
#' loki <- list()
#' class(loki) <- "puny god"
#' ._("I am a %s.", class(loki))
#'
._ <- function(msg, ..., domain=NULL){
if (...length())
gettextf(msg, ..., domain = domain)
else
gettext(msg, domain = domain)
}
if(FALSE){#@testing
expect_identical(._('I am testing the function `._`')
, 'I am testing the function `._`')
expect_identical(._('I am testing the function `%s`', '._')
, 'I am testing the function `._`')
}
pkgcond/NEWS.md 0000644 0001762 0000144 00000000306 14042055253 012774 0 ustar ligges users # pkgcond 0.1.1
* Changed dependency of `assertthat` from Enhances to Imports
* Updated documentation
# pkgcond 0.1.0
* Added a `NEWS.md` file to track changes to the package.
* Initial release.
pkgcond/MD5 0000644 0001762 0000144 00000003453 14042171336 012215 0 ustar ligges users dfb7ca13a412795252638f7407db5766 *DESCRIPTION
8b44fb05d2d39b43103d508c0a60cc5c *NAMESPACE
452709668ef9154d3d4b1bb6dda16988 *NEWS.md
1b9694b634caf044812cd5a269068e4c *R/assert_that.R
e29ef63e9f8445fc5f23a27499291151 *R/comma_list.R
ed835574c77a17bda23cd1cba6ff2dd4 *R/conditions.R
9ff75bed88cf5c052bc59a59d9fe85eb *R/find_scope.R
df80b0a8c6a5e04571c3faf57dd2ab3d *R/infix.R
61ced4dcbe6a5738707cedeabf779a80 *R/skip_scope.R
bed963af9470b13b1d9cdc7071997632 *R/suppress.R
ef17a942bae64107d371045b0d3207b6 *R/translate.R
4bb3b258a482f8238a6ea9c8f6241c8d *README.md
4e126d8dd7cda4cfc6d0048162620bdf *inst/WORDLIST
d57e8c6d5616d6bf32159f7aa9bfbe52 *man/assert_that.Rd
1110512d58de9eafd56aea7678f244f8 *man/collapse.Rd
7baaddcf7516ecb80b881c65f924c6fd *man/comma_list.Rd
c7f109dca83bcf3fbb36001b37f7c547 *man/condition.Rd
ab20eb75506918c522c59f96ee44521f *man/dot-underscore.Rd
89687f6415eec2608e2641281ae25156 *man/figures/logo.png
5157653ac2c36b8b6496d0dfe21f9235 *man/find_scope.Rd
6d8901f1f7a70cab20fcf9a748cacec8 *man/infix-concatenation.Rd
c799bd2a8cc0ef571f20f60ade70b789 *man/not-in.Rd
2826d8f1baa8458251c26553094710fb *man/skip_scope.Rd
ee30943bb43c1bc1bdf5a0c1f904f1dd *man/suppress.Rd
c334fecb2e8075c7c42eb45440ed9935 *tests/testthat.R
fac80ca6b73f15eaf88201947dfa32c9 *tests/testthat/test-assert_that.R
6775516921411025331a20a29f9baa5f *tests/testthat/test-comma_list.R
6fb369fd42dd8dbedc91e3aa80a345c1 *tests/testthat/test-condition.R
211e8e3cc52b628ce26785d1743c35dd *tests/testthat/test-conditions.R
63caf252c663a983218c7bffb9234ef2 *tests/testthat/test-find_scope.R
f3b8e262d7651259416d2f7c1c0536d0 *tests/testthat/test-infix.R
9a1a4673debf5a329048e9b5892b7e1e *tests/testthat/test-skip_scope.R
fe0d1ddc1a77bb545ed585a87c302f29 *tests/testthat/test-suppress.R
18bca808c4ba462f5815a573c9617315 *tests/testthat/test-translate.R
pkgcond/inst/ 0000755 0001762 0000144 00000000000 13373615677 012676 5 ustar ligges users pkgcond/inst/WORDLIST 0000644 0001762 0000144 00000000011 13373615743 014052 0 ustar ligges users etcetera
[](https://travis-ci.org/RDocTaskForce/pkgcond)
[](https://codecov.io/github/RDocTaskForce/pkgcond?branch=master)
The goal of pkgcond is to facilitate the creation of errors, warnings,
and messages (collectively called signals or conditions) that are more informative
than the base versions.
Signals can be created through `pkg_error()`, `pkg_warning()` and `pkg_message()`.
When these are used a scope is computed and used to create errors, warnings and
signals, respectively, with classes set to the combinations of the scope.
The scope, while is could be set explicitly, infers where the condition is created,
and will typically include the function call and package name.
## Installation
You can install the released version of pkgcond from [CRAN](https://CRAN.R-project.org) with:
``` r
install.packages("pkgcond")
```
## Understanding Scope
Let's consider a toy example to understand the scope.
Say that we are creating a package named `hw` with a function `hello_world()`
defined as follows:
```r
hello_world <- function(greeting = 'hello', who = 'world'){
if (!is.character(greeting) && length(greeting) == 1L)
pkg_error("greeting must be a string.")
if (!is.character(who) && length(who) == 1L)
pkg_error("who must be a string.")
pkg_message(paste(greeting, who))
}
```
If the function is called with the defaults the `pkg_message()` function will
be called. The effect is the same as if a `base::message()` call were here;
A message with "hello world" would appear in the console. However,
`pkg_message()` does a little more. The base call would create a '`message`' object
and signal it. With `pkg_message()` since it was invoked inside the `hello_world()`
function inside the `hw` package the scope would be set to `c('hw', 'hello_world')`
This in turn would be used to create the message signal with the following classes.
* `hw::hello_world-message`
* `hw::hello_world-condition`
* `hw-message`
* `hw-condition`
* `message`
* `condition`
The `pkg_error()` and `pkg_warning()` functions have similar scoping however with
error and warning replacing message, respectively.
This becomes really useful if one wishes to capture conditions. This is done with
the `tryCatch()` function. In this way one can easily catch the conditions that originate from a specific function call or a specific package while passing others through or handling them differently.
```r
tryCatch( hello_world("die", stop)
, "hw::hello_world-error" = function(cond){
# This would handle the error that is raised from passing
# `stop` into the `hello_world function()
}
, "hw-condition" = function(cond){
# This would capture all error originating in the hw package
# that were signaled using any of the `pkg_*` functions.
}
# Errors that did not originate from the hw package or were created
# with the traditional stop, warning, or message functions
# will be passed through since they will not be "Caught"
)
```
## Helpers included:
These functions are included with `pkgcond` to help create error messages.
* `assert_that()` This intentionally masks `assertthat::assert_that()` when an assertion fails from this call the scope is set as above but a type is also created that indicates this is a 'assertion failure' that can also be used to catch specific errors.
* `comma_list()` takes a list of items and creates a correctly formatted (for English at least) comma separated list contained in a single string.
* `collapse()` takes a character vector and collapses it to a single string separated by a space.
* `collapse0()` same as previous but no space separating parts.
* `lhs %<<% rhs` an infix operator version of paste but will attempt to coerce and collapse lhs and rhs as well.
* `lhs %<<<%` an infix operator version of paste0, will use collapse0 on lhs and rhs prior to concatenation of the two.
* `lhs %\% rhs` Similar to the previous two but separates with a new line. This will use collapse prior to concatenation.
* `._()` Used to enable translation for a signal message. When used with a single argument acts as an alias for `gettext()` when given multiple arguments it wraps
`gettextf()`.
## Documentation
The `pkgcond` package is developed by the R Documentation Task Force, an
[R Consortium](https://www.r-consortium.org)
[Infrastructure Steering Committee working group](https://www.r-consortium.org/projects/isc-working-groups).
pkgcond/man/ 0000755 0001762 0000144 00000000000 13401266221 012447 5 ustar ligges users pkgcond/man/infix-concatenation.Rd 0000644 0001762 0000144 00000001267 13401252034 016701 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/infix.R
\name{infix-concatenation}
\alias{infix-concatenation}
\alias{\%<<\%}
\alias{\%\\\%}
\alias{\%<<<\%}
\title{Infix string concatenation.}
\usage{
lhs \%<<\% rhs
lhs \%<<<\% rhs
}
\arguments{
\item{lhs}{left string}
\item{rhs}{right string}
}
\description{
The infix operators listed here are three versions of paste.
\itemize{
\item \code{\%\\\%} is for preserving line breaks
\item \code{\%<<\%} is an infix replacement for \code{\link{paste}}
\item \code{\%<<<\%} is paste with no space and no break."
}
}
\examples{
who <- "world"
'hello_' \%<<<\% who
'Sing with me' \%<<\% head(letters) \%<<\% '...'
}
pkgcond/man/skip_scope.Rd 0000644 0001762 0000144 00000002231 14042034363 015075 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/skip_scope.R
\name{skip_scope}
\alias{skip_scope}
\title{Exclude a function from find_scope}
\usage{
skip_scope(fun)
}
\arguments{
\item{fun}{a function to tag}
}
\value{
The \code{fun} function with the \code{skipscope} attribute set to TRUE.
}
\description{
In the course of work it will often be the case that
one would like to create a new condition function, such
such as for specific errors or warning. These should
not be included in the scope when inferred. The natural
solution would be to include the scope in every call to
condition or have it inferred in each function definition.
This however, gets very tedious.
}
\details{
The \code{skip_scope} function tags a function as one that should be
excluded from consideration when determining scope via
\code{\link[=find_scope]{find_scope()}}.
}
\examples{
new_msg <- function(where=find_scope()){
"Hello from" \%<<\% where
}
new_postcard <- function(msg){
greeting <- new_msg()
paste0(greeting, '\n\n', msg)
}
cat(new_postcard("Not all is well"), '\n')
new_msg <- skip_scope(new_msg)
cat(new_postcard("Now all is well"))
}
pkgcond/man/condition.Rd 0000644 0001762 0000144 00000003355 14042034363 014734 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/conditions.R
\name{condition}
\alias{condition}
\alias{pkg_error}
\alias{pkg_warning}
\alias{pkg_message}
\title{Raise a mutable and classed condition.}
\usage{
condition(
msg,
cond = .conditions,
...,
scope = find_scope(),
type = NULL,
call = sys.call(1)
)
pkg_error(msg, ..., scope = find_scope(), call = sys.call(1))
pkg_warning(msg, ..., scope = find_scope(), call = sys.call(1))
pkg_message(msg, ..., scope = find_scope(), call = sys.call(1))
}
\arguments{
\item{msg}{The message to convey}
\item{cond}{The severity of the condition, or what to do;
give a 'message' (default), a 'warning', an 'error'
or do 'none' and ignore.}
\item{...}{Attributes to be added to condition object for \code{condition},
arguments passed to condition for all others.}
\item{scope}{A character vector of the scope(s) of the signal.
Defaults to the package name but could be longer such as
package name, a class name, and a method call.
This should be used as a where the error occurred.}
\item{type}{Used with \code{scope} and \code{cond} to set the class of the condition object to raise.
This should be a type of error; out of bounds, type mismatch, etcetera.}
\item{call}{The call to use to include in the condition.}
}
\description{
Raising Classed conditions helps with catching errors.
These allow for typing errors as they arise and adding scopes
to better catch errors from specific locations.
}
\details{
The \code{condition()} function alone provides a flexible and dynamic way of
producing conditions in code. The functions \code{pkg_error}, \code{pkg_warning},
and \code{pkg_message} do the same as condition except restricted to errors, warnings,
and messages respectively.
}
pkgcond/man/suppress.Rd 0000644 0001762 0000144 00000004620 14042034363 014626 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/suppress.R
\name{suppress}
\alias{suppress}
\alias{suppress_conditions}
\alias{suppress_warnings}
\alias{suppress_messages}
\title{Selectively suppress warnings and messages}
\usage{
suppress_conditions(expr, pattern = NULL, class = NULL, ...)
suppress_warnings(expr, pattern = NULL, class = "warning", ...)
suppress_messages(expr, pattern = NULL, class = "message", ...)
}
\arguments{
\item{expr}{An expression to evaluate.}
\item{pattern}{A regular expression pattern to match on.}
\item{class}{The class or classes that you would like to filter.
When more that one is given the condition may match any
of the classes.}
\item{...}{
Arguments passed on to \code{\link[base:grep]{base::grepl}}
\describe{
\item{\code{x}}{a character vector where matches are sought, or an
object which can be coerced by \code{as.character} to a character
vector. \link[base]{Long vectors} are supported.}
\item{\code{ignore.case}}{if \code{FALSE}, the pattern matching is \emph{case
sensitive} and if \code{TRUE}, case is ignored during matching.}
\item{\code{perl}}{logical. Should Perl-compatible regexps be used?}
\item{\code{fixed}}{logical. If \code{TRUE}, \code{pattern} is a string to be
matched as is. Overrides all conflicting arguments.}
\item{\code{useBytes}}{logical. If \code{TRUE} the matching is done
byte-by-byte rather than character-by-character. See
\sQuote{Details}.}
}}
}
\description{
This collection of functions allow the suppression of condition messages,
warnings and messages, through filtering the condition message, the condition
class or a combination of the two.
}
\section{Functions}{
\itemize{
\item \code{suppress_conditions}: The general case of suppressing both messages and warnings.
\item \code{suppress_warnings}: A convenience wrapper that specifies warning class to suppress.
\item \code{suppress_messages}: A convenience wrapper that specifies warning class to suppress.
}}
\examples{
\dontrun{
testit <- function(){
warning("this function does nothing.")
warning("it's pretty useless.")
}
suppress_warning(testit(), "useless") # Will suppress only the second warning by pattern
# If my_pkg used pkgcond for conditions,
# This would suppress all messages and warnings originating
# in my_pkg functions.
suppress_conditions(my_function(), class='my_pkg-condition')
}
}
pkgcond/man/collapse.Rd 0000644 0001762 0000144 00000000565 13401252034 014543 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/infix.R
\name{collapse}
\alias{collapse}
\alias{collapse0}
\title{Collapse character Vectors}
\usage{
collapse(x, with = " ")
collapse0(x, with = "")
}
\arguments{
\item{x}{a character vector}
\item{with}{character to place between elements of x.}
}
\description{
Collapse character Vectors
}
pkgcond/man/figures/ 0000755 0001762 0000144 00000000000 13375311510 014115 5 ustar ligges users pkgcond/man/figures/logo.png 0000644 0001762 0000144 00000035370 13375311510 015573 0 ustar ligges users PNG
IHDR x a> gAMA a cHRM z& u0 ` : pQ< bKGD pHYs 6z, tIME ѽ 9IDATxwx չ?gwɒ,l5ɽal08` pBK(J @*PB i`clc-۲f^weҺJzٙ9;߷H ,|@t 4j8"yt@
li ^BPT3!>3? cK=c-}([[x+O3>`E\ VN|S ٌPX. [ JY{+(E
J1mͅ 8@ |%)IYO