Initial prototype works, interface needs cleanup

urbit/app/simple.hoon

@@ -0,0 +1,75 @@
+/+  verb, dbug, sss
+::
+=>
+  |%
+  ++  in
+    |%
+    ++  rock
+      $%  [[%foo %bar ~] (list cord)]
+      ==
+    +$  wave
+      $%  [[%foo %bar ~] cord]
+      ==
+    ++  wash
+      |=  [rok=rock wav=wave]
+      ^+  rok
+      ?>  =(-.rok -.wav)
+      [-.rok [+.wav +.rok]]
+    --
+  ++  out
+    |%
+    ++  rock  (list cord)
+    ++  wave  cord
+    ++  wash
+      |=  [xs=(list cord) x=cord]
+      ^+  xs
+      [x xs]
+    --
+  --
+::
+%-  agent:dbug
+%+  verb  &
+::
+=/  sss  (sss out in)
+%-  mk-agent:sss
+^-  agent:sss
+::
+|_  =bowl:gall
++*  this  .
+::
+++  on-init  `this
+++  on-save  *vase
+++  on-load  _`this
+::
+++  on-poke
+  |=  [=mark =vase]
+  ^-  (quip card:sss _this)
+  ?+    mark  !!
+      %add
+    :_  this
+    [%give %wave /foo/bar !<(cord vase)]~
+  ::
+      %surf
+    :_  this
+    [%pass /start/surf %agent [!<(@p vase) %simple] %surf /foo/bar]~
+  ==
+::
+++  on-agent  _`this
+++  on-wave
+  |=  [=rock:in wave=(unit wave:in)]
+  =-  ?~  wave  -
+      ?>  =(-.rock -.u.wave)
+      -
+  ?-    -.rock
+      [%foo %bar ~]
+    ~&  >
+      "received rock {<rock>} and wave {<wave>}"
+    `this
+  ==
+::
+++  on-arvo   _`this
+++  on-peek   _~
+++  on-watch  _`this
+++  on-leave  _`this
+++  on-fail   _`this
+--

urbit/desk.bill

@@ -0,0 +1,2 @@
+:~  %simple
+==

urbit/desk.docket-0

@@ -0,0 +1,9 @@
+:~  title+'SSS'
+    info+'Solid state subscriptions prototyping.'
+    color+0x11.8c4f
+    site+/apps/sss
+    base+'sss'
+    version+[0 0 1]
+    website+'https://urbit.org'
+    license+'AGPL'
+==

urbit/lib/docket.hoon

