:: hawk :: the manx machine :: /- hawk, *hawk, hu=hawk-upgrade, *hawk-upgrade, spider /+ *html-utils, *hawk, hawk-utils=hawk, hawk-ui, html-utils, manx-utils, strandio, strand /+ markdown :: =/ trace %.n :: printfs =- :: =| state-6:hu =* state - ^- agent:gall |_ =bowl:gall +* this . dok [our.bowl %hawk] ++ on-init :: %- (slog 'welcome to hawk.' ~) :_ this :~ [%pass /bind-site %arvo %e %connect `/~~ dap.bowl] [%pass /bind-site %arvo %e %connect `/apps/hawk dap.bowl] [%pass /hatch %agent dok %poke hatch-egg/!>(~)] == :: ++ on-save :: !>(state) :: ++ on-load :: |= old-state=vase ^- (quip card:agent:gall _this) %- (slog 'hawk updated.' ~) :- ;: welp ?. %.y ~ :~ [%pass /reset %agent dok %poke hatch-egg/!>(~)] == ?. %.n ~ :~ [%pass /bind-site %arvo %e %connect `/~~ dap.bowl] [%pass /bind-site %arvo %e %connect `/apps/hawk dap.bowl] == == =; r=(each state-6:hu tang) ?: ?=([%.y ^] r) this(state p.r) %- (slog 'thats my b, bro. ~migrev' p.r) this(state *state-6:hu) %- mule |. =/ old !<(state-n:hu old-state) ?- -.old %0 *state-6:hu %1 *state-6:hu %2 *state-6:hu %3 *state-6:hu %4 (state-4-to-6:hu old) %5 (state-5-to-6:hu old) %6 old == :: ++ on-poke ::: |= [=mark =vase] ?+ mark ::: %- (slog [leaf+"hawk: unknown mark {(trip mark)}" ~]) `this :: %login :: interactive bootstrapper :: :: ^- (quip card:agent:gall _this) ?> =(src.bowl our.bowl) =/ host ,(unit @t) =/ [host=(unit @t) key=@p] :: =, bowl :- .^((unit @t) %ex (scot %p our) %$ (scot %da now) /eauth/url) .^(@p %j (scot %p our) %code (scot %da now) (scot %p our) ~) %- %- slog :: :~ ' ' ' ' ' ' ' this is a secret login link' ' don\'t share it' ' don\'t use it on an untrustworthy computer' ' don\'t use it on an untrustworthy network' ' ' %- crip ;: welp " " ?~ host "http://localhost" =/ ho (trip u.host) (scag (^sub (lent ho) 8) ho) "/apps/hawk/login/" +:(scow %p key) == ' ' ' ' ' ' == :_ this [%pass /login-connect %arvo %e %connect [~ /] %hawk]~ :: %noun :: EVENT LOOP INITIATOR :: ^- (quip card:agent:gall _this) ?> =(src.bowl our.bowl) =+ !<([src=@p root=path nif=info] vase) =/ stops=steps:hu (plex-plan root nif (add-bowl *card src root bowl)) =/ first (fall (longest ~(key by stops)) root) =/ =foot:hu [first (~(gut by stops) first (add-bowl *card src root bowl))] =/ =hike:hu [root ~ (~(get of bin) first) foot (~(del by stops) first) *steps:hu] :_ this(logs (~(put by logs) now.bowl hike)) [%pass /begin-hike %agent dok %poke left/!>(now.bowl)]~ :: %left :: EVENT LOOP: first half :: ?> =(src.bowl our.bowl) =+ !<([id=@da] vase) =/ =hike:hu (~(got by logs) id) ~? >> trace [%left p.now.hike] ?^ sc=(system-command now.hike) :: handle system commands :: :: this code path is unoptimized. :: the effect returned from (system-command :: re-mists the effected path. :: :: optimize by removing mists from system commands :: and merging the effected paths into the hike :: :: eventually, the only valid way to issue :: a system command is through this code path :: :- :~ [%pass /system %agent dok %poke effect.u.sc] [%pass /in-left %agent dok %poke right/!>([id ~])] == this :: =/ muve=(unit move:hu) (send-card now.hike tree bin) ?~ muve :_ this [%pass /in-left %agent dok %poke right/!>([id ~])]~ =/ =move:hu u.muve ?- -.move %.n ^- (quip card:agent:gall _this) :_ this [%pass /in-left %agent dok %poke right/!>([id `[%.n p.move]])]~ :: %.y ^- (quip card:agent:gall _this) =/ =stir:hu p.move :_ %= this logs (~(put by logs) id hike(deps deps.stir, cache cache.stir)) bin (~(del of bin) p.now.hike) ::XX fix this cache bullshit. for now, no cache ::?~ cache.stir ::(~(del of bin) p.now.hike) ::(~(put of bin) p.now.hike u.cache.stir) :: :: the bug is that when using complex load types, :: the cache gets filled with the wrong hoon. :: :: for example, when using %call, the cache gets :: filled with the thing %call points to instead :: of the hoon of the %call file itself. :: :: also, there is a bug where the cache invalidates :: itself every other time it runs because of the :: wack way i'm returning from +make-load :: :: so it's commented out for now. :: == =/ next final.stir ?- -.next %.n [%pass [%result (scot %da id) ~] %arvo %k %lard %hawk p.next]~ %.y [%pass /in-left %agent dok %poke right/!>([id `[%.y p.next]])]~ == == :: %right :: EVENT LOOP: second half :: ?> =(src.bowl our.bowl) =+ !<([id=@da wunk=(unit wink)] vase) =/ =hike:hu (~(got by logs) id) ~? > trace [%rite p.now.hike] ^- (quip card:agent:gall _this) :: ?~ wunk =/ pax p.now.hike =/ subs (fall (~(get of sub) pax) *(set path)) =/ next (next-step hike subs bowl) :- ?~ next ~ [%pass /in-right %agent dok %poke left/!>([id])]~ %= this dep (~(del of dep) pax) err (~(del of err) pax) bin (~(del of bin) pax) sub (update-sub pax (fall (~(get of dep) pax) *(set path)) ~ sub) logs (~(put by logs) id (fall next hike)) == =/ =wink u.wunk ?- -.wink %.n =/ next (next-step hike ~ bowl) :- ?~ next ~ [%pass /in-right %agent dok %poke left/!>([id])]~ %= this err (~(put of err) p.now.hike [q.now.hike p.wink]) logs (~(put by logs) id (fall next hike)) == %.y =/ pax p.now.hike =/ old=page (need (~(get of tree) pax)) =/ new=page old(data p.wink, meta (~(put of meta.old) /case da/id)) =/ subs (fall (~(get of sub) pax) *(set path)) ::=/ same ?&(=(data.old data.new) (gth ~(wyt by done.hike) 0)) =/ same %.n :: turned off becuase it's wrong? i think so... =/ next (next-step hike ?:(same ~ subs) bowl) :- ?~ next ~ [%pass /in-right %agent dok %poke left/!>([id])]~ %= this dep (~(put of dep) pax (silt deps.hike)) sub (update-sub pax (fall (~(get of dep) pax) *(set path)) (silt deps.hike) sub) tree (~(put of tree) pax new) err (~(del of err) pax) logs (~(put by logs) id (fall next hike)) == == :: %mist :: ?> =(src.bowl our.bowl) =+ !<(paths=(set path) vase) =/ pax ?~ ~(wyt in paths) / (snag 0 ~(tap in paths)) ?~ long=(longest paths) `this =/ todo %- malt %+ turn ~(tap in (~(del in paths) u.long)) |= =path [path (add-bowl *card our.bowl path bowl)] =/ =hike:hu [pax ~ ~ [u.long (add-bowl *card our.bowl pax bowl)] todo ~] :_ this(logs (~(put by logs) now.bowl hike)) [%pass /mist %agent dok %poke left/!>(now.bowl)]~ :: %rain :: :: mist path and all subpaths :: ?> =(src.bowl our.bowl) =+ !<(pax=path vase) :_ this [%pass /hawk-rain %agent dok %poke mist/!>((leafs pax (~(dip of tree) pax)))]~ :: %lay-egg :: :: write the system file to an egg :: at /lib/egg/noun :: =/ egg=atom %- jam %- ~(gas of *file) %+ turn %~ tap of (~(dip of (~(lop of tree) /~/config)) /~) |= [=path =page] :- path page(data *manx) =/ soba [/lib/egg/atom %ins %noun !>(egg)]~ :_ this [%pass /info %arvo %c %info %hawk %& soba]~ :: %hatch-egg :: =/ coop=path %+ welp /(scot %p our.bowl)/hawk/(scot %da now.bowl) /lib/egg/atom ?. .^(? %cu coop) %- (slog 'hawk: chicken before egg!' ~) `this =/ egg=atom .^(atom %cx coop) =/ seed=(each file tang) (mule |.(;;(file (cue egg)))) ?: ?=(%.n -.seed) %- (slog 'hawk: rotten egg!' p.seed) `this :- [%pass /rain %agent dok %poke rain/!>(/~)]~ %= this tree %- %~ gas of %. /~/system %~ lop of (~(lop of tree) /~/manual) %+ turn ~(tap of p.seed) |= [pax=path =page] [(welp /~ pax) page] == :: %egg-any :: =+ !<(=egg-any:gall vase) ?. ?=(%live +<.egg-any) %- (slog [dap.bowl %egg-is-not-live ~]) [~ this] (on-load +.old-state.egg-any) :: %graft :: :: overwrite a whole subtree ?> =(src.bowl our.bowl) =+ !<([pax=path payload=file] vase) =/ imports ^- (list (pair path page)) %+ turn ~(tap of payload) |= [pix=path =page] [(welp pax pix) page] :- =/ paths (turn imports |=([=path *] path)) [%pass /graft-mist %agent dok %poke mist/!>((silt paths))]~ this(tree (~(gas of tree) imports)) :: %become :: :: turns a one location (self) into another (idol) ?> =(src.bowl our.bowl) =+ !<([self=path idol=path] vase) =/ old (fall (~(get of tree) self) default-page) =/ promise (~(dip of tree) idol) ?: ?& =(0 ~(wyt by dir.promise)) =(~ fil.promise) == ~|(%empty-promise !!) =/ bounty=(list [path page]) %+ turn ~(tap of promise) |= [=path =page] [(welp self path) page] :- %+ welp %+ turn bounty |= [=path =page] [%pass /hawk-become %agent dok %poke noun/!>([our.bowl path *card])] :~ [%pass /hawk-become %agent dok %poke mist/!>((sy self ~))] == this(tree (~(gas of tree) bounty)) :: %put :: ?> =(src.bowl our.bowl) =+ !<(=path vase) :- [%pass /hawk-put %agent dok %poke mist/!>((sy path ~))]~ this(tree (~(put of tree) path default-page)) :: %del :: ?> =(src.bowl our.bowl) =+ !<(=path vase) :- [%pass /hawk-del %agent dok %poke mist/!>((sy path ~))]~ this(tree (~(del of tree) path), bin (~(del of bin) path)) :: %lop :: ?> =(src.bowl our.bowl) =+ !<(=path vase) :- [%pass /hawk-lop %agent dok %poke mist/!>((leafs path (~(dip of tree) path)))]~ %= this tree (~(lop of tree) path) bin (~(lop of bin) path) == :: %data :: ?> =(src.bowl our.bowl) =+ !<([=path data=@t] vase) =/ old (fall (~(get of tree) path) *page) =/ rend (render-doc data) :- [%pass /hawk-data %agent dok %poke mist/!>((sy path ~))]~ ?- -.rend %.y =/ new old(data p.rend) this(tree (~(put of tree) path new)) %.n ((slog 'hawk: boom!' ~) this) :: == :: %code :: ?> =(src.bowl our.bowl) =+ !<([=path =mime] vase) =/ old (fall (~(get of tree) path) default-page) :- [%pass /code %agent dok %poke mist/!>((sy path ~))]~ %= this tree (~(put of tree) path old(code mime)) bin (~(del of bin) path) == :: %meta-set :: ?> =(src.bowl our.bowl) =+ !<([here=path rib=path val=dime] vase) =/ old (fall (~(get of tree) here) *page) =/ uni (~(gas of meta.old) [rib val]~) =/ new old(meta uni) :_ this(tree (~(put of tree) here new)) [%pass /code %agent dok %poke mist/!>((sy here ~))]~ :: %meta-sot :: ?> =(src.bowl our.bowl) =+ !<([here=path rib=path vals=info] vase) =/ old (fall (~(get of tree) here) *page) =/ uni=info (~(pas iu (~(lop of meta.old) rib)) rib ~(tap iu vals)) =/ new old(meta uni) :_ this(tree (~(put of tree) here new)) [%pass /code %agent dok %poke mist/!>((sy here ~))]~ :: %meta-del :: ?> =(src.bowl our.bowl) =+ !<([=path del=path] vase) =/ old (fall (~(get of tree) path) *page) =/ new old(meta (~(del of meta.old) del)) :_ this(tree (~(put of tree) path new)) [%pass /code %agent dok %poke mist/!>((sy path ~))]~ :: %copy :: ?> =(src.bowl our.bowl) =+ !<([from=path to=path cuz=(unit card)] vase) =/ from-gas ~(tap of (~(dip of tree) from)) =/ mod %+ turn from-gas |= [=path =page] [(welp to path) page] :- ?~ cuz [%pass /hawk-copy %agent dok %poke mist/!>((sy to ~))]~ [%pass /copy %agent dok %poke noun/!>([our.bowl to u.cuz])]~ this(tree (~(gas of tree) mod)) :: %mock :: ?> =(src.bowl our.bowl) =+ !<([from=path to=path cuz=(unit card)] vase) =/ from-gas ~(tap of (~(dip of tree) from)) =/ mod %+ turn from-gas |= [=path =page] [(welp to path) page] :- ?~ cuz [%pass /hawk-mock %agent dok %poke mist/!>((sy to ~))]~ [%pass /mock %agent dok %poke noun/!>([our.bowl to u.cuz])]~ this(tree (~(gas of tree) mod)) :: %like :: ?> =(src.bowl our.bowl) =+ !<([from=path to=path cuz=(unit card)] vase) =/ from-page (fall (~(get of tree) from) *page) :- ?~ cuz [%pass /hawk-like %agent dok %poke mist/!>((sy to ~))]~ [%pass /like %agent dok %poke noun/!>([our.bowl to u.cuz])]~ this(tree (~(put of tree) to from-page)) :: %move :: ?> =(src.bowl our.bowl) =+ !<([from=path to=path] vase) =/ from-gas ~(tap of (~(dip of tree) from)) =/ mod %+ turn from-gas |= [=path =page] [(welp to path) page] :- =/ to-mist (~(uni in (sy to ~)) (leafs from (~(dip of tree) from))) [%pass /hawk-move %agent dok %poke mist/!>(to-mist)]~ this(tree (~(gas of (~(lop of tree) from)) mod), bin (~(lop of bin) from)) :: %pulse :: :: mists the most stale pulseable page :: within a file ?> =(src.bowl our.bowl) =+ !<(pax=path vase) =/ have-pulse ^- (list (pair path dime)) %+ murn ~(tap of (~(dip of tree) pax)) |= [=path =page] =/ m (~(m fu tree) (welp pax path)) ?. =(`f/.y (reb:m /pulse)) ~ `[path (rub.m /case da/*@da)] :: =/ stale-order %+ sort have-pulse |= [a=[=path =dime] b=[=path =dime]] (lth q.dime.a q.dime.b) :: ?~ (lent stale-order) `this =/ pix=path (welp pax p:(snag 0 stale-order)) =/ old=page (need (~(get of tree) pix)) =/ met (~(put of meta.old) /case da/now.bowl) =/ new old(meta met) %- %- slog :~ leaf+"hawk: pulse stalest of {<(lent stale-order)>}" leaf+(spud pix) == :_ this(tree (~(put of tree) pix new)) [%pass /hawk-pulse %agent dok %poke mist/!>((sy pix ~))]~ :: %handle-http-request :: =+ !<(r=(pair @ta inbound-request:eyre) vase) =; res [cards.res this(tree tree.res)] %- ~(res server:hawk-ui [bowl state]) !<((pair @ta inbound-request:eyre) vase) :: == :: ++ on-watch :: |= =path `this :: ++ on-leave :: |= =path `this :: ++ on-peek :: |= =path ~ :: ++ on-agent :: |= [=wire =sign:agent:gall] ?: ?& ?=([%poke-ack *] sign) !=(~ p.sign) == %- (slog leaf+"{<wire>}" ~) %- (slog (fall p.sign ~['huh?'])) `this `this :: ++ on-arvo :: |= [=wire sign=sign-arvo] ^- (quip card:agent:gall _this) ?. ?=([%result *] wire) `this ?. ?=([%khan %arow *] sign) ~|(%wierd-arrow !!) =/ id=@da (slav %da +<.wire) =/ =wink ?: ?=(%.n -.p.sign) [%.n tang.p.p.sign] =/ vas=vase q.p.p.sign ?~ data=((soft manx) q.vas) :- %.n :~ '%shed must return a vase of manx' 'example:' ' :- %shed' ' =/ m (strand ,vase)' ' %- pure:m !>' ' ;h1: mind is chief' == [%.y u.data] :_ this [%pass /from-arvo %agent dok %poke right/!>([id `wink])]~ :: ++ on-fail :: |= [=term =tang] %- (slog 'hawk: on fail' term tang) `..on-init :: -- :: |% :: :: ++ next-step :: :: the foot placement algorithm |= [old=hike:hu subs=(set path) =bowl:agent:gall] ^- (unit hike:hu) =/ deduplicated=(set path) %. ~(key by done.old) %~ dif in %- ~(uni in (~(uni in ~(key by todo.old)) subs)) (silt (ancestors p.now.old)) =/ long=(unit path) (longest deduplicated) =/ remapped %- malt %+ turn ~(tap in deduplicated) |= =path [path (~(gut by todo.old) path (add-bowl [~ ~] our.bowl from.old bowl))] :: ?~ long ~ :: hike is done :- ~ %= old now [u.long (~(got by remapped) u.long)] deps ~ cache ~ todo (~(del by remapped) u.long) done (~(put by done.old) p.now.old q.now.old) == :: ++ system-command :: |= =foot:hu ^- (unit [effect=cage]) ?~ kind=(~(reb iu q.foot) /) ~ ?+ q.u.kind ~ %sys-oust :: :+ ~ %del !> %- fall :_ p.foot (stub q:(~(rib iu q.foot) /pax)) :: %sys-trim :: :+ ~ %trim !> %- fall :_ p.foot (stub q:(~(rib iu q.foot) /pax)) :: %sys-cull :: :+ ~ %lop !> %- fall :_ p.foot (stub q:(~(rib iu q.foot) /pax)) :: %sys-copy :: :+ ~ %copy !> :+ (fall (stub q:(~(rib iu q.foot) /from)) p.foot) (stab q:(~(rib iu q.foot) /to)) `(~(dip iu q.foot) /init) :: %sys-mock :: :+ ~ %mock !> :+ (stab q:(~(rib iu q.foot) /from)) (fall (stub q:(~(rib iu q.foot) /to)) p.foot) `(~(dip iu q.foot) /init) :: %sys-like :: :+ ~ %like !> :+ (stab q:(~(rib iu q.foot) /from)) (fall (stub q:(~(rib iu q.foot) /to)) p.foot) `(~(dip iu q.foot) /init) :: %sys-move :: :+ ~ %move !> :- (fall (stub q:(~(rib iu q.foot) /from)) p.foot) (stab q:(~(rib iu q.foot) /to)) :: :: == :: ++ update-sub :: :: multiplexes dependencies out to subscriptions |= [pax=path old=(set path) new=(set path) sub=(axal (set path))] ^- (axal (set path)) =/ to-del ~(tap in (~(dif in old) new)) =/ deleted =/ lst=(list path) to-del |- ?~ lst sub ?~ x=(~(get of sub) i.lst) $(lst t.lst) =/ new-node (~(del in u.x) pax) =/ new-sub (~(put of sub) i.lst new-node) $(lst t.lst, sub new-sub) :: =/ to-add ~(tap in new) =/ added =/ lst=(list path) to-add =/ sub deleted |- ?~ lst sub =/ old (fall (~(get of sub) i.lst) *(set path)) =/ new-sub (~(put of sub) i.lst (~(put in old) pax)) $(lst t.lst, sub new-sub) :: added :: ++ render-doc :: |= code=@t ^- wink =/ mul %- mule |. !< manx %+ slap !>(..zuse) %- ream (crip (welp (trip code) (trip 10))) ?- -.mul %.y [%.y (manx p.mul)] %.n [%.n (tang p.mul)] == ++ default-page :: %* . *page code [/text/hawk-500 (as-octs:mimes:html '')] == :: ++ add-bowl :: |= [caz=card:hawk src=@p from=path =bowl:agent:gall] ^- card %- ~(gas of caz) ^- (list (pair path dime)) :: :~ :- /sys/src p/src :- /sys/our p/our.bowl :- /sys/now da/now.bowl :- /sys/eny uv/eny.bowl :- /sys/from tas/(spat from) == :: ++ send-card :: |= [=foot:hu tree=file bin=(axal hoon)] ^- (unit move:hu) :: empty if there is no file ?~ (~(get of tree) p.foot) ~ :- ~ ^- move:hu =/ =file (~(dip of tree) p.foot) =/ f ~(. fu file) =/ mite p:mim:f :: ?+ mite [%.n ['unknown mime' ~]] :: [%text %hawk-500 ~] =/ cash (~(get of bin) p.foot) ~? >>> ?&(trace !=(~ cash)) [%cash p.foot] (apply-card p.foot q.foot tree bin cash) :: [%text %markdown ~] ?~ parsed=(de:markdown cod:f) [%.n ['parse fail: markdown' ~]] =/ m=manx (sail-en:markdown u.parsed) :* %.y ~ ~ %.y m(a.g [[%class "prose page"] a.g.m]) == :: [%application %json *] :* %.y ~ ~ %.y ;div.p4.pre.mono: {(trip cod:f)} == :: [%text *] :* %.y ~ ~ %.y ;div.p4.pre.mono: {(trip cod:f)} == :: == ++ apply-card :: |= [pax=path caz=card tree=file bin=(axal hoon) huun=(unit hoon)] ^- move:hu =| hops=@ud =| deps=(list path) =| origin=(unit path) =| luud=(unit load) :: =; xex=(pair (unit info) move:hu) ?~ p.xex q.xex ::XX handle meta changes q.xex :: |- ^- (pair (unit info) move:hu) ~? >>> &(trace !=(~ huun)) [%cush pax] =/ t ~(. fu tree) ?: (gth hops 5) [~ %.n 'max recursion hit' ~] :: =/ lude=(each (pair load (unit hoon)) tang) ?~ luud (make-load pax origin caz tree huun) [%.y [u.luud ~]] ?- -.lude %.n [~ lude] %.y =/ lod p.p.lude ?- -.lod %manx :: :* ~ %.y deps q.p.lude %.y manx.lod == %shed :: :* ~ %.y deps q.p.lude [%.n shed.lod] == %marx :: =/ [* inner=move:hu] $(huun ~, luud `load.lod) ?- -.inner %.n [~ inner] %.y =/ =stir:hu p.inner ?- -.final.stir %.n [~ %.n 'shed is not composable' ~] %.y :* ~ %.y deps.stir cache.stir %.y [marx.lod `marl`c.p.final.stir] == :: == :: == %vase :: :* ~ %.y deps q.p.lude %.y ;div.p4.mono.s0.break: {(text vase.lod)} == %view :: ?: =(path.lod pax) [~ %.n leaf+"self loop: {(spud pax)}" ~] :* ~ %.y ?~(hops [path.lod ~] deps) ?~(hops q.p.lude huun) %.y dat:(f:t path.lod) == %twin :: ?: =(path.lod pax) [~ %.n leaf+"self loop: {(spud pax)}" ~] =/ old (git:t pax) =/ new old(code mim:(f:t path.lod)) %= $ ::pax path.lod tree (~(put of tree) pax new) deps ?~(hops [path.lod ~] deps) hops +(hops) huun (~(get of bin) path.lod) luud ~ == %call :: ?: =(path.lod pax) [~ %.n leaf+"self loop: {(spud pax)}" ~] =/ old (git:t pax) =/ new old(code mim:(f:t path.lod)) %= $ ::pax path.lod tree (~(put of tree) pax new) caz card.lod hops +(hops) deps ?~(hops [path.lod ~] deps) huun (~(get of bin) pax) luud ~ == %lens :: %= $ pax path.lod origin `pax deps ?~(hops [path.lod ~] deps) hops +(hops) luud ~ huun `hoon.lod == %cons :: =/ [* head=move:hu] %= $ luud `+<.lod huun ~ == =/ [* tail=move:hu] %= $ luud `+>.lod huun ~ == ?: ?=([%.n *] head) [~ %.n '%cons: head failed' +.head] ?: ?=([%.n *] tail) [~ %.n '%cons: tail failed' +.tail] ?: ?=([%.y * * %.n *] head) [~ %.n '%cons: head is shed' ~] ?: ?=([%.y * * %.n *] tail) [~ %.n '%cons: tail is shed' ~] :* ~ %.y ?~(hops (welp +<.head +<.tail) deps) ~ %.y %= p.final.p.tail c [p.final.p.head c.p.final.p.tail] == == %snoc :: =/ [* head=move:hu] %= $ luud `+<.lod huun ~ == =/ [* tail=move:hu] %= $ luud `+>.lod huun ~ == ?: ?=([%.n *] head) [~ %.n '%snoc: head failed' +.head] ?: ?=([%.n *] tail) [~ %.n '%snoc: tail failed' +.tail] ?: ?=([%.y * * %.n *] head) [~ %.n '%snoc: head is shed' ~] ?: ?=([%.y * * %.n *] tail) [~ %.n '%snoc: tail is shed' ~] :* ~ %.y ?~(hops (welp +<.head +<.tail) deps) ~ %.y %= p.final.p.head c (snoc c.p.final.p.head p.final.p.tail) == == %lynx :: =/ [lead=manx loads=(list load)] +.lod =| fail=(unit tang) =| kids=marl =| index=@ =| deps=(list path) |- ?^ fail [~ %.n u.fail] ?~ loads :* ~ %.y deps q.p.lude %.y [g.lead (flop kids)] == =/ [* kid=move:hu] %= ^$ luud `i.loads huun ~ == ?- -.kid %.n $(fail `[leaf+"join: index={<index>}: failed" p.kid]) %.y =/ x=(each manx shed:khan) final.p.kid =/ ds=(list path) deps.p.kid ?- -.x %.y :: %= $ loads t.loads kids [p.x kids] index +(index) deps (welp ds deps) == %.n %= $ fail :- ~ :~ leaf+"join: index={<index>}" '%shed is not composable' == :: == :: == :: == %join :: =/ loads=(list load) +.lod =| fail=(unit tang) =| kids=marl =| index=@ =| deps=(list path) |- ?^ fail [~ %.n u.fail] ?~ loads :* ~ %.y deps q.p.lude %.y [[%div ~] (flop kids)] == =/ [* kid=move:hu] %= ^$ luud `i.loads huun ~ == ?- -.kid %.n $(fail `[leaf+"join: index={<index>}: failed" p.kid]) %.y =/ x=(each manx shed:khan) final.p.kid =/ ds=(list path) deps.p.kid ?- -.x %.y %= $ loads t.loads kids [p.x kids] index +(index) deps (welp ds deps) == %.n %= $ fail :- ~ :~ leaf+"join: index={<index>}" '%shed is not composable' == :: == :: == :: == == :: == :: ++ stdlib :: ^~ ;: slop :: standard library !>(hawk) !>(hawk-utils) !>(html-utils) !>(mu=manx-utils) !>(strandio) !>(..zuse) == ++ make-load :: |= [here=path origin=(unit path) =card tree=file huun=(unit hoon)] ^- (each (pair load (unit hoon)) tang) =/ file (~(dip of tree) here) =/ page (~(git fu file) /) =/ t ~(. fu tree) =/ c ~(. iu card) %- mule |. =/ our (crip (pib:c /sys/our)) =/ now (crip (pib:c /sys/now)) =/ haan %+ fall huun %- ream =/ code (trip q.q.code.page) ?: =(code "") '*manx\0a' (crip (welp code "\0a")) =/ slapped %- slap :_ haan ;: slop ::: !>(the-card=card) !>(the-file=file) !>(here=here) !>(origin=origin) :: :: bound engines !>(c=c) !>(f=(f:t here)) :: :: bound engines for the root file !>(d=(d:t here)) !>(m=(m:t here)) :: stdlib == =/ hiin ?^(huun ~ `haan) :: don't return cache if passed in ?^ munx=((soft manx) +.slapped) [[%manx u.munx] hiin] [!<(load slapped) hiin] :: --