x <- reactiveValues()

# --- Repair malformed SeaLog CSV quoting -------------------------------------
# The logging software sometimes writes an inch-mark (") in the free-text
# Comments column without escaping it: either left undoubled mid-value
# ("... 9" VIZ ...") or doubled at the end of a value but with the field's
# closing quote dropped ("... 8""<newline>). Either way the line ends up with an
# odd number of quotes and readr merges the following lines into a runaway
# quoted field, silently dropping rows.
#
# Comments is always the last column and the only free-text field; every column
# before it is a code, number, date, or time and never contains a comma or
# quote. So the raw Comments text is everything after the (ncol - 1)th comma and
# can be re-emitted with valid RFC 4180 quoting. ncol comes from the header row
# rather than a hardcoded count.
fix_comment_field <- function(raw) {
  if (is.na(raw) || raw == "") {
    return(raw)
  }
  txt <- raw
  if (str_starts(txt, '"')) {
    txt <- str_remove(txt, '^"') # opening quote
    txt <- str_remove(txt, '"$') # closing quote, if the writer emitted one
    txt <- str_replace_all(txt, '""', '"') # collapse escaped quotes
  }
  if (str_detect(txt, '[",\n]')) {
    txt <- str_c('"', str_replace_all(txt, '"', '""'), '"')
  }
  txt
}

# Rewrite only the malformed lines to a temporary copy and return its path plus
# the number of rows repaired. A well-formed field has an even number of quotes
# (two delimiters plus two per escaped inner quote); the logging bug leaves an
# odd count, so untouched rows stay byte-for-byte identical.
repair_sealog_csv <- function(path) {
  lines <- read_lines(path)
  header <- lines[1]
  body <- lines[-1]
  n_col <- str_count(header, ",") + 1L
  pat <- str_c("^((?:[^,]*,){", n_col - 1L, "})(.*)$")
  m <- str_match(body, pat)

  comment <- m[, 3]
  broken <- !is.na(comment) & (str_count(comment, '"') %% 2L == 1L)
  body[broken] <- str_c(
    m[broken, 2],
    vapply(comment[broken], fix_comment_field, character(1))
  )

  out_path <- tempfile(fileext = ".csv")
  write_lines(c(header, body), out_path)
  list(path = out_path, n_fixed = sum(broken))
}

read_sealog_file <- function(f) {
  col_names <- c(
    "Vessel",
    "TxWidth",
    "TripID",
    "Transect",
    "Record",
    "PortObs",
    "StarboardObs",
    "PortCondition",
    "StarboardCondition",
    "Beaufort",
    "Weather",
    "CloudCover",
    "FogConc",
    "IceType",
    "IceConc",
    "On/OffTx",
    "Type",
    "ObsSideIO",
    "ObsSidePS",
    "Species",
    "Count",
    "PrimaryBehavior",
    "SecondaryBehavior",
    "Age",
    "Sex",
    "Plumage",
    "Distance",
    "Angle",
    "Bin",
    "UserSelect1",
    "UserSelect2",
    "UserText",
    "UserNumeric",
    "Latitude",
    "Longitude",
    "Date",
    "Time",
    "GPSTime",
    "Comments"
  )

  if (path_ext(f) == "csv") {
    repaired <- repair_sealog_csv(f)
    if (repaired$n_fixed > 0) {
      console_log(
        "process_raw_data.r",
        glue(
          "repaired {repaired$n_fixed} Comments field(s) with unescaped ",
          "quotes in {basename(f)}"
        )
      )
    }
    d <- read_csv(
      repaired$path,
      col_names = col_names,
      col_types = "ccccccccccccccccccccccccccccccccccccccc",
      skip = 1,
      na = c("null", "")
    )
  } else if (path_ext(f) == "xlsx") {
    d <- read_excel(
      f,
      col_names = col_names,
      col_types = "text",
      skip = 1,
      na = c("null", "")
    ) |>
      mutate(
        ts = convert_to_datetime(as.numeric(Date) + as.numeric(Time)),
        Date = as.character(convert_to_date(as.numeric(Date))),
        Time = as.character(hms::hms(
          hours = hour(ts),
          minutes = minute(ts),
          seconds = second(ts)
        ))
      )
  }
  d |>
    mutate(
      across(
        c(
          TxWidth,
          Record,
          PortCondition,
          StarboardCondition,
          Beaufort,
          CloudCover,
          FogConc,
          IceConc,
          Count,
          Distance,
          Angle
        ),
        as.integer
      ),
      across(c(UserNumeric, Latitude, Longitude), as.numeric),
      GPSTime = ymd_hms(GPSTime, tz = "UTC"),
      ts = parse_date_time(
        glue("{Date} {Time}"),
        c("ymd HMS", "mdy HMS"),
        tz = x$timezone
      ),
      Date = as.Date(ts, tz = x$timezone),
      Time = hms::hms(
        hours = hour(ts),
        minutes = minute(ts),
        seconds = second(ts)
      ),
      Species = str_trim(Species),
      PrimaryBehavior = str_trim(PrimaryBehavior),
      SecondaryBehavior = str_trim(SecondaryBehavior),
      `On/OffTx` = str_trim(`On/OffTx`),
      timestamp = force_tz(Date + seconds(Time), tz = x$timezone),
      TripID = coalesce(TripID, "NULL"),
      Transect = coalesce(Transect, "NULL"),
      TxWidth = coalesce(TxWidth, as.integer(9999))
    ) |>
    select(-ts) |>
    rename(ONOFFTX = `On/OffTx`) |>
    filter(
      !is.na(Latitude),
      Latitude > 0,
      Latitude < 90,
      !is.na(Longitude),
      Longitude >= -180,
      Longitude <= 180
    )
}