@@ -0,0 +1,223 @@
+/-  *docket
+|%
+::
+++  mime
+  |%
+  +$  draft
+    $:  title=(unit @t)
+        info=(unit @t)
+        color=(unit @ux)
+        glob-http=(unit [=url hash=@uvH])
+        glob-ames=(unit [=ship hash=@uvH])
+        base=(unit term)
+        site=(unit path)
+        image=(unit url)
+        version=(unit version)
+        website=(unit url)
+        license=(unit cord)
+    ==
+  ::
+  ++  finalize
+    |=  =draft
+    ^-  (unit docket)
+    ?~  title.draft  ~
+    ?~  info.draft  ~
+    ?~  color.draft  ~
+    ?~  version.draft  ~
+    ?~  website.draft  ~
+    ?~  license.draft  ~
+    =/  href=(unit href)
+      ?^  site.draft  `[%site u.site.draft]
+      ?~  base.draft  ~
+      ?^  glob-http.draft
+        `[%glob u.base hash.u.glob-http %http url.u.glob-http]:draft
+      ?~  glob-ames.draft
+        ~
+      `[%glob u.base hash.u.glob-ames %ames ship.u.glob-ames]:draft
+    ?~  href  ~
+    =,  draft
+    :-  ~
+    :*  %1
+        u.title
+        u.info
+        u.color
+        u.href
+        image
+        u.version
+        u.website
+        u.license
+    ==
+  ::
+  ++  from-clauses
+    =|  =draft
+    |=  cls=(list clause)
+    ^-  (unit docket)
+    =*  loop  $
+    ?~  cls  (finalize draft)
+    =*  clause  i.cls
+    =.  draft
+      ?-  -.clause
+        %title  draft(title `title.clause)
+        %info   draft(info `info.clause)
+        %color  draft(color `color.clause)
+        %glob-http   draft(glob-http `[url hash]:clause)
+        %glob-ames   draft(glob-ames `[ship hash]:clause)
+        %base   draft(base `base.clause)
+        %site   draft(site `path.clause)
+        %image  draft(image `url.clause)
+        %version  draft(version `version.clause)
+        %website  draft(website `website.clause)
+        %license  draft(license `license.clause)
+      ==
+    loop(cls t.cls)
+  ::
+  ++  to-clauses
+    |=  d=docket
+    ^-  (list clause)
+    %-  zing
+    :~  :~  title+title.d
+            info+info.d
+            color+color.d
+            version+version.d
+            website+website.d
+            license+license.d
+        ==
+        ?~  image.d  ~  ~[image+u.image.d]
+        ?:  ?=(%site -.href.d)  ~[site+path.href.d]
+        =/  ref=glob-reference  glob-reference.href.d
+        :~  base+base.href.d
+            ?-  -.location.ref
+              %http  [%glob-http url.location.ref hash.ref]
+              %ames  [%glob-ames ship.location.ref hash.ref]
+    ==  ==  ==
+  ::
+  ++  spit-clause
+    |=  =clause
+    ^-  tape
+    %+  weld  "  {(trip -.clause)}+"
+    ?+  -.clause  "'{(trip +.clause)}'"
+      %color  (scow %ux color.clause)
+      %site   (spud path.clause)
+    ::
+        %glob-http
+      "['{(trip url.clause)}' {(scow %uv hash.clause)}]"
+    ::
+        %glob-ames
+      "[{(scow %p ship.clause)} {(scow %uv hash.clause)}]"
+    ::
+        %version
+      =,  version.clause
+      "[{(scow %ud major)} {(scow %ud minor)} {(scow %ud patch)}]"
+    ==
+  ::
+  ++  spit-docket
+    |=  dock=docket
+    ^-  tape
+    ;:  welp
+      ":~\0a"
+      `tape`(zing (join "\0a" (turn (to-clauses dock) spit-clause)))
+      "\0a=="
+    ==
+  --
+::
+++  enjs
+  =,  enjs:format
+  |%
+  ::
+  ++  charge-update
+    |=  u=^charge-update
+    ^-  json
+    %+  frond  -.u
+    ^-  json
+    ?-  -.u
+      %del-charge  s+desk.u
+    ::
+        %initial
+      %-  pairs
+      %+  turn  ~(tap by initial.u)
+      |=([=desk c=^charge] [desk (charge c)])
+    ::
+        %add-charge
+      %-  pairs
+      :~  desk+s+desk.u
+          charge+(charge charge.u)
+      ==
+    ==
+  ::
+  ++  num
+    |=  a=@u
+    ^-  ^tape
+    =/  p=json  (numb a)
+    ?>  ?=(%n -.p)
+    (trip p.p)
+  ::
+  ++  version
+    |=  v=^version
+    ^-  json
+    :-  %s
+    %-  crip
+    "{(num major.v)}.{(num minor.v)}.{(num patch.v)}"
+  ::
+  ++  merge
+    |=  [a=json b=json]
+    ^-  json
+    ?>  &(?=(%o -.a) ?=(%o -.b))
+    [%o (~(uni by p.a) p.b)]
+  ::
+  ++  href
+    |=  h=^href
+    %+  frond  -.h
+    ?-    -.h
+        %site  s+(spat path.h)
+        %glob
+      %-  pairs
+      :~  base+s+base.h
+          glob-reference+(glob-reference glob-reference.h)
+      ==
+    ==
+  ::
+  ++  glob-reference
+    |=  ref=^glob-reference
+    %-  pairs
+    :~  hash+s+(scot %uv hash.ref)
+        location+(glob-location location.ref)
+    ==
+  ::
+  ++  glob-location
+    |=  loc=^glob-location
+    ^-  json
+    %+  frond  -.loc
+    ?-  -.loc
+      %http  s+url.loc
+      %ames  s+(scot %p ship.loc)
+    ==
+  ::
+  ++  charge
+    |=  c=^charge
+    %+  merge  (docket docket.c)
+    %-  pairs
+    :~  chad+(chad chad.c)
+    ==
+  ::
+  ++  docket
+    |=  d=^docket
+    ^-  json
+    %-  pairs
+    :~  title+s+title.d
+        info+s+info.d
+        color+s+(scot %ux color.d)
+        href+(href href.d)
+        image+?~(image.d ~ s+u.image.d)
+        version+(version version.d)
+        license+s+license.d
+        website+s+website.d
+    ==
+  ::
+  ++  chad
+    |=  c=^chad
+    %+  frond  -.c
+    ?+  -.c  ~
+      %hung  s+err.c
+    ==
+  --
+--

urbit/lib/sss.hoon

