R/subrecords.R

In jl5000/tidyged.internals: Internal Data Structures for the 'Tidyged' Package

#' Construct the LINEAGE_LINKED_HEADER_EXTENSION tibble
#' 
#' This function constructs a tibble representation of the LINEAGE_LINKED_HEADER_EXTENSION 
#' from the GEDCOM 5.5.5 specification.
#'
#' @inheritParams primitive_definitions
#' @param business_address An ADDRESS_STRUCTURE() object giving the address of the business.
#'
#' @tests
#' expect_equal(LINEAGE_LINKED_HEADER_EXTENSION("tidyged"),
#'              tibble::tibble(level = 0, tag = "SOUR", value = "tidyged"))
#' expect_snapshot_value(LINEAGE_LINKED_HEADER_EXTENSION("tidyged",
#'                business_address = ADDRESS_STRUCTURE("Road name",
#'                                                     "City",
#'                                                     "State",
#'                                                     "ABC",
#'                                                     "UK",
#'                                                     123445567,
#'                                                     "email@domain.com",
#'                                                     4587375238427,
#'                                                     "www.url.com"),
#'                name_of_source_data = "source data name",
#'                publication_date = date_exact(2009,5,25),
#'                copyright_source_data = "source copyright",
#'                receiving_system_name = "destination system",
#'                file_creation_date = date_exact(2008,4,3),
#'                file_creation_time = "10:56:05",
#'                language_of_text = "English",
#'                xref_subm = "@U1@",
#'                gedcom_file_name = "file.ged",
#'                copyright_gedcom_file = "gedcom copyright",
#'                gedcom_content_description = "gedcom_description"), "json2")
#'                
#' @return A tidy tibble containing the HEADER part of a GEDCOM file.
#' @export
LINEAGE_LINKED_HEADER_EXTENSION <- function(system_id,
                                            product_version_number = character(),
                                            name_of_product = character(),
                                            name_of_business = character(),
                                            business_address = ADDRESS_STRUCTURE(),
                                            name_of_source_data = character(),
                                            publication_date = date_exact(),
                                            copyright_source_data = character(),
                                            receiving_system_name = character(),
                                            file_creation_date = date_exact(),
                                            file_creation_time = character(),
                                            language_of_text = character(),
                                            xref_subm = character(),
                                            gedcom_file_name = character(),
                                            copyright_gedcom_file = character(),
                                            gedcom_content_description = character()) {
  
  product_version_number <- as.character(product_version_number)
  product_version_number <- str_extract(product_version_number, 
                                        "^\\d{1,3}\\.\\d{1,3}(\\.\\d{1,3})?")
  
  chk_system_id(system_id, 1) |> parse_error()
  chk_product_version_number(product_version_number, 1) |> parse_error()
  chk_name_of_product(name_of_product, 1) |> parse_error()
  chk_name_of_business(name_of_business, 1) |> parse_error()
  chk_name_of_source_data(name_of_source_data, 1) |> parse_error()
  chk_date_exact(publication_date, 1) |> parse_error()
  chk_copyright_source_data(copyright_source_data, 1) |> parse_error()
  chk_receiving_system_name(receiving_system_name, 1) |> parse_error()
  chk_date_exact(file_creation_date, 1) |> parse_error()
  chk_time_value(file_creation_time, 1) |> parse_error()
  chk_language_of_text(language_of_text, 1) |> parse_error()
  chk_xref(xref_subm, 1) |> parse_error()
  chk_gedcom_file_name(gedcom_file_name, 1) |> parse_error()
  chk_copyright_gedcom_file(copyright_gedcom_file, 1) |> parse_error()
  chk_gedcom_content_description(gedcom_content_description, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "DEST", value = receiving_system_name),
    tibble::tibble(level = 0, tag = "SOUR", value = system_id),
    tibble::tibble(level = 1, tag = "VERS", value = product_version_number),
    tibble::tibble(level = 1, tag = "NAME", value = name_of_product),
    tibble::tibble(level = 1, tag = "CORP", value = name_of_business),
    business_address |> add_levels(2),
    tibble::tibble(level = 1, tag = "DATA", value = name_of_source_data),
    tibble::tibble(level = 2, tag = "DATE", value = publication_date),
    tibble::tibble(level = 2, tag = "COPR", value = copyright_source_data),
    tibble::tibble(level = 0, tag = "DATE", value = file_creation_date),
    tibble::tibble(level = 1, tag = "TIME", value = file_creation_time),
    tibble::tibble(level = 0, tag = "LANG", value = language_of_text),
    tibble::tibble(level = 0, tag = "SUBM", value = xref_subm),
    tibble::tibble(level = 0, tag = "FILE", value = gedcom_file_name),
    tibble::tibble(level = 0, tag = "COPR", value = copyright_gedcom_file),
    tibble::tibble(level = 0, tag = "NOTE", value = gedcom_content_description)
  ) 
  
}


