library(testthat)
library(igvShiny)

# The track loaders are thin wrappers: they validate and reshape their inputs,
# then hand a payload to igv.js over session$sendCustomMessage(). These tests
# pin down that payload - the R/JS contract is exactly what broke in #36, #105
# and #116, and until now nothing checked it outside a real browser.

ELEMENT_ID <- "igvShiny_0"

bed_tbl <- function() {
  data.frame(
    chr = c("chr1", "chr1", "chr1"),
    start = c(7432, 7561, 7300),
    end = c(7503, 7580, 7350),
    value = c(0.5, 0.9, 0.1),
    stringsAsFactors = FALSE
  )
}

# igv.js sorts an alignment track from this object at load time. Each loader
# builds its own payload, so a dropped trackConfig is a per-loader regression.
sort_by_hp <- function() {
  list(chr = "chr1", position = 155160540, option = "TAG", tag = "HP",
       direction = "ASC")
}

test_that("loadBedTrack sends a bed file path and honours colour and height", {
  session <- fake_session()
  loadBedTrack(session, ELEMENT_ID, "bed", bed_tbl(),
               color = "blue", trackHeight = 77)

  msg <- last_message(session, "loadBedTrackFromFile")
  expect_equal(msg$elementID, ELEMENT_ID)
  expect_equal(msg$trackName, "bed")
  expect_equal(msg$color, "blue")
  expect_equal(msg$trackHeight, 77)
  expect_match(msg$bedFilepath, "^tracks/.*\\.bed$")
  expect_true(file.exists(file.path(get_tracks_dir(), basename(msg$bedFilepath))))
})

test_that("loadBedTrack deletes same-named tracks first, and can be told not to", {
  session <- fake_session()
  loadBedTrack(session, ELEMENT_ID, "bed", bed_tbl())
  expect_length(sent_messages(session, "removeTracksByName"), 1L)

  session <- fake_session()
  loadBedTrack(session, ELEMENT_ID, "bed", bed_tbl(),
               deleteTracksOfSameName = FALSE)
  expect_length(sent_messages(session, "removeTracksByName"), 0L)
})

test_that("loadBedTrack rejects a data.frame without chr/start/end", {
  session <- fake_session()
  tbl <- data.frame(a = "chr1", b = 1, c = 2, stringsAsFactors = FALSE)
  expect_error(loadBedTrack(session, ELEMENT_ID, "bad", tbl),
               "improper columns")
})

test_that("loadBedGraphTrack passes the autoscale settings through", {
  session <- fake_session()
  loadBedGraphTrack(session, ELEMENT_ID, "bedgraph", bed_tbl(),
                    autoscale = FALSE, min = 0, max = 10,
                    autoscaleGroup = 2)

  msg <- last_message(session, "loadBedGraphTrack")
  expect_false(msg$autoscale)
  expect_equal(msg$min, 0)
  expect_equal(msg$max, 10)
  expect_equal(msg$autoscaleGroup, 2)
})

test_that("loadBedGraphTrackFromURL forwards the url and autoscaleGroup (#105)", {
  session <- fake_session()
  url <- "https://example.org/data.bedGraph"
  loadBedGraphTrackFromURL(session, ELEMENT_ID, "remote", url,
                           autoscale = TRUE, autoscaleGroup = 1)

  msg <- last_message(session, "loadBedGraphTrackFromURL")
  expect_equal(msg$url, url)
  expect_true(msg$autoscale)
  expect_equal(msg$autoscaleGroup, 1)
})

test_that("loadSegTrack serialises the table as JSON", {
  session <- fake_session()
  tbl <- data.frame(
    chr = "chr1", start = 100, end = 200, value = 0.3,
    stringsAsFactors = FALSE
  )
  loadSegTrack(session, ELEMENT_ID, "seg", tbl)

  msg <- last_message(session, "loadSegTrack")
  expect_equal(msg$trackName, "seg")
  expect_match(as.character(msg$tbl), "chr1")
})