@@ -0,0 +1,267 @@
+/-  *sss
+::
+|*  [pub=(lake) sub=(lake)]
+|%
+++  adit
+  |*  [=wire =(lake)]
+  %+  slap  !>([lake=lake ..zuse])
+  ^-  spec
+  :-  %ktcl
+  :-  %bccl
+  :~  :-  %bccl
+      ;;  (lest spec)
+      %-  snoc  :_  base/%null
+      %+  turn  wire
+      |=  =term
+      ^-  spec
+      [%leaf %tas `@`term]
+  ::
+      [%like ~[%rock] ~[~[%lake]]]
+  ==
+::
+++  agent
+  $_  ^|
+  |_  =bowl:agent:gall
+  ++  on-init                                   *(quip card _^|(..on-init))
+  ++  on-save                                   *vase
+  ++  on-load   |~  vase                        *(quip card _^|(..on-init))
+  ++  on-poke   |~  [mark vase]                 *(quip card _^|(..on-init))
+  ++  on-watch  |~  path                        *(quip card _^|(..on-init))
+  ++  on-leave  |~  path                        *(quip card _^|(..on-init))
+  ++  on-peek   |~  path                        *(unit (unit cage))
+  ++  on-agent  |~  [wire sign:agent:gall]      *(quip card _^|(..on-init))
+  ++  on-wave   |~  [rock:sub (unit wave:sub)]  *(quip card _^|(..on-init))
+  ++  on-arvo   |~  [wire sign-arvo]            *(quip card _^|(..on-init))
+  ++  on-fail   |~  [term tang]                 *(quip card _^|(..on-init))
+  --
++$  act
+  $%  [%on-init *]
+      [%on-watch path]
+  ==
+::
++$  card  (wind note gift)
++$  note
+  $%  [%agent [=ship name=term] =task]
+      [%arvo note-arvo]
+      [%pyre =tang]
+  ==
++$  task
+  $%  [%surf =path]
+      task:agent:gall
+  ==
++$  gift
+  $%  [%wave =path =wave:pub]
+      gift:agent:gall
+  == 
+::
++$  state
+  $:  exo=(map [ship dude path] (pair @ud rock:sub))
+      endo=(map path tide)
+      =agent
+  ==
++$  tide
+  $:  pine=[aeon=@ud =rock:pub]
+      wait=((mop @ud (set (pair ship dude))) lte)
+      book=((mop @ud wave:pub) gte)
+  ==
+++  wait  ((on @ud (set (pair ship dude))) lte)
+++  book  ((on @ud wave:pub) gte)
+++  zoom  |=  =path  `^path`$/sss/path
+::
+++  mk-agent
+  |=  inner=agent
+  ::
+  =|  state
+  =.  agent  inner
+  =*  state  -
+  |^
+  ^-  agent:gall
+  |_  =bowl:gall
+  +*  ag       ~(. agent bowl)
+      this     .
+      handler  ~(sss-engine hc bowl)
+  ::
+  ++  on-init
+    =^  cards  state  (run:handler on-init:ag)
+    [cards this]
+  ::
+  ++  on-save
+    %+  slop  on-save:ag
+    !>([%sss exo endo])
+  ::
+  ++  on-load
+    |=  =vase
+    =/  old  !<([%sss =_exo =_endo] (slot 3 vase))
+    =.  exo   exo.old
+    =.  endo  endo.old
+    =^  cards  state  (run:handler (on-load:ag (slot 2 vase)))
+    [cards this]
+  ::
+  ++  on-poke
+    |=  [=mark =vase]
+    ?+      mark
+          =^  cards  state  (run:handler (on-poke:ag +<))
+          [cards this]
+        %sss-request
+      =^  cards  state  abet:(request:handler !<(request:poke vase))
+      [cards this]
+    ::
+        %sss-response
+      =^  cards  state  abet:(response:handler !<((response:poke sub) vase))
+      [cards this]
+    ==
+  ++  on-watch
+    |=  path
+    =^  cards  state  (run:handler (on-watch:ag +<))
+    [cards this]
+  ::
+  ++  on-leave
+    |=  path
+    =^  cards  state  (run:handler (on-leave:ag +<))
+    [cards this]
+  ::
+  ++  on-peek  on-peek:ag
+  ::
+  ++  on-agent
+    |=  [=wire =sign:agent:gall]
+    ?.  ?=([~ %sss *] wire)
+      =^  cards  state  (run:handler (on-agent:ag +<))
+      [cards this]
+    ?.  ?=(%poke-ack -.sign)  `this
+    ?~  p.sign  `this
+    ((slog u.p.sign) `this)
+  ::
+  ++  on-arvo
+    |=  [wire sign-arvo]
+    =^  cards  state  (run:handler (on-arvo:ag +<))
+    [cards this]
+  ::
+  ++  on-fail
+    |=  [term tang]
+    =^  cards  state  (run:handler (on-fail:ag +<))
+    [cards this]
+  ::
+  --
+  ::
+  ++  hc
+    |_  =bowl:gall
+    ++  sss-engine
+      |_  cards=(list card:agent:gall)
+      +*  ag    ~(. agent bowl)
+      ++  this  .
+      ++  emit  |=(=card:agent:gall this(cards [card cards]))
+::    ++  emil  |=(cs=_cards this(cards (weld cs cards)))  ::TODO roll?
+      ++  abet  [(flop cards) state]
+      ::
+      ++  run
+        |=  res=(quip card ^agent)
+        ^-  (quip card:agent:gall _state)
+        =^  cards  agent  res
+        abet:(output cards)
+      ::
+      ++  request
+        |=  req=request:poke
+        ^+  this
+        ?-    -.req
+            %pine
+          %-  emit
+          :*  %pass   (zoom response/pine/(scot %p src.bowl)^from.req^path.req)
+              %agent  [src.bowl from.req]
+              %poke   :-  %sss-response  !> ::  ^-  response:poke
+              =/  last  pine:(~(gut by endo) path.req *tide)
+              [%pine dap.bowl aeon.last path.req rock.last]
+          ==
+        ::
+            %scry
+          ?^  wave=(get:book book:(~(got by endo) path.req) aeon.req)
+            (respond-scry src.bowl u.wave +.req)
+          %=    this
+              endo
+            %+  ~(jab by endo)  path.req
+            |=  =tide
+            %=    tide
+                wait
+              (put:wait wait.tide aeon.req *(set [ship dude]))
+            ==
+          ==
+        ==
+      ::
+      ++  enqueue
+        |=  [=dude =path aeon=@ud]
+        ^+  endo
+        %+  ~(jab by endo)  path
+        |=  =tide
+        %=    tide
+            wait
+          %^  put:wait  wait.tide  aeon
+          %-  ~(put in (fall (get:wait wait.tide aeon) ~))
+          [src.bowl dude]
+        ==
+      ::
+      ++  respond-scry
+        |=  [=ship =wave:pub =dude =path aeon=@ud]
+        ^+  this
+        %-  emit
+        :*  %pass   (zoom response/scry/(scot %p ship)^dude^(scot %ud aeon)^path)
+            %agent  [ship dude]
+            %poke   :-  %sss-response  !> ::  ^-  response:poke
+            [%scry dap.bowl aeon path wave]
+        ==
+      ::
+      ++  response
+        |=  res=(response:poke sub)
+        ^+  this
+        =/  old  (~(gut by exo) [src.bowl from.res &4.res] *[@ud rock:sub])
+        =/  new
+          ?-    -.res
+              %pine
+            ?>  |((gth aeon.res -.old) =(+.old rock.res))
+            [rock.res ~]
+          ::
+              %scry
+            ?>  =(aeon.res +(-.old))
+            [(wash:sub +.old wave.res) `wave.res]
+          ==
+        =^  cards  agent  (on-wave:ag new)
+        =.  exo
+          (~(put by exo) [src.bowl from.res &4.res] aeon.res -.new)
+        %-  output
+        :_  cards
+        :*  %pass   (zoom request/scry/(scot %p src.bowl)^from.res^(scot %ud +(aeon.res))^&4.res)
+            %agent  [src.bowl from.res]
+            %poke   :-  %sss-request  !>  ^-  request:poke
+            [%scry dap.bowl &4.res +(aeon.res)]
+        ==
+      ::
+      ++  wave
+        |=  [=path =wave:pub]
+        ^+  this
+        =/  =tide  (~(gut by endo) path *tide)
+        =/  next  +(key:(fall (pry:book book.tide) [key=0 value=*wave:pub]))
+        =^  waiting=(unit (set (pair ship dude)))  wait.tide  (del:wait wait.tide next)
+        =.  endo  (~(put by endo) path tide(book (put:book book.tide next wave)))
+        ?~  waiting  this
+        %-  ~(rep in u.waiting)
+        |=  [[=ship =dude] =_this]
+        ^+  this
+        (respond-scry:this ship wave dude path next) ::TODO does this really work?
+      ::
+      ++  output
+        |=  cs=(list card)
+        %+  roll  cs
+        |=  [=card =_this]
+        ?+    card  (emit `card:agent:gall`card)
+            [%slip %agent * %surf *]    ~|(%slip-surf !!)
+            [%give %wave *]             (wave +.p.card)
+            [%pass * %agent * %surf *]
+          %-  emit
+          :*  %pass   (zoom request/pine/(scot %p ship.&4.card)^name.&4.card^p.card)
+              %agent  &4.card
+              %poke   :-  %sss-request
+              !>(`request:poke`[%pine dap.bowl path.task.q.card])
+          ==
+        ==
+      --
+    --
+  --
+--