#' Construct the ADDRESS_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the ADDRESS_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' 
#' @tests
#' expect_error(ADDRESS_STRUCTURE(letters[1:4]))
#' expect_error(ADDRESS_STRUCTURE("address", address_city = 1:2))
#' expect_error(ADDRESS_STRUCTURE("address", address_state = 1:2))
#' expect_error(ADDRESS_STRUCTURE("address", address_postal_code = 1:2))
#' expect_error(ADDRESS_STRUCTURE("address", phone_number = 1:4))
#' expect_error(ADDRESS_STRUCTURE("address", address_email = 1:4))
#' expect_error(ADDRESS_STRUCTURE("address", address_fax = 1:4))
#' expect_error(ADDRESS_STRUCTURE("address", address_web_page = 1:4))
#' expect_error(ADDRESS_STRUCTURE(paste0(rep("a", 61), collapse = "")))
#' expect_error(ADDRESS_STRUCTURE("address", address_city = paste0(rep("a", 61), collapse = "")))
#' expect_error(ADDRESS_STRUCTURE("address", address_state = paste0(rep("a", 61), collapse = "")))
#' expect_error(ADDRESS_STRUCTURE("address", address_postal_code = paste0(rep("a", 11), collapse = "")))
#' expect_error(ADDRESS_STRUCTURE("address", address_country = paste0(rep("a", 61), collapse = "")))
#' expect_error(ADDRESS_STRUCTURE("address", address_web_page = paste0(rep("a", 2048), collapse = "")))
#' expect_equal(ADDRESS_STRUCTURE(), tibble::tibble())
#' expect_snapshot_value(ADDRESS_STRUCTURE("Road name"), "json2")
#' expect_snapshot_value(ADDRESS_STRUCTURE(letters[1:3]), "json2")
#' expect_snapshot_value(ADDRESS_STRUCTURE(letters[1:2], address_country = "UK"), "json2")
#' expect_snapshot_value(ADDRESS_STRUCTURE(
#'          local_address_lines = c("road1", "road2", "road3"),
#'          address_city = "city",
#'          address_state = "state",
#'          address_postal_code = "XYZ123",
#'          address_country = "country",
#'          phone_number = 1:3 * 6345645,
#'          address_email = c("email1@domain.co.uk","email2@domain.co.uk","email3@domain.co.uk"),
#'          address_fax = 4:6 * 937463,
#'          address_web_page = c("http://www.domain1.com","http://www.domain2.com","http://www.domain3.com")), "json2")
#'   
#' @return A tidy tibble containing the ADDRESS_STRUCTURE part of a GEDCOM file.
#' @export
ADDRESS_STRUCTURE <- function(local_address_lines = character(),
                              address_city = character(),
                              address_state = character(),
                              address_postal_code = character(),
                              address_country = character(),
                              phone_number = character(),
                              address_email = character(),
                              address_fax = character(),
                              address_web_page = character()) {
  
  address_postal_code <- as.character(address_postal_code)
  phone_number <- as.character(phone_number)
  address_fax <- as.character(address_fax)
  
  chk_address_lines(local_address_lines, 3) |> parse_error()
  chk_address_city(address_city, 1) |> parse_error()
  chk_address_state(address_state, 1) |> parse_error()
  chk_address_postal_code(address_postal_code, 1) |> parse_error()
  chk_address_country(address_country, 1) |> parse_error()
  chk_phone_number(phone_number, 3) |> parse_error()
  chk_address_email(address_email, 3) |> parse_error()
  chk_address_fax(address_fax, 3) |> parse_error()
  chk_address_web_page(address_web_page, 3) |> parse_error()
  
  address_lines <- tibble::tibble(level = 0, tag = "ADDR", value = "")
  
  for (i in seq_along(local_address_lines)) {
    
    address_lines <- dplyr::bind_rows(
      address_lines,
      tibble::tibble(level = 1, tag = paste0("ADR", i), value = local_address_lines[i])
    )
  }
  
  temp <- dplyr::bind_rows(
    address_lines,
    tibble::tibble(level = 1, tag = "CITY", value = address_city),
    tibble::tibble(level = 1, tag = "STAE", value = address_state),
    tibble::tibble(level = 1, tag = "POST", value = address_postal_code),
    tibble::tibble(level = 1, tag = "CTRY", value = address_country),
    tibble::tibble(level = 0, tag = "PHON", value = phone_number),
    tibble::tibble(level = 0, tag = "EMAIL", value = address_email),
    tibble::tibble(level = 0, tag = "FAX", value = address_fax),
    tibble::tibble(level = 0, tag = "WWW", value = address_web_page)
  )
  
  if(nrow(temp) <= 1) {
    return(tibble::tibble())
  } else {
    return(temp)
  }
  
}

#' Construct the ASSOCIATION_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the ASSOCIATION_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_error(ASSOCIATION_STRUCTURE())
#' expect_error(ASSOCIATION_STRUCTURE("@1@"))
#' expect_error(ASSOCIATION_STRUCTURE(c("@1@", "@2@"), "Godfather"))
#' expect_equal(ASSOCIATION_STRUCTURE(character()), tibble::tibble())
#' expect_equal(ASSOCIATION_STRUCTURE("", character()), tibble::tibble())
#' 
#' expect_snapshot_value(ASSOCIATION_STRUCTURE("@I1@", "Godfather"), "json2")
#' expect_snapshot_value(ASSOCIATION_STRUCTURE("@I1@", "Father", 
#'              notes = list(NOTE_STRUCTURE("This is a note")),
#'              source_citations = list(SOURCE_CITATION("@S1@"))), "json2")
#'              
#' @return A tidy tibble containing the ASSOCIATION_STRUCTURE part of a GEDCOM file.
#' @export
ASSOCIATION_STRUCTURE <- function(xref_indi,
                                  relation_is_descriptor,
                                  source_citations = list(),
                                  notes = list()) {
  
  if (length(xref_indi) == 0) return(tibble::tibble())
  if (length(relation_is_descriptor) == 0) return(tibble::tibble())
  
  chk_xref(xref_indi, 1) |> parse_error()
  chk_relation_is_descriptor(relation_is_descriptor, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "ASSO", value = xref_indi),
    tibble::tibble(level = 1, tag = "RELA", value = relation_is_descriptor),
    source_citations |> dplyr::bind_rows() |> add_levels(1),
    notes |> dplyr::bind_rows() |> add_levels(1)
  )
  
}

#' Construct the CHANGE_DATE tibble
#'
#' This function constructs a tibble representation of the CHANGE_DATE from the GEDCOM 5.5.5
#' specification.
#' 
#' @inheritParams primitive_definitions
#' @param change_date A date_exact() object giving the date that this data was changed.
#' @tests
#' expect_snapshot_value(CHANGE_DATE(date_exact(1990, 10, 5)), "json2")
#' expect_snapshot_value(CHANGE_DATE(date_exact(2008, 12, 18), time_value = "11:00:08.56"), "json2")
#' expect_snapshot_value(CHANGE_DATE(date_exact(1990, 10, 5), "10:34:56", 
#'                          notes = list(NOTE_STRUCTURE("Note 1"),
#'                                       NOTE_STRUCTURE("Note 2"))), "json2")
#'
#' @return A tidy tibble containing the CHANGE_DATE part of a GEDCOM file.
#' @export
CHANGE_DATE <- function(change_date = date_exact(),
                        time_value = character(),
                        notes = list()) {
  
  if (length(change_date) == 0) 
    change_date <- date_current()
  
  chk_date_exact(change_date, 1) |> parse_error()
  chk_time_value(time_value, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "CHAN", value = ""),
    tibble::tibble(level = 1, tag = "DATE", value = change_date),
    tibble::tibble(level = 2, tag = "TIME", value = time_value),
    notes |> dplyr::bind_rows() |> add_levels(1)
  )
  
}

