├── .Rbuildignore ├── .all-contributorsrc ├── .gitignore ├── .lintr ├── .travis.yml ├── CONDUCT.md ├── DESCRIPTION ├── LICENSE ├── Makefile ├── NAMESPACE ├── R ├── context.R ├── execute.R ├── host-http-server.R ├── host.R ├── json.R ├── main.R ├── r-context.R └── type.R ├── README.md ├── _pkgdown.yml ├── getting-started.md ├── index.md ├── inst ├── rstudio │ └── addins.dcf └── static │ ├── favicon.ico │ ├── index.html │ └── logo-name-beta.svg ├── man ├── Context.Rd ├── Host.Rd ├── HostHttpServer.Rd ├── RContext.Rd ├── environ.Rd ├── host-instance.Rd ├── open.Rd ├── register.Rd ├── run.Rd ├── spawn.Rd ├── start.Rd └── stop_.Rd ├── stencila.Rproj └── tests ├── testthat.R └── testthat ├── test-context.R ├── test-dir-1 └── main.md ├── test-dir-2 └── db.sqlite ├── test-host-http-server.R ├── test-host.R ├── test-lib-1 └── funcs │ ├── func1.R │ ├── func2.R │ └── func3.R └── test-r-context.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^.*\.sublime-workspace$ 4 | ^.*\.sublime-project$ 5 | ^\.travis\.yml$ 6 | ^\.sandbox$ 7 | ^Makefile$ 8 | ^LICENSE$ 9 | ^index.md$ 10 | ^CONDUCT.md$ 11 | ^_pkgdown\.yml$ 12 | ^stencila_.+\.tar\.gz$ 13 | ^docs$ 14 | ^\.lintr$ 15 | -------------------------------------------------------------------------------- /.all-contributorsrc: -------------------------------------------------------------------------------- 1 | { 2 | "projectName": "r", 3 | "projectOwner": "stencila", 4 | "repoType": "github", 5 | "repoHost": "https://github.com", 6 | "files": [ 7 | "README.md" 8 | ], 9 | "imageSize": 100, 10 | "commit": true, 11 | "contributors": [ 12 | { 13 | "login": "apawlik", 14 | "name": "Aleksandra Pawlik", 15 | "avatar_url": "https://avatars2.githubusercontent.com/u/2358535?v=4", 16 | "profile": "http://stenci.la", 17 | "contributions": [ 18 | "code" 19 | ] 20 | }, 21 | { 22 | "login": "daniellecrobinson", 23 | "name": "Danielle Robinson", 24 | "avatar_url": "https://avatars2.githubusercontent.com/u/13207169?v=4", 25 | "profile": "https://github.com/daniellecrobinson", 26 | "contributions": [ 27 | "doc" 28 | ] 29 | }, 30 | { 31 | "login": "RaoOfPhysics", 32 | "name": "Achintya Rao", 33 | "avatar_url": "https://avatars2.githubusercontent.com/u/7623019?v=4", 34 | "profile": "https://scholar.social/@RaoOfPhysics", 35 | "contributions": [ 36 | "doc" 37 | ] 38 | }, 39 | { 40 | "login": "nuest", 41 | "name": "Daniel Nüst", 42 | "avatar_url": "https://avatars1.githubusercontent.com/u/1325054?v=4", 43 | "profile": "http://nordholmen.net", 44 | "contributions": [ 45 | "code" 46 | ] 47 | }, 48 | { 49 | "login": "harryprince", 50 | "name": "HarryZhu", 51 | "avatar_url": "https://avatars2.githubusercontent.com/u/5362577?v=4", 52 | "profile": "https://github.com/harryprince", 53 | "contributions": [ 54 | "doc" 55 | ] 56 | }, 57 | { 58 | "login": "nokome", 59 | "name": "Nokome Bentley", 60 | "avatar_url": "https://avatars0.githubusercontent.com/u/1152336?v=4", 61 | "profile": "https://github.com/nokome", 62 | "contributions": [ 63 | "code" 64 | ] 65 | } 66 | ] 67 | } 68 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Generated docs 2 | /docs 3 | 4 | # History and session Data files 5 | .Rhistory 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | .Rproj.user 20 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: with_defaults( 2 | line_length_linter = line_length_linter(180), 3 | absolute_paths_linter = NULL) 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | 3 | r: 4 | - oldrel 5 | - release 6 | - devel 7 | 8 | bioc_packages: 9 | - graph 10 | 11 | r_github_packages: 12 | - r-lib/covr 13 | - r-lib/pkgdown 14 | 15 | cache: packages 16 | 17 | warnings_are_errors: false 18 | 19 | after_success: 20 | # Run and upload test coverage to codecov.io 21 | - Rscript -e 'covr::codecov()' 22 | # Build docs 23 | - Rscript -e 'devtools::document(); pkgdown::build_site()' 24 | 25 | deploy: 26 | # Deploy documentation to Github Pages 27 | # See https://docs.travis-ci.com/user/deployment/pages/ 28 | provider: pages 29 | skip-cleanup: true 30 | github-token: $GITHUB_TOKEN 31 | local-dir: docs 32 | on: 33 | branch: master 34 | -------------------------------------------------------------------------------- /CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of experience, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at conduct@stenci.la. All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant](http://contributor-covenant.org), version 1.4, 71 | available at [http://contributor-covenant.org/version/1/4](http://contributor-covenant.org/version/1/4/). 72 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: stencila 2 | Type: Package 3 | Title: Stencila for R 4 | Description: Create R execution contexts to use in Stencila, the office suite for reproducible research. 5 | Authors@R: c(person("Nokome", "Bentley", email = "nokome@stenci.la", role = c("aut", "cre"))) 6 | URL: https://github.com/stencila/r#readme 7 | BugReports: https://github.com/stencila/r/issues 8 | License: Apache-2.0 9 | Version: 0.29.1 10 | LazyData: TRUE 11 | Imports: 12 | base64enc, 13 | CodeDepends, 14 | DBI, 15 | evaluate, 16 | httpuv, 17 | jose, 18 | jsonlite, 19 | mime, 20 | methods, 21 | R6, 22 | stringr, 23 | tools, 24 | urltools, 25 | uuid 26 | Suggests: 27 | covr, 28 | devtools, 29 | lintr, 30 | testthat 31 | RoxygenNote: 6.1.1.9000 32 | Collate: 33 | 'context.R' 34 | 'execute.R' 35 | 'host-http-server.R' 36 | 'r-context.R' 37 | 'host.R' 38 | 'json.R' 39 | 'main.R' 40 | 'type.R' 41 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: setup build 2 | 3 | setup: 4 | Rscript -e 'install.packages(c("devtools","roxygen2","testthat","covr","lintr"),repo="http://cloud.r-project.org/")' 5 | Rscript -e 'devtools::install_github("hadley/pkgdown")' 6 | 7 | build: 8 | Rscript -e 'devtools::document()' 9 | R CMD build . 10 | 11 | install: 12 | Rscript -e 'devtools::install()' 13 | 14 | docs: 15 | Rscript -e 'devtools::document(); pkgdown::build_site()' 16 | .PHONY: docs 17 | 18 | run: 19 | Rscript -e 'stencila::run()' 20 | 21 | check: 22 | R CMD check $$(ls stencila_*.tar.gz | tail -n 1) 23 | 24 | check-as-cran: 25 | R CMD check $$(ls stencila_*.tar.gz | tail -n 1) --as-cran 26 | 27 | lint: 28 | Rscript -e 'lintr::lint_package()' 29 | 30 | test: 31 | Rscript -e 'devtools::document(); devtools::test()' 32 | 33 | cover: 34 | Rscript -e 'covr::package_coverage()' 35 | 36 | clean: 37 | rm -rf ..Rcheck 38 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(RContext) 4 | export(execute) 5 | export(host) 6 | export(open) 7 | export(register) 8 | export(run) 9 | export(spawn) 10 | export(start) 11 | export(stop_) 12 | import(methods) 13 | import(stringr) 14 | import(tools) 15 | importFrom(grDevices,dev.off) 16 | importFrom(grDevices,png) 17 | importFrom(grDevices,replayPlot) 18 | importFrom(utils,capture.output) 19 | importFrom(utils,read.csv) 20 | importFrom(utils,write.csv) 21 | -------------------------------------------------------------------------------- /R/context.R: -------------------------------------------------------------------------------- 1 | #' A base for context classes to share implementation of 2 | #' variable packing and unpacking 3 | Context <- R6::R6Class("Context", 4 | public = list( 5 | 6 | compile = function(cell) { 7 | lang <- NULL 8 | code <- "" 9 | expr <- FALSE 10 | global <- FALSE 11 | inputs <- list() 12 | if (typeof(cell) == "character") { 13 | code <- cell 14 | } else { 15 | if (!is.null(cell$code)) code <- cell$code 16 | else if (!is.null(cell$source) & !is.null(cell$source$data)) code <- cell$source$data # legacy structure 17 | if (!is.null(cell$expr)) expr <- cell$expr 18 | if (!is.null(cell$global)) global <- cell$global 19 | if (!is.null(cell$inputs)) inputs <- cell$inputs 20 | } 21 | 22 | list( 23 | type = "cell", 24 | lang = lang, 25 | code = code, 26 | expr = expr, 27 | global = global, 28 | options = list(), 29 | inputs = inputs, 30 | outputs = list(), 31 | messages = list() 32 | ) 33 | }, 34 | 35 | pack = function (value) { 36 | type <- type(value) 37 | # Of course, the order of these if statements is important. 38 | # Rearrange with caution (and testing!) 39 | if (type == "table") { 40 | df <- as.data.frame(value) 41 | list( 42 | type = "table", 43 | data = list( 44 | type = "table", 45 | columns = ncol(df), 46 | rows = nrow(df), 47 | # Limit the amount of data actually sent 48 | data = head(df, n=100) 49 | ) 50 | ) 51 | } else if (type == "plot") { 52 | format <- "src" 53 | path <- tempfile(fileext = paste0(".", format)) 54 | png(path) 55 | if (inherits(value, "recordedplot")) replayPlot(value) 56 | else print(value) 57 | dev.off() 58 | list ( 59 | type = "image", 60 | src = paste0("data:image/", format, ";base64,", base64enc::base64encode(path)) 61 | ) 62 | } else if (type == "unknown") { 63 | # Unknown types serialised using `print` which may be customised 64 | # e.g. `print.table` is used for the results of `summary` 65 | content <- paste(capture.output(print(value)), collapse = "\n") 66 | } else { 67 | list( 68 | type = type, 69 | data = value 70 | ) 71 | } 72 | }, 73 | 74 | unpack = function (packed) { 75 | # If necessary convert JSON to list 76 | if (inherits(packed, "character")) { 77 | packed <- from_json(packed) 78 | } 79 | # Ensure data package is a list with necessary properties 80 | if (!inherits(packed, "list") ) { 81 | stop("should be a list") 82 | } 83 | if (!"type" %in% names(packed)) { 84 | stop("should have field `type`") 85 | } 86 | 87 | type <- packed$type 88 | if (type == "array") { 89 | if (is.list(packed$data) && length(packed$data) == 0) vector() 90 | else packed$data 91 | } else if (type == "table") { 92 | do.call(data.frame, c(packed$data$data, stringsAsFactors = FALSE)) 93 | } else { 94 | packed$data 95 | } 96 | }, 97 | 98 | libraries = function (...) { 99 | list() 100 | } 101 | ) 102 | ) 103 | -------------------------------------------------------------------------------- /R/execute.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | execute <- function (operation, scope = list()) { 3 | if (is.atomic(operation) | mode(operation) == "function") operation 4 | else if (operation$type == "get") { 5 | value <- scope[[operation$name]] 6 | if (is.null(value)) value <- functions[[operation$name]] 7 | if (is.null(value)) stop("Could not find variable: \"", operation$name, "\"") 8 | value 9 | } else if (operation$type == "call") { 10 | func <- execute(operation$func, scope) 11 | if (mode(func) == "function") { 12 | args <- as.list(operation$args) 13 | do.call(func, args) 14 | } else { 15 | stop("Value is not a function: \"", func, "\"") 16 | } 17 | } else { 18 | operation 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /R/host-http-server.R: -------------------------------------------------------------------------------- 1 | #' A HTTP server for a Host 2 | #' 3 | #' Normally there is no need to create a new \code{HostHttpServer}, instead 4 | #' use the \code{start} method of the \code{host} instance. 5 | #' 6 | #' Note for developers: the general approach taken in developing this class is 7 | #' to mirror implementations in Node and Python to make it easier to port 8 | #' code between the languages and ensure consisten implementations. 9 | #' 10 | #' @format \code{R6Class}. 11 | HostHttpServer <- R6::R6Class("HostHttpServer", 12 | public = list( 13 | #' @section new(): 14 | #' 15 | #' \describe{ 16 | #' \item{host}{The host to be served} 17 | #' \item{address}{The port to listen on. Default \code{'127.0.0.1'}} 18 | #' \item{port}{The port to listen on. Default \code{2000}} 19 | #' } 20 | initialize = function(host, address="127.0.0.1", port=2000) { 21 | private$.host <- host 22 | private$.address <- address 23 | private$.port <- port 24 | private$.server <- NULL 25 | }, 26 | 27 | #' @section start(): 28 | #' 29 | #' Start the server 30 | start = function() { 31 | if (is.null(private$.server)) { 32 | while (private$.port < 65535) { 33 | result <- tryCatch( 34 | httpuv::startServer(private$.address, private$.port, list(call = self$handle)), 35 | error = identity 36 | ) 37 | if (inherits(result, "error")) { 38 | if (result$message == "Failed to create server") { 39 | private$.port <- private$.port + 10 40 | } else { 41 | stop(result$message) # nocov 42 | } 43 | } else { 44 | private$.server <- result 45 | break 46 | } 47 | } 48 | } 49 | }, 50 | 51 | #' @section stop(): 52 | #' 53 | #' Stop the server 54 | stop = function() { 55 | if (!is.null(private$.server)) { 56 | httpuv::stopServer(private$.server) 57 | private$.server <- NULL 58 | } 59 | }, 60 | 61 | #' @section handle(): 62 | #' 63 | #' Handle a HTTP request 64 | handle = function(env) { 65 | response <- tryCatch({ 66 | # Create request, getthing variables from request environment 67 | # See https://github.com/jeffreyhorner/Rook#the-environment for further details. 68 | request <- list( 69 | path = httpuv::decodeURIComponent(env$PATH_INFO), 70 | query = if (!is.null(env$QUERY_STRING)) httpuv::decodeURIComponent(env$QUERY_STRING) else "", 71 | method = env$REQUEST_METHOD, 72 | headers = list( 73 | Accept = env$HTTP_ACCEPT, 74 | Authorization = env$HTTP_AUTHORIZATION, 75 | Cookie = env$HTTP_COOKIE, 76 | Referer = env$HTTP_REFERER, 77 | Origin = env$HTTP_ORIGIN 78 | ), 79 | body = paste(env$rook.input$read_lines(), collapse = "") 80 | ) 81 | 82 | # Create empty response 83 | response <- list( 84 | body = "", 85 | status = 200, 86 | headers = list() 87 | ) 88 | 89 | # Check authorization 90 | authorized <- FALSE 91 | if (is.null(private$.host$key)) { 92 | authorized <- TRUE 93 | } else { 94 | auth_header <- request$headers$Authorization 95 | if (!is.null(auth_header)) { 96 | token <- str_match(auth_header, "^Bearer (.+)")[, 2] 97 | payload <- tryCatch(private$.host$authorize_token(token)) 98 | if (inherits(payload, "error")) { 99 | return (self$error403(request, response, toString(error))) 100 | } else { 101 | authorized <- TRUE 102 | } 103 | } 104 | } 105 | 106 | # Add CORS headers used to control access by browsers. In particular, CORS 107 | # can prevent access by XHR requests made by Javascript in third party sites. 108 | # See https://developer.mozilla.org/en-US/docs/Web/HTTP/Access_control_CORS 109 | 110 | # Get the Origin header (sent in CORS and POST requests) and fall back to Referer header 111 | # if it is not present (either of these should be present in most browser requests) 112 | origin <- request$headers$Origin 113 | if (is.null(origin) & !is.null(request$headers$Referer)) { 114 | origin <- str_match(request$headers$Referer, "^https?://([\\w.]+)(:\\d+)?")[1, 1] 115 | } 116 | 117 | # Check that origin is in whitelist of file://, http://127.0.0.1, http://localhost, or http://*.stenci.la 118 | # The origin "file://" is sent when a connection is made from Electron (i.e Stencila Desktop) 119 | if (!is.null(origin)) { 120 | if (origin != "file://") { 121 | host <- str_match(origin, "^https?://([\\w.]+)(:\\d+)?")[1, 2] 122 | if (!str_detect(host, "(127\\.0\\.0\\.1)|(localhost)|(([^.]+\\.)?stenci.la)$")) origin <- NULL 123 | } 124 | } 125 | 126 | # If an origin has been found and is authorized set CORS headers 127 | # Without these headers browser XHR request get an error like: 128 | # No "Access-Control-Allow-Origin" header is present on the requested resource. 129 | # Origin "http://evil.hackers:4000" is therefore not allowed access. 130 | if (!is.null(origin)) { 131 | # "Simple" requests (GET and POST XHR requests) 132 | response$headers <- c(response$headers, list( 133 | "Access-Control-Allow-Origin" = origin, 134 | # Allow sending cookies and other credentials 135 | "Access-Control-Allow-Credentials" = "true" 136 | )) 137 | # Pre-flighted requests by OPTIONS method (made before PUT, DELETE etc XHR requests and in other circumstances) 138 | # get additional CORS headers 139 | if (request$method == "OPTIONS") { 140 | response$headers <- c(response$headers, list( 141 | # Allowable methods and headers 142 | "Access-Control-Allow-Methods" = "GET, POST, PUT, DELETE, OPTIONS", 143 | "Access-Control-Allow-Headers" = "Authorization, Content-Type", 144 | # "how long the response to the preflight request can be cached for without sending another preflight request" 145 | "Access-Control-Max-Age" = "86400" # 24 hours 146 | )) 147 | } 148 | } 149 | 150 | if (request$method == "OPTIONS") { 151 | # For preflighted CORS OPTIONS requests return an empty response with headers set 152 | # (https://developer.mozilla.org/en-US/docs/Web/HTTP/Access_control_CORS#Preflighted_requests) 153 | return(response) 154 | } else { 155 | endpoint <- self$route(request$method, request$path, authorized) 156 | method_name <- endpoint[1] 157 | method_args <- endpoint[2:length(endpoint)] 158 | method <- self[[method_name]] 159 | response <- do.call(method, c(list(request = request, response = response), method_args)) 160 | return(response) 161 | } 162 | }, error = identity) # nolint (end of tryCatch block) 163 | 164 | if (inherits(response, "error")) self$error500(request, error=response) 165 | else response 166 | }, 167 | 168 | #' @section route(): 169 | #' 170 | #' Route a HTTP request 171 | route = function(verb, path = NULL, authorized = FALSE) { 172 | if (path == "/") return(c("static", "index.html")) 173 | if (str_sub(path, 1, 8) == "/static/") return(c("static", str_sub(path, 9))) 174 | 175 | version <- str_match(path, "^/(v\\d+)")[, 2] 176 | if (is.na(version)) { 177 | # Unversioned API endpoints 178 | if (path == "/manifest") return(c("run", "manifest")) 179 | 180 | if (!authorized) return(c("error401", path)) 181 | 182 | if (str_sub(path, 1, 9) == "/environ/") { 183 | if (verb == "POST") return(c("run", "startup", str_sub(path, 10))) 184 | if (verb == "DELETE") return(c("run", "shutdown", str_sub(path, 10))) 185 | } 186 | 187 | match <- str_match(path, "^/(.+?)(!(.+))?$") 188 | if (!is.na(match[1, 1])) { 189 | id <- match[1, 2] 190 | method <- match[1, 4] 191 | if (verb == "POST" & !is.null(id)) return(c("run", "create", id)) 192 | if (verb == "DELETE" & !is.null(id)) return(c("run", "destroy", id)) 193 | if (verb == "PUT" & !is.null(id) & !is.null(method)) return(c("run", "call", id, method)) 194 | } 195 | } else if (version == "v1") { 196 | # Versioned API endpoints 197 | parts <- str_split(path, "/")[[1]][-1] 198 | resource <- parts[2] 199 | 200 | if (verb == "GET" && resource %in% c("manifest", "environs", "services")) return(c("run", resource)) 201 | 202 | if (!authorized) return(c("error401", path)) 203 | 204 | if (resource == "hosts") { 205 | id <- parts[3] 206 | if (verb == "GET") return(c("run", "hosts")) 207 | if (verb == "POST" && !is.null(id)) return(c("run", "startup", id)) 208 | if (verb == "DELETE" && !is.null(id)) return(c("run", "shutdown", id)) 209 | } 210 | 211 | if (resource == "instances") { 212 | id <- parts[3] 213 | method <- parts[4] 214 | if (verb == "GET") return(c("run", "instances")) 215 | if (verb == "POST" && !is.null(id)) return(c("run", "create", id)) 216 | if (verb == "DELETE" && !is.null(id)) return(c("run", "destroy", id)) 217 | if (verb == "PUT" && !is.null(id) & !is.null(method)) return(c("run", "call", id, method)) 218 | } 219 | } 220 | 221 | return(c("error400", path)) 222 | }, 223 | 224 | #' @section static(): 225 | #' 226 | #' Handle a request for a static file 227 | static = function(request, response, path) { 228 | static_path <- normalizePath(system.file("static", package = "stencila"), winslash = "/") 229 | requested_path <- suppressWarnings(normalizePath(file.path(static_path, path), winslash = "/")) 230 | if (!str_detect(requested_path, paste0("^", static_path)) | str_detect(requested_path, "\\.\\./")) { 231 | # Don't allow any request outside of static folder 232 | self$error403(request, response, requested_path) 233 | } else if (!file.exists(requested_path)) { 234 | self$error404(request, response, requested_path) 235 | } else { 236 | file_connection <- file(requested_path, "r") 237 | lines <- suppressWarnings(readLines(file_connection)) 238 | content <- paste(lines, collapse = "\n") 239 | close(file_connection) 240 | mimetype <- mime::guess_type(path) 241 | 242 | response$body <- content 243 | response$headers["Content-Type"] <- mimetype 244 | response 245 | } 246 | }, 247 | 248 | #' @section run(): 249 | #' 250 | #' Handle a request to call a host method 251 | run = function(request, response, method, ...) { 252 | args <- list(...) 253 | if (!is.null(request$body) && nchar(request$body) > 0) { 254 | args[[length(args) + 1]] <- from_json(request$body) 255 | } 256 | result <- do.call(private$.host[[method]], args) 257 | 258 | response$body <- to_json(result) 259 | response$headers["Content-Type"] <- "application/json" 260 | response 261 | }, 262 | 263 | #' @section error(): 264 | #' 265 | #' Generate an error response 266 | error = function(request, response, code, name, what = "") { 267 | response$status <- code 268 | response$body <- paste0(name, ": ", what) 269 | response$headers["Content-Type"] <- "text/plain" 270 | response 271 | }, 272 | 273 | #' @section error400(): 274 | #' 275 | #' Generate a 400 error 276 | error400 = function(request, response, what = "") { 277 | self$error(request, response, 400, "Bad request", what) 278 | }, 279 | 280 | #' @section error401(): 281 | #' 282 | #' Generate a 401 error 283 | error401 = function(request, response, what = "") { 284 | self$error(request, response, 401, "Unauthorized", what) 285 | }, 286 | 287 | #' @section error403(): 288 | #' 289 | #' Generate a 403 error 290 | error403 = function(request, response, what = "") { 291 | self$error(request, response, 403, "Forbidden", what) 292 | }, 293 | 294 | #' @section error404(): 295 | #' 296 | #' Generate a 404 error 297 | error404 = function(request, response, what = "") { 298 | self$error(request, response, 404, "Not found", what) 299 | }, 300 | 301 | #' @section error500(): 302 | #' 303 | #' Generate a 500 error 304 | error500 = function(request, error) { 305 | response <- list( 306 | headers = list() 307 | ) 308 | message <- paste(toString(error), .traceback(), collapse='\n') 309 | self$error(request, response, 500, "Internal error", message) # nocov 310 | } 311 | ), 312 | 313 | active = list( 314 | #' @section address: 315 | #' 316 | #' The address of the server 317 | address = function() { 318 | private$.address 319 | }, 320 | 321 | #' @section port: 322 | #' 323 | #' The port of the server 324 | port = function() { 325 | private$.port 326 | }, 327 | 328 | #' @section url: 329 | #' 330 | #' The URL of the server, or \code{NULL} if not yet started 331 | url = function() { 332 | if (is.null(private$.server)) NULL 333 | else paste0("http://", private$.address, ":", private$.port) 334 | } 335 | ), 336 | 337 | private = list( 338 | .host = NULL, 339 | .address = NULL, 340 | .port = NULL, 341 | .server = NULL 342 | ) 343 | ) 344 | -------------------------------------------------------------------------------- /R/host.R: -------------------------------------------------------------------------------- 1 | # List of types that hosts supports 2 | #' @include r-context.R 3 | TYPES <- list( 4 | RContext = RContext 5 | ) 6 | 7 | # List of specifications for the types 8 | TYPES_SPECS <- list() 9 | for (name in names(TYPES)) { 10 | TYPES_SPECS[[name]] <- TYPES[[name]]$spec 11 | } 12 | 13 | #' A Host 14 | #' 15 | #' Hosts allows you to remotely create, get, run methods of, and delete instances of various types. 16 | #' The types can be thought of a "services" provided by the host e.g. `RContext`, `FileSystemStorer` 17 | #' 18 | #' The API of a host is similar to that of a HTTP server. It's methods names 19 | #' (e.g. `post`, `get`) are similar to HTTP methods (e.g. `POST`, `GET`) but 20 | #' the sematics sometimes differ (e.g. a host's `put()` method is used to call an 21 | #' instance method) 22 | #' 23 | #' A host's methods are exposed by `HostHttpServer` and `HostWebsocketServer`. 24 | #' Those other classes are responsible for tasks associated with their communication 25 | #' protocol (e.g. serialising and deserialising objects). 26 | #' 27 | #' This is a singleton class. There should only ever be one `Host` in memory in each process 28 | #' (although, for purposes of testing, this is not enforced) 29 | #' 30 | #' @format \code{R6Class}. 31 | #' @examples 32 | #' host$servers 33 | #' host$start() 34 | #' host$servers 35 | #' host$stop() 36 | Host <- R6::R6Class("Host", 37 | public = list( 38 | 39 | #' @section new(): 40 | #' 41 | #' Create a new \code{Host} 42 | initialize = function () { 43 | private$.id <- paste0("r-host-", uuid::UUIDgenerate()) 44 | if (Sys.getenv("STENCILA_AUTH") == "false") { 45 | key <- NULL 46 | } else { 47 | key <- paste(sample(c(letters, 0:9), 64, replace = TRUE), collapse = "") 48 | } 49 | private$.key <- key 50 | private$.servers <- list() 51 | private$.instances <- list() 52 | }, 53 | 54 | #' @section user_dir(): 55 | #' 56 | #' Get the current user's Stencila data directory. 57 | #' 58 | #' This is the directory that Stencila configuration settings, such as the 59 | #' installed Stencila hosts, and document buffers get stored. 60 | user_dir = function() { 61 | os <- tolower(Sys.info()["sysname"]) 62 | dir <- switch(os, 63 | darwin = file.path(Sys.getenv("HOME"), "Library", "Application Support", "Stencila"), 64 | linux = file.path(Sys.getenv("HOME"), ".stencila"), 65 | windows = file.path(Sys.getenv("APPDATA"), "Stencila") 66 | ) 67 | if (!dir.exists(dir)) dir.create(dir, recursive = T) 68 | dir 69 | }, 70 | 71 | #' @section temp_dir(): 72 | #' 73 | #' Get the current user's Stencila temporary directory 74 | #' 75 | #' This directory is used by Stencila for files such as "run files" (see below) 76 | temp_dir = function() { 77 | # Get system's temporary directory 78 | # Thanks to Steve Weston at https://stackoverflow.com/a/16492084/4625911 79 | os <- tolower(Sys.info()["sysname"]) 80 | envs <- Sys.getenv(c("TMPDIR", "TMP", "TEMP")) 81 | useable <- which(file.info(envs)$isdir & file.access(envs, 2) == 0) 82 | if (length(useable) > 0) 83 | temp <- envs[[useable[1]]] 84 | else if (os == "windows") 85 | temp <- Sys.getenv("R_USER") 86 | else 87 | temp <- "/tmp" 88 | dir <- file.path(temp, "stencila") 89 | if (!dir.exists(dir)) dir.create(dir, recursive = T) 90 | dir 91 | }, 92 | 93 | #' @section run_file(): 94 | #' 95 | #' Get the path of the "run file" for this host. 96 | #' 97 | #' A run file is used to indicate that a particular host is running 98 | #' and allow other Stencila processes on the same machine 99 | #' to communicate with it. It is created by by \code{host$start()} and 100 | #' destroyed by \code{host$stop()}. It is placed in the machine's temporarily 101 | #' directory to reduce the chances of a run file being present when a host 102 | #' has aborted with out by \code{host$stop()} being called. 103 | run_file = function() { 104 | dir <- file.path(self$temp_dir(), "hosts") 105 | if (!file.exists(dir)) dir.create(dir, recursive = TRUE) 106 | file.path(dir, paste0(self$id, ".json")) 107 | }, 108 | 109 | #' @section new(): 110 | #' 111 | #' Get the environment of this \code{Host} including the version of R 112 | #' and the version of installed packages. 113 | environ = function () { 114 | # R 115 | env <- with(R.version, list( 116 | version = paste(major, minor, sep = "."), 117 | codename = nickname, 118 | date = paste(year, month, day, sep = "-"), 119 | platform = platform 120 | )) 121 | # Installed packages and their versions in order of library paths 122 | # to prevent duplicates caused by the same package being in multiple libraries 123 | packages <- list() 124 | for (library in .libPaths()) { 125 | library_packages <- installed.packages(library)[, c(1, 3)] 126 | if (nrow(library_packages)) { 127 | for (row in 1:nrow(library_packages)) { 128 | name <- library_packages[row, 1] 129 | if (!(name %in% names(packages))) { 130 | version <- library_packages[row, 2] 131 | packages[[name]] <- version 132 | } 133 | } 134 | } 135 | } 136 | env[["packages"]] <- packages[sort(names(packages))] 137 | env 138 | }, 139 | 140 | #' @section manifest(): 141 | #' 142 | #' Get a manifest for this host 143 | #' 144 | #' The manifest describes the host and it's capabilities. It is used 145 | #' by peer hosts to determine which "types" this host provides and 146 | #' which "instances" have already been instantiated. 147 | manifest = function (complete=TRUE) { 148 | environs <- list( 149 | list(id = "local", name = "local", version = "") 150 | ) 151 | manifest <- list( 152 | stencila = list( 153 | package = "r", 154 | version = version 155 | ), 156 | id = private$.id, 157 | spawn = c(unname(Sys.which("Rscript")), "-e", "stencila:::spawn()"), 158 | environs = environs, 159 | types = TYPES_SPECS 160 | ) 161 | if (complete) { 162 | manifest <- c(manifest, list( 163 | machine = list(), 164 | process = list( 165 | pid = Sys.getpid() 166 | ), 167 | servers = self$servers 168 | )) 169 | } 170 | manifest 171 | }, 172 | 173 | #' @section register(): 174 | #' 175 | #' Register this Stencila \code{Host} on this machine. 176 | #' 177 | #' Registering a host involves creating a file \code{r.json} inside of 178 | #' the user's Stencila data (see \code{user_dir}) directory which describes 179 | #' the capabilities of this host. 180 | register = function () { 181 | dir <- file.path(self$user_dir(), "hosts") 182 | if (!file.exists(dir)) dir.create(dir, recursive = TRUE) 183 | cat( 184 | jsonlite::toJSON( 185 | self$manifest(complete = FALSE), 186 | pretty = TRUE, auto_unbox = TRUE 187 | ), 188 | file = file.path(dir, "r.json") 189 | ) 190 | }, 191 | 192 | # TODO: these methods implement edndpoints for 193 | # starting and stopping hosts in other environments 194 | # (e.g. a Docker container). Currently, only 'local' 195 | # environment is supported 196 | startup = function (environ) { 197 | list(path = "") 198 | }, 199 | shutdown = function (host) { 200 | TRUE 201 | }, 202 | 203 | #' @section create(): 204 | #' 205 | #' Create a new instance of a type 206 | #' 207 | #' \describe{ 208 | #' \item{type}{Type of new instance} 209 | #' \item{args}{Arguments to be passed to type constructor} 210 | #' \item{name}{Name of new instance. Depreciated but retained for compatability.} 211 | #' \item{return}{Address of the newly created instance} 212 | #' } 213 | create = function (type, args = list(), name = NULL) { 214 | Class <- TYPES[[type]] 215 | if (!is.null(Class)) { 216 | # Remove depreciated `name` arg from arguments 217 | args[["name"]] <- NULL 218 | instance <- do.call(Class$new, args) 219 | # Generate and ID 220 | id <- paste0(type, paste(sample(c(letters, 0:9), 10), collapse = "")) 221 | private$.instances[[id]] <- instance 222 | id 223 | } else { 224 | stop(paste("Unknown type:", type)) 225 | } 226 | }, 227 | 228 | #' @section get(): 229 | #' 230 | #' Get an instance 231 | #' 232 | #' \describe{ 233 | #' \item{id}{ID of instance} 234 | #' \item{return}{The instance} 235 | #' } 236 | get = function (id) { 237 | instance <- private$.instances[[id]] 238 | if (!is.null(instance)) { 239 | instance 240 | } else { 241 | stop(paste("Unknown instance:", id)) 242 | } 243 | }, 244 | 245 | #' @section call(): 246 | #' 247 | #' Call a method of an instance 248 | #' 249 | #' \describe{ 250 | #' \item{id}{ID of instance} 251 | #' \item{method}{Name of instance method} 252 | #' \item{arg}{The argument to pass to the method} 253 | #' \item{return}{The result of the method call} 254 | #' } 255 | call = function (id, method, arg = NULL) { 256 | instance <- private$.instances[[id]] 257 | if (!is.null(instance)) { 258 | func <- instance[[method]] 259 | if (!is.null(func)) { 260 | do.call(func, list(arg)) 261 | } else { 262 | stop(paste("Unknown method:", method)) 263 | } 264 | } else { 265 | stop(paste("Unknown instance:", id)) 266 | } 267 | }, 268 | 269 | #' @section delete(): 270 | #' 271 | #' Delete an instance 272 | #' 273 | #' \describe{ 274 | #' \item{id}{ID of the instance} 275 | #' } 276 | delete = function (id) { 277 | instance <- private$.instances[[id]] 278 | if (!is.null(instance)) { 279 | private$.instances[[id]] <- NULL 280 | } else { 281 | stop(paste("Unknown instance:", id)) 282 | } 283 | }, 284 | 285 | #' @section start(): 286 | #' 287 | #' Start serving this host 288 | #' 289 | #' \describe{ 290 | #' \item{address}{The address to listen. Default '127.0.0.1'} 291 | #' \item{port}{The port to listen on. Default 2000} 292 | #' \item{quiet}{Don't print out message. Default FALSE} 293 | #' } 294 | #' 295 | #' Currently, HTTP is the only server available 296 | #' for hosts. We plan to implement a `HostWebsocketServer` soon. 297 | start = function (address="127.0.0.1", port=2000, quiet=FALSE) { 298 | if (is.null(private$.servers[["http"]])) { 299 | # Start HTTP server 300 | server <- HostHttpServer$new(self, address, port) 301 | private$.servers[["http"]] <- server 302 | server$start() 303 | 304 | # Register as a running host ... 305 | dir <- file.path(self$temp_dir(), "hosts") 306 | if (!file.exists(dir)) dir.create(dir, recursive = TRUE) 307 | # ...by creating a manifest file 308 | manifest_file <- file.path(dir, paste0(self$id, ".json")) 309 | file.create(manifest_file) 310 | Sys.chmod(manifest_file, "0600") 311 | cat( 312 | jsonlite::toJSON(self$manifest(), pretty = TRUE, auto_unbox = TRUE), 313 | file = manifest_file 314 | ) 315 | 316 | # ...and a key file 317 | key_file <- file.path(dir, paste0(self$id, ".key")) 318 | file.create(key_file) 319 | Sys.chmod(key_file, "0600") 320 | cat( 321 | self$key, 322 | file = key_file 323 | ) 324 | 325 | if (!quiet) { 326 | cat("Host HTTP server has started:\n") 327 | cat(" URL:", server$url, "\n") 328 | cat(" Key:", self$key, "\n") 329 | if (is.null(self$key)) { 330 | cat(" Warning: authentication has been disabled!\n") 331 | } 332 | } 333 | } 334 | invisible(self) 335 | }, 336 | 337 | #' @section stop(): 338 | #' 339 | #' Stop serving this host. Stops all servers that are currently serving this host 340 | stop = function (quiet=FALSE) { 341 | # Stop each server 342 | for (name in names(private$.servers)) { 343 | server <- private$.servers[[name]] 344 | server$stop() 345 | private$.servers[[name]] <- NULL 346 | } 347 | 348 | # Deregister as a running host 349 | for (file in paste0(self$id, c(".json", ".key"))) { 350 | path <- file.path(self$temp_dir(), "hosts", file) 351 | if (file.exists(path)) file.remove(path) 352 | } 353 | 354 | if (!quiet) cat("Host has stopped\n") 355 | 356 | invisible(self) 357 | }, 358 | 359 | #' @section run(): 360 | #' 361 | #' \describe{ 362 | #' \item{address}{The address to listen. Default '127.0.0.1'} 363 | #' \item{port}{The port to listen on. Default 2000} 364 | #' \item{quiet}{Do not print status messages to the console? Default FALSE} 365 | #' \item{echo}{Print the host's manifest to the console? Default FALSE} 366 | #' } 367 | #' 368 | #' Start serving the Stencila host and wait for connections indefinitely 369 | run = function (address="127.0.0.1", port=2000, quiet=FALSE, echo=FALSE) { 370 | if (echo) quiet <- TRUE 371 | self$start(address = address, port = port, quiet = quiet) 372 | 373 | if (echo) { 374 | cat(to_json(list( 375 | id = self$id, 376 | manifest = self$manifest(), 377 | key = self$key 378 | ))) 379 | flush.console() 380 | } 381 | 382 | if (!quiet) cat("Use Ctl+C (terminal) or Esc (RStudio) to stop\n") 383 | tryCatch({ 384 | while (TRUE) { 385 | # Process HTTP requests 386 | httpuv::service() 387 | } 388 | }, 389 | interrupt = function (condition) { 390 | self$stop(quiet = quiet) 391 | } 392 | ) 393 | }, 394 | 395 | spawn = function (options=list()) { 396 | self$run(quiet = TRUE, echo = TRUE) 397 | }, 398 | 399 | #' @section open(): 400 | #' 401 | #' Open a file in the browser. 402 | open = function (address="", external=FALSE) { 403 | # Difficult to test headlessly, so don't include in coverage 404 | # nocov start 405 | self$start() 406 | # Eventually we plan to serve static HTML, JS and CSS from within the package 407 | # but for now use S3 bucket http://open.stenci.la 408 | origin <- "http://open.stenci.la" 409 | server <- private$.servers[["http"]] 410 | peer <- server$url 411 | url <- sprintf("%s/?address=%s&peers=%s", origin, address, peer) 412 | # See if there is a `viewer` option (defined by RStudio if we are in RStudio) 413 | viewer <- getOption("viewer") 414 | # Currently, force external because Stencila will not run in the older 415 | # browser that is embedded in RStdio (as of Stencila 0.27 and RStudio 1.0.153) 416 | external <- TRUE 417 | if (is.null(viewer) || external) { 418 | # Use builtin function to open the URL in a new browser window/tab 419 | utils::browseURL(url) 420 | } else { 421 | # Use the `rstudioapi` function to view in a pane 422 | # Arbitrarily large height to produce max height while still maintaining 423 | # the visibility of other panes above or below. 424 | viewer(url, height = 5000) 425 | } 426 | invisible(self) 427 | # nocov end 428 | }, 429 | 430 | #' @section generate_token(): 431 | #' 432 | #' Generate a request token. 433 | #' 434 | #' \describe{ 435 | #' \item{host}{The id of the host} 436 | #' } 437 | generate_token = function (host = NULL) { 438 | if (is.null(host)) key <- self$key 439 | else { 440 | # TODO Support token generation for peers based on held keys 441 | stop("Generation of tokens for peer hosts is not yet supported") # nocov 442 | } 443 | now <- unclass(Sys.time()) 444 | payload <- jose::jwt_claim( 445 | iat = now, 446 | exp = now + 300, 447 | iss = self$id, 448 | jti = paste(sample(c(letters, 0:9), 32), collapse = "") 449 | ) 450 | jose::jwt_encode_hmac(payload, secret = charToRaw(key)) 451 | }, 452 | 453 | #' @section authorize_token(): 454 | #' 455 | #' Authorize a request token. 456 | #' 457 | #' Throws an error if the token is invalid. 458 | #' 459 | #' \describe{ 460 | #' \item{token}{The request token} 461 | #' } 462 | authorize_token = function (token) { 463 | payload <- jose::jwt_decode_hmac(token, secret = charToRaw(private$.key)) 464 | 465 | # Has token expired? 466 | exp <- payload$exp 467 | if (!is.null(exp)) { 468 | if (exp < Sys.time()) stop("Token has expired") 469 | } 470 | 471 | # TODO Check and store `iss` and `jti` to prevent replay attacks 472 | 473 | return(payload) 474 | } 475 | ), 476 | 477 | active = list( 478 | #' @section id: 479 | #' 480 | #' Get unique ID of this host 481 | id = function () { 482 | private$.id 483 | }, 484 | 485 | #' @section key: 486 | #' 487 | #' Get secret key of this host 488 | key = function () { 489 | private$.key 490 | }, 491 | 492 | #' @section servers: 493 | #' 494 | #' Get a list of servers for this host. Servers are identified by the protocol shorthand 495 | #' e.g. `http` for `HostHttpServer` 496 | servers = function () { 497 | servers <- list() 498 | for (name in names(private$.servers)) { 499 | server <- private$.servers[[name]] 500 | servers[[name]] <- list( 501 | url = server$url 502 | ) 503 | } 504 | servers 505 | }, 506 | 507 | #' @section urls: 508 | #' 509 | #' Get a list of URLs for this host 510 | urls = function () { 511 | sapply(private$.servers, function (server) server$url) 512 | } 513 | ), 514 | 515 | private = list( 516 | .id = NULL, 517 | .key = NULL, 518 | .servers = NULL, 519 | .instances = NULL 520 | ) 521 | ) 522 | 523 | #' The singleton instance of the \code{Host} class 524 | #' @rdname host-instance 525 | #' @export 526 | host <- NULL 527 | -------------------------------------------------------------------------------- /R/json.R: -------------------------------------------------------------------------------- 1 | # Convert JSON to a value 2 | from_json <- function(json) { 3 | jsonlite::fromJSON(json, simplifyDataFrame = FALSE) 4 | } 5 | 6 | # Convert a value to JSON 7 | to_json <- function(value) { 8 | # Override jsonlite which converts empty R lists to empty JSON arrays 9 | if (is.list(value) && length(value) == 0) { 10 | "{}" 11 | } else { 12 | toString(jsonlite::toJSON( 13 | value, 14 | null = "null", 15 | na = "null", 16 | dataframe = "columns", 17 | digits = NA, 18 | auto_unbox = TRUE, 19 | force = TRUE 20 | )) 21 | } 22 | } 23 | 24 | asJSON <- jsonlite:::asJSON 25 | 26 | # Create a hook for conversion of R6 instances to JSON 27 | methods::setClass("R6") 28 | methods::setMethod("asJSON", "R6", function(x, ...) { 29 | members <- list() 30 | for (name in ls(x, sorted = FALSE)) { 31 | if (!is.function(x[[name]])) members[[name]] <- x[[name]] 32 | } 33 | to_json(members) 34 | }) 35 | -------------------------------------------------------------------------------- /R/main.R: -------------------------------------------------------------------------------- 1 | # This file is used to define necessary import and importFrom statements in the package's 2 | # NAMESPACE file using roxygen2. Since those imports are global to the entire package (unlike 3 | # for example, Python's module local import staements), for purposes of DRY they may as well be 4 | # all together here in none file. 5 | 6 | # nocov start 7 | 8 | # We're following Hadley Wickham's advice: 9 | # If you are using just a few functions from another package, the recommended option is to note the 10 | # package name in the Imports: field of the DESCRIPTION file and call the function(s) explicitly 11 | # using ::, e.g., pkg::fun(). 12 | # But these are imports for some commonly used functions: 13 | # 14 | #' @importFrom grDevices dev.off png replayPlot 15 | #' @import methods 16 | #' @import stringr 17 | #' @import tools 18 | #' @importFrom utils capture.output read.csv write.csv 19 | NULL 20 | 21 | # The following free functions have generic names which may clash with 22 | # names in other packages (e.g. `start` masks `stats::start`). For this 23 | # reason the are not exported 24 | 25 | # Set the package version string 26 | version <- tryCatch(toString(packageVersion("stencila")), error = "0.0.0") 27 | 28 | #' Register the Stencila host 29 | #' 30 | #' @param ... Arguments to pass to \code{host$register} 31 | #' @seealso \code{Host} 32 | #' @export 33 | register <- function (...) host$register(...) 34 | 35 | #' Display the Stencila host's environment 36 | #' 37 | #' @seealso \code{Host} 38 | environ <- function () { 39 | cat(jsonlite::toJSON(host$environ(), pretty = TRUE, auto_unbox = TRUE)) 40 | } 41 | 42 | #' Start serving the Stencila host 43 | #' 44 | #' @param ... Arguments to pass to \code{host$start} 45 | #' @seealso \code{Host} 46 | #' @export 47 | start <- function (...) host$start(...) 48 | 49 | #' Stop serving the Stencila host 50 | #' 51 | #' @param ... Arguments to pass to \code{host$stop} 52 | #' @seealso \code{Host} 53 | # 54 | # Called 'stop_' because 'stop' masks `stats::stop`, 55 | # even within this package. 56 | #' @export 57 | stop_ <- function (...) host$stop(...) 58 | 59 | #' Run the Stencila host 60 | #' 61 | #' @param ... Arguments to pass to \code{host$run} 62 | #' @seealso \code{Host} 63 | #' @export 64 | run <- function (...) host$run(...) 65 | 66 | #' Spawn a Stencila host 67 | #' 68 | #' @seealso \code{Host} 69 | #' @export 70 | spawn <- function (...) host$spawn(...) 71 | 72 | #' Open an address in Stencila 73 | #' 74 | #' @param ... Arguments to pass to \code{host$open} 75 | #' @seealso \code{Host} 76 | #' @export 77 | open <- function (...) host$open(...) 78 | 79 | # Hooks for namespace events 80 | # See https://stat.ethz.ch/R-manual/R-devel/library/base/html/ns-hooks.html 81 | 82 | # Called when namespace is loaded 83 | .onLoad <- function (libname, pkgname) { 84 | # This appears to be better than instantiating 'globally' 85 | # which causes issues with bindings 86 | host <<- Host$new() 87 | } 88 | 89 | # nocov end 90 | -------------------------------------------------------------------------------- /R/r-context.R: -------------------------------------------------------------------------------- 1 | #' A R context 2 | #' 3 | #' An execution context for R code 4 | #' 5 | #' In Stencila, a "context" is the thing that executes code for a particular programming language. 6 | #' This is the context for R. 7 | #' It implements the \code{Context} API so that it can talk to other parts of the platform, 8 | #' including contexts for other languages, Documents, and Sheets. 9 | #' 10 | #' @format \code{R6Class} 11 | #' @export 12 | RContext <- R6::R6Class("RContext", 13 | inherit = Context, 14 | public = list( 15 | 16 | #' @section new(): 17 | #' 18 | #' Create a new \code{RContext} 19 | #' 20 | #' Currently the parameter \code{closed} defaults to \code{FALSE} so that you can use 21 | #' \code{library(somepackage)} to make a package available in subsequent calls to 22 | #' \code{runCode} or \code{callCode}. In the future, it would be good to have a better machanism for that. 23 | #' 24 | #' \describe{ 25 | #' \item{local}{Context can not assign to the global environment. Default \code{TRUE}} 26 | #' \item{closed}{Context can not read from the global environment. Default \code{FALSE}} 27 | #' } 28 | initialize = function (dir=NULL, local=TRUE, closed=FALSE) { 29 | # Set the working directory 30 | private$.dir <- dir 31 | if (!is.null(dir)) { 32 | setwd(dir) 33 | } 34 | 35 | private$.variables <- new.env(parent = emptyenv()) 36 | 37 | private$.input_collector <- CodeDepends::inputCollector() 38 | }, 39 | 40 | #' @section compile(): 41 | #' 42 | #' Analyse R code and return the names of inputs, outputs 43 | #' and the implicitly returned vaue expression 44 | #' 45 | #' \describe{ 46 | #' \item{code}{R code to be analysed} 47 | #' \item{exprOnly}{Ensure that the code is a simple expression?} 48 | #' } 49 | compile = function(cell) { 50 | cell <- super$compile(cell) 51 | 52 | # Ensure this is an R cell 53 | if (!is.null(cell$lang)) { 54 | if (cell$lang != "r") { 55 | cell$messages[[length(cell$messages) + 1]] <- list( 56 | type = "error", 57 | message = "Cell code must be R code" 58 | ) 59 | return(cell) 60 | } 61 | } else cell$lang <- "r" 62 | 63 | if (cell$code == "") return(cell) 64 | 65 | # Parse the code and catch any syntax errors 66 | ast <- tryCatch(parse(text = cell$code), error = identity) 67 | if (inherits(ast, "error")) { 68 | match <- str_match(ast$message, ":(\\d):(\\d):(.+)") 69 | column <- as.integer(match[, 2]) 70 | line <- as.integer(match[, 3]) 71 | message <- match[, 4] 72 | cell$messages[[length(cell$messages) + 1]] <- list( 73 | type = "error", 74 | message = message, 75 | line = line, 76 | column = column 77 | ) 78 | return(cell) 79 | } 80 | 81 | # Is an expression an assignment? 82 | is.assignment <- function(expr) { 83 | if (is.call(expr)) { 84 | op <- expr[[1]] 85 | if (op == "<-" | op == "=") return(TRUE) 86 | } 87 | FALSE 88 | } 89 | 90 | if (cell$expr) { 91 | # Check for single, simple expression 92 | fail <- FALSE 93 | if (length(ast) != 1) fail <- TRUE 94 | else { 95 | expr <- ast[[1]] 96 | # Dissallow assignments 97 | if (is.assignment(expr)) fail <- TRUE 98 | } 99 | if (fail) { 100 | cell$messages[[length(cell$messages) + 1]] <- list( 101 | type = "error", 102 | message = "Code is not a single, simple expression" 103 | ) 104 | return(cell) 105 | } 106 | } 107 | 108 | # Determine inputs 109 | lines <- strsplit(cell$code, "\n")[[1]] 110 | script_info <- tryCatch( 111 | CodeDepends::getInputs( 112 | CodeDepends::readScript(txt = lines), 113 | collector = private$.input_collector 114 | ), 115 | error = identity 116 | ) 117 | inputs <- NULL 118 | if (!inherits(script_info, "error")) { 119 | assigned <- NULL 120 | for (line in script_info) { 121 | assigned <- c(assigned, line@outputs) 122 | inputs <- c(inputs, line@inputs[!(line@inputs %in% assigned)]) 123 | } 124 | } 125 | # Exclude any globally defined variables (ie non-functions) e.g. pi, mtcars 126 | if (length(inputs)) { 127 | inputs <- inputs[!sapply(inputs, function(input) { 128 | global <- tryCatch(get(input, envir = globalenv()), error = identity) 129 | if (inherits(global, "error")) FALSE else mode(global) != "function" 130 | })] 131 | } 132 | 133 | # Determine output name 134 | output <- NULL 135 | if (length(ast) > 0) { 136 | last <- ast[[length(ast)]] 137 | if (is.assignment(last)) { 138 | if (is.name(last[[2]])) { 139 | output <- as.character(last[[2]]) 140 | } 141 | } 142 | } 143 | 144 | # Ensure no circular dependency i.e. output is not in inputs 145 | # (This can happen if a user types a variable into a cell 146 | # just because they want to see it's value) 147 | if (length(inputs) & !is.null(output)) { 148 | if (output %in% inputs) output <- NULL 149 | } 150 | 151 | # Create array of named inputs 152 | existing <- sapply(cell$inputs, function(input) input$name) 153 | for (input in inputs) { 154 | if (!(input %in% existing)) { 155 | cell$inputs[[length(cell$inputs) + 1]] <- list(name = input) 156 | } 157 | } 158 | 159 | # Create array on outputs 160 | if (!is.null(output)) cell$outputs <- list(list(name = output)) 161 | else cell$outputs <- list() 162 | 163 | cell 164 | }, 165 | 166 | #' @section execute(): 167 | #' 168 | #' Run R code within the context's scope 169 | #' 170 | #' \describe{ 171 | #' \item{code}{R code to be executed} 172 | #' \item{inputs}{A list with a data pack for each input} 173 | #' \item{exprOnly}{Ensure that the code is a simple expression?} 174 | #' } 175 | execute = function(cell) { 176 | cell <- self$compile(cell) 177 | 178 | env <- new.env(parent = globalenv()) 179 | for (input in cell$inputs) { 180 | name <- input$name 181 | value <- input$value 182 | if (name %in% ls(private$.variables)) { 183 | value <- get(name, envir = private$.variables) 184 | } else if (!is.null(value)) { 185 | value <- self$unpack(value) 186 | } 187 | if (!is.null(value)) env[[input$name]] <- value 188 | } 189 | 190 | # Do eval and process into a result 191 | evaluation <- evaluate::evaluate( 192 | cell$code, 193 | envir = env, 194 | output_handler = evaluate_output_handler 195 | ) 196 | 197 | # Extract errors and the last value from an `evaluate` result 198 | # Note that not all source items will have a value (e.g. an emptyline) 199 | # Also, sometimes lines are sometimes groupd together so we need to count lines 200 | line <- 0 201 | messages <- list() 202 | value <- NULL 203 | has_value <- FALSE 204 | for (item in evaluation) { 205 | if (inherits(item, "source")) { 206 | line <- line + max(1, str_count(item, "\n")) 207 | } else if (inherits(item, "error")) { 208 | cell$messages[[length(cell$messages) + 1]] <- list( 209 | type = "error", 210 | message = item$message, 211 | line = line, 212 | column = 0 213 | ) 214 | } else { 215 | value <- item 216 | has_value <- TRUE 217 | } 218 | } 219 | 220 | if (!has_value & length(cell$outputs)) { 221 | # If the last statement was an assignment then grab that variable 222 | name <- cell$outputs[[1]]$name 223 | if (!is.null(name) & name %in% ls(env)) { 224 | value <- get(name, envir = env) 225 | has_value <- TRUE 226 | } 227 | } 228 | 229 | if (has_value) { 230 | # Errors can occur in conversion of values e.g. ggplots 231 | # so they must be caught here 232 | packed <- tryCatch(self$pack(value), error = identity) 233 | if (inherits(packed, "error")) { 234 | cell$messages[[length(cell$messages) + 1]] <- list( 235 | line = 0, 236 | column = 0, 237 | type = "error", 238 | message = packed$message 239 | ) 240 | return(cell) 241 | } 242 | 243 | if (length(cell$outputs)) { 244 | output <- cell$outputs[[1]] 245 | if (!is.null(output$name)) { 246 | private$.variables[[output$name]] <- value 247 | } 248 | cell$outputs[[1]]$value <- packed 249 | } else { 250 | cell$outputs <- list(list( 251 | value = packed 252 | )) 253 | } 254 | } 255 | 256 | cell 257 | }, 258 | 259 | #nolint start 260 | callFunction = function(library, name, args, namedArgs){ 261 | # At present we still need to unpack args and namedArgs 262 | # but in the future this might be handled by execute itself. 263 | argValues <- lapply(args, self$unpack) 264 | namedArgValues <- lapply(args, self$unpack) 265 | # Use `execute` to actually call the function 266 | result <- execute(list( 267 | type = "call", 268 | func = list(type = "get", name = name), 269 | args = argValues, 270 | namedArgs = namedArgValues 271 | )) 272 | # Pack it up 273 | list( 274 | messages = list(), 275 | value = self$pack(result) 276 | ) 277 | } 278 | #nolint end 279 | ), 280 | 281 | private = list( 282 | # Context's working directory 283 | .dir = NULL, 284 | 285 | # Variables that reside in this context 286 | .variables = NULL, 287 | 288 | # Used when collecting variables to keep track of libraries 289 | # that have been loaded 290 | .input_collector = NULL 291 | ) 292 | ) 293 | 294 | # Specification of an RContext (used in host manifest) 295 | RContext$spec <- list( 296 | name = "RContext", 297 | client = "ContextHttpClient" 298 | ) 299 | 300 | # Custom output handler for the `run` and `call` methods 301 | # Returns the value itself instead of the default which is to `print()` it 302 | evaluate_output_handler <- evaluate::new_output_handler( 303 | # No `visible` argument so that only visible results get converted to string 304 | value = function(value) { 305 | value 306 | } 307 | ) 308 | -------------------------------------------------------------------------------- /R/type.R: -------------------------------------------------------------------------------- 1 | type <- function(value) { 2 | len <- length(value) 3 | type <- tolower(typeof(value)) 4 | 5 | # Of course, the order of these if statements is important. 6 | # Rearrange with caution (and testing!) 7 | if ( 8 | type == "null" || 9 | (len == 1 && type %in% c("logical", "integer", "double", "character")) 10 | ) { 11 | if (is.null(value) || is.na(value)) { 12 | "null" 13 | } else { 14 | switch(type, 15 | logical = "boolean", 16 | integer = "integer", 17 | double = "number", 18 | character = "string", 19 | type 20 | ) 21 | } 22 | } else if (inherits(value, "data.frame") || inherits(value, "matrix")) { 23 | "table" 24 | } else if (inherits(value, "recordedplot") || inherits(value, "ggplot")) { 25 | # Use the special "plot" type to identify plot values that need 26 | # to be converted to the standard "image" type during `pack()` 27 | "plot" 28 | } else if (is.list(value)) { 29 | type <- value$type 30 | if (typeof(type) == "character" && length(type) == 1) type 31 | else "object" 32 | } else if (is.vector(value)) { 33 | "array" 34 | } else { 35 | "unknown" 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 🔵 `r` 2 | 3 | **R interpreter for executable documents** 4 | 5 | [![All Contributors](https://img.shields.io/badge/all_contributors-6-orange.svg?style=flat-square)](#contributors) 6 | [![Build status](https://travis-ci.org/stencila/r.svg?branch=master)](https://travis-ci.org/stencila/r) 7 | [![Code coverage](https://codecov.io/gh/stencila/r/branch/master/graph/badge.svg)](https://codecov.io/gh/stencila/r) 8 | 9 | ## ⚠️ Deprecated 10 | 11 | This project is deprecated and no longer maintained. At the time of writing, we are instead focussing on using [`tree-sitter`](https://github.com/tree-sitter/tree-sitter) for sematic analysis, and [`IRKernel`](https://github.com/IRkernel/IRkernel#readme) for execution, of R code. Please see, our main repository, [`stencila/stencila`](https://github.com/stencila/stencila) for further information. 12 | 13 | ## 📦 Install 14 | 15 | This package isn't on CRAN yet, but you can install it from this repository using the [`devtools`](https://github.com/hadley/devtools) package, 16 | 17 | ```r 18 | devtools::install_github("stencila/r") 19 | ``` 20 | 21 | You may need to install the `graph` package from Bioconductor if you don't already have it: 22 | 23 | ```r 24 | source("https://bioconductor.org/biocLite.R") 25 | biocLite("graph") 26 | ``` 27 | 28 | Then install the package so that other Stencila packages and applications can detect it: 29 | 30 | ```r 31 | stencila:::register() 32 | ``` 33 | 34 | **Note** Installing Stencila package for R may take a while as there are a number of dependencies which need to be installed. 35 | 36 | ## ⚡ Use 37 | 38 | This package lets you run R code from inside Stencila Documents. When you start the [Stencila Desktop](https://github.com/stencila/desktop) it will be automatically detect the installed R package and you'll be able to execute R code cells from within your documents. 39 | 40 | Check out what people are doing with Stencila and R. [Giulio Valentino Dalla Riva](https://github.com/gvdr) has created Tiny Open Access Data Samples ([TOADS](https://github.com/gvdr/toads/)). These awesome open datasets teach programming and statistics using Stencila. Check out the TOADS! 41 | 42 | More documentation is available at https://stencila.github.io/r 43 | 44 | We love feedback. Create a [new issue](https://github.com/stencila/r/issues/new), add to [existing issues](https://github.com/stencila/r/issues) or [chat](https://gitter.im/stencila/stencila) with members of the community. 45 | 46 | ## ⚒️ Develop 47 | 48 | Most development tasks can be run from R, using `make` shortcuts or RStudio keyboard shortcuts. 49 | 50 | Task | `make` | R/RStudio | 51 | ------------------------------------------------------- |-----------------------|-----------------| 52 | Install development dependencies | `make setup` | 53 | Run linting | `make lint` | `lintr::lint_package()` 54 | Run tests | `make test` | `devtools::test()` or `Ctrl+Shift+T` 55 | Run tests with coverage | `make cover` | `covr::package_coverage()` 56 | Build documentation | `make docs` | 57 | Check the package | `make check` | `Ctrl+Shift+E` 58 | Build | `make build` | `Ctrl+Shift+B` 59 | Clean | `make clean` | 60 | 61 | To run test files individually, in R use `test_file`: 62 | 63 | ```r 64 | library(testthat) 65 | testthat::test_file(system.file("tests/testthat/test-r-context.R",package="stencila")) 66 | ``` 67 | 68 | To get started, please read our contributor [code of conduct](CONDUCT.md), then [get in touch](https://gitter.im/stencila/stencila) or checkout the [platform-wide, cross-repository kanban board](https://github.com/orgs/stencila/projects/1), or just send in a pull request! 69 | 70 | Unit tests live in the `tests` folder and are mostly written using `testthat`. Documentation is written using `roxygen2` and the documentation site is generated by `pkgdown` into the [`docs`](docs) folder and published on Github pages. 71 | 72 | Tests are run on [Travis](https://travis-ci.org/stencila/r) and code coverage tracked at [Codecov](https://codecov.io/gh/stencila/r). 73 | 74 | ## 💖 Contributors 75 | 76 | Thanks goes to these wonderful people ([emoji key](https://github.com/kentcdodds/all-contributors#emoji-key)): 77 | 78 | 79 | 80 | | [
Aleksandra Pawlik](http://stenci.la)
[💻](https://github.com/stencila/r/commits?author=apawlik "Code") | [
Danielle Robinson](https://github.com/daniellecrobinson)
[📖](https://github.com/stencila/r/commits?author=daniellecrobinson "Documentation") | [
Achintya Rao](https://scholar.social/@RaoOfPhysics)
[📖](https://github.com/stencila/r/commits?author=RaoOfPhysics "Documentation") | [
Daniel Nüst](http://nordholmen.net)
[💻](https://github.com/stencila/r/commits?author=nuest "Code") | [
HarryZhu](https://github.com/harryprince)
[📖](https://github.com/stencila/r/commits?author=harryprince "Documentation") | [
Nokome Bentley](https://github.com/nokome)
[💻](https://github.com/stencila/r/commits?author=nokome "Code") | 81 | | :---: | :---: | :---: | :---: | :---: | :---: | 82 | 83 | 84 | This project follows the [all-contributors](https://github.com/kentcdodds/all-contributors) specification. Contributions of any kind welcome! -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | template: 2 | params: 3 | bootswatch: cosmo 4 | 5 | navbar: 6 | title: "Stencila for R" 7 | left: 8 | - text: "Home" 9 | href: index.html 10 | - text: "Reference" 11 | href: "reference/index.html" 12 | right: 13 | - icon: fa-github 14 | href: https://github.com/stencila/r 15 | 16 | reference: 17 | - title: Classes 18 | contents: 19 | - RContext 20 | - SqliteContext 21 | - FileStorer 22 | - Host 23 | - HostHttpServer 24 | 25 | -------------------------------------------------------------------------------- /getting-started.md: -------------------------------------------------------------------------------- 1 | Running Stencila via RStudio 2 | ==== 3 | 4 | **Hello and welcome!** :tada: 5 | 6 | This guide will help you set up RStudio to run Stencila locally in the browser, without assuming that you're super comfortable with RStudio. This is a fun way to explore data and learn more about what R can do with a friendly Stencila interface. In this document, we will run through the steps to get started and identify a few trouble-shooting strategies. 7 | 8 | :bug: As software developers, bugs are a part of our life. This integration is new and experimental and is provided mainly for testing. So we want to know if you find a bug! Please don't hesitate to reach out if you are having trouble by creating a new [issue](https://github.com/stencila/r/issues). 9 | 10 | 👋🏽 We also want to know if you find it useful! If you want to learn more about Stencila or if you have an idea for a feature, join us on the [community forum](https://community.stenci.la/). 11 | 12 | More support for setting up RStudio can be found [here](https://jennybc.github.io/2014-05-12-ubc/r-setup.html) and [here](https://support.rstudio.com/hc/en-us/categories/200035113-Documentation) 13 | 14 | -- 15 | Step 1. **Install the Stencila R package** by running this code in Rstudio. If you haven't used `devtools` before, you will need to install that package first: 16 | 17 | ``` 18 | install.packages('devtools') 19 | ``` 20 | 21 | Then, install the Stencila R package directly from the Github repository: 22 | 23 | ``` 24 | devtools::install_github("stencila/r", ref="master") 25 | ``` 26 | 27 | If you have problems installing `stencila/r` using `devtools`, try using one of the [pre-built Stencila R releases](https://github.com/stencila/r/releases). 28 | 29 | 30 | Step 2. **Set your working directory** to the file path where you've downloaded the examples you want to work with. You can do this by typing in the console with the command ```setwd``` or through the interface, read more about workspaces and directories [here](https://support.rstudio.com/hc/en-us/articles/200711843-Working-Directories-and-Workspaces). For example, I'll be working with a file called `Hello-Nokome.rmd`, located in the directory `Friendly-Intro-to-R`: 31 | ``` 32 | setwd("~/Documents/Friendly-Intro-to-R") 33 | ``` 34 | Step 3. Now it's time to **open your file!** We are running a bit of code first that turns off the authorization, as this was buggy in our earlier trials. Run the following code, with your file path, in Rstudio: 35 | ``` 36 | stencila:::start(authorization=FALSE) 37 | stencila:::open("~/Documents/Friendly-Intro-to-R/Hello-Nokome.rmd") 38 | ``` 39 | Alternately, open the Markdown file you wish to view in RStudio, click the "Addins" menu item and select the "Open with Stencila" option. This should also pop up right away in the browser. 40 | 41 | Step 4. **Use Stencila and R in your browser!** Stencila should pop up in a browser window right away. The green blinking dot means Stencila is loading in the browser. It will then connect to your R session and load the document. 42 | 43 | Step 5. **Saving or printing your work.** 44 | Windows: `Cntrl+S` will allow you to save the markdown file you were editing in the browser. 45 | Mac: `Command+S` will save the markdown file you were editing in the browser in RStudio. Check the RStudio console and you should see your updated file. 46 | 47 | 48 | Step 6. **Stop your Stencila session** by typing: 49 | ``` 50 | stencila:::stop() 51 | ``` 52 | 53 | **Errors** 54 | 55 | We hope you don't run into errors, but if you do try quitting your browser session, clearing the cache, or a different browser. 56 | 57 | **Alternatives** 58 | 59 | For a less experimental way to use Stencila with R, please download [Stencila Desktop](https://github.com/stencila/desktop). Stencila Desktop provides a more stable platform which allows you to connect to multiple languages. 60 | -------------------------------------------------------------------------------- /index.md: -------------------------------------------------------------------------------- 1 | ## Stencila for R 2 | 3 | ### Install 4 | 5 | This package isn't on CRAN yet, but you can install it from this repository using the [`devtools`](https://github.com/hadley/devtools) package, 6 | 7 | ```r 8 | devtools::install_github("stencila/r") 9 | ``` 10 | 11 | Alternatively, check the [releases page](https://github.com/stencila/r/releases) for prebuilt versions. 12 | 13 | Then install the package so that other Stencila packages and applications can detect it: 14 | 15 | ```r 16 | stencila:::install() 17 | ``` 18 | 19 | ### Use 20 | 21 | This package lets you run R code from inside Stencila Documents. When you start the [Stencila Desktop](https://github.com/stencila/desktop) it will be automatically detect the installed R package and you'll be able to execute R code cells from within your documents. 22 | -------------------------------------------------------------------------------- /inst/rstudio/addins.dcf: -------------------------------------------------------------------------------- 1 | Name: Stencila: open file 2 | Description: Open the file currently in the source editor using Stencila 3 | Binding: addin_open 4 | Interactive: false 5 | 6 | Name: Stencila: register function 7 | Description: Register the function file in the source editor using Stencila 8 | Binding: addin_register 9 | Interactive: false 10 | -------------------------------------------------------------------------------- /inst/static/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stencila/r/6bb44819b7dede5ae3c6681c3b067a0cab266b1e/inst/static/favicon.ico -------------------------------------------------------------------------------- /inst/static/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Stencila for R 6 | 7 | 8 |
9 | 10 | 
11 | stop("work in progress. dashboard coming soon!")
12 |
13 |
14 | 15 | 16 | -------------------------------------------------------------------------------- /inst/static/logo-name-beta.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | image/svg+xml -------------------------------------------------------------------------------- /man/Context.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/context.R 3 | \docType{data} 4 | \name{Context} 5 | \alias{Context} 6 | \title{A base for context classes to share implementation of 7 | variable packing and unpacking} 8 | \format{An object of class \code{R6ClassGenerator} of length 24.} 9 | \usage{ 10 | Context 11 | } 12 | \description{ 13 | A base for context classes to share implementation of 14 | variable packing and unpacking 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/Host.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/host.R 3 | \docType{data} 4 | \name{Host} 5 | \alias{Host} 6 | \title{A Host} 7 | \format{\code{R6Class}.} 8 | \usage{ 9 | Host 10 | } 11 | \description{ 12 | Hosts allows you to remotely create, get, run methods of, and delete instances of various types. 13 | The types can be thought of a "services" provided by the host e.g. `RContext`, `FileSystemStorer` 14 | } 15 | \details{ 16 | The API of a host is similar to that of a HTTP server. It's methods names 17 | (e.g. `post`, `get`) are similar to HTTP methods (e.g. `POST`, `GET`) but 18 | the sematics sometimes differ (e.g. a host's `put()` method is used to call an 19 | instance method) 20 | 21 | A host's methods are exposed by `HostHttpServer` and `HostWebsocketServer`. 22 | Those other classes are responsible for tasks associated with their communication 23 | protocol (e.g. serialising and deserialising objects). 24 | 25 | This is a singleton class. There should only ever be one `Host` in memory in each process 26 | (although, for purposes of testing, this is not enforced) 27 | } 28 | \section{new()}{ 29 | 30 | 31 | Create a new \code{Host} 32 | 33 | 34 | 35 | Get the environment of this \code{Host} including the version of R 36 | and the version of installed packages. 37 | } 38 | 39 | \section{user_dir()}{ 40 | 41 | 42 | Get the current user's Stencila data directory. 43 | 44 | This is the directory that Stencila configuration settings, such as the 45 | installed Stencila hosts, and document buffers get stored. 46 | } 47 | 48 | \section{temp_dir()}{ 49 | 50 | 51 | Get the current user's Stencila temporary directory 52 | 53 | This directory is used by Stencila for files such as "run files" (see below) 54 | } 55 | 56 | \section{run_file()}{ 57 | 58 | 59 | Get the path of the "run file" for this host. 60 | 61 | A run file is used to indicate that a particular host is running 62 | and allow other Stencila processes on the same machine 63 | to communicate with it. It is created by by \code{host$start()} and 64 | destroyed by \code{host$stop()}. It is placed in the machine's temporarily 65 | directory to reduce the chances of a run file being present when a host 66 | has aborted with out by \code{host$stop()} being called. 67 | } 68 | 69 | \section{manifest()}{ 70 | 71 | 72 | Get a manifest for this host 73 | 74 | The manifest describes the host and it's capabilities. It is used 75 | by peer hosts to determine which "types" this host provides and 76 | which "instances" have already been instantiated. 77 | } 78 | 79 | \section{register()}{ 80 | 81 | 82 | Register this Stencila \code{Host} on this machine. 83 | 84 | Registering a host involves creating a file \code{r.json} inside of 85 | the user's Stencila data (see \code{user_dir}) directory which describes 86 | the capabilities of this host. 87 | } 88 | 89 | \section{create()}{ 90 | 91 | 92 | Create a new instance of a type 93 | 94 | \describe{ 95 | \item{type}{Type of new instance} 96 | \item{args}{Arguments to be passed to type constructor} 97 | \item{name}{Name of new instance. Depreciated but retained for compatability.} 98 | \item{return}{Address of the newly created instance} 99 | } 100 | } 101 | 102 | \section{get()}{ 103 | 104 | 105 | Get an instance 106 | 107 | \describe{ 108 | \item{id}{ID of instance} 109 | \item{return}{The instance} 110 | } 111 | } 112 | 113 | \section{call()}{ 114 | 115 | 116 | Call a method of an instance 117 | 118 | \describe{ 119 | \item{id}{ID of instance} 120 | \item{method}{Name of instance method} 121 | \item{arg}{The argument to pass to the method} 122 | \item{return}{The result of the method call} 123 | } 124 | } 125 | 126 | \section{delete()}{ 127 | 128 | 129 | Delete an instance 130 | 131 | \describe{ 132 | \item{id}{ID of the instance} 133 | } 134 | } 135 | 136 | \section{start()}{ 137 | 138 | 139 | Start serving this host 140 | 141 | \describe{ 142 | \item{address}{The address to listen. Default '127.0.0.1'} 143 | \item{port}{The port to listen on. Default 2000} 144 | \item{quiet}{Don't print out message. Default FALSE} 145 | } 146 | 147 | Currently, HTTP is the only server available 148 | for hosts. We plan to implement a `HostWebsocketServer` soon. 149 | } 150 | 151 | \section{stop()}{ 152 | 153 | 154 | Stop serving this host. Stops all servers that are currently serving this host 155 | } 156 | 157 | \section{run()}{ 158 | 159 | 160 | \describe{ 161 | \item{address}{The address to listen. Default '127.0.0.1'} 162 | \item{port}{The port to listen on. Default 2000} 163 | \item{quiet}{Do not print status messages to the console? Default FALSE} 164 | \item{echo}{Print the host's manifest to the console? Default FALSE} 165 | } 166 | 167 | Start serving the Stencila host and wait for connections indefinitely 168 | } 169 | 170 | \section{open()}{ 171 | 172 | 173 | Open a file in the browser. 174 | } 175 | 176 | \section{generate_token()}{ 177 | 178 | 179 | Generate a request token. 180 | 181 | \describe{ 182 | \item{host}{The id of the host} 183 | } 184 | } 185 | 186 | \section{authorize_token()}{ 187 | 188 | 189 | Authorize a request token. 190 | 191 | Throws an error if the token is invalid. 192 | 193 | \describe{ 194 | \item{token}{The request token} 195 | } 196 | } 197 | 198 | \section{id}{ 199 | 200 | 201 | Get unique ID of this host 202 | } 203 | 204 | \section{key}{ 205 | 206 | 207 | Get secret key of this host 208 | } 209 | 210 | \section{servers}{ 211 | 212 | 213 | Get a list of servers for this host. Servers are identified by the protocol shorthand 214 | e.g. `http` for `HostHttpServer` 215 | } 216 | 217 | \section{urls}{ 218 | 219 | 220 | Get a list of URLs for this host 221 | } 222 | 223 | \examples{ 224 | host$servers 225 | host$start() 226 | host$servers 227 | host$stop() 228 | } 229 | \keyword{datasets} 230 | -------------------------------------------------------------------------------- /man/HostHttpServer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/host-http-server.R 3 | \docType{data} 4 | \name{HostHttpServer} 5 | \alias{HostHttpServer} 6 | \title{A HTTP server for a Host} 7 | \format{\code{R6Class}.} 8 | \usage{ 9 | HostHttpServer 10 | } 11 | \description{ 12 | Normally there is no need to create a new \code{HostHttpServer}, instead 13 | use the \code{start} method of the \code{host} instance. 14 | } 15 | \details{ 16 | Note for developers: the general approach taken in developing this class is 17 | to mirror implementations in Node and Python to make it easier to port 18 | code between the languages and ensure consisten implementations. 19 | } 20 | \section{new()}{ 21 | 22 | 23 | \describe{ 24 | \item{host}{The host to be served} 25 | \item{address}{The port to listen on. Default \code{'127.0.0.1'}} 26 | \item{port}{The port to listen on. Default \code{2000}} 27 | } 28 | } 29 | 30 | \section{start()}{ 31 | 32 | 33 | Start the server 34 | } 35 | 36 | \section{stop()}{ 37 | 38 | 39 | Stop the server 40 | } 41 | 42 | \section{handle()}{ 43 | 44 | 45 | Handle a HTTP request 46 | } 47 | 48 | \section{route()}{ 49 | 50 | 51 | Route a HTTP request 52 | } 53 | 54 | \section{static()}{ 55 | 56 | 57 | Handle a request for a static file 58 | } 59 | 60 | \section{run()}{ 61 | 62 | 63 | Handle a request to call a host method 64 | } 65 | 66 | \section{error()}{ 67 | 68 | 69 | Generate an error response 70 | } 71 | 72 | \section{error400()}{ 73 | 74 | 75 | Generate a 400 error 76 | } 77 | 78 | \section{error401()}{ 79 | 80 | 81 | Generate a 401 error 82 | } 83 | 84 | \section{error403()}{ 85 | 86 | 87 | Generate a 403 error 88 | } 89 | 90 | \section{error404()}{ 91 | 92 | 93 | Generate a 404 error 94 | } 95 | 96 | \section{error500()}{ 97 | 98 | 99 | Generate a 500 error 100 | } 101 | 102 | \section{address}{ 103 | 104 | 105 | The address of the server 106 | } 107 | 108 | \section{port}{ 109 | 110 | 111 | The port of the server 112 | } 113 | 114 | \section{url}{ 115 | 116 | 117 | The URL of the server, or \code{NULL} if not yet started 118 | } 119 | 120 | \keyword{datasets} 121 | -------------------------------------------------------------------------------- /man/RContext.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/r-context.R 3 | \docType{data} 4 | \name{RContext} 5 | \alias{RContext} 6 | \title{A R context} 7 | \format{\code{R6Class}} 8 | \usage{ 9 | RContext 10 | } 11 | \description{ 12 | An execution context for R code 13 | } 14 | \details{ 15 | In Stencila, a "context" is the thing that executes code for a particular programming language. 16 | This is the context for R. 17 | It implements the \code{Context} API so that it can talk to other parts of the platform, 18 | including contexts for other languages, Documents, and Sheets. 19 | } 20 | \section{new()}{ 21 | 22 | 23 | Create a new \code{RContext} 24 | 25 | Currently the parameter \code{closed} defaults to \code{FALSE} so that you can use 26 | \code{library(somepackage)} to make a package available in subsequent calls to 27 | \code{runCode} or \code{callCode}. In the future, it would be good to have a better machanism for that. 28 | 29 | \describe{ 30 | \item{local}{Context can not assign to the global environment. Default \code{TRUE}} 31 | \item{closed}{Context can not read from the global environment. Default \code{FALSE}} 32 | } 33 | } 34 | 35 | \section{compile()}{ 36 | 37 | 38 | Analyse R code and return the names of inputs, outputs 39 | and the implicitly returned vaue expression 40 | 41 | \describe{ 42 | \item{code}{R code to be analysed} 43 | \item{exprOnly}{Ensure that the code is a simple expression?} 44 | } 45 | } 46 | 47 | \section{execute()}{ 48 | 49 | 50 | Run R code within the context's scope 51 | 52 | \describe{ 53 | \item{code}{R code to be executed} 54 | \item{inputs}{A list with a data pack for each input} 55 | \item{exprOnly}{Ensure that the code is a simple expression?} 56 | } 57 | } 58 | 59 | \keyword{datasets} 60 | -------------------------------------------------------------------------------- /man/environ.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/main.R 3 | \name{environ} 4 | \alias{environ} 5 | \title{Display the Stencila host's environment} 6 | \usage{ 7 | environ() 8 | } 9 | \description{ 10 | Display the Stencila host's environment 11 | } 12 | \seealso{ 13 | \code{Host} 14 | } 15 | -------------------------------------------------------------------------------- /man/host-instance.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/host.R 3 | \docType{data} 4 | \name{host} 5 | \alias{host} 6 | \title{The singleton instance of the \code{Host} class} 7 | \format{An object of class \code{Host} (inherits from \code{R6}) of length 26.} 8 | \usage{ 9 | host 10 | } 11 | \description{ 12 | The singleton instance of the \code{Host} class 13 | } 14 | \keyword{datasets} 15 | -------------------------------------------------------------------------------- /man/open.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/main.R 3 | \name{open} 4 | \alias{open} 5 | \title{Open an address in Stencila} 6 | \usage{ 7 | open(...) 8 | } 9 | \arguments{ 10 | \item{...}{Arguments to pass to \code{host$open}} 11 | } 12 | \description{ 13 | Open an address in Stencila 14 | } 15 | \seealso{ 16 | \code{Host} 17 | } 18 | -------------------------------------------------------------------------------- /man/register.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/main.R 3 | \name{register} 4 | \alias{register} 5 | \title{Register the Stencila host} 6 | \usage{ 7 | register(...) 8 | } 9 | \arguments{ 10 | \item{...}{Arguments to pass to \code{host$register}} 11 | } 12 | \description{ 13 | Register the Stencila host 14 | } 15 | \seealso{ 16 | \code{Host} 17 | } 18 | -------------------------------------------------------------------------------- /man/run.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/main.R 3 | \name{run} 4 | \alias{run} 5 | \title{Run the Stencila host} 6 | \usage{ 7 | run(...) 8 | } 9 | \arguments{ 10 | \item{...}{Arguments to pass to \code{host$run}} 11 | } 12 | \description{ 13 | Run the Stencila host 14 | } 15 | \seealso{ 16 | \code{Host} 17 | } 18 | -------------------------------------------------------------------------------- /man/spawn.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/main.R 3 | \name{spawn} 4 | \alias{spawn} 5 | \title{Spawn a Stencila host} 6 | \usage{ 7 | spawn(...) 8 | } 9 | \description{ 10 | Spawn a Stencila host 11 | } 12 | \seealso{ 13 | \code{Host} 14 | } 15 | -------------------------------------------------------------------------------- /man/start.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/main.R 3 | \name{start} 4 | \alias{start} 5 | \title{Start serving the Stencila host} 6 | \usage{ 7 | start(...) 8 | } 9 | \arguments{ 10 | \item{...}{Arguments to pass to \code{host$start}} 11 | } 12 | \description{ 13 | Start serving the Stencila host 14 | } 15 | \seealso{ 16 | \code{Host} 17 | } 18 | -------------------------------------------------------------------------------- /man/stop_.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/main.R 3 | \name{stop_} 4 | \alias{stop_} 5 | \title{Stop serving the Stencila host} 6 | \usage{ 7 | stop_(...) 8 | } 9 | \arguments{ 10 | \item{...}{Arguments to pass to \code{host$stop}} 11 | } 12 | \description{ 13 | Stop serving the Stencila host 14 | } 15 | \seealso{ 16 | \code{Host} 17 | } 18 | -------------------------------------------------------------------------------- /stencila.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(stencila) 3 | 4 | test_check("stencila") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-context.R: -------------------------------------------------------------------------------- 1 | context("Context") 2 | 3 | describe("Context.pack()", { 4 | c <- Context$new() 5 | check <- function (x, json) { 6 | p <- c$pack(x) 7 | j <- to_json(p) 8 | expect_equal(j, json) 9 | } 10 | 11 | # nolint start 12 | 13 | it("works for primitive types", { 14 | check(NULL, '{"type":"null","data":null}') 15 | check(NA, '{"type":"null","data":null}') 16 | 17 | check(TRUE, '{"type":"boolean","data":true}') 18 | check(FALSE, '{"type":"boolean","data":false}') 19 | 20 | check(as.integer(42), '{"type":"integer","data":42}') 21 | check(as.integer(1000000000), '{"type":"integer","data":1000000000}') 22 | 23 | check(3.14, '{"type":"number","data":3.14}') 24 | check(pi, '{"type":"number","data":3.14159265358979}') 25 | 26 | check(1e10, '{"type":"number","data":10000000000}') 27 | check(1e-10, '{"type":"number","data":1e-10}') 28 | }) 29 | 30 | it("works for lists", { 31 | check( 32 | list(a = 1, b = 3.14, c = "foo", d = list(e = 1, f = 2)), 33 | '{"type":"object","data":{"a":1,"b":3.14,"c":"foo","d":{"e":1,"f":2}}}' 34 | ) 35 | }) 36 | 37 | it("works for vectors", { 38 | check(vector(), '{"type":"array","data":[]}') 39 | check(1:4, '{"type":"array","data":[1,2,3,4]}') 40 | check(seq(1.1, 2.1, 1), '{"type":"array","data":[1.1,2.1]}') 41 | }) 42 | 43 | it("works for data frames and matrices", { 44 | check(data.frame(), '{"type":"table","data":{"type":"table","columns":0,"rows":0,"data":{}}}') 45 | check(data.frame(a = 1:3), '{"type":"table","data":{"type":"table","columns":1,"rows":3,"data":{"a":[1,2,3]}}}') 46 | check(data.frame(a = 1:3, b = c("x", "y", "z")), '{"type":"table","data":{"type":"table","columns":2,"rows":3,"data":{"a":[1,2,3],"b":["x","y","z"]}}}') 47 | 48 | check(matrix(data = 1:4, nrow = 2), '{"type":"table","data":{"type":"table","columns":2,"rows":2,"data":{"V1":[1,2],"V2":[3,4]}}}') 49 | }) 50 | 51 | # nolint end 52 | 53 | it("works for recorded plots", { 54 | # For recodPlot to work.. 55 | png(tempfile()) 56 | dev.control("enable") 57 | 58 | plot(mpg~disp, mtcars) 59 | p <- c$pack(recordPlot()) 60 | expect_equal(p$type, "image") 61 | expect_equal(str_sub(p$src, 1, 10), "data:image") 62 | }) 63 | 64 | if (require("ggplot2", quietly = T)) { 65 | it("works for ggplots", { 66 | p <- c$pack(ggplot(mtcars) + geom_point(aes(x = disp, y = mpg))) 67 | expect_equal(p$type, "image") 68 | expect_equal(str_sub(p$src, 1, 10), "data:image") 69 | }) 70 | } 71 | }) 72 | 73 | describe("Context.unpack()", { 74 | c <- Context$new() 75 | 76 | # nolint start 77 | 78 | it("can take a list or a JSON stringing", { 79 | expect_null(c$unpack('{"type":"null", "data":null}')) 80 | expect_null(c$unpack(list(type = "null", data = NULL))) 81 | }) 82 | 83 | it("errors if package is malformed", { 84 | expect_error(c$unpack(1), "should be a list") 85 | expect_error(c$unpack(list()), "should have field `type`") 86 | }) 87 | 88 | it("works for primitive types", { 89 | expect_null(c$unpack('{"type":"null","data":null}')) 90 | 91 | expect_true(c$unpack('{"type":"boolean","data":true}')) 92 | expect_false(c$unpack('{"type":"boolean","data":false}')) 93 | 94 | expect_equal(c$unpack('{"type":"integer","data":42}'), 42) 95 | expect_equal(c$unpack('{"type":"integer","data":1000000000}'), as.integer(1000000000)) 96 | 97 | expect_equal(c$unpack('{"type":"float","data":3.12}'), 3.12) 98 | expect_equal(c$unpack('{"type":"float","data":1e20}'), 1e20) 99 | }) 100 | 101 | it("works for objects", { 102 | expect_equivalent(c$unpack('{"type":"object","data":{}}'), list()) 103 | expect_equal(c$unpack('{"type":"object","data":{"a":1,"b":"foo","c":[1,2,3]}}'), list(a = 1, b = "foo", c = 1:3)) 104 | }) 105 | 106 | it("works for arrays", { 107 | expect_equal(c$unpack('{"type":"array","data":[]}'), vector()) 108 | expect_equal(c$unpack('{"type":"array","data":[1,2,3,4,5]}'), 1:5) 109 | }) 110 | 111 | # nolint end 112 | 113 | it("works for tabular data", { 114 | df <- data.frame(a = 1:3, b = c("x", "y", "z"), stringsAsFactors = FALSE) 115 | expect_equal( 116 | c$unpack(c$pack(df)), 117 | df 118 | ) 119 | }) 120 | }) 121 | -------------------------------------------------------------------------------- /tests/testthat/test-dir-1/main.md: -------------------------------------------------------------------------------- 1 | Hello world! 2 | -------------------------------------------------------------------------------- /tests/testthat/test-dir-2/db.sqlite: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stencila/r/6bb44819b7dede5ae3c6681c3b067a0cab266b1e/tests/testthat/test-dir-2/db.sqlite -------------------------------------------------------------------------------- /tests/testthat/test-host-http-server.R: -------------------------------------------------------------------------------- 1 | context("HostHttpServer") 2 | 3 | test_that("HostHttpServer$stop+start", { 4 | s1 <- HostHttpServer$new(NULL) 5 | s2 <- HostHttpServer$new(NULL) 6 | 7 | expect_equal(s1$url, NULL) 8 | 9 | s1$start() 10 | expect_true(str_detect(s1$url, "^http://127.0.0.1")) 11 | 12 | s2$start() 13 | p1 <- as.integer(str_match(s1$url, "^http://127.0.0.1:(\\d+)")[1, 2]) 14 | p2 <- as.integer(str_match(s2$url, "^http://127.0.0.1:(\\d+)")[1, 2]) 15 | expect_true(p2 > p1) 16 | s2$stop() 17 | 18 | s1$stop() 19 | expect_equal(s1$url, NULL) 20 | }) 21 | 22 | test_that("HostHttpServer$route", { 23 | s <- HostHttpServer$new(NULL) 24 | 25 | expect_equal(s$route("GET", "/"), c("static", "index.html")) 26 | expect_equal(s$route("GET", "/static/some/file.js"), c("static", "some/file.js")) 27 | 28 | # Unversioned requests 29 | 30 | expect_equal(s$route("GET", "/manifest"), c("run", "manifest")) 31 | 32 | expect_equal(s$route("POST", "/environ/local", TRUE), c("run", "startup", "local")) 33 | expect_equal(s$route("DELETE", "/environ/id", TRUE), c("run", "shutdown", "id")) 34 | 35 | expect_equal(s$route("POST", "/type", TRUE), c("run", "create", "type")) 36 | expect_equal(s$route("PUT", "/id!method", TRUE), c("run", "call", "id", "method")) 37 | expect_equal(s$route("DELETE", "/id", TRUE), c("run", "destroy", "id")) 38 | 39 | # v1 requests 40 | 41 | expect_equal(s$route("GET", "/v1/manifest", FALSE), c("run", "manifest")) 42 | expect_equal(s$route("GET", "/v1/environs", FALSE), c("run", "environs")) 43 | expect_equal(s$route("GET", "/v1/services", FALSE), c("run", "services")) 44 | 45 | expect_equal(s$route("GET", "/v1/hosts", TRUE), c("run", "hosts")) 46 | expect_equal(s$route("POST", "/v1/hosts/local", TRUE), c("run", "startup", "local")) 47 | expect_equal(s$route("DELETE", "/v1/hosts/id", TRUE), c("run", "shutdown", "id")) 48 | expect_equal(s$route("GET", "/v1/hosts", FALSE), c("error401", "/v1/hosts")) 49 | 50 | expect_equal(s$route("GET", "/v1/instances", TRUE), c("run", "instances")) 51 | expect_equal(s$route("GET", "/v1/instances", FALSE), c("error401", "/v1/instances")) 52 | 53 | expect_equal(s$route("POST", "/v1/instances/Service", TRUE), c("run", "create", "Service")) 54 | expect_equal(s$route("POST", "/v1/instances/Service", FALSE), c("error401", "/v1/instances/Service")) 55 | 56 | expect_equal(s$route("DELETE", "/v1/instances/instance1", TRUE), c("run", "destroy", "instance1")) 57 | 58 | expect_equal(s$route("PUT", "/v1/instances/instance1/method", TRUE), c("run", "call", "instance1", "method")) 59 | expect_equal(s$route("PUT", "/v1/instances/instance1/method", FALSE), c("error401", "/v1/instances/instance1/method")) 60 | 61 | expect_equal(s$route("PUT", "/v1/foobar", TRUE), c("error400", "/v1/foobar")) 62 | }) 63 | 64 | test_that("HostHttpServer$handle", { 65 | s <- HostHttpServer$new(host) 66 | 67 | # Home 68 | r <- s$handle(list( 69 | PATH_INFO = "/", 70 | REQUEST_METHOD = "GET", 71 | rook.input = list(read_lines = function() NULL) 72 | )) 73 | expect_equal(r$status, 200) 74 | expect_equal(str_sub(r$body, 1, 23), "\n\n") 75 | 76 | # Manifest 77 | r <- s$handle(list( 78 | PATH_INFO = "/v1/manifest", 79 | REQUEST_METHOD = "GET", 80 | rook.input = list(read_lines = function() NULL) 81 | )) 82 | expect_equal(r$status, 200) 83 | expect_equal(str_sub(r$body, 1, 22), "{\"stencila\":{\"package\"") 84 | 85 | # Browser-based CORS request 86 | for (origin in c("http://127.0.0.1:2000", "http://localhost:2010", "https://open.stenci.la")) { 87 | r <- s$handle(list( 88 | PATH_INFO = "/v1/manifest", 89 | REQUEST_METHOD = "GET", 90 | HTTP_REFERER = sprintf("%s/some/file/path", origin), 91 | rook.input = list(read_lines = function() NULL) 92 | )) 93 | expect_equal(r$headers[["Access-Control-Allow-Origin"]], origin) 94 | expect_equal(r$headers[["Access-Control-Allow-Credentials"]], "true") 95 | } 96 | 97 | # Browser-based CORS pre-flight request 98 | for (origin in c("http://127.0.0.1:2000", "http://localhost:2010", "https://open.stenci.la")) { 99 | r <- s$handle(list( 100 | PATH_INFO = "/v1/manifest", 101 | REQUEST_METHOD = "OPTIONS", 102 | HTTP_ORIGIN = origin, 103 | rook.input = list(read_lines = function() NULL) 104 | )) 105 | expect_equal(r$headers[["Access-Control-Allow-Origin"]], origin) 106 | expect_equal(r$headers[["Access-Control-Allow-Credentials"]], "true") 107 | expect_equal(r$headers[["Access-Control-Allow-Methods"]], "GET, POST, PUT, DELETE, OPTIONS") 108 | expect_equal(r$headers[["Access-Control-Max-Age"]], "86400") 109 | } 110 | 111 | # Browser-based CORS pre-flight request from third party site 112 | r <- s$handle(list( 113 | PATH_INFO = "/", 114 | REQUEST_METHOD = "OPTIONS", 115 | HTTP_ORIGIN = "http://evil.hackers.com", 116 | rook.input = list(read_lines = function() NULL) 117 | )) 118 | expect_equal(r$headers[["Access-Control-Allow-Origin"]], NULL) 119 | }) 120 | 121 | test_that("HostHttpServer$static", { 122 | server <- HostHttpServer$new(host) 123 | req <- list() 124 | res <- list(status = 200) 125 | 126 | res <- server$static(req, res, "logo-name-beta.svg") 127 | expect_equal(res$status, 200) 128 | expect_equal(res$headers[["Content-Type"]], "image/svg+xml") 129 | expect_equal(str_sub(res$body, 1, 54), "") 130 | 131 | res <- server$static(req, res, "foo.bar") 132 | expect_equal(res$status, 404) 133 | 134 | res <- server$static(req, res, "../DESCRIPTION") 135 | expect_equal(res$status, 403) 136 | }) 137 | 138 | test_that("HostHttpServer$run", { 139 | server <- HostHttpServer$new(host) 140 | req <- list() 141 | res <- list(status = 200) 142 | 143 | # Get manifest 144 | res <- server$run(req, res, "manifest") 145 | expect_equal(res$status, 200) 146 | expect_equal(res$headers[["Content-Type"]], "application/json") 147 | 148 | # Create an RContext 149 | res <- server$run(req, res, "create", "RContext") 150 | expect_equal(res$status, 200) 151 | expect_equal(res$headers[["Content-Type"]], "application/json") 152 | id <- from_json(res$body) 153 | 154 | # Call a context method 155 | res <- server$run(list(body = "\"6*7\""), res, "call", id, "execute") 156 | expect_equal(res$status, 200) 157 | expect_equal(res$headers[["Content-Type"]], "application/json") 158 | cell <- from_json(res$body) 159 | expect_equal(cell$type, "cell") 160 | 161 | # Delete the context 162 | res <- server$run(req, res, "delete", id) 163 | expect_equal(res$status, 200) 164 | expect_equal(res$headers[["Content-Type"]], "application/json") 165 | }) 166 | -------------------------------------------------------------------------------- /tests/testthat/test-host.R: -------------------------------------------------------------------------------- 1 | context("Host") 2 | 3 | describe("Host", { 4 | host <- Host$new() 5 | 6 | it("is a class", { 7 | expect_equal(class(host)[1], "Host") 8 | }) 9 | 10 | it("has a manifest() method", { 11 | manifest <- host$manifest() 12 | expect_equal(manifest$stencila$package, "r") 13 | expect_equal(manifest$stencila$version, version) 14 | expect_equal(length(manifest$urls), 0) 15 | expect_equal(length(manifest$instances), 0) 16 | expect_true(length(manifest$types) > 0) 17 | }) 18 | 19 | it("has a register() method", { 20 | host$register() 21 | manifest <- host$manifest(complete = FALSE) 22 | expect_equal( 23 | manifest, 24 | from_json(file.path(host$user_dir(), "hosts", "r.json")) 25 | ) 26 | }) 27 | 28 | it("has a create() method", { 29 | id1 <- host$create("RContext") 30 | id2 <- host$create("RContext") 31 | expect_true(id1 != id2) 32 | 33 | expect_error(host$create("Foo"), "Unknown type") 34 | }) 35 | 36 | it("has a get() method", { 37 | id <- host$create("RContext") 38 | expect_true(inherits(host$get(id), "RContext")) 39 | 40 | expect_error(host$get("foo"), "Unknown instance") 41 | }) 42 | 43 | it("has a call() method", { 44 | id <- host$create("RContext") 45 | expect_equal(host$call(id, "execute", "6*7")$type, "cell") 46 | expect_error(host$call(id, "fooBar"), "Unknown method") 47 | expect_error(host$call("foo", "bar"), "Unknown instance") 48 | }) 49 | 50 | it("has a delete() method", { 51 | id <- host$create("RContext") 52 | expect_true(inherits(host$get(id), "RContext")) 53 | host$delete(id) 54 | expect_error(host$delete(id), "Unknown instance") 55 | }) 56 | 57 | it("has start() and stop() methods", { 58 | host$start(quiet = TRUE) 59 | expect_equal(names(host$servers), "http") 60 | expect_equal(length(host$servers), 1) 61 | expect_equal(length(host$manifest()$servers), 1) 62 | expect_true(file.exists(host$run_file())) 63 | host$stop() 64 | expect_equal(length(host$servers), 0) 65 | expect_equal(length(host$manifest()$servers), 0) 66 | expect_true(!file.exists(host$run_file())) 67 | }) 68 | 69 | it("has generate_token() and authorize_token() methods", { 70 | token1 <- host$generate_token() 71 | host$authorize_token(token1) 72 | 73 | token2 <- host$generate_token() 74 | host$authorize_token(token2) 75 | 76 | expect_true(token1 != token2) 77 | expect_error(host$authorize_token("not a valid token")) 78 | expect_error(host$authorize_token("eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjE1MjY5NjA1Nzl9.pgTAtdDGHZZd05hg-Tmy8Cl_yrWBzBSZMaCTkbztc1E")) 79 | }) 80 | }) 81 | -------------------------------------------------------------------------------- /tests/testthat/test-lib-1/funcs/func1.R: -------------------------------------------------------------------------------- 1 | # A test function with no documentation 2 | # string so docs are extracted from it's source code 3 | func1 <- function(param1, param2=42) { 4 | "Hello from func1" 5 | } 6 | -------------------------------------------------------------------------------- /tests/testthat/test-lib-1/funcs/func2.R: -------------------------------------------------------------------------------- 1 | #' Function Title 2 | #' 3 | #' The description of the function 4 | #' 5 | #' @param param1 Description of the first parameter 6 | #' @param param2 Description of the second parameter 7 | #' @return Description of the return value 8 | #' 9 | #' @examples 10 | #' func2(1,2) 11 | #' 12 | #' @seealso `func1` 13 | #' 14 | #' @author Anne Appleby 15 | #' @author Barry Barsden 16 | func2 <- function(param1, param2) { 17 | # Implement your function here... 18 | } 19 | -------------------------------------------------------------------------------- /tests/testthat/test-lib-1/funcs/func3.R: -------------------------------------------------------------------------------- 1 | #' Function Title 2 | #' 3 | #' The description of the function 4 | #' 5 | #' @param param1:number=1 Description of the first parameter 6 | #' @param param2:number Description of the second parameter 7 | #' 8 | #' @return Description of the return value 9 | func3 <- function(param1, param2) { 10 | # Implement your function here... 11 | } 12 | -------------------------------------------------------------------------------- /tests/testthat/test-r-context.R: -------------------------------------------------------------------------------- 1 | context("RContext") 2 | 3 | describe("RContext", { 4 | 5 | it("can be constructed", { 6 | s <- RContext$new() 7 | 8 | expect_equal(class(s)[1], "RContext") 9 | }) 10 | 11 | it("has a compile method", { 12 | context <- RContext$new() 13 | 14 | check <- function (source, expected) { 15 | cell <- context$compile(source) 16 | expect_equal(cell$type, "cell") 17 | expect_equal(cell[c("inputs", "outputs", "messages")], expected) 18 | } 19 | 20 | check("", list( 21 | inputs = list(), 22 | outputs = list(), 23 | messages = list() 24 | )) 25 | 26 | # syntax error 27 | check("6 *", list( 28 | inputs = list(), 29 | outputs = list(), 30 | messages = list(list( 31 | type = "error", 32 | message = " unexpected end of input", 33 | line = 0, 34 | column = 2 35 | )) 36 | )) 37 | 38 | # x assigned and then used 39 | check("x <- 2\nx", list( 40 | inputs = list(), 41 | outputs = list(), 42 | messages = list() 43 | )) 44 | 45 | # x used and then assigned (this will throw an error when executed) 46 | check("x\nx <- 2", list( 47 | inputs = list(list(name = "x")), 48 | outputs = list(), 49 | messages = list() 50 | )) 51 | 52 | # globals are not included as inputs 53 | check("cos(2 * pi * r)", list( 54 | inputs = list(list(name = "r")), 55 | outputs = list(), 56 | messages = list() 57 | )) 58 | 59 | check("plot(1:1000)", list( 60 | inputs = list(), 61 | outputs = list(), 62 | messages = list() 63 | )) 64 | 65 | # Currently ignoring terms in formulae 66 | check("lm(x~y, my_data)", list( 67 | inputs = list(list(name = "my_data")), 68 | outputs = list(), 69 | messages = list() 70 | )) 71 | 72 | # Globally available data frame is not an input 73 | check("mtcars", list( 74 | inputs = list(), 75 | outputs = list(), 76 | messages = list() 77 | )) 78 | # ...nor is it's column 79 | check("mtcars$cyl", list( 80 | inputs = list(), 81 | outputs = list(), 82 | messages = list() 83 | )) 84 | 85 | # NSE functions 86 | check("subset(mtcars, cyl < 6)", list( 87 | inputs = list(), 88 | outputs = list(), 89 | messages = list() 90 | )) 91 | check("library(dplyr)\n filter(mtcars, cyl < 6)", list( 92 | inputs = list(), 93 | outputs = list(), 94 | messages = list() 95 | )) 96 | # Once dplyr has been library'ed then the 97 | # dependency analysis is smart enough to know filter is NSE 98 | check("data %>% filter(cyl < 6)", list( 99 | inputs = list(list(name = "data")), 100 | outputs = list(), 101 | messages = list() 102 | )) 103 | 104 | # Expression cells 105 | cell <- context$compile(list( 106 | source = context$pack("x * 2"), 107 | expr = TRUE 108 | )) 109 | expect_equal(cell[c("inputs", "outputs", "messages")], list( 110 | inputs = list(list(name = "x")), 111 | outputs = list(), 112 | messages = list() 113 | )) 114 | 115 | cell <- context$compile(list( 116 | source = context$pack("x <- 2"), 117 | expr = TRUE 118 | )) 119 | expect_equal(cell[c("inputs", "outputs", "messages")], list( 120 | inputs = list(), 121 | outputs = list(), 122 | messages = list(list( 123 | type = "error", 124 | message = "Code is not a single, simple expression" 125 | )) 126 | )) 127 | }) 128 | 129 | it("has an execute method", { 130 | context <- RContext$new() 131 | 132 | cell <- context$execute("6 * 7") 133 | expect_equal(cell$type, "cell") 134 | expect_equal(cell$inputs, list()) 135 | expect_equal(cell$outputs, list(list( 136 | value = list( 137 | type = "number", 138 | data = 42 139 | ) 140 | ))) 141 | expect_equal(cell$messages, list()) 142 | 143 | check <- function (source, expected) { 144 | cell <- context$execute(source) 145 | expect_equal(cell$type, "cell") 146 | if (!is.null(expected$outputs)) expect_equal(cell$outputs, expected$outputs) 147 | if (!is.null(expected$messages)) expect_equal(cell$messages, expected$messages) 148 | else expect_equal(cell$messages, list()) 149 | } 150 | 151 | check("", list( 152 | outputs = list(), 153 | messages = list() 154 | )) 155 | 156 | check("6 * 7", list( 157 | outputs = list(list( 158 | value = list(type = "number", data = 42) 159 | )) 160 | )) 161 | 162 | check("x <- 42", list( 163 | outputs = list(list( 164 | name = "x", 165 | value = list(type = "number", data = 42) 166 | )) 167 | )) 168 | 169 | expect_equal(context$execute("y <- 3.14\ny")$outputs[[1]]$value$data, 3.14) 170 | 171 | expect_equal(context$execute("foo")$messages, list(list( 172 | type = "error", 173 | message = "object 'foo' not found", 174 | line = 1, 175 | column = 0 176 | ))) 177 | 178 | r <- context$execute(list( 179 | code = "y*10\nfoo\ny*5", 180 | inputs = list(list( 181 | name = "y", 182 | value = list(type = "number", data = 1.1) 183 | )) 184 | )) 185 | expect_equal(r$messages, list(list( 186 | type = "error", 187 | message = "object 'foo' not found", 188 | line = 2, 189 | column = 0 190 | ))) 191 | expect_equal(r$outputs[[1]]$value$data, 5.5) 192 | 193 | r <- context$execute("plot(1,1)") 194 | expect_equal(r$outputs[[1]]$value$type, "image") 195 | expect_equal(str_sub(r$outputs[[1]]$value$src, 1, 10), "data:image") 196 | 197 | return() 198 | 199 | # Load ggplot2 so that diamonds is available 200 | context$execute("library(ggplot2)") 201 | 202 | r <- context$execute("ggplot(diamonds) + geom_point(aes(x=carat, y=price))") 203 | expect_equal(r$value$type, "image") 204 | expect_equal(str_sub(r$value$src, 1, 10), "data:image") 205 | 206 | # An error in the rendering of the ggplot (in this case missing aesthtics) 207 | # which wil thow in the packing of the ggplot value 208 | r <- context$execute("ggplot(diamonds) + geom_point()") 209 | expect_equal(r$messages, list(list( 210 | line = 0, 211 | column = 0, 212 | type = "error", 213 | message = "geom_point requires the following missing aesthetics: x, y" 214 | ))) 215 | expect_equal(r$value, NULL) 216 | 217 | # Takes arguments 218 | expect_equal(context$execute("list(a_is=a,b_is=b)", list( 219 | a = context$pack(42), 220 | b = context$pack("foo") 221 | ))$value, context$pack(list(a_is = 42, b_is = "foo"))) 222 | 223 | # Last value is returned as per usual 224 | expect_equal(context$execute("foo <- 'bar'\nfoo")$value$data, "bar") 225 | 226 | # Works multiline 227 | func <- "if(x==1){ 228 | 'x is 1' 229 | } else if(x==2){ 230 | return('x is 2') 231 | } else { 232 | 'x is ?' 233 | }" 234 | expect_equal(context$unpack(context$execute(func, list(x = context$pack(1)))$value), "x is 1") 235 | expect_equal(context$unpack(context$execute(func, list(x = context$pack(2)))$value), "x is 2") 236 | expect_equal(context$unpack(context$execute(func, list(x = context$pack(3)))$value), "x is ?") 237 | 238 | # Reports errors as expecte 239 | expect_equal(context$execute("baz")$messages[[1]]$line, 1) 240 | expect_equal(context$execute("\nbaz\n")$messages[[1]]$line, 2) 241 | expect_equal(context$execute("1\nbaz")$messages[[1]]$line, 2) 242 | expect_equal(context$execute("\n\nbaz")$messages[[1]]$line, 3) 243 | }) 244 | }) 245 | --------------------------------------------------------------------------------