urbit/mar/docket-0.hoon

@@ -0,0 +1,25 @@
+/+  dock=docket
+|_  =docket:dock
+++  grow
+  |%
+  ++  mime  
+    ^-  ^mime
+    [/text/x-docket (as-octt:mimes:html (spit-docket:mime:dock docket))]
+  ++  noun  docket
+  ++  json  (docket:enjs:dock docket)
+  --
+++  grab
+  |%
+  ::
+  ++  mime
+    |=  [=mite len=@ud tex=@]
+    ^-  docket:dock
+    %-  need
+    %-  from-clauses:mime:dock
+    !<((list clause:dock) (slap !>(~) (ream tex)))
+
+  ::
+  ++  noun  docket:dock
+  --
+++  grad  %noun
+--

urbit/mar/sss/request.hoon

@@ -0,0 +1,12 @@
+/-  *sss
+|_  =request:poke
+++  grow
+  |%
+  ++  noun  request
+  --
+++  grab
+  |%
+  ++  noun  request:poke
+  --
+++  grad  %noun
+--

urbit/mar/sss/response.hoon

@@ -0,0 +1,12 @@
+/-  *sss
+|_  =(response:poke)
+++  grow
+  |%
+  ++  noun  response
+  --
+++  grab
+  |%
+  ++  noun  (response:poke)
+  --
+++  grad  %noun
+--

