# The development version from GitHub:
# install.packages("devtools")
devtools::install_github("schloerke/gqlr")

 
library(magrittr)
library(gqlr)
 
schema <- "
  type Hello {
    world: String
  }
  schema {
    query: Hello
  }
" %>%
  gqlr_schema()
 
execute_request("{world}", schema, initial_value = list(world = "Hi!"))
# {
#   "data": {
#     "world": "Hi!"
#   }
# }

add_human <- function(human_data, id, name, appear, home, friend) {
  human <- list(id = id, name = name, appearsIn = appear, friends = friend, homePlanet = home)
  # set up a function to be calculated if the field totalCredits is required
  human$totalCredits <- function(obj, args, schema) {
    length(human$appearsIn)
  }
  human_data[[id]] <- human
  human_data
}
add_droid <- function(droid_data, id, name, appear, pf, friend) {
  droid <- list(id = id, name = name, appearsIn = appear, friends = friend, primaryFunction = pf)
  # set extra fields manually
  droid$totalCredits <- length(droid$appearsIn)
  droid_data[[id]] <- droid
  droid_data
}
 
human_data <- list() %>%
  add_human("1000", "Luke Skywalker", c(4, 5, 6), "Tatooine", c("1002", "1003", "2000", "2001")) %>%
  add_human("1002", "Han Solo",       c(4, 5, 6), "Corellia", c("1000", "1003", "2001")) %>%
  add_human("1003", "Leia Organa",    c(4, 5, 6), "Alderaan", c("1000", "1002", "2000", "2001"))
 
droid_data <- list() %>%
  add_droid("2000", "C-3PO", c(4, 5, 6), "Protocol", c("1000", "1002", "1003", "2001")) %>%
  add_droid("2001", "R2-D2", c(4, 5, 6), "Astromech", c("1000", "1002", "1003"))
 
all_characters <- list() %>% append(human_data) %>% append(droid_data)
all_characters[[1]]
# $id
# [1] "1000"
#
# $name
# [1] "Luke Skywalker"
#
# $appearsIn
# [1] 4 5 6
#
# $friends
# [1] "Tatooine"
#
# $homePlanet
# [1] "1002" "1003" "2000" "2001"
#
# $totalCredits
# function (obj, args, schema)
# {
#     length(human$appearsIn)
# }
# <environment: 0x7fadd8ca2038>

"
enum Episode { NEWHOPE, EMPIRE, JEDI }
 
interface Character {
  id: String!
  name: String
  friends: [Character]
  appearsIn: [Episode]
}
 
type Droid implements Character {
  id: String!
  name: String
  friends: [Character]
  appearsIn: [Episode]
  primaryFunction: String
}
type Human implements Character {
  id: String!
  name: String
  friends: [Character]
  appearsIn: [Episode]
  homePlanet: String
}
 
type Query {
  hero(episode: Episode): Character
  human(id: String!): Human
  droid(id: String!): Droid
}
# the schema type must be provided if a query or mutation is to be executed
schema {
  query: Query
}
" %>%
  gqlr_schema(
    Episode = list(
      resolve = function(episode_id, schema) {
        switch(as.character(episode_id),
          "4" = "NEWHOPE",
          "5" = "EMPIRE",
          "6" = "JEDI",
          "UNKNOWN_EPISODE"
        )
      }
    ),
    Character = list(
      resolve_type = function(id, schema) {
        ifelse(id %in% names(droid_data), "Droid", "Human")
      }
    ),
    Human = list(
      # Add a resolve method for type Human that takes in an id and returns the human data
      resolve = function(id, args, schema) {
        human_data[[id]]
      }
    ),
    Droid = list(
      # description for Droid
      description = "A mechanical creature in the Star Wars universe.",
      # Add a resolve method for type Droid that takes in an id and returns the droid data
      resolve = function(id, schema) {
        droid_data[[id]]
      }
    ),
    Query = function(null, schema) {
      list(
        # return a function for key 'hero'
        # the id will be resolved by the appropriate resolve() method of Droid or Human
        hero = function(obj, args, schema) {
          episode <- args$episode
          if (identical(episode, 5) || identical(episode, "EMPIRE")) {
            "1000" # Luke
          } else {
            "2001" # R2-D2
          }
        },
        # the id will be resolved by the Human resolve() method
        human = function(obj, args, schema) {
          args$id
        },
        # the id will be resolved by the Droid resolve() method
        droid = function(obj, args, schema) {
          args$id
        }
      )
    }
  ) ->
star_wars_schema

# Use the resolve method to initialize the data
"
{
  hero {
    id
    name
    friends {
      id
      name
    }
  }
}
" %>%
  execute_request(star_wars_schema)
# {
#   "data": {
#     "hero": {
#       "id": "2001",
#       "name": "R2-D2",
#       "friends": [
#         {
#           "id": "1000",
#           "name": "Luke Skywalker"
#         },
#         {
#           "id": "1002",
#           "name": "Han Solo"
#         },
#         {
#           "id": "1003",
#           "name": "Leia Organa"
#         }
#       ]
#     }
#   }
# }
 
 
# Use variables...
"
query FetchSomeIDQuery($someId: String!) {
  human(id: $someId) {
    name
  }
}
" %>%
  execute_request(star_wars_schema, variables = list(someId = "1000"))
# {
#   "data": {
#     "human": {
#       "name": "Luke Skywalker"
#     }
#   }
# }
 
 
# Introspection
"
query IntrospectionTypeQuery {
  __type(name: \"Droid\") {
    kind
    name
    fields {
      name
    }
  }
}
" %>%
  execute_request(star_wars_schema)
# {
#   "data": {
#     "__type": {
#       "kind": "OBJECT",
#       "name": "Droid",
#       "fields": [
#         {
#           "name": "id"
#         },
#         {
#           "name": "name"
#         },
#         {
#           "name": "friends"
#         },
#         {
#           "name": "appearsIn"
#         },
#         {
#           "name": "primaryFunction"
#         },
#         {
#           "name": "__typename"
#         }
#       ]
#     }
#   }
# }

# R
server(star_wars_schema, log = TRUE)