From c66fe584020cd329a2f8b6198847a5974dd73e4c Mon Sep 17 00:00:00 2001
From: Philip C Monk <philip.monk@tlon.io>
Date: Tue, 5 Apr 2016 20:44:04 -0400
Subject: [PATCH] generalized endpoint translation

---
 app/gh.hoon       | 295 ++++++++++++++++++++++++----------------------
 app/gh/split.hoon | 179 ----------------------------
 2 files changed, 151 insertions(+), 323 deletions(-)
 delete mode 100644 app/gh/split.hoon

diff --git a/app/gh.hoon b/app/gh.hoon
index 9cd899da64..a2fe14e0f8 100644
--- a/app/gh.hoon
+++ b/app/gh.hoon
@@ -7,20 +7,23 @@
 ::
 ::    - subscribe to /scry/x/listen/{owner}/{repo}/{events...}
 ::      for webhook-powered event notifications.  For event list,
-::      see https://developer.github.com/webhooks/.
+::      see kttps://developer.github.com/webhooks/.
 ::
 ::  See the %github app for example usage.
 ::
 /?  314
 /-  gh, plan-acct
 /+  gh-parse
-::  /ape/gh/split.hoon defines ++split, which splits a request
-::  at the end of the longest possible endpoint.
-::
-//  /%/split
 ::
 !:
 =>  |%
+    ++  place
+      $:  guard/mold
+          read-x/$-(path move)
+          read-y/$-(path move)
+          sigh-x/$-(jon/json (unit sub-result))
+          sigh-y/$-(jon/json (unit arch))
+      ==
     ++  move  (pair bone card)
     ++  sub-result
       $%  {$arch arch}
@@ -44,6 +47,106 @@
 |_  {hid/bowl cnt/@ hook/(map @t {id/@t listeners/(set bone)})}
 ++  prep  _`.
 ::
+::  List of endpoints
+::
+++  places
+  |=  wir/wire
+  =<  
+    ^-  (list place)
+    :~  ^-  place
+        :*  guard=$~
+            read-x=read-null
+            read-y=(read-static %issues ~)
+            sigh-x=sigh-strange
+            sigh-y=sigh-strange
+        ==
+        ^-  place
+        :*  guard={$issues $~}
+            read-x=read-null
+            read-y=(read-static %mine %by-repo ~)
+            sigh-x=sigh-strange
+            sigh-y=sigh-strange
+        ==
+        ^-  place
+        :*  guard={$issues $mine $~}
+            read-x=(read-get /issues)
+            read-y=(read-get /issues)
+            sigh-x=sigh-list-issues-x
+            sigh-y=sigh-list-issues-y
+        ==
+        ^-  place
+        :*  guard={$issues $by-repo $~}
+            read-x=read-null
+            ^=  read-y
+            |=  pax/path
+            =+  /(scot %p our.hid)/home/(scot %da now.hid)/web/plan
+            =+  .^({* acc/(map knot plan-acct)} %cx -)
+          ::
+            ((read-static usr:(~(got by acc) %github) ~) pax)
+            sigh-x=sigh-strange
+            sigh-y=sigh-strange
+        ==
+        ^-  place
+        :*  guard={$issues $by-repo @t $~}
+            read-x=read-null
+            read-y=|=(pax/path (get /users/[-.+>.pax]/repos))
+            sigh-x=sigh-strange
+            ^=  sigh-y
+            |=  jon/json
+            %+  bind  ((ar:jo repository:gh-parse) jon)
+            |=  repos/(list repository:gh)
+            :-  `(shax (jam repos))
+            (malt (turn repos |=(repository:gh [name ~])))
+        ==
+        ^-  place
+        :*  guard={$issues $by-repo @t @t $~}
+            read-x=|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues))
+            read-y=|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues))
+            sigh-x=sigh-list-issues-x
+            sigh-y=sigh-list-issues-y
+        ==
+    ==
+  =>
+    |%                              ::  generic helpers (should be library)
+    ++  read-null  |=(pax/path [ost.hid %diff %null ~])
+    ++  read-static
+      |=  children/(list @t)
+      |=  pax/path
+      [ost.hid %diff %arch ~ (malt (turn children |=(@t [+< ~])))]
+    ::
+    ++  read-get
+      |=  endpoint/path
+      |=  pax/path
+      (get endpoint)
+    ::
+    ++  sigh-strange  |=(jon/json ~)
+    ::
+    ++  get
+      |=  endpoint/path
+      ^-  move
+      :*  ost.hid  %hiss  wir  `~  %httr  %hiss
+          (endpoint-to-purl endpoint)  %get  ~  ~
+      ==
+    ::
+    ++  endpoint-to-purl
+      |=  endpoint/path
+      (scan "https://api.github.com{<`path`endpoint>}" auri:epur)
+    --
+  |%                                ::  gh-specific helpers
+  ++  sigh-list-issues-x
+    |=  jon/json
+    %+  bind  ((ar:jo issue:gh-parse) jon)
+    |=  issues/(list issue:gh)
+    gh-list-issues+issues
+  ::
+  ++  sigh-list-issues-y
+    |=  jon/json
+    %+  bind  ((ar:jo issue:gh-parse) jon)
+    |=  issues/(list issue:gh)
+    :-  `(shax (jam issues))
+    (malt (turn issues |=(issue:gh [(rsh 3 2 (scot %ui number)) ~])))
+  --
+::
 ::  This core manages everything related to a particular request.
 ::
 ::  Each request has a particular 'style', which is currently
