Initial commit

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,3 @@
+.Rproj.user
+.Rhistory
+.RData

DESCRIPTION

@@ -0,0 +1,13 @@
+Package: fstrings
+Title: What the Package Does (one line, title case)
+Version: 0.0.0.9000
+Authors@R: person("Jim", "Hester", email = "james.f.hester@gmail.com", role = c("aut", "cre"))
+Description: What the package does (one paragraph).
+Depends: R (>= 3.3.2)
+License: MIT + file LICENSE
+Encoding: UTF-8
+LazyData: true
+LinkingTo: Rcpp
+Imports: Rcpp
+RoxygenNote: 5.0.1.9000
+Suggests: testthat

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2016
+COPYRIGHT HOLDER: Jim Hester

NAMESPACE

@@ -0,0 +1,6 @@
+# Generated by roxygen2: do not edit by hand
+
+export(f)
+export(fstring)
+importFrom(Rcpp,sourceCpp)
+useDynLib(fstrings)

R/RcppExports.R

@@ -0,0 +1,7 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+fstring_ <- function(x, f) {
+    .Call('fstrings_fstring_', PACKAGE = 'fstrings', x, f)
+}
+

R/fstrings.R

@@ -0,0 +1,23 @@
+#' @useDynLib fstrings
+#' @importFrom Rcpp sourceCpp
+NULL
+
+#' Format a string
+#' @param x the string to format
+#' @param sep separator used to collapse elements if \code{fun} returns more than one item.
+#' @param fun Function to call to format each expression.
+#' @param envir Environment to evaluate each expression in. Expressions are
+#' evaluated in the order they appear.
+#' @examples
+#' name <- "Fred"
+#' age <- 50
+#' anniversary <- as.Date("1991-10-12")
+#' f('My name is {name}, my age next year is {age + 1}, my anniversary is {format(anniversary, "%A, %B %d, %Y")}.')
+#' @export
+fstring <- function(x, sep = "", fun = as.character, envir = parent.frame()) {
+  fstring_(x, function(x) paste(collapse = sep, fun(eval(parse(text = x), envir = envir))))
+}
+
+#' @export
+#' @rdname fstring
+f <- fstring

README.md

