Merge pull request #19 from davidycliao/v0.1.6

V0.1.6
davidycliao · Sep 17, 2023 · b267402 · b267402
2 parents e13fda7 + 309b12f
commit b267402
Show file tree

Hide file tree

Showing 50 changed files with 1,026 additions and 813 deletions.
diff --git a/.github/workflows/r.yml b/.github/workflows/r.yml
@@ -24,18 +24,25 @@ jobs:
       matrix:
         r-version: ['3.6.3', '4.1.1']
 
-    steps:
+   steps:
       - uses: actions/checkout@v3
       - uses: r-lib/actions/setup-pandoc@v2
       - name: Set up R ${{ matrix.r-version }}
         uses: r-lib/actions/setup-r@f57f1301a053485946083d7a45022b278929a78a
         with:
           r-version: ${{ matrix.r-version }}
-      - name: Install dependencies
+          cran: https://cran-archive.r-project.org
+       - name: Install dependencies
         run: |
           install.packages(c("remotes", "rcmdcheck"))
-          remotes::install_deps(dependencies = TRUE)
+          remotes::install_deps(dependencies = TRUE, type = "binary")
         shell: Rscript {0}
+        env:
+          R_LIBS_USER: /Users/runner/work/_temp/Library
+          TZ: UTC
+          _R_CHECK_SYSTEM_CLOCK_: FALSE
+          NOT_CRAN: true
+        timeout-minutes: 30
       - name: Check
         run: rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "error")
         shell: Rscript {0}
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -22,14 +22,18 @@ Imports:
 	stringr,
   curl,
   tibble,
-  rvest
+  rvest,
+  withr,
+  httr
 Suggests: 
   knitr,
   rmarkdown,
   ggplot2,
   remotes,
   tidyverse,
   testthat (>= 3.0.0)
+Config/Needs/website:
+    tidyverse/tidytemplate  
 RoxygenNote: 7.2.3
 BugReports: https://github.com/davidycliao/legisTaiwan/issues
 URL: https://davidycliao.github.io/legisTaiwan/

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,10 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export(.onAttach)
-export(api_check)
-export(check_date)
-export(check_date2)
-export(check_internet)
 export(get_bills)
 export(get_bills_2)
 export(get_caucus_meetings)
@@ -16,16 +11,15 @@ export(get_parlquestions)
 export(get_public_debates)
 export(get_speech_video)
 export(get_variable_info)
-export(review_session_info)
-export(transformed_date_bill)
-export(transformed_date_meeting)
-export(website_availability2)
 importFrom(attempt,stop_if_all)
 importFrom(attempt,stop_if_not)
 importFrom(curl,has_internet)
+importFrom(httr,GET)
+importFrom(httr,content)
 importFrom(jsonlite,fromJSON)
 importFrom(rvest,html_text2)
 importFrom(rvest,read_html)
 importFrom(stringr,str_split_1)
 importFrom(stringr,str_sub)
 importFrom(tibble,as_tibble)
+importFrom(withr,with_options)
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,6 @@
+# `legisTaiwan` 0.1.6
+
+
 # `legisTaiwan` 0.1.4 (development version)
 
 * re-documentation and inserting handlers.

diff --git a/R/bill.R b/R/bill.R
diff --git a/R/info.R b/R/info.R
@@ -30,72 +30,139 @@
 #'@importFrom rvest html_text2 read_html
 #'@importFrom tibble as_tibble
 #'
-#'@export
+#' @export
 #'
