HenrikBengtsson / R.rsp
1
###########################################################################/**
2
# @RdocDefault rstring
3
# @alias rstring.RspString
4
# @alias rstring.RspDocument
5
# @alias rstring.RspSourceCode
6
# @alias rstring.function
7
# @alias rstring.expression
8
#
9
# @title "Evaluates an RSP string and returns the generated string"
10
#
11
# \description{
12
#  @get "title".
13
# }
14
#
15
# @synopsis
16
#
17
# \arguments{
18
#   \item{...}{A @character string with RSP markup.}
19
#   \item{file, path}{Alternatively, a file, a URL or a @connection from
20
#      with the strings are read.
21
#      If a file, the \code{path} is prepended to the file, iff given.}
22
#   \item{envir}{The @environment in which the RSP string is
23
#      preprocessed and evaluated.}
24
#   \item{args}{A named @list of arguments assigned to the environment
25
#     in which the RSP string is parsed and evaluated.
26
#     See @see "R.utils::cmdArgs".}
27
#   \item{verbose}{See @see "R.utils::Verbose".}
28
# }
29
#
30
# \value{
31
#   Returns an @see "RspStringProduct".
32
# }
33
#
34
# @examples "../incl/rstring.Rex"
35
#
36
# @author
37
#
38
# \seealso{
39
#  To display the output (instead of returning a string), see
40
#  @see "rcat".
41
#  For evaluating and postprocessing an RSP document and
42
#  writing the output to a file, see @see "rfile".
43
# }
44
#
45
# @keyword file
46
# @keyword IO
47
#*/###########################################################################
48
setMethodS3("rstring", "default", function(..., file=NULL, path=NULL, envir=parent.frame(), args="*", verbose=FALSE) {
49
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
50
  # Validate arguments
51
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
52
  # Argument 'file' & 'path':
53 1
  if (inherits(file, "connection")) {
54 1
  } else if (is.character(file)) {
55 1
    if (!is.null(path)) {
56 0
      file <- file.path(path, file)
57
    }
58 1
    if (!isUrl(file)) {
59 1
      file <- Arguments$getReadablePathname(file, absolute=TRUE)
60
    }
61
  }
62

63
  # Argument 'verbose':
64 1
  verbose <- Arguments$getVerbose(verbose)
65 1
  if (verbose) {
66 1
    pushState(verbose)
67 1
    on.exit(popState(verbose))
68
  }
69

70

71 1
  verbose && enter(verbose, "rstring() for default")
72

73 1
  if (is.null(file)) {
74 1
    s <- RspString(...)
75
  } else {
76 1
    verbose && cat(verbose, "Input file: ", file)
77 1
    s <- .readText(file)
78 1
    s <- RspString(s, source=file, ...)
79 1
    s <- setMetadata(s, name="source", value=file)
80
  }
81 1
  verbose && cat(verbose, "Length of RSP string: ", nchar(s))
82

83 1
  res <- rstring(s, envir=envir, args=args, verbose=verbose)
84

85 1
  verbose && exit(verbose)
86

87 1
  res
88
}) # rstring()
89

90

91
setMethodS3("rstring", "RspString", function(object, envir=parent.frame(), args="*", ..., verbose=FALSE) {
92
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
93
  # Validate arguments
94
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
95
  # Argument 'args':
96 1
  args <- cmdArgs(args)
97

98
  # Argument 'verbose':
99 1
  verbose <- Arguments$getVerbose(verbose)
100 1
  if (verbose) {
101 1
    pushState(verbose)
102 1
    on.exit(popState(verbose))
103
  }
104

105 1
  verbose && enter(verbose, "rstring() for ", class(object)[1L])
106

107 1
  if (length(args) > 0L) {
108 1
    verbose && enter(verbose, "Assigning RSP arguments to processing environment")
109 1
    verbose && cat(verbose, "Environment: ", getName(envir))
110

111 1
    verbose && cat(verbose, "RSP arguments:")
112 1
    verbose && str(verbose, args)
113

114
    # Assign arguments to the parse/evaluation environment
115 1
    names <- attachLocally(args, envir=envir)
116 1
    if (verbose) {
117 1
      if (length(names) > 0L) {
118 1
        printf(verbose, "Variables assigned: [%d] %s\n", length(names), hpaste(names))
119 1
        member <- NULL; rm(list="member"); # To please R CMD check
120 1
        ll <- subset(ll(envir=envir), member %in% names)
121 1
        print(verbose, ll)
122
      }
123
    }
124 1
    verbose && exit(verbose)
125
  } else {
126 1
    names <- NULL
127
  }
128

129 1
  if (verbose) {
130 1
    enter(verbose, "Parse RSP string to RSP document")
131 1
    cat(verbose, "Parse environment: ", getName(envir))
132 1
    if (length(names) > 0L) {
133 1
      ll <- subset(ll(envir=envir), member %in% names)
134 1
      print(verbose, ll)
135
    }
136
  }
137 1
  doc <- parseDocument(object, envir=envir, ..., verbose=verbose)
138 1
  verbose && print(verbose, doc)
139 1
  verbose && exit(verbose)
140

141 1
  res <- rstring(doc, envir=envir, args=NULL, ..., verbose=verbose)
142

143 1
  verbose && exit(verbose)
144

145 1
  res
146
}) # rstring()
147

