/- sur=graph-store, pos=post /+ res=resource =< [sur .] =< [pos .] =, sur =, pos |% :: ++ update-log-to-one |= =update-log:zero ^- ^update-log %+ gas:orm-log *^update-log %+ turn (tap:orm-log:zero update-log) |= [=time =logged-update:zero] :- time :- p.logged-update (logged-update-to-one q.logged-update) :: ++ logged-update-to-one |= upd=logged-update-0:zero ?+ -.upd upd %add-graph upd(graph (graph-to-one graph.upd)) %add-nodes upd(nodes (~(run by nodes.upd) node-to-one)) == :: ++ node-to-one |= =node:zero (node:(upgrade ,post:zero ,post) node post-to-one) :: ++ graph-to-one |= =graph:zero (graph:(upgrade ,post:zero ,post) graph post-to-one) :: ++ marked-graph-to-one |= [=graph:zero m=(unit mark)] [(graph-to-one graph) m] :: ++ post-to-one |= p=post:zero ^- post p(contents (contents-to-one contents.p)) :: ++ contents-to-one |= cs=(list content:zero) ^- (list content) %+ murn cs |= =content:zero ^- (unit ^content) ?: ?=(%reference -.content) ~ `content :: ++ upgrade |* [in-pst=mold out-pst=mold] => |% ++ in-orm ((ordered-map atom in-node) gth) +$ in-node [post=in-pst children=in-internal-graph] +$ in-graph ((mop atom in-node) gth) +$ in-internal-graph $~ [%empty ~] $% [%graph p=in-graph] [%empty ~] == :: ++ out-orm ((ordered-map atom out-node) gth) +$ out-node [post=out-pst children=out-internal-graph] +$ out-graph ((mop atom out-node) gth) +$ out-internal-graph $~ [%empty ~] $% [%graph p=out-graph] [%empty ~] == -- |% :: ++ graph |= $: gra=in-graph fn=$-(in-pst out-pst) == ^- out-graph %+ gas:out-orm *out-graph ^- (list [atom out-node]) %+ turn (tap:in-orm gra) |= [a=atom n=in-node] ^- [atom out-node] [a (node n fn)] :: ++ node |= [nod=in-node fn=$-(in-pst out-pst)] ^- out-node :- (fn post.nod) ^- out-internal-graph ?: ?=(%empty -.children.nod) [%empty ~] [%graph (graph p.children.nod fn)] -- :: NOTE: move these functions to zuse ++ nu :: parse number as hex |= jon=json ?> ?=([%s *] jon) (rash p.jon hex) :: ++ re :: recursive reparsers |* [gar=* sef=_|.(fist:dejs-soft:format)] |= jon=json ^- (unit _gar) =- ~! gar ~! (need -) - ((sef) jon) :: ++ dank :: tank ^- $-(json (unit tank)) =, ^? dejs-soft:format %+ re *tank |. ~+ %- of :~ leaf+sa palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~) rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~) == :: ++ orm ((ordered-map atom node) gth) ++ orm-log ((ordered-map time logged-update) gth) :: ++ enjs =, enjs:format |% :: ++ signatures |= s=^signatures ^- json [%a (turn ~(tap in s) signature)] :: ++ signature |= s=^signature ^- json %- pairs :~ [%signature s+(scot %ux p.s)] [%ship (ship q.s)] [%life (numb r.s)] == :: ++ index |= ind=^index ^- json :- %s ?: =(~ ind) '/' %+ roll ind |= [cur=@ acc=@t] ^- @t =/ num (numb cur) ?> ?=(%n -.num) (rap 3 acc '/' p.num ~) :: ++ uid |= u=^uid ^- json %- pairs :~ [%resource (enjs:res resource.u)] [%index (index index.u)] == :: ++ content |= c=^content ^- json ?- -.c %mention (frond %mention (ship ship.c)) %text (frond %text s+text.c) %url (frond %url s+url.c) %reference (frond %reference (reference +.c)) %code %+ frond %code %- pairs :- [%expression s+expression.c] :_ ~ :- %output :: virtualize output rendering, +tank:enjs:format might crash :: =/ result=(each (list json) tang) (mule |.((turn output.c tank))) ?- -.result %& a+p.result %| a+[a+[%s '[[output rendering error]]']~]~ == == :: ++ reference |= ref=^reference |^ %+ frond -.ref ?- -.ref %graph (graph +.ref) %group (group +.ref) == :: ++ graph |= [grp=res gra=res idx=^index] %- pairs :~ graph+s+(enjs-path:res gra) group+s+(enjs-path:res grp) index+(index idx) == :: ++ group |= grp=res s+(enjs-path:res grp) -- :: ++ post |= p=^post ^- json %- pairs :~ [%author (ship author.p)] [%index (index index.p)] [%time-sent (time time-sent.p)] [%contents [%a (turn contents.p content)]] [%hash ?~(hash.p ~ s+(scot %ux u.hash.p))] [%signatures (signatures signatures.p)] == :: ++ update |= upd=^update ^- json |^ (frond %graph-update (pairs ~[(encode q.upd)])) :: ++ encode |= upd=action ^- [cord json] ?- -.upd %add-graph :- %add-graph %- pairs :~ [%resource (enjs:res resource.upd)] [%graph (graph graph.upd)] [%mark ?~(mark.upd ~ s+u.mark.upd)] [%overwrite b+overwrite.upd] == :: %remove-graph [%remove-graph (enjs:res resource.upd)] :: %add-nodes :- %add-nodes %- pairs :~ [%resource (enjs:res resource.upd)] [%nodes (nodes nodes.upd)] == :: %remove-nodes :- %remove-nodes %- pairs :~ [%resource (enjs:res resource.upd)] [%indices (indices indices.upd)] == :: %add-signatures :- %add-signatures %- pairs :~ [%uid (uid uid.upd)] [%signatures (signatures signatures.upd)] == :: %remove-signatures :- %remove-signatures %- pairs :~ [%uid (uid uid.upd)] [%signatures (signatures signatures.upd)] == :: %add-tag :- %add-tag %- pairs :~ [%term s+term.upd] [%resource (enjs:res resource.upd)] == :: %remove-tag :- %remove-tag %- pairs :~ [%term s+term.upd] [%resource (enjs:res resource.upd)] == :: %archive-graph [%archive-graph (enjs:res resource.upd)] :: %unarchive-graph [%unarchive-graph (enjs:res resource.upd)] :: %keys [%keys [%a (turn ~(tap in resources.upd) enjs:res)]] :: %tags [%tags [%a (turn ~(tap in tags.upd) |=(=term s+term))]] :: %run-updates [%run-updates ~] :: %tag-queries :- %tag-queries %- pairs %+ turn ~(tap by tag-queries.upd) |= [=term =resources] ^- [cord json] [term [%a (turn ~(tap in resources) enjs:res)]] == :: ++ graph |= g=^graph ^- json %- pairs %+ turn (tap:orm g) |= [a=atom n=^node] ^- [@t json] :_ (node n) =/ idx (numb a) ?> ?=(%n -.idx) p.idx :: ++ node |= n=^node ^- json %- pairs :~ [%post (post post.n)] :- %children ?- -.children.n %empty ~ %graph (graph +.children.n) == == :: :: ++ nodes |= m=(map ^index ^node) ^- json %- pairs %+ turn ~(tap by m) |= [n=^index o=^node] ^- [@t json] :_ (node o) =/ idx (index n) ?> ?=(%s -.idx) p.idx :: ++ indices |= i=(set ^index) ^- json [%a (turn ~(tap in i) index)] :: -- -- :: ++ dejs =, dejs:format |% ++ update |= jon=json ^- ^update :- *time ^- action =< (decode jon) |% ++ decode %- of :~ [%add-nodes add-nodes] [%remove-nodes remove-nodes] [%add-signatures add-signatures] [%remove-signatures remove-signatures] :: [%add-graph add-graph] [%remove-graph remove-graph] :: [%add-tag add-tag] [%remove-tag remove-tag] :: [%archive-graph archive-graph] [%unarchive-graph unarchive-graph] [%run-updates run-updates] :: [%keys keys] [%tags tags] [%tag-queries tag-queries] == :: ++ add-graph %- ot :~ [%resource dejs:res] [%graph graph] [%mark (mu so)] [%overwrite bo] == :: ++ graph |= a=json ^- ^graph =/ or-mp ((ordered-map atom ^node) gth) %+ gas:or-mp ~ %+ turn ~(tap by ((om node) a)) |* [b=cord c=*] ^- [atom ^node] => .(+< [b c]=+<) [(rash b dem) c] :: ++ remove-graph (ot [%resource dejs:res]~) ++ archive-graph (ot [%resource dejs:res]~) ++ unarchive-graph (ot [%resource dejs:res]~) :: ++ add-nodes %- ot :~ [%resource dejs:res] [%nodes nodes] == :: ++ nodes (op ;~(pfix fas (more fas dem)) node) :: ++ node %- ot :~ [%post post] [%children internal-graph] == :: ++ internal-graph |= jon=json ^- ^internal-graph ?~ jon [%empty ~] [%graph (graph jon)] :: ++ post %- ot :~ [%author (su ;~(pfix sig fed:ag))] [%index index] [%time-sent di] [%contents (ar content)] [%hash (mu nu)] [%signatures (as signature)] == :: ++ content %- of :~ [%mention (su ;~(pfix sig fed:ag))] [%text so] [%url so] [%reference reference] [%code eval] == :: ++ reference |^ %- of :~ graph+graph group+dejs-path:res == :: ++ graph %- ot :~ group+dejs-path:res graph+dejs-path:res index+index == -- :: ++ tang |= jon=^json ^- ^tang ?> ?=(%a -.jon) %- zing %+ turn p.jon |= jo=^json ^- (list tank) ?> ?=(%a -.jo) %+ turn p.jo |= j=^json ?> ?=(%s -.j) ^- tank leaf+(trip p.j) :: ++ eval %- ot :~ expression+so output+tang == :: ++ remove-nodes %- ot :~ [%resource dejs:res] [%indices (as index)] == :: ++ add-signatures %- ot :~ [%uid uid] [%signatures (as signature)] == :: ++ remove-signatures %- ot :~ [%uid uid] [%signatures (as signature)] == :: ++ signature %- ot :~ [%hash nu] [%ship (su ;~(pfix sig fed:ag))] [%life ni] == :: ++ uid %- ot :~ [%resource dejs:res] [%index index] == :: ++ index (su ;~(pfix fas (more fas dem))) :: ++ add-tag %- ot :~ [%term so] [%resource dejs:res] == :: ++ remove-tag %- ot :~ [%term so] [%resource dejs:res] == :: ++ keys |= =json *resources :: ++ tags |= =json *(set term) :: ++ tag-queries |= =json *^tag-queries :: ++ run-updates |= a=json ^- [resource update-log] [*resource *update-log] -- -- :: ++ create |_ [our=ship now=time] ++ post |= [=index contents=(list content)] ^- ^post :* our index now contents ~ *signatures == -- --