**GraphQL with Tcl**

This is not currently an attempt to build a fully compliant GraphQL package, but I did want to be a parse the GraphQL general syntax and use it to unify the syntax that I use to communicate between various parts of my application.  I figured others may find this useful to use or extend.  I built this without reading the spec closely so it should be considered when using this code.  I will likely improve it over time, and if it ends up being used a lot in our production app you can expect it will grow out from here.

GraphQL can be an awesome way of querying and controlling various aspects and can be considered a replacement of the "REST" protocol.  

----

`GraphQL is a query language for APIs and a runtime for fulfilling those queries with your existing data. GraphQL provides a complete and understandable description of the data in your API, gives clients the power to ask for exactly what they need and nothing more, makes it easier to evolve APIs over time, and enables powerful developer tools.`

----


======
namespace eval graphql {}

namespace eval ::graphql::regexp {
  variable graphql_re {(?xi) # this is the _expanded_ syntax
    ^\s*
    ([^\s\(\{]*) # Capture the first value (query|mutation) -> $type
    \s*
    (?:\(([^\)]*)\))? # Capture the values within the variables scope
    \s*
    (?:{\s*(.*)\s*})
    $
  }

  # The start of the parsing, we capture the next value in the body
  # which starts the process of capturing downwards.
  variable graphql_body_re {(?xi)
    ^\s*
    (?!\})
    ([^\s\(\{:]*)  # capture the name of the query
    (?:            # optionally may define a name and fn mapping
      :            # if a colon, then we need the fn name next
      \s*
      ([^\s\(\{]*) # capture the name of the fn
    )?
    \s*
    (?:\(([^\)]*)\))? # optionally capture var definitions
    \s*
    (.*)  # grab the rest of the request
    $
  }

  variable graphql_next_query_re {(?xi)
    ^\s*(?:\{\s*)?
    (?!\})
    ([^\s\(\{:]*)  # capture the name of the query
    (?:        # optionally may define a name and fn mapping
      (?=\s*:)
      \s*:         # if a colon, then we need the fn name next
      \s*
      ([^\s\(\{]*) # capture the name of the fn
    )?
    (?:
      (?=\s*\()    # check if we have arg declarations
      \s*
      \(
        ([^\)]*)   # grab the arg values
      \)
    )?
    (?:
      (?=\s*\{)    # this is a object type, capture the rest so we know
                   # to continue parsing
      \s*\{
      (.*)
      $
    )?
    \s*           # this will only have a value if we are done parsing
    (.*)          # this value, otherwise its sibling will.
  }
}

namespace eval ::graphql::parse {}

proc ::graphql::parse packet {
  set data [json get $packet]
  set parsed [dict create]
  set type {}
  set definitions {}

  if {[dict exists $data variables]} {
    dict set parsed variables [dict get $data variables]
  }

  if {[dict exists $data query query]} {
    set query [dict get $data query query]
  }

  regexp -- $regexp::graphql_re $query \
    -> type definitions body

  dict set parsed type $type

  set body [string trim $body]

  if {$definitions ne {}} {
    ::graphql::parse::definitions $definitions
  }

  ::graphql::parse::body $body

  return $parsed
}

proc ::graphql::parse::definitions definitions {
  upvar 1 parsed parsed
  foreach {var type} $definitions {
    set var [string trimright $var :]
    set var [string trimleft $var \$]
    if {[string match "*!" $type]} {
      set type [string trimright $type !]
      set required true
      if {![dict exists $parsed variables $var]} {
        tailcall return \
          -code error \
          -errorCode [list GRAPHQL PARSE VAR_NOT_DEFINED] \
          " variable $var is required but it was not provided within the request"
      }
    } else {
      set required false
    }
    if {[string index $type 0] eq "\["} {
      set isArray true
      set type [string range $type 1 end-1]
    } else {
      set isArray false
    }
    if {[dict exists $parsed variables $var]} {
      set varValue [dict get $parsed variables $var]
    }
    switch -nocase -- $type {
      float {
        set type double
        set checkType true
      }
      boolean {
        set checkType true
      }
      int {
        set type integer
        set checkType true
      }
      default {
        set checkType false
      }
    }
    if {$checkType && [info exists varValue]} {
      if {$isArray} {
        set i 0
        foreach elval $varValue {
          if {![string is $type -strict $elval]} {
            tailcall return \
              -code error \
              -errorCode [list GRAPHQL PARSE VAR_INVALID_TYPE IN_ARRAY] \
              " variable $var element $i should be ${type} but received: \"$elval\" while checking \"Array<${varValue}>\""
          }
          incr i
        }
      } elseif {![string is $type -strict $varValue]} {

      }
    }
    dict set parsed definitions $var [dict create \
      type     [string tolower $type] \
      required $required
    ]
  }
}

proc ::graphql::parse::arg arg {
  upvar 1 parsed parsed
  if {[dict exists $parsed variables]} {
    set variables [dict get $parsed variables]
  }
  if {[string index $arg 0] eq "\$"} {
    set name [string range $arg 1 end]
    if {[dict exists $variables $name]} {
      set arg [dict get $variables $name]
    } else {
      return -code error " variable $name not found for arg $arg"
    }
  }
  return $arg
}

proc ::graphql::parse::fnargs fnargs {
  upvar 1 parsed parsed
  set data [dict create]

  # set argName  {}
  # set argValue {}
  foreach arg $fnargs {
    set arg [string trim $arg]
    if {$arg eq ":"} {
      continue
    }
    if {[info exists argValue]} {
      # Once defined, we can set the value and unset our vars
      dict set data [arg $argName] [arg $argValue]
      unset argName
      unset argValue
    }
    if {![info exists argName]} {
      set colonIdx [string first : $arg]
      if {$colonIdx != -1} {
        if {[string index $arg end] eq ":"} {
          set argName [string trimright $arg :]
        } else {
          lassign [split $arg :] argName argValue
        }
      } else {
        # this is probably not right?
        set argName $arg
      }
    } else {
      set argValue $arg
    }
  }

  if {[info exists argName] && [info exists argValue]} {
    dict set data [arg $argName] [arg $argValue]
  }

  return $data
}

proc ::graphql::parse::body remaining {
  upvar 1 parsed parsed
  set lvl 1
  set props [list]

  while {$remaining ne {}} {
    regexp -- $::graphql::regexp::graphql_body_re $remaining \
      -> name fn fnargs remaining

    if {$fn eq {}} {
      set fn $name
    }

    if {$fnargs ne {}} {
      set fnargs [::graphql::parse::fnargs $fnargs]
      puts $fnargs
    }

    set remaining [nextType $remaining]

    dict set parsed requests $name [dict create \
      name  $name \
      fn    $fn \
      args  $fnargs \
      props $props
    ]

    set remaining [string trimleft $remaining { \} }]
  }
}

proc ::graphql::parse::nextType remaining {
  upvar 1 props pprops
  upvar 1 lvl plvl
  upvar 1 parsed parsed
  set lvl [expr {$plvl + 1}]

  while {[string index $remaining 0] ne "\}" && $remaining ne {}} {
    set props [list]

    regexp -- $::graphql::regexp::graphql_next_query_re $remaining \
      -> name fn fnargs schema remaining

    if {![info exists name] || $name eq {}} {
      break
    }

    set prop [dict create \
      name $name
    ]

    if {[info exists fnargs] && $fnargs ne {}} {
      set fnargs [::graphql::parse::fnargs $fnargs]
      dict set prop args $fnargs
    }

    if {[info exists schema]} {
      set schema [string trim $schema]
      if {$schema ne {}} {
        if {$fn eq {}} {
          set fn $name
        }
        dict set prop fn $fn
        set schema [nextType $schema]
        set schema [string trim $schema]
        set remaining [string trimleft $schema \}]
      }
    }

    if {[llength $props] > 0} {
      dict set prop props $props
    }

    lappend pprops $prop

    set remaining [string trimleft $remaining { \}\n}]
  }

  # At this point, $schema will have content if we need to continue
  # parsing this type, otherwise it will be within remaining
  return $remaining
}

======


<<categories>>Enter Category Here