test_that("loadGwasTrack writes the table and sets the y-axis limits", {
  session <- fake_session()
  f <- system.file(package = "igvShiny", "extdata", "gwas.RData")
  tbl.gwas <- get(load(f))
  loadGwasTrack(session, ELEMENT_ID, "gwas", tbl.gwas, ymin = 1, ymax = 20)

  msg <- last_message(session, "loadGwasTrack")
  expect_match(msg$gwasDataFilepath, "^tracks/.*\\.gwas$")
  expect_equal(msg$min, 1)
  expect_equal(msg$max, 20)
  expect_false(msg$autoscale)
})

test_that("loadGwasTrack carries a column mapping and color table through", {
  session <- fake_session()
  f <- system.file(package = "igvShiny", "extdata", "gwas.RData")
  tbl.gwas <- get(load(f))
  columns <- list(chromosome = 3, position = 4, value = 10)
  colors <- list("19" = "purple", "*" = "gray")
  # the documented way for a loadGwasTrack caller to reach what GWASTrack takes
  # as arguments, so the allowlist and the loader have to agree
  loadGwasTrack(session, ELEMENT_ID, "gwas", tbl.gwas,
                trackConfig = list(columns = columns, colorTable = colors))

  msg <- last_message(session, "loadGwasTrack")
  expect_equal(msg$columns, columns)
  expect_equal(msg$colorTable, colors)
})

test_that("loadBamTrackFromURL sends both the bam and the index url", {
  session <- fake_session()
  loadBamTrackFromURL(session, ELEMENT_ID, "bam",
                      bamURL = "https://example.org/x.bam",
                      indexURL = "https://example.org/x.bam.bai",
                      displayMode = "SQUISHED", showAllBases = TRUE)

  msg <- last_message(session, "loadBamTrackFromURL")
  expect_equal(msg$bam, "https://example.org/x.bam")
  expect_equal(msg$index, "https://example.org/x.bam.bai")
  expect_equal(msg$displayMode, "SQUISHED")
  expect_true(msg$showAllBases)
})

test_that("loadCramTrackFromURL sends both the cram and the index url", {
  session <- fake_session()
  loadCramTrackFromURL(session, ELEMENT_ID, "cram",
                       cramURL = "https://example.org/x.cram",
                       indexURL = "https://example.org/x.cram.crai")

  msg <- last_message(session, "loadCramTrackFromURL")
  expect_equal(msg$cram, "https://example.org/x.cram")
  expect_equal(msg$index, "https://example.org/x.cram.crai")
})

test_that("loadGFF3TrackFromURL forwards the colour mapping", {
  session <- fake_session()
  colorTable <- list(protein_coding = "red", lncRNA = "blue")
  loadGFF3TrackFromURL(session, ELEMENT_ID, "gff3",
                       gff3URL = "https://example.org/x.gff3",
                       indexURL = "https://example.org/x.gff3.tbi",
                       colorTable = colorTable,
                       colorByAttribute = "biotype",
                       displayMode = "EXPANDED",
                       visibilityWindow = 1000000)

  msg <- last_message(session, "loadGFF3TrackFromURL")
  expect_equal(msg$dataURL, "https://example.org/x.gff3")
  expect_equal(msg$indexURL, "https://example.org/x.gff3.tbi")
  expect_equal(msg$colorByAttribute, "biotype")
  expect_equal(msg$colorTable$protein_coding, "red")
  expect_equal(msg$visibilityWindow, 1000000)
})

test_that("loadGFF3TrackFromLocalData writes the file into the tracks dir", {
  session <- fake_session()
  f <- system.file(package = "igvShiny", "extdata", "GRCh38.94.NDUFS2.gff3")
  tbl.gff3 <- read.table(f, sep = "\t", header = FALSE, comment.char = "#",
                         quote = "", nrows = 50, stringsAsFactors = FALSE)
  loadGFF3TrackFromLocalData(session, ELEMENT_ID, "local gff3", tbl.gff3,
                             colorTable = list(exon = "red"),
                             colorByAttribute = "biotype",
                             displayMode = "EXPANDED",
                             visibilityWindow = 5000)

  msg <- last_message(session, "loadGFF3TrackFromLocalData")
  expect_match(msg$filePath, "^tracks/.*\\.gff3$")
  expect_true(file.exists(file.path(get_tracks_dir(), basename(msg$filePath))))
})

