source('~/s2dverification/R/Utils.R')
library(ncdf4)

.CheckSelectors <- function(selectors, var = NULL, return_indices = TRUE) {
  if (return_indices) {
    if (is.list(selectors)) {
    } else if (is.numeric(selectors)) {
    } else if (is.character(selectors)) {
    }
  } else {
    if (is.list(selectors)) {
    } else if (is.numeric(selectors)) {
      if (length(selectors) > 0) {
        if (!is.null(var)) {
          var[selectors]
        }
      } else {
        stop("No selectors provided.")
      }
    } else if (is.character(selectors)) {
      if ((length(selectors) == 1) && 
          (selectors %in% c('all', 'first', 'last'))) {
        if (selectors == 'all') {
          var
        } else if (selectors == 'first') {
          head(var, 1)
        } else {
          tail(var, 1)
        }
      } else {
        selectors
      }
    }
  }
}

## TODO: Somehow reorder lons and lats
.NcOpener <- function(file_name) {
  nc_open(file_name)
}

.NcReader <- function(file_pointer, indices, vars, file_dims) {
  if (is.null(variable_name)) {
  }
  ## TODO: check performance of wrapping opener functions
  ncvar_get(file_name, variable_name)
}

.NcCloser <- function(file_pointer) {
  nc_close(file_pointer)
}