read_files <- function(
  input_files,
  species_json_file,
  optional_fields_json_file,
  nppsd_species_crosswalk_file,
  x
) {
  console_log(
    "process_raw_data.r",
    glue("map({input_files}, read_sealog_file, ...)")
  )

  x$timezone <- Sys.timezone()
  timezone <- x$timezone

  r <- map(
    input_files,
    read_sealog_file
  ) |>
    list_rbind()

  median_longitude <- median((360 + r$Longitude) %% 360, na.rm = TRUE)
  median_longitude <- if_else(
    median_longitude > 180,
    median_longitude - 360,
    median_longitude
  )
  srid_prefix <- 32600 # northern hemisphere; 32700 is southern
  zone <- floor((median_longitude + 180) / 6.0) + 1
  x$crs <- as.character(glue("EPSG:{srid_prefix + zone}"))
  console_log(
    "process_raw_data.r",
    glue("x$crs <- {x$crs}")
  )

  # fill and correct position of records missing Date/Time
  s <- r %>%
    st_as_sf(coords = c("Longitude", "Latitude"), crs = 4326) %>%
    st_transform(x$crs) %>%
    sfc_as_cols() %>%
    st_drop_geometry() %>%
    mutate(
      x = if_else(is.na(Date), as.numeric(NA), x),
      y = if_else(is.na(Date), as.numeric(NA), y)
    ) %>%
    mutate(
      Date = if_else(is.na(Date), date(with_tz(GPSTime, tz = timezone)), Date),
      Time = if_else(
        is.na(Time),
        hms::hms(
          hours = hour(with_tz(GPSTime, tz = timezone)),
          minutes = minute(with_tz(GPSTime, tz = timezone)),
          seconds = second(with_tz(GPSTime, tz = timezone))
        ),
        Time
      ),
      timestamp = if_else(
        is.na(timestamp),
        force_tz(Date + seconds(Time), tz = timezone),
        timestamp
      ),
      x = na.approx(x),
      y = na.approx(y)
    ) %>%
    st_as_sf(coords = c("x", "y"), crs = x$crs) %>%
    st_transform(4326) %>%
    sfc_as_cols(names = c("Longitude", "Latitude")) %>%
    st_drop_geometry() %>%
    select(names(r))

  x$unfiltered_obs_data <- s
  console_log(
    "process_raw_data.r",
    glue("species_raw <- read_lines({species_json_file})")
  )
  species_raw <- read_lines(species_json_file)
  species_list <- fromJSON(species_raw)
  x$valid_species_list <- species_list

  nppsd_invalid_codes <- anti_join(
    tibble(code = species_list),
    ref_species_codes,
    by = "code"
  ) %>%
    pull(code)
  x$nppsd_invalid_code_list <- nppsd_invalid_codes

  column_mapping <- tibble(
    json_field = c(
      "vessel",
      "tx_width",
      "trip_id",
      "transect",
      "record",
      "port_observer",
      "starboard_observer",
      "port_condition",
      "starboard_condition",
      "beaufort",
      "weather",
      "cloud_cover",
      "fog_conc",
      "ice_type",
      "ice_conc",
      "on_off_transect",
      "type",
      "obs_side_io",
      "obs_side_ps",
      "species",
      "count",
      "behavior_primary",
      "behavior_secondary",
      "age",
      "sex",
      "plumage",
      "distance",
      "angle",
      "bin",
      "user_select_1",
      "user_select_2",
      "user_text",
      "user_numeric",
      "lat",
      "lon",
      "date",
      "time",
      "gps_time",
      "comments"
    ),
    field = c(
      "Vessel",
      "TxWidth",
      "TripID",
      "Transect",
      "Record",
      "PortObs",
      "StarboardObs",
      "PortCondition",
      "StarboardCondition",
      "Beaufort",
      "Weather",
      "CloudCover",
      "FogConc",
      "IceType",
      "IceConc",
      "ONOFFTX",
      "Type",
      "ObsSideIO",
      "ObsSidePS",
      "Species",
      "Count",
      "PrimaryBehavior",
      "SecondaryBehavior",
      "Age",
      "Sex",
      "Plumage",
      "Distance",
      "Angle",
      "Bin",
      "UserSelect1",
      "UserSelect2",
      "UserText",
      "UserNumeric",
      "Latitude",
      "Longitude",
      "Date",
      "Time",
      "GPSTime",
      "Comments"
    )
  )
  console_log(
    "process_raw_data.r",
    glue("optional_fields_raw <- read_lines({optional_fields_json_file})")
  )
  optional_fields_raw <- read_lines(optional_fields_json_file)
  optional_fields <- fromJSON(optional_fields_raw) %>%
    as_tibble() %>%
    pivot_longer(
      cols = everything(),
      names_to = "json_field",
      values_to = "enabled"
    ) %>%
    inner_join(column_mapping, by = "json_field") %>%
    select(-json_field) %>%
    mutate(
      enabled = if_else(
        field == "Latitude" | field == "Longitude",
        TRUE,
        enabled
      )
    )
  x$optional_fields <- optional_fields

  if (!is.null(input$nppsd_species_crosswalk_file)) {
    console_log(
      "process_raw_data.r",
      glue(
        "nppsd_species_crosswalk <- read_csv({nppsd_species_crosswalk_file}, ...)"
      )
    )
    nppsd_species_crosswalk <- read_csv(
      nppsd_species_crosswalk_file,
      col_names = c(
        "custom_species_code",
        "custom_common_name",
        "nppsd_species_code"
      ),
      col_types = "ccc",
      skip = 1,
      na = "null"
    ) %>%
      full_join(
        tibble(custom_species_code = nppsd_invalid_codes),
        by = "custom_species_code"
      )
    x$nppsd_species_crosswalk <- nppsd_species_crosswalk
  } else {
    console_log(
      "process_raw_data.r",
      glue("nppsd_species_crosswalk_file empty")
    )
    x$nppsd_species_crosswalk <- tibble(
      custom_species_code = nppsd_invalid_codes,
      custom_common_name = NA_character_,
      nppsd_species_code = NA_character_
    )
  }

  x
}