test_that("loadVcfTrack writes a vcf and points igv.js at it", {
  skip_if_not_installed("VariantAnnotation")
  session <- fake_session()
  f <- system.file(package = "igvShiny", "extdata", "chr19-cebpaRegion.vcf.gz")
  vcf <- VariantAnnotation::readVcf(f)
  loadVcfTrack(session, ELEMENT_ID, "vcf", vcf)

  msg <- last_message(session, "loadVcfTrack")
  expect_match(msg$vcfDataFilepath, "^tracks/.*\\.vcf$")
})

test_that("loadBamTrackFromLocalData exports the alignments to the tracks dir", {
  skip_if_not_installed("GenomicAlignments")
  skip_if_not_installed("Rsamtools")
  skip_if_not_installed("rtracklayer")
  session <- fake_session()
  f <- system.file(package = "igvShiny", "extdata", "tumor.bam")
  ga <- GenomicAlignments::readGAlignments(f, use.names = TRUE)
  loadBamTrackFromLocalData(session, ELEMENT_ID, "local bam", ga,
                            trackConfig = list(sort = sort_by_hp()))

  msg <- last_message(session, "loadBamTrackFromLocalData")
  expect_match(msg$bamDataFilepath, "^tracks/.*\\.bam$")
  expect_equal(msg$sort, sort_by_hp())
})

test_that("loadCramTrackFromLocalData serves the cram and its index (#102)", {
  session <- fake_session()
  cram <- tempfile(fileext = ".cram")
  writeBin(charToRaw("CRAM"), cram)
  writeBin(charToRaw("CRAI"), paste0(cram, ".crai"))
  loadCramTrackFromLocalData(session, ELEMENT_ID, "local cram", cram,
                             trackConfig = list(sort = sort_by_hp()))

  msg <- last_message(session, "loadCramTrackFromURL")
  expect_match(msg$cram, "^tracks/.*\\.cram$")
  expect_match(msg$index, "^tracks/.*\\.crai$")
  # whether the file was linked or copied, the served paths must reach the
  # bytes - and the index must not be a second copy of the cram
  served <- function(path) file.path(get_tracks_dir(), basename(path))
  expect_equal(readBin(served(msg$cram), "raw", 4L), charToRaw("CRAM"))
  expect_equal(readBin(served(msg$index), "raw", 4L), charToRaw("CRAI"))
  expect_equal(msg$sort, sort_by_hp())
})

test_that("loadCramTrackFromLocalData rejects a file that is not there (#102)", {
  session <- fake_session()
  cram <- tempfile(fileext = ".cram")
  writeBin(charToRaw("CRAM"), cram)

  expect_error(
    loadCramTrackFromLocalData(session, ELEMENT_ID, "gone",
                               tempfile(fileext = ".cram")))
  # a cram without its index is the likelier mistake, and igv.js needs both
  expect_error(
    loadCramTrackFromLocalData(session, ELEMENT_ID, "unindexed", cram))
  expect_length(sent_messages(session, "loadCramTrackFromURL"), 0L)
})

test_that("the alignment loaders pass a sort-by-tag object through (#104)", {
  session <- fake_session()
  loadBamTrackFromURL(session, ELEMENT_ID, "bam",
                      "https://example.org/a.bam", "https://example.org/a.bai",
                      trackConfig = list(sort = sort_by_hp()))
  expect_equal(last_message(session, "loadBamTrackFromURL")$sort, sort_by_hp())

  session <- fake_session()
  loadCramTrackFromURL(session, ELEMENT_ID, "cram",
                       "https://example.org/a.cram",
                       "https://example.org/a.crai",
                       trackConfig = list(sort = sort_by_hp()))
  expect_equal(last_message(session, "loadCramTrackFromURL")$sort, sort_by_hp())
})