-#'@seealso
-#'`review_session_info()`
+#' @seealso `review_session_info()`.
+#'
+#' @examples
+#' \dontrun{
+#' get_variable_info("get_bills")
+#' }
+# get_variable_info <- function(param_) {
+#   check_internet()
+#   attempt::stop_if_all(website_availability(), isFALSE, msg = "the error from the API.")
+#   attempt::stop_if_all(param_, is.numeric, msg = "use string format only.")
+#   attempt::stop_if_all(param_, is.null, msg = "use correct funtion names.")
+#   attempt::stop_if(param_ , ~ length(.x) >1, msg = "only allowed to query one function.")
+#   if (param_ == "get_parlquestions") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=6"
+#   }
+#   else if (param_ == "get_legislators") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=16"
+#   }
+#   else if (param_ == "get_committee_record") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=46"
+#   }
+#   else if (param_ == "get_executive_response") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=2"
+#   }
+#   else if (param_ == "get_caucus_meetings") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=8"
+#   }
+#   else if (param_ == "get_speech_video") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=148"
+#   }
+#   else if (param_ == "get_bills_2") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=20"
+#   }
+#   else if (param_ == "get_public_debates") {
+#     url <- "https://data.ly.gov.tw/getds.action?id=7"
+#   }
+#   else if (param_ %in% c("get_bills", "get_meetings")) {
+#     if (param_ == "get_meetings") {
+#       url <- "https://www.ly.gov.tw/Pages/List.aspx?nodeid=154"
+#       }
+#     else if (param_ == "get_bills") {
+#       url <- "https://www.ly.gov.tw/Pages/List.aspx?nodeid=153"
+#       }
+#     html_info <- rvest::html_text2(rvest::html_nodes(rvest::html_nodes(rvest::read_html(url), "*[id='form_Query']"), "div") )
+#     page_info <- list(page_info = strsplit(html_info[14], split = "\n")[[1]], reference_url = url)
+#     return(page_info)
+#   }
+#   else {
+#     stop("Use correct funtion names below in character format:
+#          get_bills: the records of the bills
+#          get_bills_2: the records of legislators and the government proposals
+#          get_meetings: the spoken meeting records
+#          get_caucus_meetings: the meeting records of cross-caucus session
+#          get_speech_video: the full video information of meetings and committees
+#          get_public_debates: the records of national public debates
+#          get_parlquestions: the records of parliamentary questions
+#          get_executive_response: the records of the questions answered by the executives")
+#     }
+#     html <- rvest::html_nodes(rvest::read_html(url), "*[id='content']")
+#     title <- gsub("[[:space:]]", "", rvest::html_text2(rvest::html_nodes(html, "h2")))
+#
+#     content <- gsub("[[:space:]]", "", rvest::html_text2(rvest::html_nodes(html, "span")))
+#     df <- data.frame(content[seq(1, length(content), 2 )],
+#                      content[seq(1, length(content) + 1, 2 ) -1])
+#     colnames(df) <- c(title[2], title[1])
+#     df <- tibble::as_tibble(df)
+#     page_info <- list(page_info = df, reference_url = url)
+#   return(page_info)
+# }
 
 get_variable_info <- function(param_) {
-  legisTaiwan::check_internet()
-  attempt::stop_if_all(website_availability(), isFALSE, msg = "the error from the API.")
-  attempt::stop_if_all(param_, is.numeric, msg = "use string format only.")
-  attempt::stop_if_all(param_, is.null, msg = "use correct funtion names.")
-  attempt::stop_if(param_ , ~ length(.x) >1, msg = "only allowed to query one function.")
-  if (param_ == "get_parlquestions") {
-    url <- "https://data.ly.gov.tw/getds.action?id=6"
-  }
-  else if (param_ == "get_legislators") {
-    url <- "https://data.ly.gov.tw/getds.action?id=16"
-  }
-  else if (param_ == "get_committee_record") {
-    url <- "https://data.ly.gov.tw/getds.action?id=46"
-  }
-  else if (param_ == "get_executive_response") {
-    url <- "https://data.ly.gov.tw/getds.action?id=2"
-  }
-  else if (param_ == "get_caucus_meetings") {
-    url <- "https://data.ly.gov.tw/getds.action?id=8"
-  }
-  else if (param_ == "get_speech_video") {
-    url <- "https://data.ly.gov.tw/getds.action?id=148"
-  }
-  else if (param_ == "get_bills_2") {
-    url <- "https://data.ly.gov.tw/getds.action?id=20"
+  # Ensure internet and website availability
+  check_internet()
+  attempt::stop_if_not(website_availability(), msg = "the error from the API.")
+
+  # Parameter checks
+  attempt::stop_if(param_, is.numeric, msg = "use string format only.")
+  attempt::stop_if(param_, is.null, msg = "use correct function names.")
+  attempt::stop_if(param_, ~ length(.x) > 1, msg = "only allowed to query one function.")
+
+  # Dictionary for URL mapping
+  url_mapping <- list(
+    get_parlquestions = "https://data.ly.gov.tw/getds.action?id=6",
+    get_legislators = "https://data.ly.gov.tw/getds.action?id=16",
+    get_committee_record = "https://data.ly.gov.tw/getds.action?id=46",
+    get_executive_response = "https://data.ly.gov.tw/getds.action?id=2",
+    get_caucus_meetings = "https://data.ly.gov.tw/getds.action?id=8",
+    get_speech_video = "https://data.ly.gov.tw/getds.action?id=148",
+    get_bills_2 = "https://data.ly.gov.tw/getds.action?id=20",
+    get_public_debates = "https://data.ly.gov.tw/getds.action?id=7"
+  )
+  if (!(param_ %in% names(url_mapping) || param_ %in% c("get_bills", "get_meetings"))) {
+    stop("Use correct function names below in character format:
+          get_bills: the records of the bills
+          get_bills_2: the records of legislators and the government proposals
+          get_meetings: the spoken meeting records
+          get_caucus_meetings: the meeting records of cross-caucus session
+          get_speech_video: the full video information of meetings and committees
+          get_public_debates: the records of national public debates
+          get_parlquestions: the records of parliamentary questions
+          get_executive_response: the records of the questions answered by the executives")
   }
-  else if (param_ == "get_public_debates") {
-    url <- "https://data.ly.gov.tw/getds.action?id=7"
+
+
+  # Fetch URL from dictionary or process special cases
+  if (param_ %in% names(url_mapping)) {
+    url <- url_mapping[[param_]]
+  } else if (param_ == "get_meetings") {
+    url <- "https://www.ly.gov.tw/Pages/List.aspx?nodeid=154"
+  } else if (param_ == "get_bills") {
+    url <- "https://www.ly.gov.tw/Pages/List.aspx?nodeid=153"
+  } else {
+    stop("Use correct function names below in character format.")
   }
-  else if (param_ %in% c("get_bills", "get_meetings")) {
-    if (param_ == "get_meetings") {
-      url <- "https://www.ly.gov.tw/Pages/List.aspx?nodeid=154"
-      }
-    else if (param_ == "get_bills") {
-      url <- "https://www.ly.gov.tw/Pages/List.aspx?nodeid=153"
-      }
-    html_info <- rvest::html_text2(rvest::html_nodes(rvest::html_nodes(rvest::read_html(url), "*[id='form_Query']"), "div") )
+
+  if (param_ %in% c("get_bills", "get_meetings")) {
+    html_info <- rvest::html_text2(rvest::html_nodes(rvest::html_nodes(rvest::read_html(url), "*[id='form_Query']"), "div"))
     page_info <- list(page_info = strsplit(html_info[14], split = "\n")[[1]], reference_url = url)
     return(page_info)
   }
-  else {
-    stop("Use correct funtion names below in character format:
-         get_bills: the records of the bills
-         get_bills_2: the records of legislators and the government proposals
-         get_meetings: the spoken meeting records
-         get_caucus_meetings: the meeting records of cross-caucus session
-         get_speech_video: the full video information of meetings and committees
-         get_public_debates: the records of national public debates
-         get_parlquestions: the records of parliamentary questions
-         get_executive_response: the records of the questions answered by the executives")
-    }
-    html <- rvest::html_nodes(rvest::read_html(url), "*[id='content']")
-    title <- gsub("[[:space:]]", "", rvest::html_text2(rvest::html_nodes(html, "h2")))
-
-    content <- gsub("[[:space:]]", "", rvest::html_text2(rvest::html_nodes(html, "span")))
-    df <- data.frame(content[seq(1, length(content), 2 )],
-                     content[seq(1, length(content) + 1, 2 ) -1])
-    colnames(df) <- c(title[2], title[1])
-    df <- tibble::as_tibble(df)
-    page_info <- list(page_info = df, reference_url = url)
+
+  html <- rvest::html_nodes(rvest::read_html(url), "*[id='content']")
+  title <- gsub("[[:space:]]", "", rvest::html_text2(rvest::html_nodes(html, "h2")))
+
+  content <- gsub("[[:space:]]", "", rvest::html_text2(rvest::html_nodes(html, "span")))
+  df <- data.frame(content[seq(1, length(content), 2)],
+                   content[seq(1, length(content) + 1, 2) - 1])
+  colnames(df) <- c(title[2], title[1])
+  df <- tibble::as_tibble(df)
+  page_info <- list(page_info = df, reference_url = url)
+
   return(page_info)
 }
 
@@ -115,28 +182,55 @@ get_variable_info <- function(param_) {
 #'@importFrom rvest html_text2 read_html
 #'@importFrom tibble as_tibble
 #'
-#'@export
+#' @seealso
+#' Regarding Minguo calendar, please see \url{https://en.wikipedia.org/wiki/Republic_of_China_calendar}.
 #'
-#'@seealso
-#'Regarding Minguo calendar, please see \url{https://en.wikipedia.org/wiki/Republic_of_China_calendar}.
+#' @examples
+#' \dontrun{
+#' review_session_info(7)
+#' }
+
+# review_session_info <- function(term){
+#   attempt::stop_if_all(website_availability2(), isFALSE, msg = "the error from the API.")
+#   attempt::stop_if_all(term, is.null, msg = "use correct `term`")
+#   attempt::stop_if_all(term %in% 1:11, isFALSE, msg = "use correct `term`")
+#   url <- paste("https://npl.ly.gov.tw/do/www/appDate?status=0&expire=",
+#                sprintf("%02d", as.numeric(term)),
+#                "&startYear=0", sep ="")
+#   html_ <- rvest::html_nodes(rvest::read_html(url), "*[class='section_wrapper']")
+#   title <- stringr::str_split_1(rvest::html_text2(rvest::html_nodes(html_, "[class='tt_titlebar2']")), "\t\r")[1:2]
+#   o <- rvest::html_text2(rvest::html_nodes(html_, "[class='tt_listrow_odd']"))
+#   e <- rvest::html_text2(rvest::html_nodes(html_, "[class='tt_listrow_even']"))
+#   s <- lapply(lapply(c(o, e),function(.){stringr::str_split_1(., "\r\r" )}),
+#                      function(.){gsub("[[:space:]]", "", .)})
+#   df <- do.call(rbind, s)
+#   colnames(df) <- title
+#   df <- tibble::as_tibble(df)
+#   return(df)
+#   }
+#
+#
+
+
+
+review_session_info <- function(term) {
+  attempt::stop_if_not(website_availability2(), msg = "the error from the API.")
+  attempt::stop_if(term, is.null, msg = "use correct `term`.")
+  attempt::stop_if_not(term %in% 1:11, msg = "use correct `term`.")
 
-review_session_info <- function(term){
-  attempt::stop_if_all(legisTaiwan::website_availability2(), isFALSE, msg = "the error from the API.")
-  attempt::stop_if_all(term, is.null, msg = "use correct `term`")
-  attempt::stop_if_all(term %in% 1:11, isFALSE, msg = "use correct `term`")
   url <- paste("https://npl.ly.gov.tw/do/www/appDate?status=0&expire=",
                sprintf("%02d", as.numeric(term)),
                "&startYear=0", sep ="")
+
   html_ <- rvest::html_nodes(rvest::read_html(url), "*[class='section_wrapper']")
   title <- stringr::str_split_1(rvest::html_text2(rvest::html_nodes(html_, "[class='tt_titlebar2']")), "\t\r")[1:2]
   o <- rvest::html_text2(rvest::html_nodes(html_, "[class='tt_listrow_odd']"))
   e <- rvest::html_text2(rvest::html_nodes(html_, "[class='tt_listrow_even']"))
-  s <- lapply(lapply(c(o, e),function(.){stringr::str_split_1(., "\r\r" )}),
-                     function(.){gsub("[[:space:]]", "", .)})
+  s <- lapply(lapply(c(o, e), function(.) {stringr::str_split_1(., "\r\r")}),
+              function(.) {gsub("[[:space:]]", "", .)})
   df <- do.call(rbind, s)
   colnames(df) <- title
   df <- tibble::as_tibble(df)
-  return(df)
-  }
-
 
+  return(df)
+}
diff --git a/R/legislators.R b/R/legislators.R
@@ -33,6 +33,7 @@
 #'
 #'@importFrom attempt stop_if_all
 #'@importFrom jsonlite fromJSON
+#'@importFrom withr with_options
 #'
 #'@export
 #'
@@ -45,15 +46,15 @@
 #'`queried_term`, `url`, `variable_names`, `manual_info` and `data`.
 #'
 #'@note To retrieve the user manual and more information about variable of the data
-#' frame, please use `legisTaiwan::get_variable_info("get_legislators")`
+#' frame, please use `get_variable_info("get_legislators")`
 #' or visit the API manual at \url{https://data.ly.gov.tw/getds.action?id=16}.
 #' 提供委員基本資料，最早資料可追溯至第2屆。
 #'
 #'@seealso
 #'`get_variable_info("get_legislators")`, `review_session_info()`
 
 get_legislators <- function(term = NULL, verbose = TRUE) {
-  legisTaiwan::check_internet()
+  check_internet()
   if (is.null(term)) {
     set_api_url <- paste("https://data.ly.gov.tw/odw/ID16Action.action?name=&sex=&party=&partyGroup=&areaName=&term=",
                          term, "=&fileType=json", sep = "")
@@ -71,7 +72,7 @@ get_legislators <- function(term = NULL, verbose = TRUE) {
   }
   tryCatch(
     {
-      json_df <- jsonlite::fromJSON(set_api_url)
+      with_options(list(timeout = max(1000, getOption("timeout"))),{json_df <- jsonlite::fromJSON(set_api_url)})
       df <- tibble::as_tibble(json_df$dataList)
       attempt::stop_if_all(nrow(df) == 0, isTRUE, msg = "The query is unavailable.")
       term <- paste(sort(as.numeric(unique(df$term))), collapse = " ", sep = ",")