R/depreciated/get_toc.R

In JiaxiangBU/add2md: Add to Markdown

#' Get toc in a R project

#' @author Jiaxiang Li
#'
#' @importFrom readr read_lines
#' @importFrom stringr str_detect
#' @importFrom yaml yaml.load
#' @importFrom purrr map
#' @importFrom data.table transpose
#' @import tibble
#' @import dplyr
#' @importFrom knitr kable
#' @import fs
#' @export


################################################################################
# pre-defined function
################################################################################

# get yaml options in each file
safely_extract_yaml <- function(file_name){
    if (stringr::str_detect(file_name,'\\.(Rmd)$')) {
        bottom_line <-
            readr::read_lines(file_name) %>%
            stringr::str_detect("^---") %>%
            cumsum() %>%
            max()
        readr::read_lines(file_name,n_max = bottom_line) %>%
            yaml::yaml.load() %>%
            .$title %>%
            .[1]
    } else {
        ""
        cat("The document does not include yaml option.")
    }
}

extract_yaml <- function(file_name){
    bottom_line <-
        readr::read_lines(file_name) %>%
        stringr::str_detect("^---") %>%
        which() %>%
        .[2]
    readr::read_lines(file_name,n_max = bottom_line) %>%
        yaml::yaml.load() %>%
        .$title %>%
        .[1]
}
safely_extract_yaml2 <- purrr::possibly(extract_yaml,NA)

display_table <- function(x) {
    x %>%
        dplyr::transmute(
            hyperlink = map2_chr(link_text,link_href,~kableExtra::text_spec(.x, link = .y))
            ,github.io = map2_chr(link_text
                                  ,str_remove_all(link_href,"\\.(Rmd|md|html)$")
                                  ,~kableExtra::text_spec(.x, link = .y))
        ) %>%
        dplyr::mutate(
            index = dplyr::row_number()
        ) %>%
        dplyr::select(index,hyperlink,github.io) %>%
        knitr::kable(escape = F)
}



################################################################################
# get_toc
################################################################################


get_toc <- function(input_path = "."){
    # get input document
    rmd_path <- list.files(path = input_path,recursive = T,full.names = T,pattern = '\\.(Rmd)$')
    ipynb_path <- list.files(path = input_path,recursive = T,full.names = T,pattern = '\\.(ipynb)$')

    # get output document
    md_path <- list.files(path = input_path,recursive = T,full.names = T,pattern = '\\.(md)$')
    html_path <- list.files(path = input_path,recursive = T,full.names = T,pattern = '\\.(html)$')

    ignore_some <- function(path){
        ignore_path <- c("NEWS.md","README.md","README.Rmd")
        path[!basename(path) %in% ignore_path]

    }
    rmd_path <- ignore_some(rmd_path)
    md_path <- ignore_some(md_path)
    html_path <- ignore_some(html_path)

    # clean `a` file
    ignore_a_file <- function(path){
        path[
            !basename(path) %>% stringr::str_detect("^a\\d{8,}")
            ]
    }
    rmd_path <- ignore_a_file(rmd_path)

    # get document number
    n_rmd <-
        rmd_path %>%
        length()
    n_ipynb <-
        ipynb_path %>%
        length()
    n_md <-
        md_path %>%
        length()
    n_html <-
        html_path %>%
        length()

    rmd_title <-
        rmd_path %>%
        purrr::map(safely_extract_yaml) %>%
        purrr::compact() %>%
        data.table::transpose(fill="",ignore.empty=FALSE) %>%
        .[[1]]
    rmd_title <-
        tibble::data_frame(
            rmd_path = rmd_path
            ,rmd_title = rmd_title
        )

    get_name <- function(path,rm = '\\.(Rmd)$'){
        data_frame(
            path = path
            ,name = basename(path) %>% str_remove_all(rm)
        )
    }

    rmd_name <- get_name(rmd_path,'\\.(Rmd)$')
    ipynb_name <- get_name(ipynb_path,'\\.(ipynb)$')
    md_name <- get_name(md_path,'\\.(md)$')
    html_name <- get_name(html_path,'\\.(html)$')

    dplyr::bind_rows(rmd_name,ipynb_name) %>%
        dplyr::rename(rmd_path = path) %>%
        dplyr::left_join(
            rmd_title
            ,by = 'rmd_path'
        ) %>%
        dplyr::left_join(
            html_name %>%
                dplyr::rename(html_path = path)
            ,by = 'name'
        ) %>%
        dplyr::left_join(
            md_name %>%
                dplyr::rename(md_path = path)
            ,by = 'name'
        ) %>%
        dplyr::transmute(
            link_text = dplyr::case_when(
                rmd_title != '' ~ rmd_title
                ,name != '' ~ name
                ,rmd_path != '' ~ rmd_path
            )
            ,link_href = dplyr::case_when(
                !is.na(html_path) ~ html_path
                ,!is.na(md_path) ~ md_path
                ,!is.na(rmd_path) ~ rmd_path
            )
        ) %>%
        display_table()

    usethis::ui_warn("get_toc() is depreciated, use workflowr::wflow_toc()")

}

################################################################################
# get_toc2
################################################################################


get_toc2 <- function(input_path = ".",
                     file_pattern = "\\.(Rmd|md|html|ipynb)$",
                     ignore_path = c("NEWS.md","README.md","README.Rmd"),
                     ignore_pattern = '^a\\d',
                     recursive = TRUE
                     ){

    ########################
    # extract path
    ########################

    fs_table <-
        fs::dir_info(input_path, recursive = recursive) %>%
        dplyr::filter(path %>% stringr::str_detect(file_pattern)) %>%
        dplyr::filter(!path %in% ignore_path) %>%
        dplyr::filter(!basename(path) %>% str_detect(ignore_pattern)) %>%
        dplyr::mutate(file_name = stringr::str_remove_all(basename(path),file_pattern))

    rmd_title <-
        fs_table %>%
        dplyr::filter(path %>% stringr::str_detect('\\.Rmd$')) %>%
        dplyr::mutate(title = purrr::map(path,safely_extract_yaml2)) %>%
        dplyr::filter(purrr::map_lgl(title,is_character)) %>%
        tidyr::unnest() %>%
        dplyr::select(file_name, title)

    rmd_path <-
        fs_table %>%
        dplyr::filter(path %>% stringr::str_detect('\\.Rmd$')) %>%
        dplyr::transmute(file_name, orig_path = path)
    ipynb_path <-
        fs_table %>%
        dplyr::filter(path %>% stringr::str_detect('\\.ipynb$')) %>%
        dplyr::transmute(file_name, orig_path = path)
    md_path <-
        fs_table %>%
        dplyr::filter(path %>% stringr::str_detect('\\.md$')) %>%
        dplyr::transmute(file_name, md_path = path)
    html_path <-
        fs_table %>%
        dplyr::filter(path %>% stringr::str_detect('\\.html$')) %>%
        dplyr::transmute(file_name, html_path = path)


    path_table <-
        dplyr::bind_rows(rmd_path,ipynb_path) %>%
        dplyr::left_join(rmd_title, by = 'file_name') %>%
        dplyr::left_join(md_path,   by = 'file_name') %>%
        dplyr::left_join(html_path, by = 'file_name')


    path_table %>%
        dplyr::transmute(
            link_text = ifelse(!is.na(title),title,file_name)
            ,link_href = dplyr::case_when(
                !is.na(html_path) ~ html_path
                ,!is.na(md_path) ~ md_path
                ,!is.na(orig_path) ~ orig_path
            )
        ) %>%
        display_table()
    usethis::ui_warn("get_toc() is depreciated, use workflowr::wflow_toc()")
}