test_that("loadSpliceJunctionTrackFromURL sends the url and the junction knobs (#103)", {
  session <- fake_session()
  loadSpliceJunctionTrackFromURL(
    session, ELEMENT_ID, "junctions",
    "https://example.org/sampleA.SJ.out.bed",
    trackHeight = 140,
    trackConfig = list(minUniquelyMappedReads = 2,
                       thicknessBasedOn = "numReads",
                       colorBy = "isAnnotatedJunction",
                       labelWith = "totalReadCount",
                       hideMotifs = list("non-canonical"))
  )

  msg <- last_message(session, "loadSpliceJunctionTrackFromURL")
  expect_equal(msg$elementID, ELEMENT_ID)
  expect_equal(msg$url, "https://example.org/sampleA.SJ.out.bed")
  expect_equal(msg$trackHeight, 140)
  expect_equal(msg$displayMode, "COLLAPSED")
  # an empty indexURL is what tells the JS side to set indexed = false; igv.js
  # otherwise guesses url + ".tbi"
  expect_equal(msg$indexURL, "")
  expect_equal(msg$minUniquelyMappedReads, 2)
  expect_equal(msg$thicknessBasedOn, "numReads")
  expect_equal(msg$colorBy, "isAnnotatedJunction")
  expect_equal(msg$labelWith, "totalReadCount")
  expect_equal(msg$hideMotifs, list("non-canonical"))
})

test_that("loadSpliceJunctionTrackFromURL carries a tabix index when given one", {
  session <- fake_session()
  loadSpliceJunctionTrackFromURL(
    session, ELEMENT_ID, "junctions",
    "https://example.org/sampleA.SJ.out.bed.gz",
    indexURL = "https://example.org/sampleA.SJ.out.bed.gz.tbi",
    deleteTracksOfSameName = FALSE
  )

  msg <- last_message(session, "loadSpliceJunctionTrackFromURL")
  expect_equal(msg$indexURL, "https://example.org/sampleA.SJ.out.bed.gz.tbi")
  expect_length(sent_messages(session, "removeTracksByName"), 0L)
})

test_that("loadSpliceJunctionTrackFromURL treats an unusable indexURL as no index", {
  # NULL survives list() and reaches the browser as JSON null, where the
  # handler's message.indexURL.length throws and the track silently never
  # loads. Normalising in R keeps that off the wire.
  session <- fake_session()
  loadSpliceJunctionTrackFromURL(session, ELEMENT_ID, "j",
                                 "https://example.org/a.bed", indexURL = NULL)
  expect_equal(last_message(session, "loadSpliceJunctionTrackFromURL")$indexURL, "")

  session <- fake_session()
  expect_warning(
    loadSpliceJunctionTrackFromURL(session, ELEMENT_ID, "j",
                                   "https://example.org/a.bed",
                                   indexURL = c("a.tbi", "b.tbi")),
    "single character string"
  )
  expect_equal(last_message(session, "loadSpliceJunctionTrackFromURL")$indexURL, "")

  session <- fake_session()
  expect_warning(
    loadSpliceJunctionTrackFromURL(session, ELEMENT_ID, "j",
                                   "https://example.org/a.bed", indexURL = NA),
    "single character string"
  )
  expect_equal(last_message(session, "loadSpliceJunctionTrackFromURL")$indexURL, "")
})

test_that("the label options from the bundled example are not igv.js 3.x options", {
  # spliceJunctionTrack.html still sets labelUniqueReadCount and friends; the
  # library dropped them for labelWith/labelWithInParen, so allowlisting them
  # would have promised users something that draws nothing
  session <- fake_session()
  expect_warning(
    loadSpliceJunctionTrackFromURL(
      session, ELEMENT_ID, "junctions", "https://example.org/a.bed",
      trackConfig = list(labelUniqueReadCount = TRUE)
    ),
    "invalid or unsupported"
  )
  expect_null(last_message(session, "loadSpliceJunctionTrackFromURL")$labelUniqueReadCount)
})

junction_tbl <- function() {
  data.frame(
    chrom = c("U13369.1", "U13369.1"),
    start = c(7276, 7276),
    end = c(8225, 9540),
    motif = c("GT/AG", "CT/AC"),
    uniquely_mapped = c(117, 3),
    multi_mapped = c(6, 9),
    maximum_spliced_alignment_overhang = c(37, 12),
    annotated_junction = c(TRUE, FALSE),
    strand = c("+", "-"),
    stringsAsFactors = FALSE
  )
}

read_staged_bed <- function(msg) {
  path <- file.path(get_tracks_dir(), basename(msg$url))
  expect_true(file.exists(path))
  read.table(path, sep = "\t", header = FALSE, quote = "",
             stringsAsFactors = FALSE)
}

