---
title: "TaskView Hexwall"
format: 
  dashboard:
    orientation: columns
    scrolling: true
---

```{r, echo = FALSE}
knitr::opts_chunk$set(
  message = NA,
  echo = FALSE
  )
```

```{r Get the Task View File}
# Download Views binary file from CRAN
tmpfile <- tempfile()
repo <- 'https://cloud.r-project.org'
download.file(paste(repo, "src/contrib/Views.rds", sep = "/"), destfile = tmpfile)

# Get packages on the task view
all_Views      <- readRDS(tmpfile)
unlink(tmpfile)
ctv_clintrials <- all_Views$ClinicalTrials
ctv_clintrials_packages <- ctv_clintrials$packagelist$name

```

```{r Compile Helper Functions}
# Construct URI to get contents of the man/figures subdirectory on CRAN GitHub
make_cran_uri <- function(dep, endpoint = 'api.github.com', subdir = 'man/figures'){
  sprintf('https://%s/repos/cran/%s/contents/%s', endpoint, dep, subdir)
}

# Construct URI to get contents of the man/figures subdirectory on CRAN GitHub
make_gh_uri <- function(dep, endpoint = 'api.github.com'){
  sprintf('https://%s/repos/%s/contents', endpoint, dep)
}

check_pat <- function(){
  if(!nzchar(Sys.getenv('GITHUB_PAT'))){
    message('Missing GitHub PAT!')
  }
}


# look for png files in the repos
# need a GITHUB_PAT for multiple hits to the API
get_logo <- function(dep){
  check_pat()
  res_cran <- httr::GET(
    url = make_cran_uri(dep, subdir = 'man/figures'),
    httr::add_headers(
      Authorization = sprintf('token %s',Sys.getenv('GITHUB_PAT'))
    )
  )
  
  if(httr::status_code(res_cran)=='200'){
    man_cran <- httr::content(res_cran)
    ret <- purrr::map_chr(man_cran, ~.x$download_url)
    ret[!grepl('^(README|lifecycle)',basename(ret))]
  }
  else{
    message("CRAN API Message: ", httr::status_code(res_cran))
    NA_character_
  }
}

find_remote <- function(dep){
    check_pat()
    res_cran <- httr::GET(
      url = make_cran_uri(dep, subdir = 'DESCRIPTION'),
      httr::add_headers(
        Authorization = sprintf('token %s',Sys.getenv('GITHUB_PAT'))
      )
    )

  if(httr::status_code(res_cran)=='200'){
    desc_cran <- httr::content(res_cran)
    tf <- tempfile()
    on.exit(unlink(tf),add = TRUE)
    cat(rawToChar(base64enc::base64decode(desc_cran$content)),file = tf)
    parse_desc(tf)
  }
  else{
    message("CRAN API Message: ", httr::status_code(res_cran))
    NA_character_
  }
}

parse_desc <- function(file){

  # Try Issues URL
  desc_bugs <- clean_key(desc::desc_get(file = file, keys = 'BugReports'))
  uri <- grep_github(desc_bugs)

  # Try Remotes URL
  if(!length(uri)){

    desc_remotes <- desc::desc_get_urls(file = file)
    uri <- grep_github(desc_remotes)

  }

  uri
}

clean_key <- function(key){
  trimws(strsplit(key,',')[[1]])
}

grep_github <- function(x){
  gh_raw <- grep('github\\.com',x,value = TRUE)
  gh_prefix <- gsub('^http(.*?).com/','',gh_raw)
  gh_suffix <- gsub('issues\\/$|issues$','',gh_prefix)
  gh_suffix <- gsub('\\/$','',gh_suffix)
  gh_suffix
}

find_readme <- function(dep){
  res_gh <- httr::GET(
    url = make_gh_uri(dep),
    httr::add_headers(
      Authorization = sprintf('token %s',Sys.getenv('GITHUB_PAT'))
    )
  )

  if(httr::status_code(res_gh)=='200'){
    root_gh <- httr::content(res_gh)
    ret <- purrr::map_chr(root_gh, function(x){
      if(is.null(x$download_url)){
        return(NA_character_)
      }else(
        x$download_url
      )
    })
    
    ret[grepl('^readme.md$',basename(ret),ignore.case = TRUE)]
  }
  else{
    message("GitHub API Message: ", httr::status_code(res_gh))
    NA_character_
  }
}

parse_gh_md <- function(path){
   res_readme <- httr::GET(
      url = path,
      httr::add_headers(
        Authorization = sprintf('token %s',Sys.getenv('GITHUB_PAT'))
      )
    )

  if(httr::status_code(res_readme)=='200'){
    readme_content <- httr::content(res_readme)
    readme_content_split <- strsplit(readme_content,'\n')[[1]]
    readme_content_split_lgl <- purrr::map_lgl(readme_content_split, function(x) grepl('<img(.*?)>',
    x))
    readme_img_tag <- readme_content_split[readme_content_split_lgl]
    readme_img_tags <- strsplit(readme_img_tag,'\\s')
    if(length(readme_img_tags)==0){
      return(NA_character_)
    }
    readme_img_attr <- grep('^src',readme_img_tags[[1]], value = TRUE)
    readme_img_src <- gsub("'",'',gsub('src(.*?)=','',readme_img_attr))
    readme_img_src <- gsub('"','',readme_img_src)
    file.path(dirname(path), readme_img_src)
  }
  else{
    message("README Message: ", httr::status_code(res_readme))
    
    NA_character_
  }
}
```