148

149
setMethodS3("rstring", "RspDocument", function(object, envir=parent.frame(), ..., verbose=FALSE) {
150
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
151
  # Validate arguments
152
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
153
  # Argument 'verbose':
154 1
  verbose <- Arguments$getVerbose(verbose)
155 1
  if (verbose) {
156 1
    pushState(verbose)
157 1
    on.exit(popState(verbose))
158
  }
159

160 1
  verbose && enter(verbose, "rstring() for ", class(object)[1L])
161

162 1
  verbose && enter(verbose, "Coerce RSP document to source code")
163
#  language <- getAttribute(object, "language", default="R")
164 1
  language <- getMetadata(object, "language", default="R")
165 1
  language <- capitalize(tolower(language))
166 1
  className <- sprintf("Rsp%sSourceCodeFactory", language)
167 1
  ns <- getNamespace("R.rsp")
168 1
  clazz <- Class$forName(className, envir=ns)
169 1
  factory <- newInstance(clazz)
170 1
  verbose && cat(verbose, "Language: ", getLanguage(factory))
171 1
  code <- toSourceCode(factory, object, verbose=verbose)
172 1
  verbose && cat(verbose, "Generated source code:")
173 1
  verbose && cat(verbose, head(code, n=3L))
174 1
  verbose && cat(verbose)
175 1
  verbose && cat(verbose, "[...]")
176 1
  verbose && cat(verbose)
177 1
  verbose && cat(verbose, tail(code, n=3L))
178 1
  verbose && exit(verbose)
179

180 1
  res <- rstring(code, ..., envir=envir, verbose=verbose)
181

182 1
  verbose && exit(verbose)
183

184 1
  res
185
}) # rstring()
186

187

188
setMethodS3("rstring", "RspSourceCode", function(object, envir=parent.frame(), ..., verbose=FALSE) {
189
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
190
  # Validate arguments
191
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
192
  # Argument 'verbose':
193 1
  verbose <- Arguments$getVerbose(verbose)
194 1
  if (verbose) {
195 1
    pushState(verbose)
196 1
    on.exit(popState(verbose))
197
  }
198

199 1
  verbose && enter(verbose, "rstring() for ", class(object)[1L])
200 1
  verbose && cat(verbose, "Environment: ", getName(envir))
201

202 1
  res <- process(object, envir=envir, ..., verbose=less(verbose,10))
203

204 1
  verbose && exit(verbose)
205

206 1
  res
207
}) # rstring()
208

209

210

211
setMethodS3("rstring", "function", function(object, envir=parent.frame(), ..., verbose=FALSE) {
212
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
213
  # Validate arguments
214
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
215
  # Argument 'object':
216

217
  # Argument 'verbose':
218 1
  verbose <- Arguments$getVerbose(verbose)
219 1
  if (verbose) {
220 0
    pushState(verbose)
221 0
    on.exit(popState(verbose))
222
  }
223

224 1
  verbose && enter(verbose, "rstring() for ", class(object)[1L])
225 1
  verbose && cat(verbose, "Environment: ", getName(envir))
226

227
  ## Temporarily assign the function to the evaluation environment
228
  ## and set its own environment also to the evaluation environment
229 1
  fcn <- object
230 1
  environment(fcn) <- envir
231 1
  fcnName <- tempvar(".rfcn", value=fcn, envir=envir)
232 1
  on.exit({
233 1
    rm(list=fcnName, envir=envir, inherits=FALSE)
234 1
  }, add=TRUE)
235 1
  code <- sprintf("%s()", fcnName)
236 1
  rcode <- RspRSourceCode(code)
237 1
  res <- rstring(rcode, envir=envir, ..., verbose=less(verbose,10))
238

239 1
  verbose && exit(verbose)
240

241 1
  res
242
}) # rstring()
243

244

245
setMethodS3("rstring", "expression", function(object, envir=parent.frame(), ..., verbose=FALSE) {
246
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
247
  # Validate arguments
248
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
249
  # Argument 'object':
250

251
  # Argument 'verbose':
252 0
  verbose <- Arguments$getVerbose(verbose)
253 0
  if (verbose) {
254 0
    pushState(verbose)
255 0
    on.exit(popState(verbose))
256
  }
257

258 0
  verbose && enter(verbose, "rstring() for ", class(object)[1L])
259 0
  verbose && cat(verbose, "Environment: ", getName(envir))
260
  # Deparsing 'object[[1L]]' instead of 'object' in order to drop
261
  # the 'expression({ ... })' wrapper.
262 0
  code <- deparse(object[[1L]])
263 0
  rcode <- RspRSourceCode(code)
264 0
  res <- rstring(rcode, envir=envir, ..., verbose=less(verbose,10))
265 0
  verbose && exit(verbose)
266

267 0
  res
268
}) # rstring()

Read our documentation on viewing source code .

Loading