test_that("loadSpliceJunctionTrackFromLocalData serves a bed through the url handler (#103)", {
  session <- fake_session()
  loadSpliceJunctionTrackFromLocalData(session, ELEMENT_ID, "junctions",
                                       junction_tbl(), trackHeight = 140)

  msg <- last_message(session, "loadSpliceJunctionTrackFromURL")
  expect_equal(msg$elementID, ELEMENT_ID)
  expect_equal(msg$trackName, "junctions")
  expect_match(msg$url, "^tracks/.*\\.bed$")
  expect_equal(msg$indexURL, "")
  expect_equal(msg$trackHeight, 140)

  bed <- read_staged_bed(msg)
  expect_equal(NROW(bed), 2L)
  expect_equal(bed[[1]], c("U13369.1", "U13369.1"))
  expect_equal(bed[[2]], c(7276, 7276))
  expect_equal(bed[[6]], c("+", "-"))
})

test_that("the junction attributes reach the bed name column igv.js parses (#103)", {
  session <- fake_session()
  loadSpliceJunctionTrackFromLocalData(session, ELEMENT_ID, "j",
                                       junction_tbl())
  bed <- read_staged_bed(last_message(session, "loadSpliceJunctionTrackFromURL"))

  expect_equal(
    bed[[4]][1],
    paste0("motif=GT/AG;uniquely_mapped=117;multi_mapped=6;",
           "maximum_spliced_alignment_overhang=37;annotated_junction=true")
  )
  # igv.js compares annotated_junction against "true"/"false"; R's own TRUE
  # would match neither and both hide options would let the junction through
  expect_match(bed[[4]][2], "annotated_junction=false", fixed = TRUE)
  # score stands in for the uniquely mapped count, which is what sizes the arcs
  expect_equal(bed[[5]], c(117, 3))
})

test_that("a single junction attribute still parses as an attribute (#103)", {
  # the bed decoder reads column 4 as attributes only when it holds both "="
  # and ";", so one pair on its own would arrive as a plain label
  session <- fake_session()
  tbl <- junction_tbl()[, c("chrom", "start", "end", "motif")]
  loadSpliceJunctionTrackFromLocalData(session, ELEMENT_ID, "j", tbl)
  bed <- read_staged_bed(last_message(session, "loadSpliceJunctionTrackFromURL"))

  expect_equal(bed[[4]], c("motif=GT/AG;", "motif=CT/AC;"))
  expect_equal(bed[[5]], c(1000, 1000))
  expect_equal(bed[[6]], c(".", "."))
})

test_that("a packed name column is written through untouched (#103)", {
  session <- fake_session()
  tbl <- data.frame(chrom = "chr1", start = 100, end = 200,
                    name = "motif=GT/AG;uniquely_mapped=9", score = 9,
                    stringsAsFactors = FALSE)
  loadSpliceJunctionTrackFromLocalData(session, ELEMENT_ID, "j", tbl)
  bed <- read_staged_bed(last_message(session, "loadSpliceJunctionTrackFromURL"))

  expect_equal(bed[[4]], "motif=GT/AG;uniquely_mapped=9")
  expect_equal(bed[[5]], 9)
})

test_that("loadSpliceJunctionTrackFromLocalData rejects a table without chrom/start/end", {
  session <- fake_session()
  tbl <- data.frame(a = "chr1", b = 1, c = 2, stringsAsFactors = FALSE)
  expect_error(loadSpliceJunctionTrackFromLocalData(session, ELEMENT_ID, "j", tbl),
               "improper columns")
})

test_that("the navigation and removal helpers send their own messages", {
  session <- fake_session()
  showGenomicRegion(session, ELEMENT_ID, "chr1:1-1000")
  expect_equal(last_message(session, "showGenomicRegion")$region, "chr1:1-1000")

  getGenomicRegion(session, ELEMENT_ID)
  expect_equal(last_message(session, "getGenomicRegion")$elementID, ELEMENT_ID)

  removeTracksByName(session, ELEMENT_ID, c("a", "b"))
  expect_equal(last_message(session, "removeTracksByName")$trackNames, c("a", "b"))

  removeUserAddedTracks(session, ELEMENT_ID)
  expect_gt(length(sent_messages(session, "removeTracksByName")), 1L)
})