.Load <- function(..., pattern_dims = NULL,
                  default_checker  = .CheckSelectors,
                  file_opener = .NcOpener,
                  file_reader = .NcReader,
                  file_closer = .NcCloser) {
                  #, config_file = NULL
                  #, variable_dim = , 
                  #file_dimnames = , return_vars = ) {
  dim_params <- list(...)
  # Split *_var parameters
  var_params_ind <- grep('_var$', names(dim_params))
  var_params <- dim_params[var_params_ind]
  # Check all *_var are NULL or vectors of character strings, and 
  # that they all have a matching dimension param.
  i <- 1
  for (var_param in var_params) {
    if (!is.null(var_param)) {
      if (!is.character(var_param)) {
        stop("All '*_var' parameters must be vectors of character strings or NULL.")
      } else if (!any(grepl(paste0('^', strsplit(names(var_params)[i], 
                                                 '_var$')[[1]][1], '$'),
                            names(dim_params)))) {
        stop(paste0("All '*_var' parameters must be associated to a dimension parameter. Found parameter '", 
                    names(var_params)[i], "' but no parameter '", 
                    strsplit(names(var_params)[i], '_var$')[[1]][1], "'."))
      }
    }
    i <- i + 1
  }
  # Split *_checker parameters
  check_params_ind <- grep('_checker$', names(dim_params))
  check_params <- dim_params[check_params_ind]
  # Check all *_checker are NULL or functions, and that they all have 
  # a matching dimension param.
  i <- 1
  for (check_param in check_params) {
    if (!is.null(check_param)) {
      if (!is.function(check_param)) {
        stop("All '*_checker' parameters must be functions or NULL.")
      } else if (!any(grepl(paste0('^', strsplit(names(check_params)[i], 
                                                 '_checker$')[[1]][1], '$'),
                            names(dim_params)))) {
        stop(paste0("All '*_checker' parameters must be associated to a dimension parameter. Found parameter '", 
                    names(check_params)[i], "' but no parameter '", 
                    strsplit(names(check_params)[i], '_checker$')[[1]][1], "'."))
      }
    }
    i <- i + 1
  }
  # Leave alone the dimension parameters
  if (length(c(var_params_ind, check_params_ind)) > 0) {
    dim_params <- dim_params[-c(var_params_ind, check_params_ind)]
  }
  dim_names <- names(dim_params)
  # Make the keys of 'var_params' and 'check_params' to be the name of 
  # the corresponding dimension.
  names(var_params) <- gsub('_var$', '', names(var_params))
  names(check_params) <- gsub('_checker$', '', names(check_params))

  # Check pattern_dims
  if (is.null(pattern_dims)) {
    print(paste0("Parameter 'pattern_dims' not specified. Taking the first dimension, '", 
                 dim_names[1], "' as 'pattern_dims'."))
    pattern_dims <- dim_names[1]
  } else if (is.character(pattern_dims) && (length(pattern_dims) > 0)) {
    pattern_dims <- unique(pattern_dims)
  } else {
    stop("Parameter 'pattern_dims' must be a vector of character strings.")
  }
  if (any(names(var_params) %in% pattern_dims)) {
    stop("'*_var' parameters specified for pattern dimensions. Remove or fix them.")
  }

## TODO: varmin and varmax
  # Find the pattern dimension with the pattern specifications
  found_pattern_dim <- NULL
  for (pattern_dim in pattern_dims) {
    # Check all specifications in pattern_dim are valid
    dat <- datasets <- dim_params[[pattern_dim]]
    if (is.null(dat) || !(is.character(dat) && all(nchar(dat) > 0)) && !is.list(dat)) {
      stop(paste0("Parameter '", pattern_dim, 
                  "' must be a list of lists with pattern specifications or a vector of character strings."))
    }
    if (!is.null(check_params[[pattern_dim]])) {
      print(paste0("A checker for the selectors of '", pattern_dim, 
                   "' has been specified, but it is a pattern dimension and the checker will be ignored."))
    }
    if (any(sapply(dat, is.list))) {
      if (is.null(found_pattern_dim)) {
        found_pattern_dim <- pattern_dim
      } else {
        stop("Found more than one pattern dim with pattern specifications (list of lists). One and only one pattern dim must contain pattern specifications.")
      }
    }
  }
  if (is.null(found_pattern_dim)) {
    print(paste0("Taking the first pattern dim, '", pattern_dims[1], "', as dimension with pattern specifications (to be fetched in configuration file)."))
    found_pattern_dim <- pattern_dims[1]
  }
  dat <- datasets <- dim_params[[found_pattern_dim]]
  dat_info_names <- c('name', 'path')#, 'nc_var_name', 'suffix', 'var_min', 'var_max', 'dimnames')
  dat_to_fetch <- c()
  dat_names <- c()
  if (!is.list(dat)) {
    dat <- lapply(dat, function (x) list(name = x))
  }
  for (i in 1:length(dat)) {
    if (is.character(dat[[i]]) && length(dat[[i]]) == 1 && nchar(dat[[i]]) > 0) {
      dat[[i]] <- list(name = dat[[i]])
    } else if (!is.list(dat[[i]])) {
      stop(paste0("Parameter '", pattern_dim, 
                  "' is incorrect. It must be a list of lists or character strings."))
    }
    #if (!(all(names(dat[[i]]) %in% dat_info_names))) {
    #  stop("Error: parameter 'dat' is incorrect. There are unrecognized components in the information of some of the dateriments. Check 'dat' in ?Load for details.")
    #}
    if (!('name' %in% names(dat[[i]]))) {
      dat[[i]][['name']] <- paste0('dat', i)
      if (!('path' %in% names(dat[[i]]))) {
        stop(paste0("Parameter '", found_pattern_dim, 
                    "' is incorrect. A 'path' should be provided for each dataset if no 'name' is provided."))
      }
    } else if (!('path' %in% names(dat[[i]]))) {
      dat_to_fetch <- c(dat_to_fetch, i)
    }
    #if ('path' %in% names(dat[[i]])) {
    #  if (!('nc_var_name' %in% names(dat[[i]]))) {
    #    dat[[i]][['nc_var_name']] <- '$var_name$'
    #  }
    #  if (!('suffix' %in% names(dat[[i]]))) {
    #    dat[[i]][['suffix']] <- ''
    #  }
    #  if (!('var_min' %in% names(dat[[i]]))) {
    #    dat[[i]][['var_min']] <- ''
    #  }
    #  if (!('var_max' %in% names(dat[[i]]))) {
    #    dat[[i]][['var_max']] <- ''
    #  }
    #}
    dat_names <- c(dat_names, dat[[i]][['name']])
  }
  if ((length(dat_to_fetch) > 0) && (length(dat_to_fetch) < length(dat))) {
    print("'path' has been provided for some datasets. Any information in the configuration file related to these will be ignored.")
  }

  ## check config_file
  ### TODO: Get rid of this default
  #if (is.null(config_file)) {
  #  config_file <- system.file("config", "BSC.conf", package = "s2dverification")
  #} else if (!is.character(config_file) || !(nchar(config_file) > 0)) {
  #  stop("Error: parameter 'config_file' must be a character string with the path to a .Load() configuration file, if provided.")
  #}

  ## If not all data has been provided for any of the datasets in the 
  ## pattern_dim, configuration file is read.
  #if (length(dat_to_fetch) > 0) {
  #  print(paste0("Some 'path's not explicitly provided in '", pattern_dim, 
  #               "', so will now proceed to open the configuration file.")
  #  data_info <- ConfigFileOpen(config_file, silent, TRUE)
  #
  #  # Check that the var, exp and obs parameters are right and keep the entries
  #  # that match for each dataset.
  #  # Afterwards, the matching entries are applied sequentially (as specified 
  #  # in ?ConfigFileOpen) and the replace_values are applied to the result.
  #  # Finally a path pattern for each dataset is provided.
  #  matches <- ConfigApplyMatchingEntries(data_info, var, sapply(exp[exps_to_fetch], '[[', 'name'),
  #               sapply(obs[obs_to_fetch], '[[', 'name'), show_entries = FALSE, show_result = FALSE)
  #  # 'replace_values' is a named list that associates a variable name to an 
  #  # associated value. Initially it is filled with variables and values parsed
  #  # from the configuration file, but we can add or modify some values during
  #  # the execution to choose for example which start date we want to load.
  #  # When '.ConfigReplaceVariablesInString' is called, all the variable accesses 
  #  # ($VARIABLE_NAME$) that appear in the string given as parameter are 
  #  # replaced by the associated value in 'replace_values'.
  #  replace_values <- data_info$definitions
  #  if (!is.null(exp) && length(exps_to_fetch) > 0) {
  #    counter <- 1
  #    exp[exps_to_fetch] <- lapply(matches$exp_info,
  #      function (x) {
  #        x[names(exp[[exps_to_fetch[counter]]])] <- exp[[exps_to_fetch[counter]]]
  #        x[['path']] <- paste0(x[['main_path']], x[['file_path']])
  #        counter <<- counter + 1
  #        x
  #      })
  #  }
  #  if (!is.null(obs) && length(obs_to_fetch) > 0) {
  #    counter <- 1
  #    obs[obs_to_fetch] <- lapply(matches$obs_info,
  #      function (x) {
  #        x[names(obs[[obs_to_fetch[counter]]])] <- obs[[obs_to_fetch[counter]]]
  #        x[['path']] <- paste0(x[['main_path']], x[['file_path']])
  #        counter <<- counter + 1
  #        x
  #      })
  #  }
  #  if (!silent) {
  #    .message("All pairs (var, exp) and (var, obs) have matching entries.")
  #  }
  #} else {
  #  replace_values <- list(DEFAULT_NC_VAR_NAME = '$VAR_NAME$',
  #                         DEFAULT_VAR_MIN = '',
  #                         DEFAULT_VAR_MAX = '',
  #                         DEFAULT_SUFFIX = '',
  #                         DEFAULT_DIM_NAME_LONGITUDES = 'longitude',
  #                         DEFAULT_DIM_NAME_LATITUDES = 'latitude',
  #                         DEFAULT_DIM_NAME_MEMBERS = 'ensemble')
  #}
  ## We take the dimnames that haven't been explicitly specified from the 
  ## configuration file.
  ## If the configuration file wasn't opened, we take the default values from
  ## the dictionary 'replace_values'.
  #dimnames <- list(lon = ifelse(is.null(dimnames[["lon"]]),
  #                              replace_values[["DEFAULT_DIM_NAME_LONGITUDES"]],
  #                              dimnames[['lon']]),
  #                 lat = ifelse(is.null(dimnames[["lat"]]),
  #                              replace_values[["DEFAULT_DIM_NAME_LATITUDES"]],
  #                              dimnames[['lat']]),
  #                 member = ifelse(is.null(dimnames[["member"]]),
  #                                 replace_values[["DEFAULT_DIM_NAME_MEMBERS"]],
  #                                 dimnames[['member']]))
  #mandatory_defaults <- c('DEFAULT_EXP_MAIN_PATH', 'DEFAULT_EXP_FILE_PATH',
  #                        'DEFAULT_OBS_MAIN_PATH', 'DEFAULT_OBS_FILE_PATH',
  #                        'DEFAULT_NC_VAR_NAME', 'DEFAULT_SUFFIX',
  #                        'DEFAULT_VAR_MIN', 'DEFAULT_VAR_MAX',
  #                        'DEFAULT_DIM_NAME_LONGITUDES',
  #                        'DEFAULT_DIM_NAME_LATITUDES',
  #                        'DEFAULT_DIM_NAME_MEMBERS')
  #extra_vars_with_default_ind <- (1:length(replace_values))[grep('^DEFAULT_', names(replace_values))]
  #extra_vars_with_default_ind <- extra_vars_with_default_ind[
  #                                 grep(paste0(paste0('^', mandatory_defaults),
  #                                             collapse = '|'),
  #                                      names(replace_values)[extra_vars_with_default_ind],
  #                                      invert = TRUE)
  #                               ]
  #extra_vars_with_default <- gsub('^DEFAULT_', '',
  #                                names(replace_values)[extra_vars_with_default_ind])
  #if (!is.null(exp)) {
  #  exp <- lapply(exp, function (x) {
  #    if (!('dimnames' %in% names(x))) {
  #      x[['dimnames']] <- dimnames
  #    } else {
  #      dimnames2 <- dimnames
  #      dimnames2[names(x[['dimnames']])] <- x[['dimnames']]
  #      x[['dimnames']] <- dimnames2
  #    }
  #    i <- 1
  #    while (i <= length(extra_vars_with_default)) {
  #      if (!(extra_vars_with_default[i] %in% names(x))) {
  #        x[[extra_vars_with_default[i]]] <- replace_values[[extra_vars_with_default_ind[i]]]
  #      }
  #      i <- i + 1
  #    }
  #    x
  #  })
  #}
  #if (!is.null(obs)) {
  #  obs <- lapply(obs, function (x) {
  #    if (!('dimnames' %in% names(x))) {
  #      x[['dimnames']] <- dimnames
  #    } else {
  #      dimnames2 <- dimnames
  #      dimnames2[names(x[['dimnames']])] <- x[['dimnames']]
  #      x[['dimnames']] <- dimnames2
  #    }
  #    i <- 1
  #    while (i <= length(extra_vars_with_default)) {
  #      if (!(extra_vars_with_default[i] %in% names(x))) {
  #        x[[extra_vars_with_default[i]]] <- replace_values[[extra_vars_with_default_ind[i]]]
  #      }
  #      i <- i + 1
  #    }
  #    x
  #  })
  #}
  #single_dataset <- (length(obs) + length(exp) == 1)
  dim_params[[found_pattern_dim]] <- dat_names

  # Check that no unrecognized variables are present in the path patterns
  # and also that no file dimensions are requested to THREDDs catalogs.
  # And in the mean time, build all the work pieces and look for the 
  # first available file.
  work_pieces <- list()
  first_file_with_data <- NULL
  for (i in 1:length(dat)) {
    dim_vars <- paste0('$', dim_names, '$')
    file_dims <- dim_names[which(sapply(dim_vars, grepl, dat[[i]][['path']], fixed = TRUE))]
    ## TODO: Put the file_dims in order?? Needed?
    file_dims <- unique(c(pattern_dims, file_dims))
    replace_values <- vector('list', length = length(file_dims))
    names(replace_values) <- file_dims
    # Take the first selector for all possible file dimensions
    for (file_dim in file_dims) {
      if (file_dim %in% names(var_params)) {
        print(paste0("The '", file_dim, "_var' param will be ignored since '", 
                     file_dim, "' is a file dimension (for the dataset with pattern ", 
                     dat[[i]][['path']], ")."))
      }
      if (is.character(dim_params[[file_dim]]) && 
          !((length(dim_params[[file_dim]]) == 1) && 
            (dim_params[[file_dim]] %in% c('all', 'first', 'last')))) {
        dim_params[[file_dim]] <- default_checker(selectors = dim_params[[file_dim]],
                                                  return_indices = FALSE)
        replace_values[[file_dim]] <- dim_params[[file_dim]][1]
        replace_values[[found_pattern_dim]] <- dim_params[[found_pattern_dim]][i]
      }
    }
    # Find the possible values for the selectors that are provided as
    # indices. If the requested file is on server, impossible operation.
    if (length(grep("^http", dat[[i]][['path']])) > 0) {
      if (any(sapply(replace_values, is.null))) {
        stop(paste0("All selectors for the file dimensions must be character strings if requesting data to a remote server. Found invalid selectors for the file dimension '",
                     file_dims[which(sapply(replace_values, is.null))][1], "'."))
      }
      ## TODO: Check that the user is not using shell globbing exps.
      # if (dat[[i]][['path']] has shell globs) {
      #   stop! no shell globs allowed in path patterns to catalogs
      # }
    } else {
      ## TODO: Shell glob un/semi-permissive
      ## TODO: Improve message here if no variable found:
      undefined_file_dims <- file_dims[which(sapply(replace_values, is.null))]
      if (length(undefined_file_dims) > 0) {
        replace_values[undefined_file_dims] <- rep('*', length(undefined_file_dims))
        path_with_globs <- .ConfigReplaceVariablesInString(dat[[i]][['path']], replace_values)
        actual_path <- Sys.glob(path_with_globs)
        ## TODO: Manage better case when no actual_path is found
        if (length(actual_path) == 0) {
          print("Warning: no found indices for some file dimensions with non-explicit selectors.")
          dim_params[undefined_file_dims] <- rep('', length(undefined_file_dims))
        } else {
          actual_path <- actual_path[1]
          first_values <- vector('list', length = length(undefined_file_dims))
          names(first_values) <- undefined_file_dims
          for (u_file_dim in undefined_file_dims) {
            path_with_globs_and_tag <- .ConfigReplaceVariablesInString(dat[[i]][['path']], 
                                         replace_values[-which(file_dims == u_file_dim)],
                                         allow_undefined_key_vars = TRUE)
            first_values[[u_file_dim]] <- .FindTagValue(path_with_globs_and_tag, 
                                                        actual_path, u_file_dim)
          }
          for (u_file_dim in undefined_file_dims) {
            parsed_values <- c()
            replace_values[undefined_file_dims] <- first_values
            replace_values[[u_file_dim]] <- '*'
            path_with_globs <- .ConfigReplaceVariablesInString(dat[[i]][['path']], replace_values)
            found_files <- Sys.glob(path_with_globs)
            if (length(found_files) == 0) {
              stop("Error 3.")
            }
            for (found_file in found_files) {
              path_with_globs_and_tag <- .ConfigReplaceVariablesInString(dat[[i]][['path']],
                                           replace_values[-which(file_dims == u_file_dim)],
                                           allow_undefined_key_vars = TRUE)
              parsed_values <- c(parsed_values, 
                                 .FindTagValue(path_with_globs_and_tag, found_file, 
                                               u_file_dim))
            }
            dim_params[[file_dim]] <- default_checker(selectors = dim_params[[file_dim]],
                                                      var = parsed_values,
                                                      return_indices = FALSE)
          }
        }
      } else {
        path_with_globs <- .ConfigReplaceVariablesInString(dat[[i]][['path']], replace_values)
      }
    }
    # Now fetch for the first available file
    replace_values <- vector('list', length = length(file_dims))
    names(replace_values) <- file_dims
    files_to_load <- sapply(dim_params[file_dims], length)
    files_to_load[found_pattern_dim] <- 1
    array_of_files_to_load <- array(1:prod(files_to_load), dim = files_to_load)
    j <- 1
    while (j <= prod(files_to_load)) {
      selector_indices <- which(array_of_files_to_load == j, arr.ind = TRUE)[1, ]
      selectors <- sapply(1:length(file_dims), function (x) dim_params[file_dims][[x]][selector_indices[x]])
      selectors[[which(file_dims == found_pattern_dim)]] <- dim_params[[found_pattern_dim]][i]
      replace_values[file_dims] <- selectors
      file_path <- .ConfigReplaceVariablesInString(dat[[i]][['path']], replace_values)
      if (!(length(grep("^http", file_path)) > 0)) {
        actual_file_path <- Sys.glob(file_path)
        if (length(actual_file_path) == 0) {
          actual_file_path <- NULL
        } else {
          actual_file_path <- file_path[1]
        }
      } else {
        actual_file_path <- file_path
      }
      if (!is.null(actual_file_path)) {
        if (is.null(first_file_with_data)) {
          test_file <- file_opener(actual_file_path)
          if (!is.null(test_file)) {
            first_file_with_data <- actual_file_path
            file_closer(test_file)
          }
        }
        work_pieces <- c(work_pieces, list(list(path = actual_file_path)))
      } else {
        print(paste0("File not found, filling with NA instead: ", file_path, "."))
      }
      j <- j + 1
    }
  }
  if (is.null(first_file_with_data)) {
    stop("No data files found for any of the specified datasets.")
  }
  ## We know now which is the first available file. We can work out the
  ## sizes of the dimensions inside the file.
  #first_file <- file_opener(first_file_with_data)
  #first_array <- file_reader(first_file, )
  #
  ## Check all the indices provided for each dimension inside files.
  #for (dim_name in dim_names) {
  #  if (!(dim_name %in% file_dims)) {
  #    checker <- check_params[[dim_name]]
  #    if (is.null(checker)) {
  #      checker <- default_checker
  #    }
  #    dim_params[[dim_name]] <- checker(dim_params[[dim_name]])
  #  }
  #}

  list(dim_params, dim_names, var_params, check_params, work_pieces)
}