observe({
  if (
    is.null(input$input_files) |
      is.null(input$optional_fields_json_file) |
      is.null(input$species_json_file) |
      input$process_data_button == 0
  ) {
    return(NULL)
  }

  withProgress(message = "Ingesting Data", value = 0, {
    if (is.null(x$unfiltered_obs_data)) {
      setProgress(0.05, detail = "Reading files")
      x <- read_files(
        input$input_files$datapath,
        input$species_json_file$datapath,
        input$optional_fields_json_file$datapath,
        input$nppsd_species_crosswalk_file$datapath,
        x
      )
    }

    if (is.null(x$track_lines)) {
      setProgress(0.20, detail = "Generating GIS layers")
      x <- generate_tracks(x)
    }

    if (is.null(x$nppsd_split)) {
      setProgress(0.25, detail = "Splitting transects for NPPSD")
      x <- generate_nppsd_splits(x)
    }

    if (is.null(x$nps_split)) {
      setProgress(0.5, detail = "Splitting non-NPPSD transects")
      x <- generate_nps_splits(x)
    }

    if (is.null(x$transects)) {
      setProgress(0.75, detail = "Building transects")
      x <- generate_transects(x)
    }

    if (is.null(x$all_obs_data)) {
      setProgress(0.90, detail = "Building observations")
      x <- generate_observations(x)
    }

    setProgress(0.95, detail = "Generating outputs")

    x <- get_unique_values(x)

    x <- make_tbl_location(x)

    x <- make_tbl_data_obs(x)

    x <- make_nps_transects(x)

    x <- make_nps_obs(x)
  })
})

observeEvent(input$refresh, {
  shinyjs::js$startOver()
})

output$file_list <- renderTable(
  {
    if (
      is.null(input$input_files) |
        is.null(input$optional_fields_json_file) |
        is.null(input$species_json_file) |
        input$process_data_button == 0
    ) {
      invisible(NULL)
    } else {
      input$input_files %>%
        transmute(
          filename = name,
          size_kb = round(size / 1024)
        )
    }
  },
  digits = 0
)

output$valid_species_count <- renderTable({
  if (
    is.null(input$input_files) |
      is.null(input$optional_fields_json_file) |
      is.null(input$species_json_file) |
      input$process_data_button == 0
  ) {
    invisible(NULL)
  } else {
    tibble(`Species Codes` = length(x$valid_species_list))
  }
})

output$optional_fields_count <- renderTable({
  if (
    is.null(input$input_files) |
      is.null(input$optional_fields_json_file) |
      is.null(input$species_json_file) |
      input$process_data_button == 0
  ) {
    invisible(NULL)
  } else {
    x$optional_fields %>%
      group_by(enabled) %>%
      summarize(Fields = n(), .groups = "drop") %>%
      rename(`Enabled` = enabled)
  }
})

output$track_points <- renderPrint(
  {
    if (
      is.null(input$input_files) |
        is.null(input$optional_fields_json_file) |
        is.null(input$species_json_file) |
        input$process_data_button == 0
    ) {
      invisible(NULL)
    } else {
      summary_no_hms(x$all_obs_data)
    }
  },
  width = 400
)

# vim: set ft=r fenc=utf-8 tw=80 ts=2 sw=2 sts=2:
