mirror of
https://github.com/tadad/blog.git
synced 2024-08-16 08:10:44 +03:00
feat: use thread for importing
This commit is contained in:
morelazers
parent
a5b4d5af8d
commit
1f2c585bca
@ -102,6 +102,18 @@
|
||||
[%pass /bind %arvo %e %disconnect `path.act]~
|
||||
::
|
||||
%export
|
||||
=| theme-export=(map path @tas)
|
||||
=/ files-list ~(tap by files)
|
||||
=. theme-export
|
||||
|- ?: (test files-list ~) theme-export
|
||||
=/ [=path html=@t md=@t theme=@tas] (rear files-list)
|
||||
%= $
|
||||
theme-export (~(put by theme-export) path theme)
|
||||
files-list (snip files-list)
|
||||
==
|
||||
=/ soba-meta=soba:clay
|
||||
^- soba:clay
|
||||
[[%export %published %meta %noun ~] [%ins %noun !>(theme-export)]]~
|
||||
=/ soba-html=soba:clay
|
||||
%- zing
|
||||
%+ turn ~(tap by files)
|
||||
@ -110,7 +122,10 @@
|
||||
=/ t ?~(got=(~(get by themes) theme) '' u.got)
|
||||
:~ :^ [%export %published %html (snoc path %html)]
|
||||
%ins %html
|
||||
!>((cat 3 html (add-style:blog-lib t)))
|
||||
?: css.act
|
||||
!>((cat 3 html (add-style:blog-lib t)))
|
||||
!>(html)
|
||||
::
|
||||
:^ [%export %published %md (snoc path %md)]
|
||||
%ins %md
|
||||
!>([md ~])
|
||||
@ -129,38 +144,14 @@
|
||||
:~ [%pass /info %arvo %c %info %blog %& soba-html]
|
||||
[%pass /info %arvo %c %info %blog %& soba-md]
|
||||
[%pass /info %arvo %c %info %blog %& soba-css]
|
||||
[%pass /info %arvo %c %info %blog %& soba-meta]
|
||||
==
|
||||
::
|
||||
%import
|
||||
:: One thing this does not do is actually publish the new html files
|
||||
=/ all-files ~(tap of files.act)
|
||||
|-
|
||||
?: (test all-files ~) `this
|
||||
%. (rear all-files)
|
||||
|= [=path content=*]
|
||||
%= ^$
|
||||
all-files (snip all-files)
|
||||
this
|
||||
?+ (rear path) this
|
||||
%md
|
||||
=+ content=(of-wain:format ((list cord) content))
|
||||
?: ?=(%published (snag 0 path))
|
||||
=/ file-name (oust [0 2] (snip path))
|
||||
=/ file (~(gut by files) file-name [html='' md='' theme=%default])
|
||||
this(files (~(put by files) file-name file(md content)))
|
||||
=/ draft-name (oust [0 1] (snip path))
|
||||
this(drafts (~(put by drafts) [path=draft-name md=content]))
|
||||
%css
|
||||
=/ theme-name (@tas (rear (oust [0 1] (snip path))))
|
||||
this(themes (~(put by themes) [theme-name css=(@t (@tas content))]))
|
||||
%html
|
||||
=/ file-name (oust [0 2] (snip path))
|
||||
=/ file (~(gut by files) file-name [html='' md='' theme=%default])
|
||||
this(files (~(put by files) file-name file(html (@t (@tas content)))))
|
||||
==
|
||||
==
|
||||
:_ this
|
||||
[%pass /result %arvo %k %fard q.byk.bowl %import %import !>(act)]~
|
||||
::
|
||||
%save-draft `this(drafts (~(put by drafts) [path md]:act))
|
||||
%save-draft `this(drafts (~(put by drafts) [path md]:act))
|
||||
%delete-draft `this(drafts (~(del by drafts) path.act))
|
||||
%save-theme `this(themes (~(put by themes) [theme css]:act))
|
||||
%delete-theme `this(themes (~(del by themes) theme.act))
|
||||
@ -227,6 +218,7 @@
|
||||
^- (quip card _this)
|
||||
?+ wire (on-arvo:def wire sign-arvo)
|
||||
[%bind ~] ?>(?=([%eyre %bound %.y *] sign-arvo) `this)
|
||||
[%result ~] `this
|
||||
==
|
||||
++ on-leave on-leave:def
|
||||
++ on-fail on-fail:def
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
:- %say
|
||||
|= *
|
||||
|= [[*] [css=? ~] ~]
|
||||
:- %blog-action
|
||||
[%export ~]
|
||||
[%export css]
|
||||
@ -1,20 +1,10 @@
|
||||
:- %say
|
||||
|= [[now=@da @ our=@p ^] *]
|
||||
=/ =path /(scot %p our)/blog/(scot %da now)/import
|
||||
:- %blog-action
|
||||
:- %import
|
||||
|-
|
||||
=+ .^(=arch %cy path)
|
||||
:: If there is no directory below this, read the file's contents
|
||||
?: (test dir.arch ~)
|
||||
=/ mark
|
||||
?+ (rear path) !!
|
||||
%md wain
|
||||
%html @t
|
||||
%css @t
|
||||
==
|
||||
=/ content .^(mark %cx path)
|
||||
:- [~ content] :: mimic fil.arch (unit item)
|
||||
(~(rut by dir.arch) |=([name=@ta ~] ^$(path (snoc path name))))
|
||||
:- fil.arch :: ~ or [~ u=item]
|
||||
(~(rut by dir.arch) |=([name=@ta ~] ^$(path (snoc path name))))
|
||||
|= *
|
||||
[%blog-action %import ~]
|
||||
|
||||
|
||||
:: |-
|
||||
:: :: IF we are done with all the files, return: (pure:m !>(~))
|
||||
:: :: ELSE, construct the next poke, and poke like this, see below
|
||||
:: ;< ~ bind:m (poke-our %blog !>([%publish path html md theme]))
|
||||
|
||||
|
||||
@ -25,7 +25,7 @@
|
||||
++ add-style
|
||||
|= css=@t
|
||||
^- @t
|
||||
(cat 3 (cat 3 '<style>' css) '<style/>')
|
||||
(cat 3 (cat 3 '<style>' css) '</style>')
|
||||
::
|
||||
++ http-response-cards
|
||||
|= [id=@tas hed=response-header:http data=(unit octs)]
|
||||
|
||||
760
lib/strandio.hoon
Normal file
760
lib/strandio.hoon
Normal file
@ -0,0 +1,760 @@
|
||||
/- spider
|
||||
/+ libstrand=strand
|
||||
=, strand=strand:libstrand
|
||||
=, strand-fail=strand-fail:libstrand
|
||||
|%
|
||||
++ send-raw-cards
|
||||
|= cards=(list =card:agent:gall)
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= strand-input:strand
|
||||
[cards %done ~]
|
||||
::
|
||||
++ send-raw-card
|
||||
|= =card:agent:gall
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-cards card ~)
|
||||
::
|
||||
++ ignore
|
||||
|= tin=strand-input:strand
|
||||
`[%fail %ignore ~]
|
||||
::
|
||||
++ get-bowl
|
||||
=/ m (strand ,bowl:strand)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
`[%done bowl.tin]
|
||||
::
|
||||
++ get-beak
|
||||
=/ m (strand ,beak)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
`[%done [our q.byk da+now]:bowl.tin]
|
||||
::
|
||||
++ get-time
|
||||
=/ m (strand ,@da)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
`[%done now.bowl.tin]
|
||||
::
|
||||
++ get-our
|
||||
=/ m (strand ,ship)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
`[%done our.bowl.tin]
|
||||
::
|
||||
++ get-entropy
|
||||
=/ m (strand ,@uvJ)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
`[%done eny.bowl.tin]
|
||||
::
|
||||
:: Convert skips to %ignore failures.
|
||||
::
|
||||
:: This tells the main loop to try the next handler.
|
||||
::
|
||||
++ handle
|
||||
|* a=mold
|
||||
=/ m (strand ,a)
|
||||
|= =form:m
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
=/ res (form tin)
|
||||
=? next.res ?=(%skip -.next.res)
|
||||
[%fail %ignore ~]
|
||||
res
|
||||
::
|
||||
:: Wait for a poke with a particular mark
|
||||
::
|
||||
++ take-poke
|
||||
|= =mark
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %poke @ *]
|
||||
?. =(mark p.cage.u.in.tin)
|
||||
`[%skip ~]
|
||||
`[%done q.cage.u.in.tin]
|
||||
==
|
||||
::
|
||||
::
|
||||
::
|
||||
++ take-sign-arvo
|
||||
=/ m (strand ,[wire sign-arvo])
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %sign *]
|
||||
`[%done [wire sign-arvo]:u.in.tin]
|
||||
==
|
||||
::
|
||||
:: Wait for a subscription update on a wire
|
||||
::
|
||||
++ take-fact-prefix
|
||||
|= =wire
|
||||
=/ m (strand ,[path cage])
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %fact *]
|
||||
?. =(watch+wire (scag +((lent wire)) wire.u.in.tin))
|
||||
`[%skip ~]
|
||||
`[%done (slag (lent wire) wire.u.in.tin) cage.sign.u.in.tin]
|
||||
==
|
||||
::
|
||||
:: Wait for a subscription update on a wire
|
||||
::
|
||||
++ take-fact
|
||||
|= =wire
|
||||
=/ m (strand ,cage)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %fact *]
|
||||
?. =(watch+wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
`[%done cage.sign.u.in.tin]
|
||||
==
|
||||
::
|
||||
:: Wait for a subscription close
|
||||
::
|
||||
++ take-kick
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %kick *]
|
||||
?. =(watch+wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
`[%done ~]
|
||||
==
|
||||
::
|
||||
++ echo
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
%- (main-loop ,~)
|
||||
:~ |= ~
|
||||
^- form:m
|
||||
;< =vase bind:m ((handle ,vase) (take-poke %echo))
|
||||
=/ message=tape !<(tape vase)
|
||||
%- (slog leaf+"{message}..." ~)
|
||||
;< ~ bind:m (sleep ~s2)
|
||||
%- (slog leaf+"{message}.." ~)
|
||||
(pure:m ~)
|
||||
::
|
||||
|= ~
|
||||
^- form:m
|
||||
;< =vase bind:m ((handle ,vase) (take-poke %over))
|
||||
%- (slog leaf+"over..." ~)
|
||||
(pure:m ~)
|
||||
==
|
||||
::
|
||||
++ take-watch
|
||||
=/ m (strand ,path)
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %watch *]
|
||||
`[%done path.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-wake
|
||||
|= until=(unit @da)
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %sign [%wait @ ~] %behn %wake *]
|
||||
?. |(?=(~ until) =(`u.until (slaw %da i.t.wire.u.in.tin)))
|
||||
`[%skip ~]
|
||||
?~ error.sign-arvo.u.in.tin
|
||||
`[%done ~]
|
||||
`[%fail %timer-error u.error.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-poke-ack
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %poke-ack *]
|
||||
?. =(wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
?~ p.sign.u.in.tin
|
||||
`[%done ~]
|
||||
`[%fail %poke-fail u.p.sign.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-watch-ack
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %watch-ack *]
|
||||
?. =(watch+wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
?~ p.sign.u.in.tin
|
||||
`[%done ~]
|
||||
`[%fail %watch-ack-fail u.p.sign.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ poke
|
||||
|= [=dock =cage]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ =card:agent:gall [%pass /poke %agent dock %poke cage]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
(take-poke-ack /poke)
|
||||
::
|
||||
++ raw-poke
|
||||
|= [=dock =cage]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ =card:agent:gall [%pass /poke %agent dock %poke cage]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~
|
||||
`[%wait ~]
|
||||
::
|
||||
[~ %agent * %poke-ack *]
|
||||
?. =(/poke wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
`[%done ~]
|
||||
==
|
||||
::
|
||||
++ raw-poke-our
|
||||
|= [app=term =cage]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
;< =bowl:spider bind:m get-bowl
|
||||
(raw-poke [our.bowl app] cage)
|
||||
::
|
||||
++ poke-our
|
||||
|= [=term =cage]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
;< our=@p bind:m get-our
|
||||
(poke [our term] cage)
|
||||
::
|
||||
++ watch
|
||||
|= [=wire =dock =path]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ =card:agent:gall [%pass watch+wire %agent dock %watch path]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
(take-watch-ack wire)
|
||||
::
|
||||
++ watch-one
|
||||
|= [=wire =dock =path]
|
||||
=/ m (strand ,cage)
|
||||
^- form:m
|
||||
;< ~ bind:m (watch wire dock path)
|
||||
;< =cage bind:m (take-fact wire)
|
||||
;< ~ bind:m (take-kick wire)
|
||||
(pure:m cage)
|
||||
::
|
||||
++ watch-our
|
||||
|= [=wire =term =path]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
;< our=@p bind:m get-our
|
||||
(watch wire [our term] path)
|
||||
::
|
||||
++ scry
|
||||
|* [=mold =path]
|
||||
=/ m (strand ,mold)
|
||||
^- form:m
|
||||
?> ?=(^ path)
|
||||
?> ?=(^ t.path)
|
||||
;< =bowl:spider bind:m get-bowl
|
||||
%- pure:m
|
||||
.^(mold i.path (scot %p our.bowl) i.t.path (scot %da now.bowl) t.t.path)
|
||||
::
|
||||
++ leave
|
||||
|= [=wire =dock]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ =card:agent:gall [%pass watch+wire %agent dock %leave ~]
|
||||
(send-raw-card card)
|
||||
::
|
||||
++ leave-our
|
||||
|= [=wire =term]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
;< our=@p bind:m get-our
|
||||
(leave wire [our term])
|
||||
::
|
||||
++ rewatch
|
||||
|= [=wire =dock =path]
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m ((handle ,~) (take-kick wire))
|
||||
;< ~ bind:m (flog-text "rewatching {<dock>} {<path>}")
|
||||
;< ~ bind:m (watch wire dock path)
|
||||
(pure:m ~)
|
||||
::
|
||||
++ wait
|
||||
|= until=@da
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
;< ~ bind:m (send-wait until)
|
||||
(take-wake `until)
|
||||
::
|
||||
++ sleep
|
||||
|= for=@dr
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
;< now=@da bind:m get-time
|
||||
(wait (add now for))
|
||||
::
|
||||
++ send-wait
|
||||
|= until=@da
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ =card:agent:gall
|
||||
[%pass /wait/(scot %da until) %arvo %b %wait until]
|
||||
(send-raw-card card)
|
||||
::
|
||||
++ map-err
|
||||
|* computation-result=mold
|
||||
=/ m (strand ,computation-result)
|
||||
|= [f=$-([term tang] [term tang]) computation=form:m]
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
=* loop $
|
||||
=/ c-res (computation tin)
|
||||
?: ?=(%cont -.next.c-res)
|
||||
c-res(self.next ..loop(computation self.next.c-res))
|
||||
?. ?=(%fail -.next.c-res)
|
||||
c-res
|
||||
c-res(err.next (f err.next.c-res))
|
||||
::
|
||||
++ set-timeout
|
||||
|* computation-result=mold
|
||||
=/ m (strand ,computation-result)
|
||||
|= [time=@dr computation=form:m]
|
||||
^- form:m
|
||||
;< now=@da bind:m get-time
|
||||
=/ when (add now time)
|
||||
=/ =card:agent:gall
|
||||
[%pass /timeout/(scot %da when) %arvo %b %wait when]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
|= tin=strand-input:strand
|
||||
=* loop $
|
||||
?: ?& ?=([~ %sign [%timeout @ ~] %behn %wake *] in.tin)
|
||||
=((scot %da when) i.t.wire.u.in.tin)
|
||||
==
|
||||
`[%fail %timeout ~]
|
||||
=/ c-res (computation tin)
|
||||
?: ?=(%cont -.next.c-res)
|
||||
c-res(self.next ..loop(computation self.next.c-res))
|
||||
?: ?=(%done -.next.c-res)
|
||||
=/ =card:agent:gall
|
||||
[%pass /timeout/(scot %da when) %arvo %b %rest when]
|
||||
c-res(cards [card cards.c-res])
|
||||
c-res
|
||||
::
|
||||
++ send-request
|
||||
|= =request:http
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-card %pass /request %arvo %i %request request *outbound-config:iris)
|
||||
::
|
||||
++ send-cancel-request
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-card %pass /request %arvo %i %cancel-request ~)
|
||||
::
|
||||
++ take-client-response
|
||||
=/ m (strand ,client-response:iris)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
::
|
||||
[~ %sign [%request ~] %iris %http-response %cancel *]
|
||||
::NOTE iris does not (yet?) retry after cancel, so it means failure
|
||||
:- ~
|
||||
:+ %fail
|
||||
%http-request-cancelled
|
||||
['http request was cancelled by the runtime']~
|
||||
::
|
||||
[~ %sign [%request ~] %iris %http-response %finished *]
|
||||
`[%done client-response.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
:: Wait until we get an HTTP response or cancelation and unset contract
|
||||
::
|
||||
++ take-maybe-sigh
|
||||
=/ m (strand ,(unit httr:eyre))
|
||||
^- form:m
|
||||
;< rep=(unit client-response:iris) bind:m
|
||||
take-maybe-response
|
||||
?~ rep
|
||||
(pure:m ~)
|
||||
:: XX s/b impossible
|
||||
::
|
||||
?. ?=(%finished -.u.rep)
|
||||
(pure:m ~)
|
||||
(pure:m (some (to-httr:iris +.u.rep)))
|
||||
::
|
||||
++ take-maybe-response
|
||||
=/ m (strand ,(unit client-response:iris))
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %sign [%request ~] %iris %http-response %cancel *]
|
||||
`[%done ~]
|
||||
[~ %sign [%request ~] %iris %http-response %finished *]
|
||||
`[%done `client-response.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ extract-body
|
||||
|= =client-response:iris
|
||||
=/ m (strand ,cord)
|
||||
^- form:m
|
||||
?> ?=(%finished -.client-response)
|
||||
%- pure:m
|
||||
?~ full-file.client-response ''
|
||||
q.data.u.full-file.client-response
|
||||
::
|
||||
++ fetch-cord
|
||||
|= url=tape
|
||||
=/ m (strand ,cord)
|
||||
^- form:m
|
||||
=/ =request:http [%'GET' (crip url) ~ ~]
|
||||
;< ~ bind:m (send-request request)
|
||||
;< =client-response:iris bind:m take-client-response
|
||||
(extract-body client-response)
|
||||
::
|
||||
++ fetch-json
|
||||
|= url=tape
|
||||
=/ m (strand ,json)
|
||||
^- form:m
|
||||
;< =cord bind:m (fetch-cord url)
|
||||
=/ json=(unit json) (de-json:html cord)
|
||||
?~ json
|
||||
(strand-fail %json-parse-error ~)
|
||||
(pure:m u.json)
|
||||
::
|
||||
++ hiss-request
|
||||
|= =hiss:eyre
|
||||
=/ m (strand ,(unit httr:eyre))
|
||||
^- form:m
|
||||
;< ~ bind:m (send-request (hiss-to-request:html hiss))
|
||||
take-maybe-sigh
|
||||
::
|
||||
:: +build-file: build the source file at the specified $beam
|
||||
::
|
||||
++ build-file
|
||||
|= [[=ship =desk =case] =spur]
|
||||
=* arg +<
|
||||
=/ m (strand ,(unit vase))
|
||||
^- form:m
|
||||
;< =riot:clay bind:m
|
||||
(warp ship desk ~ %sing %a case spur)
|
||||
?~ riot
|
||||
(pure:m ~)
|
||||
?> =(%vase p.r.u.riot)
|
||||
(pure:m (some !<(vase q.r.u.riot)))
|
||||
:: +build-mark: build a mark definition to a $dais
|
||||
::
|
||||
++ build-mark
|
||||
|= [[=ship =desk =case] mak=mark]
|
||||
=* arg +<
|
||||
=/ m (strand ,dais:clay)
|
||||
^- form:m
|
||||
;< =riot:clay bind:m
|
||||
(warp ship desk ~ %sing %b case /[mak])
|
||||
?~ riot
|
||||
(strand-fail %build-mark >arg< ~)
|
||||
?> =(%dais p.r.u.riot)
|
||||
(pure:m !<(dais:clay q.r.u.riot))
|
||||
:: +build-tube: build a mark conversion gate ($tube)
|
||||
::
|
||||
++ build-tube
|
||||
|= [[=ship =desk =case] =mars:clay]
|
||||
=* arg +<
|
||||
=/ m (strand ,tube:clay)
|
||||
^- form:m
|
||||
;< =riot:clay bind:m
|
||||
(warp ship desk ~ %sing %c case /[a.mars]/[b.mars])
|
||||
?~ riot
|
||||
(strand-fail %build-tube >arg< ~)
|
||||
?> =(%tube p.r.u.riot)
|
||||
(pure:m !<(tube:clay q.r.u.riot))
|
||||
::
|
||||
:: +build-nave: build a mark definition to a $nave
|
||||
::
|
||||
++ build-nave
|
||||
|= [[=ship =desk =case] mak=mark]
|
||||
=* arg +<
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
;< =riot:clay bind:m
|
||||
(warp ship desk ~ %sing %e case /[mak])
|
||||
?~ riot
|
||||
(strand-fail %build-nave >arg< ~)
|
||||
?> =(%nave p.r.u.riot)
|
||||
(pure:m q.r.u.riot)
|
||||
:: +build-cast: build a mark conversion gate (static)
|
||||
::
|
||||
++ build-cast
|
||||
|= [[=ship =desk =case] =mars:clay]
|
||||
=* arg +<
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
;< =riot:clay bind:m
|
||||
(warp ship desk ~ %sing %f case /[a.mars]/[b.mars])
|
||||
?~ riot
|
||||
(strand-fail %build-cast >arg< ~)
|
||||
?> =(%cast p.r.u.riot)
|
||||
(pure:m q.r.u.riot)
|
||||
::
|
||||
:: Read from Clay
|
||||
::
|
||||
++ warp
|
||||
|= [=ship =riff:clay]
|
||||
=/ m (strand ,riot:clay)
|
||||
;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff)
|
||||
(take-writ /warp)
|
||||
::
|
||||
++ read-file
|
||||
|= [[=ship =desk =case:clay] =spur]
|
||||
=* arg +<
|
||||
=/ m (strand ,cage)
|
||||
;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
|
||||
?~ riot
|
||||
(strand-fail %read-file >arg< ~)
|
||||
(pure:m r.u.riot)
|
||||
::
|
||||
++ check-for-file
|
||||
|= [[=ship =desk =case:clay] =spur]
|
||||
=/ m (strand ,?)
|
||||
;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
|
||||
(pure:m ?=(^ riot))
|
||||
::
|
||||
++ list-tree
|
||||
|= [[=ship =desk =case:clay] =spur]
|
||||
=* arg +<
|
||||
=/ m (strand ,(list path))
|
||||
;< =riot:clay bind:m (warp ship desk ~ %sing %t case spur)
|
||||
?~ riot
|
||||
(strand-fail %list-tree >arg< ~)
|
||||
(pure:m !<((list path) q.r.u.riot))
|
||||
::
|
||||
:: Take Clay read result
|
||||
::
|
||||
++ take-writ
|
||||
|= =wire
|
||||
=/ m (strand ,riot:clay)
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %sign * ?(%behn %clay) %writ *]
|
||||
?. =(wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
`[%done +>.sign-arvo.u.in.tin]
|
||||
==
|
||||
:: +check-online: require that peer respond before timeout
|
||||
::
|
||||
++ check-online
|
||||
|= [who=ship lag=@dr]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
%+ (map-err ,~) |=(* [%offline *tang])
|
||||
%+ (set-timeout ,~) lag
|
||||
;< ~ bind:m
|
||||
(poke [who %hood] %helm-hi !>(~))
|
||||
(pure:m ~)
|
||||
::
|
||||
:: Queue on skip, try next on fail %ignore
|
||||
::
|
||||
++ main-loop
|
||||
|* a=mold
|
||||
=/ m (strand ,~)
|
||||
=/ m-a (strand ,a)
|
||||
=| queue=(qeu (unit input:strand))
|
||||
=| active=(unit [in=(unit input:strand) =form:m-a forms=(list $-(a form:m-a))])
|
||||
=| state=a
|
||||
|= forms=(lest $-(a form:m-a))
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
=* top `form:m`..$
|
||||
=. queue (~(put to queue) in.tin)
|
||||
|^ (continue bowl.tin)
|
||||
::
|
||||
++ continue
|
||||
|= =bowl:strand
|
||||
^- output:m
|
||||
?> =(~ active)
|
||||
?: =(~ queue)
|
||||
`[%cont top]
|
||||
=^ in=(unit input:strand) queue ~(get to queue)
|
||||
^- output:m
|
||||
=. active `[in (i.forms state) t.forms]
|
||||
^- output:m
|
||||
(run bowl in)
|
||||
::
|
||||
++ run
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
^- output:m
|
||||
?> ?=(^ active)
|
||||
=/ res (form.u.active tin)
|
||||
=/ =output:m
|
||||
?- -.next.res
|
||||
%wait `[%wait ~]
|
||||
%skip `[%cont ..$(queue (~(put to queue) in.tin))]
|
||||
%cont `[%cont ..$(active `[in.u.active self.next.res forms.u.active])]
|
||||
%done (continue(active ~, state value.next.res) bowl.tin)
|
||||
%fail
|
||||
?: &(?=(^ forms.u.active) ?=(%ignore p.err.next.res))
|
||||
%= $
|
||||
active `[in.u.active (i.forms.u.active state) t.forms.u.active]
|
||||
in.tin in.u.active
|
||||
==
|
||||
`[%fail err.next.res]
|
||||
==
|
||||
[(weld cards.res cards.output) next.output]
|
||||
--
|
||||
::
|
||||
++ retry
|
||||
|* result=mold
|
||||
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
|
||||
=/ m (strand ,result)
|
||||
=| try=@ud
|
||||
|- ^- form:m
|
||||
=* loop $
|
||||
?: =(crash-after `try)
|
||||
(strand-fail %retry-too-many ~)
|
||||
;< ~ bind:m (backoff try ~m1)
|
||||
;< res=(unit result) bind:m computation
|
||||
?^ res
|
||||
(pure:m u.res)
|
||||
loop(try +(try))
|
||||
::
|
||||
++ backoff
|
||||
|= [try=@ud limit=@dr]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
;< eny=@uvJ bind:m get-entropy
|
||||
%- sleep
|
||||
%+ min limit
|
||||
?: =(0 try) ~s0
|
||||
%+ add
|
||||
(mul ~s1 (bex (dec try)))
|
||||
(mul ~s0..0001 (~(rad og eny) 1.000))
|
||||
::
|
||||
:: ----
|
||||
::
|
||||
:: Output
|
||||
::
|
||||
++ flog
|
||||
|= =flog:dill
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-card %pass / %arvo %d %flog flog)
|
||||
::
|
||||
++ flog-text
|
||||
|= =tape
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(flog %text tape)
|
||||
::
|
||||
++ flog-tang
|
||||
|= =tang
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ =wall
|
||||
(zing (turn (flop tang) (cury wash [0 80])))
|
||||
|- ^- form:m
|
||||
=* loop $
|
||||
?~ wall
|
||||
(pure:m ~)
|
||||
;< ~ bind:m (flog-text i.wall)
|
||||
loop(wall t.wall)
|
||||
::
|
||||
++ trace
|
||||
|= =tang
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(pure:m ((slog tang) ~))
|
||||
::
|
||||
++ app-message
|
||||
|= [app=term =cord =tang]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ msg=tape :(weld (trip app) ": " (trip cord))
|
||||
;< ~ bind:m (flog-text msg)
|
||||
(flog-tang tang)
|
||||
::
|
||||
:: ----
|
||||
::
|
||||
:: Handle domains
|
||||
::
|
||||
++ install-domain
|
||||
|= =turf
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-card %pass / %arvo %e %rule %turf %put turf)
|
||||
::
|
||||
:: ----
|
||||
::
|
||||
:: Threads
|
||||
::
|
||||
++ start-thread
|
||||
|= file=term
|
||||
=/ m (strand ,tid:spider)
|
||||
;< =bowl:spider bind:m get-bowl
|
||||
(start-thread-with-args byk.bowl file *vase)
|
||||
::
|
||||
++ start-thread-with-args
|
||||
|= [=beak file=term args=vase]
|
||||
=/ m (strand ,tid:spider)
|
||||
^- form:m
|
||||
;< =bowl:spider bind:m get-bowl
|
||||
=/ tid
|
||||
(scot %ta (cat 3 (cat 3 'strand_' file) (scot %uv (sham file eny.bowl))))
|
||||
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid beak file args])
|
||||
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
|
||||
;< ~ bind:m (sleep ~s0) :: wait for thread to start
|
||||
(pure:m tid)
|
||||
::
|
||||
+$ thread-result
|
||||
(each vase [term tang])
|
||||
::
|
||||
++ await-thread
|
||||
|= [file=term args=vase]
|
||||
=/ m (strand ,thread-result)
|
||||
^- form:m
|
||||
;< =bowl:spider bind:m get-bowl
|
||||
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
|
||||
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid byk.bowl file args])
|
||||
;< ~ bind:m (watch-our /awaiting/[tid] %spider /thread-result/[tid])
|
||||
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
|
||||
;< ~ bind:m (sleep ~s0) :: wait for thread to start
|
||||
;< =cage bind:m (take-fact /awaiting/[tid])
|
||||
;< ~ bind:m (take-kick /awaiting/[tid])
|
||||
?+ p.cage ~|([%strange-thread-result p.cage file tid] !!)
|
||||
%thread-done (pure:m %& q.cage)
|
||||
%thread-fail (pure:m %| ;;([term tang] q.q.cage))
|
||||
==
|
||||
--
|
||||
@ -1 +0,0 @@
|
||||
../../arvo/mar/noun.hoon
|
||||
22
mar/noun.hoon
Normal file
22
mar/noun.hoon
Normal file
@ -0,0 +1,22 @@
|
||||
::
|
||||
:::: /hoon/noun/mar
|
||||
::
|
||||
/? 310
|
||||
!:
|
||||
|_ non=*
|
||||
++ grab |%
|
||||
++ noun *
|
||||
++ mime |=([p=mite q=octs] (cue q.q))
|
||||
--
|
||||
++ grow |%
|
||||
++ mime [/application/octet-stream (as-octs:mimes:html (jam non))]
|
||||
--
|
||||
++ grad
|
||||
|%
|
||||
++ form %noun
|
||||
++ diff |=(* +<)
|
||||
++ pact |=(* +<)
|
||||
++ join |=([* *] *(unit *))
|
||||
++ mash |=([[ship desk *] [ship desk *]] `*`~|(%noun-mash !!))
|
||||
--
|
||||
--
|
||||
@ -2,8 +2,8 @@
|
||||
+$ action
|
||||
$% [%publish =path html=@t md=@t theme=@tas]
|
||||
[%unpublish =path]
|
||||
[%export ~]
|
||||
[%import files=(axal *)]
|
||||
[%export css=?]
|
||||
[%import ~]
|
||||
[%save-draft =path md=@t]
|
||||
[%delete-draft =path]
|
||||
[%save-theme theme=@tas css=@t]
|
||||
|
||||
83
ted/import.hoon
Normal file
83
ted/import.hoon
Normal file
@ -0,0 +1,83 @@
|
||||
/- spider, blog
|
||||
/+ *strandio
|
||||
=, strand=strand:spider
|
||||
=, strand-fail=strand-fail:libstrand:spider
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
;< our=@p bind:m get-our
|
||||
;< now=@da bind:m get-time
|
||||
=/ files-path=path /(scot %p our)/blog/(scot %da now)/import
|
||||
=/ files
|
||||
|-
|
||||
=+ .^(=arch %cy files-path)
|
||||
:: If there is no directory below this, read the file's contents
|
||||
?: (test dir.arch ~)
|
||||
=/ mark
|
||||
?+ (rear files-path) !!
|
||||
%md wain
|
||||
%html @t
|
||||
%css @t
|
||||
%noun noun
|
||||
==
|
||||
=/ content .^(mark %cx files-path)
|
||||
:- [~ content] :: mimic fil.arch (unit item)
|
||||
(~(urn by dir.arch) |=([name=@ta ~] ^$(files-path (snoc files-path name))))
|
||||
:- fil.arch :: ~ or [~ u=item]
|
||||
(~(urn by dir.arch) |=([name=@ta ~] ^$(files-path (snoc files-path name))))
|
||||
|
||||
=/ all-files ~(tap of files)
|
||||
=/ files-import :+
|
||||
published=*(map path [html=@t md=@t theme=@tas])
|
||||
drafts=*(map path md=@t)
|
||||
themes=*(map @tas css=@t)
|
||||
=. files-import
|
||||
|-
|
||||
?: (test all-files ~) files-import
|
||||
%. (rear all-files)
|
||||
|= [=path content=*]
|
||||
%= ^$
|
||||
all-files (snip all-files)
|
||||
files-import
|
||||
?+ (rear path) files-import
|
||||
%md
|
||||
=+ content=(of-wain:format ((list cord) content))
|
||||
?: ?=(%published (snag 0 path))
|
||||
=/ file-name (oust [0 2] (snip path))
|
||||
=/ file (~(gut by published.files-import) file-name [html='' md='' theme=%default])
|
||||
files-import(published (~(put by published.files-import) file-name file(md content)))
|
||||
=/ draft-name (oust [0 1] (snip path))
|
||||
=/ draft (~(gut by drafts.files-import) draft-name [md=''])
|
||||
files-import(drafts (~(put by drafts.files-import) draft-name draft(md content)))
|
||||
%css
|
||||
=/ theme-name (@tas (rear (oust [0 1] (snip path))))
|
||||
=/ theme (~(gut by themes.files-import) theme-name [css=''])
|
||||
files-import(themes (~(put by themes.files-import) theme-name theme(css (@t (@tas content)))))
|
||||
%html
|
||||
=/ file-name (oust [0 2] (snip path))
|
||||
=/ file (~(gut by published.files-import) file-name [html='' md='' theme=%default])
|
||||
files-import(published (~(put by published.files-import) file-name file(html (@t (@tas content)))))
|
||||
==
|
||||
==
|
||||
=/ cards *(list card:agent:gall)
|
||||
=/ themes-map ;; (map path @tas) .^(noun %cx /(scot %p our)/blog/(scot %da now)/import/published/meta/noun)
|
||||
=. cards
|
||||
;: welp
|
||||
cards
|
||||
|
||||
%+ turn ~(tap by published.files-import)
|
||||
|= [=path html=@t md=@t theme=@tas]
|
||||
[%pass /poke %agent [our %blog] %poke %blog-action !>([%publish path html md (~(gut by themes-map) path %default)])]
|
||||
|
||||
%+ turn ~(tap by drafts.files-import)
|
||||
|= [=path md=@t]
|
||||
[%pass /poke %agent [our %blog] %poke %blog-action !>([%save-draft path md])]
|
||||
|
||||
%+ turn ~(tap by themes.files-import)
|
||||
|= [theme=@tas css=@t]
|
||||
[%pass /poke %agent [our %blog] %poke %blog-action !>([%save-theme theme css])]
|
||||
|
||||
==
|
||||
;< ~ bind:m (send-raw-cards cards)
|
||||
(pure:m !>(~))
|
||||
Loading…
Reference in New Issue
Block a user