#' Construct the CHILD_TO_FAMILY_LINK tibble
#' 
#' This function constructs a tibble representation of the CHILD_TO_FAMILY_LINK from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_error(CHILD_TO_FAMILY_LINK())
#' expect_error(CHILD_TO_FAMILY_LINK("@1@", pedigree_linkage_type = "foste"))
#' expect_equal(CHILD_TO_FAMILY_LINK(character()), tibble::tibble())
#' 
#' expect_snapshot_value(CHILD_TO_FAMILY_LINK("@F1@"), "json2")
#' expect_snapshot_value(CHILD_TO_FAMILY_LINK("@F1@", "birth"), "json2")
#' 
#' @return A tidy tibble containing the CHILD_TO_FAMILY_LINK part of a GEDCOM file.
#' @export
CHILD_TO_FAMILY_LINK <- function(xref_fam,
                                 pedigree_linkage_type = character(),
                                 notes = list()) {
  
  if (length(xref_fam) == 0) return(tibble::tibble())
  
  chk_xref(xref_fam, 1) |> parse_error()
  chk_pedigree_linkage_type(pedigree_linkage_type, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "FAMC", value = xref_fam),
    tibble::tibble(level = 1, tag = "PEDI", value = pedigree_linkage_type),
    notes |> dplyr::bind_rows() |> add_levels(1)
  )
  
}

#' Construct the EVENT_DETAIL tibble
#' 
#' This function constructs a tibble representation of the EVENT_DETAIL from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @param date A date_calendar(), date_period(), date_range(), or date_approximated() value
#' giving the timing of the event.
#' @param place A PLACE_STRUCTURE() object giving the location of the event.
#' @param address An ADDRESS_STRUCTURE() object giving the address of the event.
#' @tests
#' expect_equal(dim(EVENT_DETAIL()), c(0, 3))
#' 
#' expect_snapshot_value(EVENT_DETAIL(event_or_fact_classification = "Woodworking"), "json2")
#' expect_snapshot_value(EVENT_DETAIL(place = PLACE_STRUCTURE("Somewhere")), "json2")
#' expect_snapshot_value(EVENT_DETAIL(address = ADDRESS_STRUCTURE(c("House name", "Road"))), "json2")
#' 
#' @return A tidy tibble containing the EVENT_DETAIL part of a GEDCOM file.
#' @export
EVENT_DETAIL <- function(event_or_fact_classification = character(),
                         date = character(),
                         place = PLACE_STRUCTURE(character()),
                         address = ADDRESS_STRUCTURE(),
                         responsible_agency = character(),
                         religious_affiliation = character(),
                         cause_of_event = character(),
                         notes = list(),
                         source_citations = list(),
                         multimedia_links = list()) {
  
  chk_event_or_fact_classification(event_or_fact_classification, 1) |> parse_error()
  chk_date_value(date, 1) |> parse_error()
  chk_responsible_agency(responsible_agency, 1) |> parse_error()
  chk_religious_affiliation(religious_affiliation, 1) |> parse_error()
  chk_cause_of_event(cause_of_event, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "TYPE", value = event_or_fact_classification),
    tibble::tibble(level = 0, tag = "DATE", value = date),
    place |> add_levels(0),
    address |> add_levels(0),
    tibble::tibble(level = 0, tag = "AGNC", value = responsible_agency),
    tibble::tibble(level = 0, tag = "RELI", value = religious_affiliation),
    tibble::tibble(level = 0, tag = "CAUS", value = cause_of_event),
    notes |> dplyr::bind_rows() |> add_levels(0),
    source_citations |> dplyr::bind_rows() |> add_levels(0),
    multimedia_links |> dplyr::bind_rows() |> add_levels(0)
  )
  
}

#' Construct the FAMILY_EVENT_DETAIL tibble
#' 
#' This function constructs a tibble representation of the FAMILY_EVENT_DETAIL from the GEDCOM 5.5.5
#' specification.
#' 
#' @details For ages, any labels must come after their corresponding number, for example; 4y 8m 10d.
#' The line value should be normalised; it should for example not specify 2y 13m, but 3y 1m
#' instead. Number of days is allowed to be 365 because of leap years.
#' The YYY, MM and DDD values must not be zero; if a value equals zero, that part is left off.
#' The values may not contain leading zeroes either.
#'
#' @inheritParams primitive_definitions
#' @param event_details An EVENT_DETAIL() object giving details of the event.
#' @tests
#' expect_equal(dim(FAMILY_EVENT_DETAIL()), c(0, 3))  
#' 
#' expect_snapshot_value(FAMILY_EVENT_DETAIL(husband_age_at_event = "42y"), "json2")
#' expect_snapshot_value(FAMILY_EVENT_DETAIL(wife_age_at_event = "40y"), "json2")
#' expect_snapshot_value(FAMILY_EVENT_DETAIL(husband_age_at_event = "42y", wife_age_at_event = "40y"), "json2")
#' 
#' @return A tidy tibble containing the FAMILY_EVENT_DETAIL part of a GEDCOM file.
#' @export
FAMILY_EVENT_DETAIL <- function(husband_age_at_event = character(),
                                wife_age_at_event = character(),
                                event_details = EVENT_DETAIL()) {
  
  husband_age_at_event <- as.character(husband_age_at_event)
  wife_age_at_event <- as.character(wife_age_at_event)
  
  chk_age_at_event(husband_age_at_event, 1) |> parse_error()
  chk_age_at_event(wife_age_at_event, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "HUSB_AGE", value = husband_age_at_event),
    tibble::tibble(level = 0, tag = "WIFE_AGE", value = wife_age_at_event),
    event_details |> add_levels(0),
  )
  
}