@@ -0,0 +1,12 @@
+# fstrings
+
+Python style [fstrings](https://www.python.org/dev/peps/pep-0498/) for R.
+
+```r
+name <- "Fred"
+age <- 50
+anniversary <- as.Date("1991-10-12")
+f('My name is {name}, my age next year is {age + 1}, my anniversary is {format(anniversary, "%A, %B %d, %Y")}.')
+#> [1] "My name is Fred, my age next year is 51, my anniversary is Saturday, Octobe
+r 12, 1991."
+```

fstrings.Rproj

@@ -0,0 +1,16 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+Encoding: UTF-8
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace

src/.gitignore

@@ -0,0 +1,3 @@
+*.o
+*.so
+*.dll

src/RcppExports.cpp

@@ -0,0 +1,19 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// fstring_
+std::string fstring_(std::string x, Rcpp::Function f);
+RcppExport SEXP fstrings_fstring_(SEXP xSEXP, SEXP fSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< std::string >::type x(xSEXP);
+    Rcpp::traits::input_parameter< Rcpp::Function >::type f(fSEXP);
+    rcpp_result_gen = Rcpp::wrap(fstring_(x, f));
+    return rcpp_result_gen;
+END_RCPP
+}

src/fstrings.cpp

@@ -0,0 +1,98 @@
+#include "Rcpp.h"
+
+// [[Rcpp::export]]
+std::string fstring_(std::string x, Rcpp::Function f) {
+  enum states {
+    text,
+    escape,
+    single_quote,
+    double_quote,
+    backtick,
+    brace,
+    comment
+  };
+
+  std::string out = x;
+  int i = 0;
+  int brace_level = 0;
+  int start = 0;
+  int diff = 0;
+  states state = text;
+  states prev_state = text;
+  for(;i < x.size();++i) {
+    switch(state) {
+      case text: {
+        if (x[i] == '{') {
+          state = brace;
+          brace_level = 1;
+          start = i + 1;
+        }
+        break;
+      }
+      case escape: { state = prev_state; break; }
+      case single_quote: {
+        if (x[i] == '\\') {
+          prev_state = single_quote;
+          state = escape;
+        } else if (x[i] == '\'') {
+          state = brace;
+        }
+        break;
+      }
+      case double_quote: {
+        if (x[i] == '\\') {
+          prev_state = double_quote;
+          state = escape;
+        } else if (x[i] == '\"') {
+          state = brace;
+        }
+        break;
+      }
+      case backtick: {
+        if (x[i] == '\\') {
+          prev_state = backtick;
+          state = escape;
+        } else if (x[i] == '`') {
+          state = brace;
+        }
+        break;
+      }
+      case comment: {
+        if (x[i] == '\n') {
+          state = brace;
+        }
+        break;
+      }
+      case brace: {
+        switch (x[i]) {
+          case '{': {
+            if (i > 0 && brace_level == 1 && x[i-1] == '{') {
+              state = text; break;
+            }
+            ++brace_level;
+            break;
+          }
+          case '}': --brace_level; break;
+          case '\'': state = single_quote; break;
+          case '"': state = double_quote; break;
+          case '`': state = backtick; break;
+          case '#': state = comment; break;
+        };
+        if (brace_level == 0) {
+          std::string expr = x.substr(start, i - start);
+          std::string result = Rcpp::as<std::string>(f(expr));
+          int begin = start - 1 - diff;
+          int length = i - start + 2;
+          //Rcpp::Rcout << result << "{" << begin << ':' << length << "}";
+          out.replace(begin, length, result);
+          diff += (expr.length() + 2) - result.length();
+          state = text;
+        }
+        break;
+      }
+    };
+
+  }
+
+  return out;
+}

tests/testthat.R

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

tests/testthat/test-fstring.R

@@ -0,0 +1,77 @@
+context("fstring")
+
+test_that("fstring errors if the expression fails", {
+  expect_error(f("{NoTfOuNd}"), "object .* not found")
+})
+
+test_that("fstring works with single expressions", {
+  foo <- "foo"
+  expect_identical(foo, f("{foo}"))
+
+  foo <- 1L
+  expect_identical(as.character(foo), f("{foo}"))
+
+  foo <- as.raw(1)
+  expect_identical(as.character(foo), f("{foo}"))
+
+  foo <- TRUE
+  expect_identical(as.character(foo), f("{foo}"))
+
+  foo <- as.Date("2016-01-01")
+  expect_identical(as.character(foo), f("{foo}"))
+})
+
+test_that("fstring works with repeated expressions", {
+  foo <- "foo"
+  expect_identical(paste(foo, foo), f("{foo} {foo}"))
+
+  foo <- 1L
+  expect_identical(paste(as.character(foo), as.character(foo)), f("{foo} {foo}"))
+
+  foo <- as.raw(1)
+  expect_identical(paste(as.character(foo), as.character(foo)), f("{foo} {foo}"))
+
+  foo <- TRUE
+  expect_identical(paste(as.character(foo), as.character(foo)), f("{foo} {foo}"))
+
+  foo <- as.Date("2016-01-01")
+  expect_identical(paste(as.character(foo), as.character(foo)), f("{foo} {foo}"))
+})
+
+test_that("fstring works with multiple expressions", {
+  foo <- "foo"
+  bar <- "bar"
+  expect_identical(paste(foo, bar), f("{foo} {bar}"))
+
+  foo <- 1L
+  bar <- 2L
+  expect_identical(paste(as.character(foo), as.character(bar)), f("{foo} {bar}"))
+
+  foo <- as.raw(1)
+  bar <- as.raw(2)
+  expect_identical(paste(as.character(foo), as.character(bar)), f("{foo} {bar}"))
+
+  foo <- TRUE
+  bar <- FALSE
+  expect_identical(paste(as.character(foo), as.character(bar)), f("{foo} {bar}"))
+
+  foo <- as.Date("2016-01-01")
+  bar <- as.Date("2016-01-02")
+  expect_identical(paste(as.character(foo), as.character(bar)), f("{foo} {bar}"))
+})
+
+test_that("fstring with doubled braces are ignored", {
+  expect_identical("{{foo}}", f("{{foo}}"))
+})
+
+test_that("fstring works with complex expressions", {
+  `foo}\`` <- "foo"
+
+  expect_identical(`foo}\``, f("{
+      {
+        '}\\'' # { and } in comments, single quotes
+        \"}\\\"\" # or double quotes are ignored
+        `foo}\\`` # as are { in backticks
+      }
+  }"))
+})