```{r Invoke the functions}
ctv_clintrials_remotes <- ctv_clintrials_packages |> 
  purrr::set_names() |>
  purrr::map(find_remote)
  
ctv_clintrials_readme <- ctv_clintrials_remotes |>
  purrr::discard(~length(.x)==0) |>
  purrr::discard(~!grepl('/',.x)) |> #malformed repo paths
  purrr::map(find_readme) |>
  purrr::map(parse_gh_md)

# Postprocessing
ctv_clintrials_readme_clean <- ctv_clintrials_readme  |> 
  tibble::enframe(name = 'package', value = 'url') |>
  tidyr::unnest(c(url)) |>
  dplyr::filter(!is.na(url))

message("Non Missing logo n:", nrow(ctv_clintrials_readme_clean))
```

```{r Construct list of missing logos}
missing_logo <- setdiff(names(ctv_clintrials_remotes), ctv_clintrials_readme_clean$package)
missing_logo_colors <- sample(viridis::inferno(length(missing_logo)*2), length(missing_logo))
message("Missing logo n:", length(missing_logo))
```

```{r define svg}
library(minisvg)
len     <- 95
angles  <- (seq(0, 360, 60) + 90) * pi/180
xs      <- round(len * cos(angles) + 100, 2)
ys      <- round(len * sin(angles) + 100, 2)
hex     <- stag$polygon(id = 'hex', xs = xs, ys = ys)
hex$update(stroke = '#223344', fill_opacity=0.25, stroke_width = 4)

def_layer <- svg_doc(style = "display:none", width = 200, height = 200)$update(width=90, height=90)
def_layer$add_css_url("https://fonts.googleapis.com/css?family=Abril%20Fatface")
def_layer$add_css("
.mainfont {
  font-size: 17px;
  font-family: 'Abril Fatface', sans-serif;
  fill: #223344;
}
")
def_layer$defs(hex)
```


```{r compile svg constructor function}
mysvg <- function(nm, color){
new_doc <- svg_doc(width = 200, height = 200)$update(width=90, height=90)
g <- stag$g()
g$update(onclick=sprintf("hover('%s')",file.path("https://cran.r-project.org/web/packages",nm)))
g$use(href = "#hex", fill = color)

text <- stag$text(
  nm,
  class = "mainfont",
  x = 100, y = 100,
  `text-anchor`="middle",
  `alignment-baseline`="middle"
)

g$append(text)

new_doc$append(g)
new_doc$as_character()
}

```

## Column {width=35%}

```{r construct iframe}
htmltools::tags$iframe(
  id="descIframe", width="100%", height="100%",
  src = file.path("https://cran.r-project.org/web/packages",ctv_clintrials_readme_clean$package[1])
)
```

## Column {width=50%}

```{r construct hex wall, results="asis"}
def_layer$as_character()
# Construct the wall
htmltools::tags$div(
    #style = "background-color: #feeacd; border-style: solid; border-radius: 10px; border-color: #000; border-width: 1px;",
    htmltools::tagList(
    purrr::map2(
      ctv_clintrials_readme_clean$package, 
      ctv_clintrials_readme_clean$url, 
      ~htmltools::tags$img(
                onclick=sprintf("hover('%s')",file.path("https://cran.r-project.org/web/packages",.x)),
                src = .y, 
                width = "90", 
                style="padding-left: 5px; padding-right: 5px;padding-top: 2px; padding-bottom: 2px;")
      ),
    purrr::map2(missing_logo, missing_logo_colors, ~mysvg(.x, .y)))
  )
```

```{=html}
<script>
function hover(uri) {
    document.getElementById('descIframe').src = uri;
}
</script>
```