#' Construct the FAMILY_EVENT_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the FAMILY_EVENT_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @param family_event_details A FAMILY_EVENT_DETAIL() object giving details of the event.
#' @tests
#' expect_error(FAMILY_EVENT_STRUCTURE())
#' expect_error(FAMILY_EVENT_STRUCTURE("TEST"))
#' expect_equal(FAMILY_EVENT_STRUCTURE(character()), tibble::tibble())
#' expect_snapshot_value(FAMILY_EVENT_STRUCTURE("CENS"), "json2")
#' expect_snapshot_value(FAMILY_EVENT_STRUCTURE("EVEN"), "json2")
#' expect_snapshot_value(FAMILY_EVENT_STRUCTURE("EVEN", "Random event"), "json2")
#' expect_snapshot_value(FAMILY_EVENT_STRUCTURE("MARR", 
#'            family_event_details = FAMILY_EVENT_DETAIL(wife_age_at_event = "20y")), "json2")
#'            
#' @return A tidy tibble containing the FAMILY_EVENT_STRUCTURE part of a GEDCOM file.
#' @export
FAMILY_EVENT_STRUCTURE <- function(event_type_family,
                                   event_descriptor = "",
                                   family_event_details = FAMILY_EVENT_DETAIL()) {
  
  if (length(event_type_family) == 0) return(tibble::tibble())
  
  chk_event_type_family(event_type_family, 1) |> parse_error()
  if (event_type_family == "EVEN") {
    if(event_descriptor != "") chk_event_descriptor(event_descriptor, 1) |> parse_error()
  } else {
    event_descriptor <- ""
  }
    
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = event_type_family, value = event_descriptor),
    family_event_details |> add_levels(1),
  )
  
}