urbit/sur/docket.hoon

@@ -0,0 +1,82 @@
+|%
+::
++$  version
+  [major=@ud minor=@ud patch=@ud]
+::
++$  glob  (map path mime)
+::
++$  url   cord
+::  $glob-location: How to retrieve a glob
+::
++$  glob-reference
+  [hash=@uvH location=glob-location]
+::
++$  glob-location
+  $%  [%http =url]
+      [%ames =ship]
+  ==
+::  $href: Where a tile links to
+::
++$  href
+  $%  [%glob base=term =glob-reference]
+      [%site =path]
+  ==
+::  $chad: State of a docket
+::
++$  chad
+  $~  [%install ~]
+  $%  :: Done
+      [%glob =glob]
+      [%site ~]
+      :: Waiting
+      [%install ~]
+      [%suspend glob=(unit glob)]
+      :: Error
+      [%hung err=cord]
+  ==
+::
+::  $charge: A realized $docket
+::
++$  charge
+  $:  =docket
+      =chad
+  ==
+::
+::  $clause: A key and value, as part of a docket
+::
+::    Only used to parse $docket
+::
++$  clause
+  $%  [%title title=@t]
+      [%info info=@t]
+      [%color color=@ux]
+      [%glob-http url=cord hash=@uvH]
+      [%glob-ames =ship hash=@uvH]
+      [%image =url]
+      [%site =path]
+      [%base base=term]
+      [%version =version]
+      [%website website=url]
+      [%license license=cord]
+  ==
+::
+::  $docket: A description of JS bundles for a desk
+::
++$  docket
+  $:  %1
+      title=@t
+      info=@t
+      color=@ux
+      =href
+      image=(unit url)
+      =version
+      website=url
+      license=cord
+  ==
+::
++$  charge-update
+  $%  [%initial initial=(map desk charge)]
+      [%add-charge =desk =charge]
+      [%del-charge =desk]
+  ==
+--

urbit/sur/sss.hoon

@@ -0,0 +1,23 @@
+|%
+++  lake
+  |$  [rock wave]
+  $_  ^?
+  |%
+  +$  rock  ^rock
+  +$  wave  ^wave
+  ++  wash  |~  [rock wave]  *rock
+  --
++$  dude  dude:agent:gall
+++  poke
+  |%
+  +$  request
+    $%  [%pine from=dude =path]
+        [%scry from=dude =path aeon=@ud]
+    ==
+  ++  response
+    |*  sub=(lake)
+    $%  [%pine from=dude aeon=@ud =rock:sub]
+        [%scry from=dude aeon=@ud =wave:sub]
+    ==
+  --
+--