@@ -68,93 +171,36 @@
     |=  mov/move
     +>.$(mow [mov mow])
   ::
-  ::  Produce null
-  ::
-  ++  send-null
-    (send ost.hid %diff %null ~)
-  ::
-  ::  Produce empty arch
-  ::
-  ++  send-null-arch
-    (send ost.hid %diff %arch ~ ~)
-  ::
-  ::  Append path to api.github.com and parse to a purl.
-  ::
-  ++  endpoint-to-purl
-    |=  endpoint/path
-    (scan "https://api.github.com{<`path`endpoint>}" auri:epur)
-  ::
   ::  Send a hiss
   ::
   ++  send-hiss 
     |=  hiz/hiss
     ^+  +>
-    =+  wir=`wire`[ren (scot %ud cnt) (scot %uv (jam arg)) style pax]
+    =+  wir=`wire`[ren style pax]
     (send ost.hid %hiss wir `~ %httr [%hiss hiz])
   ::
-  ::  Send a %get hiss
-  ::
-  ++  get
-    |=  endpoint/path
-    (send-hiss (endpoint-to-purl endpoint) %get ~ ~)
-  ::
   ::  Decide how to handle a request based on its style.
   ::
   ++  scry
     ^+  .
     ?+  style  ~|([%invalid-style style] !!)
-      $read     ?+(ren ~&([%invalid-care ren] !!) $x read-x, $y read-y)
+      $read     read
       $listen   listen
     ==
   ::
-  ++  read-x
-    ~&  [%read-x pax]
-    ?+    pax  ~&([%strange-path pax] send-null)
-        $~  send-null
-        {$issues *}
-      ?+    +.pax  ~&([%strange-path pax] send-null)
-          $~         send-null
-          {$mine *}  (get /issues)
-          {$by-repo *}
-        ?+  +>.pax  ~&([%strange-path pax] send-null)
-          $~          send-null
-          {@t $~}     send-null
-          {@t @t $~}  (get /repos/[-.+>.pax]/[-.+>+.pax]/issues)
-        ==
-      ==
-    ==
+  ::  Match to the endpoint in ++places and execute read-x or read-y
   ::
-  ++  read-y
-    ~&  [%read-y pax]
-    ?+    pax  ~&([%strange-path pax] send-null-arch)
-        $~  (send-children %issues ~)
-        {$issues *}
-      ?+    +.pax  ~&([%strange-path pax] send-null-arch)
-          $~            (send-children %mine %by-repo ~)
-          {$mine *}     (get /issues)
-          {$by-repo *}
-        ?+    +>.pax  ~&([%strange-path pax] send-null-arch)
-            $~
-          =+  /(scot %p our.hid)/home/(scot %da now.hid)/web/plan
-          =+  .^({* acc/(map knot plan-acct)} %cx -)
-          (send-children usr:(~(got by acc) %github) ~)
-        ::
-            {@t $~}     (get /users/[-.+>.pax]/repos)
-            {@t @t $~}  (get /repos/[-.+>.pax]/[-.+>+.pax]/issues)
-        ==
-      ==
-    ==
-  ::
-  ::  (send-hiss (endpoint-to-purl /issues) %get ~ ~)
-  ::
-  ::  Produce an arch with the given list of children
-  ::
-  ++  send-children
-    |=  children/(list @t)
-    %-  send  :*
-      ost.hid  %diff  %arch  ~
-      (malt (turn children |=(@t [+< ~])))
-    ==
+  ++  read
+    ~&  [%read pax]
+    =+  places=(places ren style pax)
+    |-  ^+  +>.$
+    ?~  places
+      ~&  [%strange-path pax]
+      (send ost.hid %diff ?+(ren !! $x null+~, $y arch+*arch))
+    =+  match=((soft guard.i.places) pax)
+    ?~  match
+      $(places t.places)
+    (send (?+(ren !! $x read-x.i.places, $y read-y.i.places) pax))
   ::
   ::  Create or update a webhook to listen for a set of events.
   ::
@@ -272,14 +318,15 @@
 ++  sigh-httr
   |=  {way/wire res/httr}
   ^-  {(list move) _+>.$}
-  ?.  ?=({care @ @ @ *} way)
+  ?.  ?=({care ?($read $listen) @ *} way)
     ~&  res=res
     [~ +>.$]
-  =+  arg=(path (cue (slav %uv i.t.t.way)))
-  =*  pax  t.t.t.way
+  =*  ren  i.way
+  =*  style  i.t.way
+  =*  pax  t.t.way
   :_  +>.$  :_  ~
   :+  ost.hid  %diff
-  ?+    i.way  null+~
+  ?+    ren  null+~
       $x
     ?~  r.res
       json+(jobe err+s+%empty-response code+(jone p.res) ~)
@@ -288,33 +335,18 @@
       json+(jobe err+s+%bad-json code+(jone p.res) body+s+q.u.r.res ~)
     ?.  =(2 (div p.res 100))
       json+(jobe err+s+%request-rejected code+(jone p.res) msg+u.jon ~)
-    ?+    +.pax  ~&([%sigh-strange-path pax] null+~)
-        {$issues $mine $~}
-      =+  issues=((ar:jo issue:gh-parse) u.jon)
-      ?~  issues
-        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
-        null+~
-      gh-list-issues+u.issues
-    ::
-        {$issues $by-repo @t @t $~}
-      =+  issues=((ar:jo issue:gh-parse) u.jon)
-      ?~  issues
-        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
-        null+~
-      gh-list-issues+u.issues
-    ==
-    ::  ::
-    ::  ::  Once we know we have good data, we drill into the JSON
-    ::  ::  to find the specific piece of data referred to by 'arg'
-    ::  ::
-    ::  |-  ^-  sub-result
-    ::  ?~  arg
-    ::    json+u.jon
-    ::  =+  dir=((om:jo some) u.jon)
-    ::  ?~  dir
-    ::    json+(jobe err+s+%json-not-object code+(jone p.res) body+u.jon ~)
-    ::  =+  new-jon=(~(get by u.dir) i.arg)
-    ::  $(arg t.arg, u.jon ?~(new-jon ~ u.new-jon))
+    =+  places=(places ren style pax)
+    |-  ^-  sub-result
+    ?~  places
+      ~&([%sigh-strange-path pax] null+~)
+    =+  match=((soft guard.i.places) pax)
+    ?~  match
+      $(places t.places)
+    =+  (sigh-x.i.places u.jon)
+    ?~  -
+      ~&  [err+s+%response-not-valid pax+pax code+(jone p.res) msg+u.jon]
+      null+~
+    u.-
   ::
       $y
     ?~  r.res
@@ -327,43 +359,18 @@
     ?.  =(2 (div p.res 100))
       ~&  [err+s+%request-rejected code+(jone p.res) msg+u.jon]
       arch+*arch
-    ?+    +.pax  ~&([%sigh-strange-path pax] arch+*arch)
-        {$issues $mine $~}
-      =+  issues=((ar:jo issue:gh-parse) u.jon)
-      ?~  issues
-        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
-        arch+*arch
-      :+  %arch  `(shax (jam u.issues))
-      (malt (turn u.issues |=(issue:gh [id ~])))
-    ::
-        {$issues $by-repo @t $~}
-      =+  repos=((ar:jo repository:gh-parse) u.jon)
-      ?~  repos
-        ~&  [err+s+%response-not-repos pax+pax code+(jone p.res) msg+u.jon]
-        arch+*arch
-      :+  %arch  `(shax (jam u.repos))
-      (malt (turn u.repos |=(repository:gh [name ~])))
-    ::
-        {$issues $by-repo @t @t $~}
-      =+  issues=((ar:jo issue:gh-parse) u.jon)
-      ?~  issues
-        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
-        arch+*arch
-      :+  %arch  `(shax (jam u.issues))
-      (malt (turn u.issues |=(issue:gh [(rsh 3 2 (scot %ui number)) ~])))
-    ==
-    ::  ::
-    ::  ::  Once we know we have good data, we drill into the JSON
-    ::  ::  to find the specific piece of data referred to by 'arg'
-    ::  ::
-    ::  |-  ^-  sub-result
-    ::  =+  dir=((om:jo some) u.jon)
-    ::  ?~  dir
-    ::    [%arch `(shax (jam u.jon)) ~]
-    ::  ?~  arg
-    ::    [%arch `(shax (jam u.jon)) (~(run by u.dir) _~)]
-    ::  =+  new-jon=(~(get by u.dir) i.arg)
-    ::  $(arg t.arg, u.jon ?~(new-jon ~ u.new-jon))
+    =+  places=(places ren style pax)
+    |-  ^-  sub-result
+    ?~  places
+      ~&([%sigh-strange-path pax] arch+*arch)
+    =+  match=((soft guard.i.places) pax)
+    ?~  match
+      $(places t.places)
+    =+  (sigh-y.i.places u.jon)
+    ?~  -
+      ~&  [err+s+%response-not-valid pax+pax code+(jone p.res) msg+u.jon]
+      arch+*arch
+    arch+u.-
   ==
 ::
 ++  sigh-tang
diff --git a/app/gh/split.hoon b/app/gh/split.hoon
deleted file mode 100644
index 7d853dc7ba..0000000000
--- a/app/gh/split.hoon
+++ /dev/null
@@ -1,179 +0,0 @@
-!:
-|%
-::  Splits a path into the endpoint prefix and the remainder,
-::  which is assumed to be a path within the JSON object.  We
-::  choose the longest legal endpoint prefix.
-::
-++  split
-  |=  pax/path
-  ::  =-  ~&  [%pax pax - (valid-endpoint pax)]  -
-  =+  l=(lent pax)
-  |-  ^-  {path path}
-  ?~  l
-    [~ pax]
-  ?:  ?=(valid-endpoint (scag l pax))
-    [(scag l pax) (slag l pax)]
-  $(l (dec l))
-::
-::  These are all the github GET endpoints, sorted with
-::  `env LC_ALL=C sort`
-::
-++  valid-endpoint
-  $?  {$emojis $~}
-      {$events $~}
-      {$feeds $~}
-      {$gists $public $~}
-      {$gists $starred $~}
-      {$gists gist-id/@ta $comments id/@ta $~}
-      {$gists gist-id/@ta $comments $~}
-      {$gists id/@ta $commits $~}
-      {$gists id/@ta $forks $~}
-      {$gists id/@ta $star $~}
-      {$gists id/@ta sha/@ta $~}
-      {$gists id/@ta $~}
-      {$gists $~}
-      {$gitignore $templates language/@ta $~}
-      {$gitignore $templates $~}
-      {$issues $~}
-      {$licenses license/@ta $~}
-      {$licenses $~}
-      {$meta $~}
-      {$networks onwer/@ta repo/@ta $events $~}
-      {$notifications $threads id/@ta $subscription $~}
-      {$notifications $threads id/@ta $~}
-      {$notifications $~}
-      {$organizations $~}
-      {$orgs org/@ta $events $~}
-      {$orgs org/@ta $hooks id/@ta $~}
-      {$orgs org/@ta $hooks $~}
-      {$orgs org/@ta $members username/@ta $~}
-      {$orgs org/@ta $members $~}
-      {$orgs org/@ta $memberships username/@ta $~}
-      {$orgs org/@ta $migrations id/@ta $archive $~}
-      {$orgs org/@ta $migrations id/@ta $~}
-      {$orgs org/@ta $migrations $~}
-      {$orgs org/@ta $'public_members' username/@ta $~}
-      {$orgs org/@ta $'public_members' $~}
-      {$orgs org/@ta $repos $~}
-      {$orgs org/@ta $teams $~}
-      {$orgs org/@ta $~}
-      {$'rate_limit' $~}
-      {$repos owner/@ta repo/@ta $assignees assignee/@ta $~}
-      {$repos owner/@ta repo/@ta $assignees $~}
-      {$repos owner/@ta repo/@ta $branches branch/@ta $~}
-      {$repos owner/@ta repo/@ta $branches $~}
-      {$repos owner/@ta repo/@ta $collaborators username/@ta $~}
-      {$repos owner/@ta repo/@ta $collaborators $~}
-      {$repos owner/@ta repo/@ta $comments id/@ta $~}
-      {$repos owner/@ta repo/@ta $comments $~}
-      {$repos owner/@ta repo/@ta $commits ref/@ta $comments $~}
-      {$repos owner/@ta repo/@ta $commits ref/@ta $status $~}
-      {$repos owner/@ta repo/@ta $commits ref/@ta $statuses $~}
-      {$repos owner/@ta repo/@ta $commits sha/@ta $~}
-      {$repos owner/@ta repo/@ta $commits $~}
-      {$repos owner/@ta repo/@ta $compare base-head/@ta $~}
-      {$repos owner/@ta repo/@ta $contents path/@ta $~}
-      {$repos owner/@ta repo/@ta $contributors $~}
-      {$repos owner/@ta repo/@ta $deployments id/@ta $statuses $~}
-      {$repos owner/@ta repo/@ta $deployments $~}
-      {$repos owner/@ta repo/@ta $events $~}
-      {$repos owner/@ta repo/@ta $forks $~}
-      {$repos owner/@ta repo/@ta $git $blobs sha/@ta $~}
-      {$repos owner/@ta repo/@ta $git $commits sha/@ta $~}
-      {$repos owner/@ta repo/@ta $git $refs ref/@ta $~}
-      {$repos owner/@ta repo/@ta $git $refs $~}
-      {$repos owner/@ta repo/@ta $git $tags sha/@ta $~}
-      {$repos owner/@ta repo/@ta $git $trees sha/@ta $~}
-      {$repos owner/@ta repo/@ta $hooks id/@ta $~}
-      {$repos owner/@ta repo/@ta $hooks $~}
-      {$repos owner/@ta repo/@ta $issues $comments id/@ta $~}
-      {$repos owner/@ta repo/@ta $issues $comments $~}
-      {$repos owner/@ta repo/@ta $issues $events id/@ta $~}
-      {$repos owner/@ta repo/@ta $issues $events $~}
-      {$repos owner/@ta repo/@ta $issues issue-number/@ta $events $~}
-      {$repos owner/@ta repo/@ta $issues number/@ta $comments $~}
-      {$repos owner/@ta repo/@ta $issues number/@ta $labels $~}
-      {$repos owner/@ta repo/@ta $issues number/@ta $~}
-      {$repos owner/@ta repo/@ta $issues $~}
-      {$repos owner/@ta repo/@ta $keys id/@ta $~}
-      {$repos owner/@ta repo/@ta $keys $~}
-      {$repos owner/@ta repo/@ta $labels name/@ta $~}
-      {$repos owner/@ta repo/@ta $labels $~}
-      {$repos owner/@ta repo/@ta $language $~}
-      {$repos owner/@ta repo/@ta $license $~}
-      {$repos owner/@ta repo/@ta $milestones number/@ta $labels $~}
-      {$repos owner/@ta repo/@ta $milestones number/@ta $~}
-      {$repos owner/@ta repo/@ta $milestones $~}
-      {$repos owner/@ta repo/@ta $notifications $~}
-      {$repos owner/@ta repo/@ta $pages $builds $latest $~}
-      {$repos owner/@ta repo/@ta $pages $builds $~}
-      {$repos owner/@ta repo/@ta $pages $~}
-      {$repos owner/@ta repo/@ta $pulls $comments id/@ta $~}
-      {$repos owner/@ta repo/@ta $pulls $comments $~}
-      {$repos owner/@ta repo/@ta $pulls number/@ta $comments $~}
-      {$repos owner/@ta repo/@ta $pulls number/@ta $commits $~}
-      {$repos owner/@ta repo/@ta $pulls number/@ta $files $~}
-      {$repos owner/@ta repo/@ta $pulls number/@ta $merge $~}
-      {$repos owner/@ta repo/@ta $pulls number/@ta $~}
-      {$repos owner/@ta repo/@ta $pulls $~}
-      {$repos owner/@ta repo/@ta $readme $~}
-      {$repos owner/@ta repo/@ta $releases $assets id/@ta $~}
-      {$repos owner/@ta repo/@ta $releases $latest $~}
-      {$repos owner/@ta repo/@ta $releases $tags tag/@ta $~}
-      {$repos owner/@ta repo/@ta $releases id/@ta $assets $~}
-      {$repos owner/@ta repo/@ta $releases id/@ta $~}
-      {$repos owner/@ta repo/@ta $releases $~}
-      {$repos owner/@ta repo/@ta $stargazers $~}
-      {$repos owner/@ta repo/@ta $stats $'commit_activity' $~}
-      {$repos owner/@ta repo/@ta $stats $contributors $~}
-      {$repos owner/@ta repo/@ta $stats $participation $~}
-      {$repos owner/@ta repo/@ta $stats $'punch_card' $~}
-      {$repos owner/@ta repo/@ta $subscribers $~}
-      {$repos owner/@ta repo/@ta $subscription $~}
-      {$repos owner/@ta repo/@ta $tags $~}
-      {$repos owner/@ta repo/@ta $teams $~}
-      {$repos owner/@ta repo/@ta archive-format/@ta ref/@ta $~}
-      {$repos owner/@ta repo/@ta $~}
-      {$repositories $~}
-      {$search $code $~}
-      {$search $issues $~}
-      {$search $repositories $~}
-      {$search $users $~}
-      {$teams id/@ta $members $~}
-      {$teams id/@ta $memberships username/@ta $~}
-      {$teams id/@ta $repos owner/@ta repo/@ta $~}
-      {$teams id/@ta $~}
-      {$user $emails $~}
-      {$user $followers $~}
-      {$user $following username/@ta $~}
-      {$user $following $~}
-      {$user $issues $~}
-      {$user $keys id/@ta $~}
-      {$user $keys $~}
-      {$user $memberships $orgs org/@ta $~}
-      {$user $memberships $orgs $~}
-      {$user $orgs $~}
-      {$user $repos $~}
-      {$user $starred owner/@ta repo/@ta $~}
-      {$user $starred $~}
-      {$user $subscriptions $~}
-      {$user $teams $~}
-      {$user username/@ta $orgs $~}
-      {$user $~}
-      {$users username/@ta $events $orgs org/@ta $~}
-      {$users username/@ta $events $public $~}
-      {$users username/@ta $events $~}
-      {$users username/@ta $followers $~}
-      {$users username/@ta $following target-user/@ta $~}
-      {$users username/@ta $following $~}
-      {$users username/@ta $gists $~}
-      {$users username/@ta $keys $~}
-      {$users username/@ta $'received_events' $public $~}
-      {$users username/@ta $'received_events' $~}
-      {$users username/@ta $starred $~}
-      {$users username/@ta $subscriptions $~}
-      {$users username/@ta $~}
-      {$users usernmae/@ta $repos $~}
-      {$users $~}
-  ==
---