#' Construct the INDIVIDUAL_ATTRIBUTE_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the INDIVIDUAL_ATTRIBUTE_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @param individual_event_details An INDIVIDUAL_EVENT_DETAIL() object giving details of the attribute.
#' @tests
#' expect_error(INDIVIDUAL_ATTRIBUTE_STRUCTURE())
#' expect_error(INDIVIDUAL_ATTRIBUTE_STRUCTURE("TEST"))
#' expect_error(INDIVIDUAL_ATTRIBUTE_STRUCTURE("FACT"))
#' expect_error(INDIVIDUAL_ATTRIBUTE_STRUCTURE(c("FACT", "EDUC"), "This is a fact"))
#' expect_error(INDIVIDUAL_ATTRIBUTE_STRUCTURE("FACT", "This is a fact"))
#' expect_error(INDIVIDUAL_ATTRIBUTE_STRUCTURE("IDNO", 123456))
#' expect_equal(INDIVIDUAL_ATTRIBUTE_STRUCTURE(character()), tibble::tibble())
#' expect_equal(INDIVIDUAL_ATTRIBUTE_STRUCTURE("", character()), tibble::tibble())
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("NATI", "British"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("CAST", "White"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("DSCR", "Tall"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("EDUC", "PhD"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("NCHI", 3), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("NMR", 2), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("OCCU", "Baker"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("PROP", "House"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("RELI", "Jedi"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("RESI", "Something"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("TITL", "Earl"), "json2")
#' expect_snapshot_value(INDIVIDUAL_ATTRIBUTE_STRUCTURE("NATI", "British", 
#'                      individual_event_details = INDIVIDUAL_EVENT_DETAIL(age_at_event = "0y")), "json2")
#'                      
#' @return A tidy tibble containing the INDIVIDUAL_ATTRIBUTE_STRUCTURE part of a GEDCOM file.
#' @export
INDIVIDUAL_ATTRIBUTE_STRUCTURE <- function(attribute_type,
                                           attribute_descriptor,
                                           individual_event_details = INDIVIDUAL_EVENT_DETAIL()) {
  
  if (length(attribute_type) == 0) return(tibble::tibble())
  if (length(attribute_descriptor) == 0) return(tibble::tibble())
  
  chk_attribute_type(attribute_type, 1) |> parse_error()
  if (attribute_type %in% c("IDNO", "NCHI", "NMR")) 
    attribute_descriptor <- as.character(attribute_descriptor) 
  
  if (attribute_type == "CAST") chk_caste_name(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "DSCR") chk_physical_description(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "EDUC") chk_scholastic_achievement(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "IDNO") chk_id_number(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "NATI") chk_national_or_tribal_origin(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "NCHI") chk_count_of_children(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "NMR") chk_number_of_relationships(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "OCCU") chk_occupation(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "PROP") chk_possessions(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "RELI") chk_religious_affiliation(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "RESI") attribute_descriptor <- ""
  if (attribute_type == "TITL") chk_nobility_type_title(attribute_descriptor, 1) |> parse_error()
  if (attribute_type == "FACT") chk_attribute_descriptor(attribute_descriptor, 1) |> parse_error()
  
  temp <- dplyr::bind_rows(
    tibble::tibble(level = 0, tag = attribute_type, value = attribute_descriptor),
    individual_event_details |> add_levels(1)
  )
  
  if (sum(temp$tag %in% c("IDNO", "FACT")) == 1 & sum(temp$tag == "TYPE") == 0)
    stop("IDNO and FACT tags require a event_or_fact_classification to be defined in the event detail.")
  
  temp
}

#' Construct the INDIVIDUAL_EVENT_DETAIL tibble
#' 
#' This function constructs a tibble representation of the INDIVIDUAL_EVENT_DETAIL from the GEDCOM 5.5.5
#' specification.
#' 
#' @details For ages, any labels must come after their corresponding number, for example; 4y 8m 10d.
#' The line value should be normalised; it should for example not specify 2y 13m, but 3y 1m
#' instead. Number of days is allowed to be 365 because of leap years.
#' The YYY, MM and DDD values must not be zero; if a value equals zero, that part is left off.
#' The values may not contain leading zeroes either.
#'
#' @inheritParams primitive_definitions
#' @param event_details An EVENT_DETAIL() object giving details of the event.
#' @tests
#' expect_equal(dim(INDIVIDUAL_EVENT_DETAIL()), c(0, 3))  
#' 
#' expect_snapshot_value(INDIVIDUAL_EVENT_DETAIL(age_at_event = "5y"), "json2")
#' 
#' @return A tidy tibble containing the INDIVIDUAL_EVENT_DETAIL part of a GEDCOM file.
#' @export
INDIVIDUAL_EVENT_DETAIL <- function(event_details = EVENT_DETAIL(),
                                    age_at_event = character()) {
  
  age_at_event <- as.character(age_at_event)
  
  chk_age_at_event(age_at_event, 1) |> parse_error()
  
  dplyr::bind_rows(
    event_details |> add_levels(0),
    tibble::tibble(level = 0, tag = "AGE", value = age_at_event)
  )
  
  
}

#' Construct the INDIVIDUAL_EVENT_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the INDIVIDUAL_EVENT_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @param individual_event_details An INDIVIDUAL_EVENT_DETAIL() object giving details of the event.
#' @tests
#' expect_error(INDIVIDUAL_EVENT_STRUCTURE())
#' expect_error(INDIVIDUAL_EVENT_STRUCTURE("BLAH"))
#' expect_error(INDIVIDUAL_EVENT_STRUCTURE("ADOP", adopted_by_which_parent = "WHO"))
#' expect_equal(INDIVIDUAL_EVENT_STRUCTURE(character()), tibble::tibble())
#' expect_snapshot_value(INDIVIDUAL_EVENT_STRUCTURE("BIRT"), "json2")
#' expect_snapshot_value(INDIVIDUAL_EVENT_STRUCTURE("CHRA"), "json2")
#' expect_snapshot_value(INDIVIDUAL_EVENT_STRUCTURE("EVEN", "A random event"), "json2")
#' expect_snapshot_value(INDIVIDUAL_EVENT_STRUCTURE("BIRT", xref_fam = "@F4@"), "json2")
#' expect_snapshot_value(INDIVIDUAL_EVENT_STRUCTURE("ADOP", xref_fam = "@F4@", 
#'                                         adopted_by_which_parent = "BOTH"), "json2")
#'                                         
#' @return A tidy tibble containing the INDIVIDUAL_EVENT_STRUCTURE part of a GEDCOM file.
#' @export
INDIVIDUAL_EVENT_STRUCTURE <- function(event_type_individual,
                                       event_descriptor = "",
                                       individual_event_details = INDIVIDUAL_EVENT_DETAIL(),
                                       xref_fam = character(),
                                       adopted_by_which_parent = character()) {
  
  if (length(event_type_individual) == 0) return(tibble::tibble())
  
  chk_event_type_individual(event_type_individual, 1) |> parse_error()
  chk_xref(xref_fam, 1) |> parse_error()
  chk_adopted_by_which_parent(adopted_by_which_parent, 1) |> parse_error()
  if(event_type_individual == "EVEN") {
    if(event_descriptor != "") chk_event_descriptor(event_descriptor, 1) |> parse_error()
  } else {
    event_descriptor <- ""
  }
    
  temp <- dplyr::bind_rows(
    tibble::tibble(level = 0, tag = event_type_individual, value = event_descriptor),
    individual_event_details |> add_levels(1)
  )
    
  if (sum(temp$tag %in% c("BIRT", "CHR", "ADOP")) == 1)
    temp <- dplyr::bind_rows(
      temp,
      tibble::tibble(level = 1, tag = "FAMC", value = xref_fam)
    )
  
  if (sum(temp$tag == "ADOP") == 1)
    temp <- dplyr::bind_rows(
      temp,
      tibble::tibble(level = 2, tag = "ADOP", value = adopted_by_which_parent)
    )
    
  temp
  
}


#' Construct the MULTIMEDIA_LINK tibble
#' 
#' This function constructs a tibble representation of the MULTIMEDIA_LINK from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_error(MULTIMEDIA_LINK("ref"))
#' expect_equal(MULTIMEDIA_LINK(character()), tibble::tibble())
#' expect_equal(MULTIMEDIA_LINK("@M1@"),
#'       tibble::tibble(level = 0, tag = "OBJE", value = "@M1@"))
#' @return A tidy tibble containing the MULTIMEDIA_LINK part of a GEDCOM file.
#' @export
MULTIMEDIA_LINK <- function(xref_obje) {
  
  if (length(xref_obje) == 0) return(tibble::tibble()) 
    
  chk_xref(xref_obje, 1) |> parse_error()
  
  tibble::tibble(level = 0, tag = "OBJE", value = xref_obje)
  
}

#' Construct the NOTE_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the NOTE_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @param note Either free-form text (comments, opinions) or an xref to another Note record.
#' @tests
#' expect_error(NOTE_STRUCTURE(c("test1", "test2")))
#' expect_equal(NOTE_STRUCTURE(), tibble::tibble())
#' expect_snapshot_value(NOTE_STRUCTURE("@T1@"), "json2")
#' expect_snapshot_value(NOTE_STRUCTURE("test text"), "json2")
#' 
#' @return A tidy tibble containing the NOTE_STRUCTURE part of a GEDCOM file.
#' @export
NOTE_STRUCTURE <- function(note = character()) {
  
  if (length(note) == 0) return(tibble::tibble())
  
  chk_user_text(note, 1) |> parse_error()
  
  if(grepl(reg_xref(TRUE), note)) {
    chk_xref(note, 1) |> parse_error()
  }
  
  tibble::tibble(level = 0, tag = "NOTE", value = note)  

}




#' Construct the PERSONAL_NAME_PIECES tibble
#' 
#' This function constructs a tibble representation of the PERSONAL_NAME_PIECES from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_equal(dim(PERSONAL_NAME_PIECES()), c(0, 3))
#' 
#' expect_snapshot_value(PERSONAL_NAME_PIECES(name_piece_prefix = "Mr", 
#'                                            name_piece_nickname = "J"), "json2")
#' expect_snapshot_value(PERSONAL_NAME_PIECES(name_piece_prefix = "Mr", 
#'                                            name_piece_nickname = "J",
#'                notes = list(NOTE_STRUCTURE("Note1"),
#'                             NOTE_STRUCTURE("Note2"))), "json2")
#'                             
#' @return A tidy tibble containing the PERSONAL_NAME_PIECES part of a GEDCOM file.
#' @export
PERSONAL_NAME_PIECES <- function(name_piece_prefix = character(),
                                 name_piece_given = character(), 
                                 name_piece_nickname = character(), 
                                 name_piece_surname_prefix = character(),
                                 name_piece_surname = character(),
                                 name_piece_suffix = character(),
                                 notes = list(),
                                 source_citations = list()) {
  
  chk_name_piece_prefix(name_piece_prefix, 1) |> parse_error()
  chk_name_piece_given(name_piece_given, 1) |> parse_error()
  chk_name_piece_nickname(name_piece_nickname, 1) |> parse_error()
  chk_name_piece_surname_prefix(name_piece_surname_prefix, 1) |> parse_error()
  chk_name_piece_surname(name_piece_surname, 1) |> parse_error()
  chk_name_piece_suffix(name_piece_suffix, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "NPFX", value = name_piece_prefix),
    tibble::tibble(level = 0, tag = "GIVN", value = name_piece_given),
    tibble::tibble(level = 0, tag = "NICK", value = name_piece_nickname),
    tibble::tibble(level = 0, tag = "SPFX", value = name_piece_surname_prefix),
    tibble::tibble(level = 0, tag = "SURN", value = name_piece_surname),
    tibble::tibble(level = 0, tag = "NSFX", value = name_piece_suffix),
    notes |> dplyr::bind_rows() |> add_levels(0),
    source_citations |> dplyr::bind_rows() |> add_levels(0)
  ) 
  
}

#' Construct the PERSONAL_NAME_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the PERSONAL_NAME_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @param name_pieces A PERSONAL_NAME_PIECES() object giving the components of the name.
#' @param phonetic_name_pieces A list of PERSONAL_NAME_PIECES() objects giving the components 
#' of the phonetic name variations.
#' @param romanised_name_pieces A list of PERSONAL_NAME_PIECES() objects giving the components 
#' of the romanised name variations.
#' @tests
#' expect_error(PERSONAL_NAME_STRUCTURE())
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe Bloggs"))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe /Bloggs/",
#'                                      name_pieces = PERSONAL_NAME_PIECES(name_piece_given = "Joe"),
#'                                      name_phonetic = "Jo Bloggs"))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe /Bloggs/",
#'                                      name_pieces = PERSONAL_NAME_PIECES(name_piece_given = "Joe"),
#'                                      name_romanised = "Jo Bloggs"))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe Bloggs", 
#'                           name_phonetic = c("Joe Blogs", "Jo Bloggs")))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe /Bloggs/", 
#'                           name_phonetic = c("Joe Blogs", "Jo Bloggs"),
#'                           phonetisation_method = "Can't spell"))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe /Bloggs/", 
#'                           name_phonetic = c("Joe Blogs", "Jo Bloggs"),
#'                           phonetisation_method = c("Can't spell", "Can't spell"),
#'                           phonetic_name_pieces = list(PERSONAL_NAME_PIECES(name_piece_given = "Joe", 
#'                                                                            name_piece_surname = "Blogs"))))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe Bloggs", 
#'                           name_romanised = c("Joe Blogs", "Jo Bloggs")))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe Bloggs", 
#'                           name_romanised = c("Joe Blogs", "Jo Bloggs"),
#'                           romanisation_method = "Can't spell"))
#' expect_error(PERSONAL_NAME_STRUCTURE("Joe Bloggs", 
#'                           name_romanised = c("Joe Blogs", "Jo Bloggs"),
#'                           romanisation_method = c("Can't spell", "Can't spell"),
#'                           romanised_name_pieces = list(PERSONAL_NAME_PIECES(name_piece_given = "Joe", 
#'                                                                            name_piece_surname = "Blogs"))))
#' expect_equal(PERSONAL_NAME_STRUCTURE(character()), tibble::tibble())  
#'                                                                                                                                                      
#' expect_snapshot_value(PERSONAL_NAME_STRUCTURE("Joe /Bloggs/", 
#'                                      name_pieces = PERSONAL_NAME_PIECES(name_piece_prefix = "Mr",
#'                                                                         name_piece_surname = "Bloggs")), "json2")
#' expect_snapshot_value(PERSONAL_NAME_STRUCTURE("Joe /Bloggs/", 
#'                                      name_pieces = PERSONAL_NAME_PIECES(name_piece_surname = "Bloggs"),
#'                                      name_phonetic = c("Joe /Blogs/", "Jo /Bloggs/"),
#'                                      phonetic_name_pieces = list(PERSONAL_NAME_PIECES(name_piece_surname = "Blogs"),
#'                                                                  PERSONAL_NAME_PIECES(name_piece_surname = "Bloggs")),
#'                                      phonetisation_method = c("Can't spell", "Can't spell")), "json2")
#' expect_snapshot_value(PERSONAL_NAME_STRUCTURE("Joe /Bloggs/", 
#'                                      name_pieces = PERSONAL_NAME_PIECES(name_piece_surname = "Bloggs"),
#'                                      name_phonetic = c("Joe Blogs", "Jo Bloggs"),
#'                                      phonetisation_method = c("Can't spell", "Can't spell"),
#'                                      phonetic_name_pieces = 
#'                                        list(PERSONAL_NAME_PIECES(name_piece_given = "Joe", 
#'                                                                  name_piece_surname = "Blogs"),
#'                                             PERSONAL_NAME_PIECES(name_piece_given = "Jo",
#'                                                                  name_piece_surname = "Bloggs"))), "json2")
#'
#' @return A tidy tibble containing the PERSONAL_NAME_STRUCTURE part of a GEDCOM file.
#' @export
PERSONAL_NAME_STRUCTURE <- function(name_personal,
                                    name_type = character(),
                                    name_pieces = PERSONAL_NAME_PIECES(), 
                                    name_phonetic = character(),
                                    phonetisation_method = character(),
                                    phonetic_name_pieces = list(),
                                    name_romanised = character(),
                                    romanisation_method = character(),
                                    romanised_name_pieces = list()) {
  
  if (length(name_personal) == 0) return(tibble::tibble())
  
  chk_name_personal(name_personal, 1) |> parse_error()
  chk_name_type(name_type, 1) |> parse_error()
  chk_name_phonetic(name_phonetic, 1000) |> parse_error()
  chk_phonetisation_method(phonetisation_method, 1000) |> parse_error()
  chk_name_romanised(name_romanised, 1000) |> parse_error()
  chk_romanisation_method(romanisation_method, 1000) |> parse_error()
  
  if(nrow(name_pieces) == 0)
    stop("No name pieces defined for ", name_personal)
  
  if (length(name_phonetic) != length(phonetisation_method))
    stop("Each phonetic variation requires a phonetisation method")
  
  if (length(name_romanised) != length(romanisation_method))
    stop("Each romanised variation requires a romanisation method")
  
  if(length(name_phonetic) > 0) {
    
    if(length(phonetic_name_pieces) > 0) {
      if (length(name_phonetic) != length(phonetic_name_pieces))
        stop("Each phonetic variation requires a set of phonetic name pieces")
    } else {
      phonetic_name_pieces <- rep(list(PERSONAL_NAME_PIECES()), length(name_phonetic))
    }

  }
  
  if(length(name_romanised) > 0) {
    
    if(length(romanised_name_pieces) > 0) {
      if (length(name_romanised) != length(romanised_name_pieces))
        stop("Each romanised variation requires a set of romanised name pieces")
    } else {
      romanised_name_pieces <- rep(list(PERSONAL_NAME_PIECES()), length(name_romanised))
    }

  }
  
  temp <- dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "NAME", value = name_personal),
    tibble::tibble(level = 1, tag = "TYPE", value = name_type),
    name_pieces |> add_levels(1)
  )
  
  for (i in seq_along(name_phonetic)) {
    if(nrow(phonetic_name_pieces[[i]]) == 0)
      stop("No name pieces defined for ", name_phonetic[i])
    
    temp <- dplyr::bind_rows(
      temp,
      tibble::tibble(level = 1, tag = "FONE", value = name_phonetic[i]),
      tibble::tibble(level = 2, tag = "TYPE", value = phonetisation_method[i]),
      phonetic_name_pieces[[i]] |> add_levels(2)
    )
  }
  for (i in seq_along(name_romanised)) {
    if(nrow(romanised_name_pieces[[i]]) == 0)
      stop("No name pieces defined for ", name_romanised[i])
    
    temp <- dplyr::bind_rows(
     temp,
     tibble::tibble(level = 1, tag = "ROMN", value = name_romanised[i]),
     tibble::tibble(level = 2, tag = "TYPE", value = romanisation_method[i]),
     romanised_name_pieces[[i]] |> add_levels(2)
    )
  }
  
  temp
  
}

#' Construct the PLACE_STRUCTURE tibble
#' 
#' This function constructs a tibble representation of the PLACE_STRUCTURE from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_error(PLACE_STRUCTURE())
#' expect_error(PLACE_STRUCTURE("Here", place_latitude = "N51.5", place_longitude = "E0.0"))
#' expect_error(PLACE_STRUCTURE("London", 
#'                   place_phonetic = c("Lundon", "Lundun")))
#' expect_error(PLACE_STRUCTURE("London", 
#'                   place_phonetic = c("Lundon", "Lundun"),
#'                   phonetisation_method = "English accent"))
#' expect_error(PLACE_STRUCTURE("London", 
#'                   place_romanised = c("Lundon", "Lundun"),
#'                   romanisation_method = "English accent"))
#' expect_snapshot_value(PLACE_STRUCTURE("Greenwich", 
#'                              place_phonetic = c("Grenidge", "Grenich"),
#'                              phonetisation_method = c("English accent", "English accent"),
#'                              place_latitude = "N51.5",
#'                              place_longitude = "E0.00"), "json2")
#' expect_snapshot_value(PLACE_STRUCTURE("Greenwich", 
#'                              place_romanised = c("Grenidge", "Grenich"),
#'                              romanisation_method = c("English accent", "English accent"),
#'                              place_latitude = "N51.5",
#'                              place_longitude = "E0.00"), "json2")                             
#' @return A tidy tibble containing the PLACE_STRUCTURE part of a GEDCOM file.
#' @export
PLACE_STRUCTURE <- function(place_name,
                            place_phonetic = character(),
                            phonetisation_method = character(),
                            place_romanised = character(),
                            romanisation_method = character(),
                            place_latitude = character(),
                            place_longitude = character(),
                            notes = list()) {

  if (length(place_name) == 0) return(tibble::tibble())
  
  chk_place_name(place_name, 1) |> parse_error()
  chk_place_phonetic(place_phonetic, 1000) |> parse_error()
  chk_phonetisation_method(phonetisation_method, 1000) |> parse_error()
  chk_place_romanised(place_romanised, 1000) |> parse_error()
  chk_romanisation_method(romanisation_method, 1000) |> parse_error()
  chk_place_latitude(place_latitude, 1) |> parse_error()
  chk_place_longitude(place_longitude, 1) |> parse_error()
  
  if (length(place_phonetic) != length(phonetisation_method))
    stop("Each phonetic variation requires a phonetic type")
  if (length(place_romanised) != length(romanisation_method))
    stop("Each romanised variation requires a romanised type")
  
  temp <- tibble::tibble(level = 0, tag = "PLAC", value = place_name)
  
  for (i in seq_along(place_phonetic)) {
    temp <- dplyr::bind_rows(
      temp,
      tibble::tibble(level = 1, tag = "FONE", value = place_phonetic[i]),
      tibble::tibble(level = 2, tag = "TYPE", value = phonetisation_method[i])
    )
  }
  for (i in seq_along(place_romanised)) {
    temp <- dplyr::bind_rows(
      temp,
      tibble::tibble(level = 1, tag = "ROMN", value = place_romanised[i]),
      tibble::tibble(level = 2, tag = "TYPE", value = romanisation_method[i])
    )
  }
  
  temp <- dplyr::bind_rows(
    temp,
    tibble::tibble(level = 1, tag = "MAP", value = ""),
    tibble::tibble(level = 2, tag = "LATI", value = place_latitude),
    tibble::tibble(level = 2, tag = "LONG", value = place_longitude),
    notes |> dplyr::bind_rows() |> add_levels(1)
  )
  
  if (sum(temp$tag == "LATI") == 0) temp <- dplyr::filter(temp, tag != "MAP")
  if (sum(temp$tag == "LONG") == 0) temp <- dplyr::filter(temp, tag != "MAP")
  temp
  
}

#' Construct the SOURCE_CITATION tibble
#' 
#' This function constructs a tibble representation of the SOURCE_CITATION from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_equal(SOURCE_CITATION(character()), tibble::tibble())
#' expect_snapshot_value(SOURCE_CITATION("@S1@"), "json2")
#' expect_snapshot_value(SOURCE_CITATION("@S1@", 
#'               where_within_source = 3, event_type_cited_from = "MARR"), "json2")
#' expect_snapshot_value(SOURCE_CITATION("@S1@", 
#'               where_within_source = 3, role_in_event = "HUSB",
#'               certainty_assessment = 2), "json2")
#' expect_snapshot_value(SOURCE_CITATION("@S1@", where_within_source = 3, 
#'                              event_type_cited_from = "CENS", 
#'                              role_in_event = "WIFE",
#'                              entry_recording_date = "28 JUN 1996",
#'                              text_from_source = c("text1","text2"),
#'                              certainty_assessment = 2), "json2")
#'                              
#' @return A tidy tibble containing the SOURCE_CITATION part of a GEDCOM file.
#' @export
SOURCE_CITATION <- function(xref_sour,
                            where_within_source = character(),
                            event_type_cited_from = character(),
                            role_in_event = character(),
                            entry_recording_date = character(),
                            text_from_source = character(),
                            certainty_assessment = character(),
                            multimedia_links = list(),
                            notes = list()) {
  
  if (length(xref_sour) == 0) return(tibble::tibble())
  
  where_within_source <- as.character(where_within_source)
  certainty_assessment <- as.character(certainty_assessment)
  
  chk_xref(xref_sour, 1) |> parse_error()
  chk_where_within_source(where_within_source, 1) |> parse_error()
  chk_event_type_cited_from(event_type_cited_from, 1) |> parse_error()
  chk_role_in_event(role_in_event, 1) |> parse_error()
  chk_date_value(entry_recording_date, 1) |> parse_error()
  chk_text_from_source(text_from_source, 1000) |> parse_error()
  chk_certainty_assessment(certainty_assessment, 1) |> parse_error()
  
  temp <- dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "SOUR", value = xref_sour),
    tibble::tibble(level = 1, tag = "PAGE", value = where_within_source),
    tibble::tibble(level = 1, tag = "EVEN", value = event_type_cited_from),
    tibble::tibble(level = 2, tag = "ROLE", value = role_in_event),
    tibble::tibble(level = 1, tag = "DATA", value = ""),
    tibble::tibble(level = 2, tag = "DATE", value = entry_recording_date),
    tibble::tibble(level = 2, tag = "TEXT", value = text_from_source),
    multimedia_links |> dplyr::bind_rows() |> add_levels(1),
    notes |> dplyr::bind_rows() |> add_levels(1),
    tibble::tibble(level = 1, tag = "QUAY", value = certainty_assessment)
  ) 
  
  if (sum(temp$tag == "EVEN") == 0) temp <- dplyr::filter(temp, tag != "ROLE")
  if (sum(temp$tag == "DATE") == 0 & sum(temp$tag == "TEXT") == 0) 
    temp <- dplyr::filter(temp, tag != "DATA")
  
  temp
    
}

#' Construct the SOURCE_REPOSITORY_CITATION tibble
#' 
#' This function constructs a tibble representation of the SOURCE_REPOSITORY_CITATION from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_error(SOURCE_REPOSITORY_CITATION())
#' expect_error(SOURCE_REPOSITORY_CITATION("@R1@", source_call_number = c("123", "456")))
#' expect_equal(SOURCE_REPOSITORY_CITATION(character()), tibble::tibble())
#' expect_snapshot_value(SOURCE_REPOSITORY_CITATION("@R1@", source_call_number = 123), "json2")
#' 
#' @return A tidy tibble containing the SOURCE_REPOSITORY_CITATION part of a GEDCOM file.
#' @export
SOURCE_REPOSITORY_CITATION <- function(xref_repo,
                                       source_call_number = character()) {
  
  if (length(xref_repo) == 0) return(tibble::tibble())
  
  source_call_number = as.character(source_call_number)
  chk_xref(xref_repo, 1) |> parse_error()
  chk_source_call_number(source_call_number, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "REPO", value = xref_repo),
    tibble::tibble(level = 1, tag = "CALN", value = source_call_number)
    )
    
}


#' Construct the SPOUSE_TO_FAMILY_LINK tibble
#' 
#' This function constructs a tibble representation of the SPOUSE_TO_FAMILY_LINK from the GEDCOM 5.5.5
#' specification.
#'
#' @inheritParams primitive_definitions
#' @tests
#' expect_error(SPOUSE_TO_FAMILY_LINK())
#' expect_equal(SPOUSE_TO_FAMILY_LINK(character()), tibble::tibble())
#' expect_snapshot_value(SPOUSE_TO_FAMILY_LINK("@F2@", 
#'                     list(NOTE_STRUCTURE("test"))), "json2")
#'                     
#' @return A tidy tibble containing the SPOUSE_TO_FAMILY_LINK part of a GEDCOM file.
#' @export
SPOUSE_TO_FAMILY_LINK <- function(xref_fam,
                                  notes = list()) {
  
  if (length(xref_fam) == 0) return(tibble::tibble())
  
  chk_xref(xref_fam, 1) |> parse_error()
  
  dplyr::bind_rows(
    tibble::tibble(level = 0, tag = "FAMS", value = xref_fam),
    notes |> dplyr::bind_rows() |> add_levels(1)
  )
}