├── LICENSE ├── README.md └── desk ├── gen └── dbug.hoon ├── lib ├── csv.hoon ├── dbug.hoon ├── default-agent.hoon ├── docket.hoon ├── etch.hoon ├── manx-utils.hoon ├── math.hoon ├── mip.hoon ├── number-to-words.hoon ├── pprint.hoon ├── regex.hoon ├── rudder.hoon ├── schooner.hoon ├── seq.hoon ├── server.hoon ├── skeleton.hoon ├── string.hoon ├── test.hoon └── twoc.hoon ├── mar ├── .gitkeep ├── aac.hoon ├── atom.hoon ├── avi.hoon ├── belt.hoon ├── bill.hoon ├── blit.hoon ├── bmp.hoon ├── css.hoon ├── csv.hoon ├── docket-0.hoon ├── flac.hoon ├── gif.hoon ├── hash.hoon ├── hoon.hoon ├── htm.hoon ├── html.hoon ├── httr.hoon ├── hymn.hoon ├── ico.hoon ├── jam.hoon ├── jpeg.hoon ├── jpg.hoon ├── js.hoon ├── json.hoon ├── kelvin.hoon ├── loob.hoon ├── map.hoon ├── mid.hoon ├── mime.hoon ├── mp3.hoon ├── mp4.hoon ├── mpeg.hoon ├── noun.hoon ├── oga.hoon ├── ogg.hoon ├── ogv.hoon ├── otf.hoon ├── path.hoon ├── pdf.hoon ├── pem.hoon ├── pill.hoon ├── png.hoon ├── purl.hoon ├── ship.hoon ├── snip.hoon ├── story.hoon ├── svg.hoon ├── tang.hoon ├── tape.hoon ├── thread-done.hoon ├── thread-fail.hoon ├── tiff.hoon ├── ttf.hoon ├── txt-diff.hoon ├── txt.hoon ├── udon.hoon ├── umd.hoon ├── urb.hoon ├── urbit.hoon ├── vere.hoon ├── wav.hoon ├── weba.hoon ├── webm.hoon ├── webp.hoon ├── woff2.hoon ├── x-htm.hoon └── xml.hoon ├── sur └── docket.hoon ├── sys.kelvin ├── ted └── naive-csv.hoon └── tests └── lib ├── math.hoon ├── regex.hoon └── seq.hoon /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 urbit 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `%yard`, A Developer Commons 2 | 3 | `%yard` is a provisional desk to offer helpful utilities for Urbit-based app development. Please direct questions and feedback to @sigilante. 4 | 5 | As discussed in [UIP-0108](https://github.com/urbit/UIPs/blob/main/UIPS/UIP-0108.md), we are fielding this as a non-core desk before deciding whether and how to more closely integrate it to the standard Urbit distribution. 6 | 7 | Some rules of thumb for inclusion in %yard: 8 | 9 | - Tools should not replicate (core, standard distribution) functionality unnecessarily, although a case can be made for unification or mirroring. 10 | - Since inclusion in such a desk implies a commitment to maintenance, we prefer to include tools that already fall within the Urbit Foundation's purview. 11 | - No kelvin decrement should be necessary, and Zuse and the rest of the standard library will not be affected. (It is worth noting that %yard will provide a way of gently introducing userspace tools en route to %base, however.) 12 | 13 | At the current time, we'd like to see: 14 | 15 | - developer feedback on any of the tools included in this desk 16 | - suggestions on what else to consider including 17 | - unit tests that adequately vet the behavior of the included libraries and marks 18 | 19 | Among other contributors, `%yard` includes: 20 | 21 | - [`/lib/sequent`](https://github.com/jackfoxy/sequent) by ~nomryg-nilref 22 | - [`/lib/regex`](https://github.com/lynko/re.hoon) by ~macrep-racdec 23 | - [`/lib/manx-utils`](https://github.com/tinnus-napbus/manx-utils/) by ~tinnus-napbus 24 | - [`/lib/math`](https://github.com/sigilante/libmath) by ~lagrev-nocfep 25 | 26 | -------------------------------------------------------------------------------- /desk/gen/dbug.hoon: -------------------------------------------------------------------------------- 1 | :: +dbug: tell /lib/dbug app to print some generic state 2 | :: 3 | :: :app +dbug 4 | :: the entire state 5 | :: :app +dbug %bowl 6 | :: the entire bowl 7 | :: :app +dbug [%state 'thing'] 8 | :: data at thing.state. allows for complex hoon, like '(lent thing)' 9 | :: :app +dbug [direction specifics] 10 | :: all in subs matching the parameters 11 | :: direction: %incoming or %outgoing 12 | :: specifics: 13 | :: ~ all subscriptions 14 | :: [%ship ~ship] subscriptions to/from this ship 15 | :: [%path /path] subscriptions on path containing /path 16 | :: [%wire /wire] subscriptions on wire containing /wire 17 | :: [%term %name] subscriptions to app %name 18 | :: 19 | /+ *dbug 20 | :: 21 | :- %say 22 | |= $: :: environment 23 | :: 24 | * 25 | :: inline arguments 26 | :: 27 | args=?(~ [what=?(%bowl %state) ~] [=poke ~]) 28 | :: named arguments 29 | :: 30 | ~ 31 | == 32 | :- %dbug 33 | ?- args 34 | ~ [%state ''] 35 | [@ ~] ?-(what.args %bowl [%bowl ~], %state [%state '']) 36 | [[@ *] ~] poke.args 37 | == 38 | -------------------------------------------------------------------------------- /desk/lib/csv.hoon: -------------------------------------------------------------------------------- 1 | :: Parse CSV files with a known schema, then perform queries on the 2 | :: results. 3 | :: 4 | |% 5 | ++ text 6 | %+ cook 7 | |= =tape 8 | (crip tape) 9 | ;~ pose 10 | (cook tape soil:vast) 11 | non-quote-text 12 | == 13 | :: 14 | ++ non-quote-text 15 | (star ;~(less com qit)) 16 | :: 17 | ++ parse 18 | |* cols=(list rule) 19 | %+ ifix 20 | :- ;~(sfix ;~(less (just `@`10) (star prn)) (just `@`10)) 21 | (just `@`10) 22 | (more (just `@`10) (parse-line cols)) 23 | :: 24 | ++ parse-line 25 | |* cols=(list rule) 26 | ?~ cols 27 | (easy ~) 28 | ?~ t.cols 29 | i.cols 30 | ;~ plug 31 | i.cols 32 | ;~(pfix com $(cols t.cols)) 33 | == 34 | :: 35 | :: inner join 36 | :: 37 | ++ join 38 | =/ name-side (ream '[left=- right=+]') 39 | |= [left=(list vase) rite=(list vase) =hoon] 40 | ^- (list vase) 41 | |- ^- (list vase) 42 | =* left-loop $ 43 | ?~ left 44 | ~ 45 | =/ rote rite 46 | |- ^- (list vase) 47 | =* rite-loop $ 48 | ?~ rite 49 | left-loop(left t.left, rite rote) 50 | =/ slopped-row (slap (slop i.left i.rite) name-side) 51 | =/ val (slap (slop slopped-row !>(..zuse)) hoon) 52 | ?. =(%& q.val) 53 | rite-loop(rite t.rite) 54 | :- slopped-row 55 | rite-loop(rite t.rite) 56 | :: 57 | :: filter 58 | :: 59 | ++ where 60 | |= [rows=(list vase) =hoon] 61 | ^- (list vase) 62 | %+ skim rows 63 | |= =vase 64 | =/ val (slap vase hoon) 65 | =(%& q.val) 66 | :: 67 | :: select 68 | :: 69 | ++ select 70 | |= [=hoon rows=(list vase)] 71 | ^- (list vase) 72 | %+ turn rows 73 | |= =vase 74 | (slap (slop vase !>(..zuse)) hoon) 75 | :: 76 | :: pretty-print rows 77 | :: 78 | ++ print-rows 79 | |= rows=(list vase) 80 | (slog (turn rows sell)) 81 | -- 82 | -------------------------------------------------------------------------------- /desk/lib/dbug.hoon: -------------------------------------------------------------------------------- 1 | :: dbug: agent wrapper for generic debugging tools 2 | :: 3 | :: usage: %-(agent:dbug your-agent) 4 | :: 5 | |% 6 | +$ poke 7 | $% [%bowl ~] 8 | [%state grab=cord] 9 | [%incoming =about] 10 | [%outgoing =about] 11 | == 12 | :: 13 | +$ about 14 | $@ ~ 15 | $% [%ship =ship] 16 | [%path =path] 17 | [%wire =wire] 18 | [%term =term] 19 | == 20 | :: 21 | ++ agent 22 | |= =agent:gall 23 | ^- agent:gall 24 | !. 25 | |_ =bowl:gall 26 | +* this . 27 | ag ~(. agent bowl) 28 | :: 29 | ++ on-poke 30 | |= [=mark =vase] 31 | ^- (quip card:agent:gall agent:gall) 32 | ?. ?=(%dbug mark) 33 | =^ cards agent (on-poke:ag mark vase) 34 | [cards this] 35 | =/ dbug 36 | !<(poke vase) 37 | =; =tang 38 | ((%*(. slog pri 1) tang) [~ this]) 39 | ?- -.dbug 40 | %bowl [(sell !>(bowl))]~ 41 | :: 42 | %state 43 | =? grab.dbug =('' grab.dbug) '-' 44 | =; product=^vase 45 | [(sell product)]~ 46 | =/ state=^vase 47 | :: if the underlying app has implemented a /dbug/state scry endpoint, 48 | :: use that vase in place of +on-save's. 49 | :: 50 | =/ result=(each ^vase tang) 51 | (mule |.(q:(need (need (on-peek:ag /x/dbug/state))))) 52 | ?:(?=(%& -.result) p.result on-save:ag) 53 | %+ slap 54 | (slop state !>([bowl=bowl ..zuse])) 55 | (ream grab.dbug) 56 | :: 57 | %incoming 58 | =; =tang 59 | ?^ tang tang 60 | [%leaf "no matching subscriptions"]~ 61 | %+ murn 62 | %+ sort ~(tap by sup.bowl) 63 | |= [[* a=[=ship =path]] [* b=[=ship =path]]] 64 | (aor [path ship]:a [path ship]:b) 65 | |= [=duct [=ship =path]] 66 | ^- (unit tank) 67 | =; relevant=? 68 | ?. relevant ~ 69 | `>[path=path from=ship duct=duct]< 70 | ?: ?=(~ about.dbug) & 71 | ?- -.about.dbug 72 | %ship =(ship ship.about.dbug) 73 | %path ?=(^ (find path.about.dbug path)) 74 | %wire %+ lien duct 75 | |=(=wire ?=(^ (find wire.about.dbug wire))) 76 | %term !! 77 | == 78 | :: 79 | %outgoing 80 | =; =tang 81 | ?^ tang tang 82 | [%leaf "no matching subscriptions"]~ 83 | %+ murn 84 | %+ sort ~(tap by wex.bowl) 85 | |= [[[a=wire *] *] [[b=wire *] *]] 86 | (aor a b) 87 | |= [[=wire =ship =term] [acked=? =path]] 88 | ^- (unit tank) 89 | =; relevant=? 90 | ?. relevant ~ 91 | `>[wire=wire agnt=[ship term] path=path ackd=acked]< 92 | ?: ?=(~ about.dbug) & 93 | ?- -.about.dbug 94 | %ship =(ship ship.about.dbug) 95 | %path ?=(^ (find path.about.dbug path)) 96 | %wire ?=(^ (find wire.about.dbug wire)) 97 | %term =(term term.about.dbug) 98 | == 99 | == 100 | :: 101 | ++ on-peek 102 | |= =path 103 | ^- (unit (unit cage)) 104 | ?. ?=([@ %dbug *] path) 105 | (on-peek:ag path) 106 | ?+ path [~ ~] 107 | [%u %dbug ~] ``noun+!>(&) 108 | [%x %dbug %state ~] ``noun+!>(on-save:ag) 109 | [%x %dbug %subscriptions ~] ``noun+!>([wex sup]:bowl) 110 | == 111 | :: 112 | ++ on-init 113 | ^- (quip card:agent:gall agent:gall) 114 | =^ cards agent on-init:ag 115 | [cards this] 116 | :: 117 | ++ on-save on-save:ag 118 | :: 119 | ++ on-load 120 | |= old-state=vase 121 | ^- (quip card:agent:gall agent:gall) 122 | =^ cards agent (on-load:ag old-state) 123 | [cards this] 124 | :: 125 | ++ on-watch 126 | |= =path 127 | ^- (quip card:agent:gall agent:gall) 128 | =^ cards agent (on-watch:ag path) 129 | [cards this] 130 | :: 131 | ++ on-leave 132 | |= =path 133 | ^- (quip card:agent:gall agent:gall) 134 | =^ cards agent (on-leave:ag path) 135 | [cards this] 136 | :: 137 | ++ on-agent 138 | |= [=wire =sign:agent:gall] 139 | ^- (quip card:agent:gall agent:gall) 140 | =^ cards agent (on-agent:ag wire sign) 141 | [cards this] 142 | :: 143 | ++ on-arvo 144 | |= [=wire =sign-arvo] 145 | ^- (quip card:agent:gall agent:gall) 146 | =^ cards agent (on-arvo:ag wire sign-arvo) 147 | [cards this] 148 | :: 149 | ++ on-fail 150 | |= [=term =tang] 151 | ^- (quip card:agent:gall agent:gall) 152 | =^ cards agent (on-fail:ag term tang) 153 | [cards this] 154 | -- 155 | -- 156 | -------------------------------------------------------------------------------- /desk/lib/default-agent.hoon: -------------------------------------------------------------------------------- 1 | /+ skeleton 2 | |* [agent=* help=*] 3 | ?: ?=(%& help) 4 | ~| %default-agent-helpfully-crashing 5 | skeleton 6 | |_ =bowl:gall 7 | ++ on-init 8 | `agent 9 | :: 10 | ++ on-save 11 | !>(~) 12 | :: 13 | ++ on-load 14 | |= old-state=vase 15 | `agent 16 | :: 17 | ++ on-poke 18 | |= =cage 19 | ~| "unexpected poke to {} with mark {}" 20 | !! 21 | :: 22 | ++ on-watch 23 | |= =path 24 | ~| "unexpected subscription to {} on path {}" 25 | !! 26 | :: 27 | ++ on-leave 28 | |= path 29 | `agent 30 | :: 31 | ++ on-peek 32 | |= =path 33 | ~| "unexpected scry into {} on path {}" 34 | !! 35 | :: 36 | ++ on-agent 37 | |= [=wire =sign:agent:gall] 38 | ^- (quip card:agent:gall _agent) 39 | ?- -.sign 40 | %poke-ack 41 | ?~ p.sign 42 | `agent 43 | %- (slog leaf+"poke failed from {} on wire {}" u.p.sign) 44 | `agent 45 | :: 46 | %watch-ack 47 | ?~ p.sign 48 | `agent 49 | =/ =tank leaf+"subscribe failed from {} on wire {}" 50 | %- (slog tank u.p.sign) 51 | `agent 52 | :: 53 | %kick `agent 54 | %fact 55 | ~| "unexpected subscription update to {} on wire {}" 56 | ~| "with mark {}" 57 | !! 58 | == 59 | :: 60 | ++ on-arvo 61 | |= [=wire =sign-arvo] 62 | ~| "unexpected system response {<-.sign-arvo>} to {} on wire {}" 63 | !! 64 | :: 65 | ++ on-fail 66 | |= [=term =tang] 67 | %- (slog leaf+"error in {}" >term< tang) 68 | `agent 69 | -- 70 | -------------------------------------------------------------------------------- /desk/lib/docket.hoon: -------------------------------------------------------------------------------- 1 | /- *docket 2 | |% 3 | :: 4 | ++ mime 5 | |% 6 | +$ draft 7 | $: title=(unit @t) 8 | info=(unit @t) 9 | color=(unit @ux) 10 | glob-http=(unit [=url hash=@uvH]) 11 | glob-ames=(unit [=ship hash=@uvH]) 12 | base=(unit term) 13 | site=(unit path) 14 | image=(unit url) 15 | version=(unit version) 16 | website=(unit url) 17 | license=(unit cord) 18 | == 19 | :: 20 | ++ finalize 21 | |= =draft 22 | ^- (unit docket) 23 | ?~ title.draft ~ 24 | ?~ info.draft ~ 25 | ?~ color.draft ~ 26 | ?~ version.draft ~ 27 | ?~ website.draft ~ 28 | ?~ license.draft ~ 29 | =/ href=(unit href) 30 | ?^ site.draft `[%site u.site.draft] 31 | ?~ base.draft ~ 32 | ?^ glob-http.draft 33 | `[%glob u.base hash.u.glob-http %http url.u.glob-http]:draft 34 | ?~ glob-ames.draft 35 | ~ 36 | `[%glob u.base hash.u.glob-ames %ames ship.u.glob-ames]:draft 37 | ?~ href ~ 38 | =, draft 39 | :- ~ 40 | :* %1 41 | u.title 42 | u.info 43 | u.color 44 | u.href 45 | image 46 | u.version 47 | u.website 48 | u.license 49 | == 50 | :: 51 | ++ from-clauses 52 | =| =draft 53 | |= cls=(list clause) 54 | ^- (unit docket) 55 | =* loop $ 56 | ?~ cls (finalize draft) 57 | =* clause i.cls 58 | =. draft 59 | ?- -.clause 60 | %title draft(title `title.clause) 61 | %info draft(info `info.clause) 62 | %color draft(color `color.clause) 63 | %glob-http draft(glob-http `[url hash]:clause) 64 | %glob-ames draft(glob-ames `[ship hash]:clause) 65 | %base draft(base `base.clause) 66 | %site draft(site `path.clause) 67 | %image draft(image `url.clause) 68 | %version draft(version `version.clause) 69 | %website draft(website `website.clause) 70 | %license draft(license `license.clause) 71 | == 72 | loop(cls t.cls) 73 | :: 74 | ++ to-clauses 75 | |= d=docket 76 | ^- (list clause) 77 | %- zing 78 | :~ :~ title+title.d 79 | info+info.d 80 | color+color.d 81 | version+version.d 82 | website+website.d 83 | license+license.d 84 | == 85 | ?~ image.d ~ ~[image+u.image.d] 86 | ?: ?=(%site -.href.d) ~[site+path.href.d] 87 | =/ ref=glob-reference glob-reference.href.d 88 | :~ base+base.href.d 89 | ?- -.location.ref 90 | %http [%glob-http url.location.ref hash.ref] 91 | %ames [%glob-ames ship.location.ref hash.ref] 92 | == == == 93 | :: 94 | ++ spit-clause 95 | |= =clause 96 | ^- tape 97 | %+ weld " {(trip -.clause)}+" 98 | ?+ -.clause "'{(trip +.clause)}'" 99 | %color (scow %ux color.clause) 100 | %site (spud path.clause) 101 | :: 102 | %glob-http 103 | "['{(trip url.clause)}' {(scow %uv hash.clause)}]" 104 | :: 105 | %glob-ames 106 | "[{(scow %p ship.clause)} {(scow %uv hash.clause)}]" 107 | :: 108 | %version 109 | =, version.clause 110 | "[{(scow %ud major)} {(scow %ud minor)} {(scow %ud patch)}]" 111 | == 112 | :: 113 | ++ spit-docket 114 | |= dock=docket 115 | ^- tape 116 | ;: welp 117 | ":~\0a" 118 | `tape`(zing (join "\0a" (turn (to-clauses dock) spit-clause))) 119 | "\0a==" 120 | == 121 | -- 122 | :: 123 | ++ enjs 124 | =, enjs:format 125 | |% 126 | :: 127 | ++ charge-update 128 | |= u=^charge-update 129 | ^- json 130 | %+ frond -.u 131 | ^- json 132 | ?- -.u 133 | %del-charge s+desk.u 134 | :: 135 | %initial 136 | %- pairs 137 | %+ turn ~(tap by initial.u) 138 | |=([=desk c=^charge] [desk (charge c)]) 139 | :: 140 | %add-charge 141 | %- pairs 142 | :~ desk+s+desk.u 143 | charge+(charge charge.u) 144 | == 145 | == 146 | :: 147 | ++ num 148 | |= a=@u 149 | ^- ^tape 150 | =/ p=json (numb a) 151 | ?> ?=(%n -.p) 152 | (trip p.p) 153 | :: 154 | ++ version 155 | |= v=^version 156 | ^- json 157 | :- %s 158 | %- crip 159 | "{(num major.v)}.{(num minor.v)}.{(num patch.v)}" 160 | :: 161 | ++ merge 162 | |= [a=json b=json] 163 | ^- json 164 | ?> &(?=(%o -.a) ?=(%o -.b)) 165 | [%o (~(uni by p.a) p.b)] 166 | :: 167 | ++ href 168 | |= h=^href 169 | %+ frond -.h 170 | ?- -.h 171 | %site s+(spat path.h) 172 | %glob 173 | %- pairs 174 | :~ base+s+base.h 175 | glob-reference+(glob-reference glob-reference.h) 176 | == 177 | == 178 | :: 179 | ++ glob-reference 180 | |= ref=^glob-reference 181 | %- pairs 182 | :~ hash+s+(scot %uv hash.ref) 183 | location+(glob-location location.ref) 184 | == 185 | :: 186 | ++ glob-location 187 | |= loc=^glob-location 188 | ^- json 189 | %+ frond -.loc 190 | ?- -.loc 191 | %http s+url.loc 192 | %ames s+(scot %p ship.loc) 193 | == 194 | :: 195 | ++ charge 196 | |= c=^charge 197 | %+ merge (docket docket.c) 198 | %- pairs 199 | :~ chad+(chad chad.c) 200 | == 201 | :: 202 | ++ docket 203 | |= d=^docket 204 | ^- json 205 | %- pairs 206 | :~ title+s+title.d 207 | info+s+info.d 208 | color+s+(scot %ux color.d) 209 | href+(href href.d) 210 | image+?~(image.d ~ s+u.image.d) 211 | version+(version version.d) 212 | license+s+license.d 213 | website+s+website.d 214 | == 215 | :: 216 | ++ chad 217 | |= c=^chad 218 | %+ frond -.c 219 | ?+ -.c ~ 220 | %hung s+err.c 221 | == 222 | -- 223 | -- 224 | -------------------------------------------------------------------------------- /desk/lib/etch.hoon: -------------------------------------------------------------------------------- 1 | :: /lib/etch.hoon 2 | :::: ~littel-wolfur, simplified by ~litlep-nibbyt 3 | :: Version ~2023.6.18 4 | :: 5 | /+ *mip 6 | |% 7 | :: 8 | ++ show-json 9 | |= =vase 10 | (en:json:html (en-vase vase)) 11 | :: 12 | ++ en-vase 13 | |= [typ=type arg=*] 14 | ^- json 15 | ?- typ 16 | %void !! 17 | %noun (en-noun arg) 18 | :: 19 | [%atom *] 20 | (en-dime p.typ ;;(@ arg)) 21 | :: 22 | [%cell *] 23 | =/ hed=json $(typ p.typ, arg -.arg) 24 | =/ tal=json $(typ q.typ, arg +.arg) 25 | :: 26 | ?: ?& !!?=([%o ^] hed) 27 | !!?=([%o ^] tal) 28 | == 29 | [%o (~(uni by ?>(?=(%o -.hed) p.hed)) ?>(?=(%o -.tal) p.tal))] 30 | :: 31 | ?~ hed tal 32 | ?: &(?=([%s @t] hed) ?=([%s @t] tal)) 33 | [%a hed tal ~] 34 | ?: &(?=([%s @t] hed) !?=([%s @t] tal) !?=([%a *] tal) !=(~ tal)) 35 | [%a hed tal ~] 36 | ?: &(?=([%a *] hed) ?=([%a *] tal)) 37 | [%a (weld p.hed p.tal)] 38 | ?: ?=([%a *] tal) 39 | [%a hed p.tal] 40 | :: 41 | ?~ tal [%a hed ~] 42 | [%a hed tal ~] 43 | :: 44 | [%core *] !! 45 | :: 46 | [%face *] [%o (malt `(list [@t json])`[;;(@t p.typ) $(typ q.typ)]~)] 47 | :: 48 | [%fork *] 49 | =/ tyz=(list type) (turn ~(tap in p.typ) peel) 50 | =. tyz 51 | %- zing 52 | %+ turn tyz 53 | |= tep=type 54 | ^- (list type) 55 | ?:(?=(%fork -.tep) ~(tap in p.tep) ~[tep]) 56 | :: 57 | ?: =(1 (lent tyz)) 58 | $(typ (head tyz)) 59 | :: $? 60 | :: 61 | ?: (levy tyz |=([t=type] ?=(%atom -.t))) 62 | =/ aura 63 | :: 64 | =/ hid (head tyz) 65 | ?>(?=([%atom @ *] hid) p.hid) 66 | ?> (levy tyz |=([t=type] ?>(?=([%atom * *] t) =(aura p.t)))) 67 | (en-dime aura ;;(@ arg)) 68 | :: $% 69 | :: 70 | ?: (levy tyz |=([t=type] ?=([%cell [%atom * ^] *] t))) 71 | =/ aura 72 | =/ hid (head tyz) 73 | ?>(?=([%cell [%atom @ ^] *] hid) p.p.hid) 74 | :: 75 | =/ hid (head tyz) 76 | =/ val ;;(@ -.arg) 77 | ?> ((sane aura) val) 78 | :: 79 | =/ tag ?:(?=(?(%t %ta %tas) aura) val (scot aura val)) 80 | =/ tin=type 81 | |- 82 | ^- type 83 | ?~ tyz !! 84 | =/ ty=type i.tyz 85 | ?> ?=([%cell [%atom @ ^] *] ty) 86 | ?: =(val u.q.p.ty) q.ty 87 | $(tyz t.tyz) 88 | %+ frond:enjs:format tag $(typ tin, arg +.arg) 89 | :: non-$% fork of cells 90 | :: 91 | ?: (levy tyz |=([t=type] ?=([%cell *] t))) 92 | ~| cell-fork/tyz 93 | ~! tyz !! 94 | :: $@ 95 | :: 96 | =/ [atoms=(list type) cells=(list type)] 97 | (skid tyz |=([t=type] ?=(%atom -.t))) 98 | ?@ arg 99 | $(p.typ (sy atoms)) 100 | $(p.typ (sy cells)) 101 | :: 102 | [%hint *] $(typ q.typ) 103 | [%hold *] $(typ (~(play ut p.typ) q.typ)) 104 | == 105 | :: +peel: recursively unwrap type 106 | :: 107 | ++ peel 108 | |= [typ=type] 109 | =| [cos=(unit term)] 110 | ^- type 111 | |- =* loop $ 112 | ?+ typ typ 113 | [%atom *] ?~ cos typ ;;(type [%face u.cos typ]) 114 | :: 115 | %void !! 116 | :: 117 | [%cell *] 118 | ?^ cos 119 | =/ coll [%cell loop(typ p.typ) loop(typ q.typ)] 120 | ;;(type [%face u.cos coll]) 121 | [%cell loop(typ p.typ) loop(typ q.typ)] 122 | :: 123 | [%face *] 124 | ?~ cos q.typ 125 | ?: =(-.q.typ %hold) loop(typ q.typ) 126 | loop(typ q.typ, cos ~) 127 | :: 128 | [%hint *] 129 | =/ =note q.p.typ 130 | ?+ -.note loop(typ q.typ) 131 | %made 132 | ?^ q.note loop(typ q.typ) 133 | :: disable for now, too slow 134 | loop(typ q.typ, cos ~) 135 | == 136 | :: 137 | [%hold *] loop(typ (~(play ut p.typ) q.typ)) 138 | == 139 | :: 140 | ++ en-noun 141 | |= arg=* 142 | ^- json 143 | ?@ arg 144 | %+ frond:enjs:format ;;(@t arg) ~ 145 | [%a ~[$(arg -.arg) $(arg +.arg)]] 146 | :: 147 | ++ en-dime 148 | |= [aura=@tas dat=@] 149 | ^- json 150 | ?+ aura $(aura %ud) 151 | %c !! 152 | :: 153 | %$ $(aura %ui) 154 | :: 155 | %da [%s (scot %da dat)] 156 | :: [%n (time:enjs:format dat)] 157 | :: 158 | %dr [%s (scot %dr dat)] 159 | :: 160 | %f [%b ;;(? dat)] 161 | :: 162 | %n ~ 163 | :: 164 | %p [%s (scot %p dat)] 165 | :: 166 | %q [%s (scot %q dat)] 167 | :: 168 | ?(%rh %rq %rd %rs) [%s (scot %rs dat)] 169 | :: 170 | %s [%s dat] 171 | :: 172 | ?(%t %ta %tas) [%s dat] 173 | :: 174 | ?(%ub %uc) (numb:enjs:format dat) 175 | :: 176 | %ux [%s (scot %ux dat)] 177 | %uv [%s (scot %uv dat)] 178 | :: 179 | %ui [%n `@t`(rsh [3 2] (scot %ui dat))] 180 | %ud [%n (scot %ud dat)] 181 | == 182 | -- 183 | -------------------------------------------------------------------------------- /desk/lib/manx-utils.hoon: -------------------------------------------------------------------------------- 1 | |_ a=manx 2 | :: whitelisted 3 | :: 4 | :: check all tags are in whitelist 5 | :: 6 | ++ whitelisted 7 | |= b=(set mane) 8 | ^- ? 9 | %- post-fold 10 | |= [g=marx w=?] 11 | ?. w w 12 | (~(has in b) n.g) 13 | :: whitelisted 14 | :: 15 | :: check whether any tags are in blacklist 16 | :: 17 | ++ blacklisted 18 | |= b=(set mane) 19 | ^- ? 20 | %- post-fold 21 | |= [g=marx w=_|] 22 | ?: w w 23 | (~(has in b) n.g) 24 | :: get-max-depth 25 | :: 26 | :: deepest node depth (root is 0) 27 | :: 28 | ++ get-max-depth 29 | ^- @ud 30 | |- 31 | ?~ c.a 0 32 | %+ max 33 | .+ $(c.a c.i.c.a) 34 | $(c.a t.c.a) 35 | :: apply-elem: 36 | :: 37 | :: apply gate to tags/attrs 38 | :: 39 | ++ apply-elem 40 | |= b=$-(marx marx) 41 | |^ ^- manx 42 | [(b g.a) (cloop c.a)] 43 | ++ cloop 44 | |= c=marl 45 | ?~ c ~ 46 | [^$(a i.c) (cloop t.c)] 47 | -- 48 | :: apply-elem-chain 49 | :: 50 | :: apply gate to tags/attrs with parentage given 51 | :: 52 | :: gate takes [a b] where a is the current marx 53 | :: and b is the list of parent marxes in ascending 54 | :: order (i is the direct parent) 55 | :: 56 | ++ apply-elem-chain 57 | =/ ch=(lest marx) ~[g.a] 58 | |= b=$-([marx (list marx)] marx) 59 | |^ ^- manx 60 | [(b ch) (cloop c.a)] 61 | ++ cloop 62 | |= c=marl 63 | ?~ c ~ 64 | [^$(a i.c, ch [g.i.c ch]) (cloop t.c)] 65 | -- 66 | :: post-apply-nodes 67 | :: 68 | :: apply gate to nodes in postorder 69 | :: 70 | :: (unlike apply-elem, the gate takes the 71 | :: whole manx instead of just marx) 72 | :: 73 | ++ post-apply-nodes 74 | |= b=$-(manx manx) 75 | |^ ^- manx 76 | (b [g.a (cloop c.a)]) 77 | ++ cloop 78 | |= c=marl 79 | ?~ c ~ 80 | [^$(a i.c) (cloop t.c)] 81 | -- 82 | :: apply-attrs 83 | :: 84 | :: apply a gate to all attributes 85 | :: 86 | ++ apply-attrs 87 | |= b=$-([mane tape] [mane tape]) 88 | ^- manx 89 | %- apply-elem 90 | |= g=marx 91 | =| y=mart 92 | |- 93 | ?~ a.g g(a (flop y)) 94 | $(a.g t.a.g, y [(b i.a.g) y]) 95 | :: apply-text 96 | :: 97 | :: apply a gate to all ordinary text 98 | :: 99 | ++ apply-text 100 | |= b=$-(tape tape) 101 | ^- manx 102 | %- apply-elem 103 | |= g=marx 104 | ?. ?=(%$ n.g) g 105 | ?~ a.g g 106 | ?. ?=(%$ n.i.a.g) g 107 | ?^ t.a.g g 108 | =. v.i.a.g (b v.i.a.g) g 109 | :: post-fold 110 | :: 111 | :: fold over tags/attrs in postorder 112 | :: 113 | ++ post-fold 114 | |* b=_|=([marx *] +<+) 115 | ^+ ,.+<+.b 116 | |- 117 | ?~ c.a (b g.a +<+.b) 118 | $(a a(c t.c.a), +<+.b $(a i.c.a)) 119 | :: pre-fold 120 | :: 121 | :: fold over tags/attrs in preorder 122 | :: 123 | ++ pre-fold 124 | |* b=_|=([marx *] +<+) 125 | ^+ ,.+<+.b 126 | |- 127 | ?~ c.a 128 | ?: =(%$^%$ n.g.a) 129 | +<+.b 130 | (b g.a +<+.b) 131 | %= $ 132 | a [[%$^%$ ~] t.c.a] 133 | +<+.b 134 | %= $ 135 | a i.c.a 136 | +<+.b 137 | ?: =(%$^%$ n.g.a) 138 | +<+.b 139 | (b g.a +<+.b) 140 | == 141 | == 142 | :: lvl-fold 143 | :: 144 | :: fold over tags/attrs in level order 145 | :: 146 | ++ lvl-fold 147 | |* b=_|=([marx *] +<+) 148 | |^ ^+ ,.+<+.b 149 | =. +<+.b (b g.a +<+.b) 150 | (cloop-a c.a +<+.b) 151 | ++ cloop-a 152 | |= [c=marl acc=_+<+.b] 153 | =/ l c 154 | |- 155 | ?~ l (cloop-b c acc) 156 | $(l t.l, acc (b g.i.l acc)) 157 | ++ cloop-b 158 | |= [c=marl acc=_+<+.b] 159 | ?~ c acc 160 | $(c t.c, acc (cloop-a c.i.c acc)) 161 | -- 162 | :: prune 163 | :: 164 | :: delete nodes when applied gate produces %.y 165 | :: 166 | ++ prune 167 | |= b=$-(manx ?) 168 | |^ ^- (unit manx) 169 | ?: (b a) ~ 170 | [~ g.a (cloop c.a)] 171 | ++ cloop 172 | =| fro=marl 173 | |= to=marl 174 | ?~ to (flop fro) 175 | =+ u=^$(a i.to) 176 | ?~ u $(to t.to) 177 | $(to t.to, fro [u.u fro]) 178 | -- 179 | :: prune-tag 180 | :: 181 | :: delete nodes by tag 182 | :: 183 | ++ prune-tag 184 | |= b=mane 185 | ^- (unit manx) 186 | (prune |=(x=manx =(b n.g.x))) 187 | :: 188 | :: prune-tags 189 | :: 190 | :: delete nodes by tags 191 | :: 192 | ++ prune-tags 193 | |= b=(set mane) 194 | ^- (unit manx) 195 | (prune |=(x=manx (~(has in b) n.g.x))) 196 | :: prune-namespace 197 | :: 198 | :: delete nodes by tag namespace 199 | :: 200 | ++ prune-namespace 201 | |= b=@tas 202 | ^- (unit manx) 203 | (prune |=(x=manx ?@(n.g.x %.n =(b -.n.g.x)))) 204 | :: prune-namespaces 205 | :: 206 | :: delete nodes by tag namespaces 207 | :: 208 | ++ prune-namespaces 209 | |= b=(set @tas) 210 | ^- (unit manx) 211 | (prune |=(x=manx ?@(n.g.x %.n (~(has in b) -.n.g.x)))) 212 | :: prune-attr 213 | :: 214 | :: delete nodes by attribute name 215 | :: 216 | ++ prune-attr 217 | |= b=mane 218 | ^- (unit manx) 219 | %- prune 220 | |= x=manx 221 | %+ roll a.g.x 222 | |= [[n=mane v=tape] w=_|] 223 | ?:(w w =(n b)) 224 | :: prune-attrs 225 | :: 226 | :: delete nodes by attribute names 227 | :: 228 | ++ prune-attrs 229 | |= b=(set mane) 230 | ^- (unit manx) 231 | %- prune 232 | |= x=manx 233 | %+ roll a.g.x 234 | |= [[n=mane v=tape] w=_|] 235 | ?: w w 236 | (~(has in b) n) 237 | :: prune-depth 238 | :: 239 | :: delete nodes deeper than b (root is 0) 240 | :: 241 | ++ prune-depth 242 | |= b=@ud 243 | |^ ^- (unit manx) 244 | ?: =(0 b) ~ 245 | [~ g.a (cloop c.a)] 246 | ++ cloop 247 | |= to=marl 248 | =| fro=marl 249 | |- 250 | ?~ to (flop fro) 251 | =/ x (prune-depth(a i.to) (dec b)) 252 | ?~ x $(to t.to) 253 | $(to t.to, fro [u.x fro]) 254 | -- 255 | :: del-attrs 256 | :: 257 | :: delete attributes by name 258 | :: 259 | ++ del-attrs 260 | |= b=(set mane) 261 | ^- manx 262 | %- apply-elem 263 | |= g=marx 264 | =| y=mart 265 | |- 266 | ?~ a.g g(a (flop y)) 267 | ?: (~(has in b) n.i.a.g) 268 | $(a.g t.a.g) 269 | $(a.g t.a.g, y [i.a.g y]) 270 | :: keep-attrs 271 | :: 272 | :: delete all attributes except those 273 | :: with the given names 274 | :: 275 | ++ keep-attrs 276 | |= b=(set mane) 277 | ^- manx 278 | %- apply-elem 279 | |= g=marx 280 | =| y=mart 281 | |- 282 | ?~ a.g g(a (flop y)) 283 | ?. (~(has in b) n.i.a.g) 284 | $(a.g t.a.g) 285 | $(a.g t.a.g, y [i.a.g y]) 286 | :: post-flatten 287 | :: 288 | :: get a list of elements by postorder traversal 289 | :: 290 | ++ post-flatten 291 | ^- marl 292 | (flop (post-fold |=([g=marx l=marl] [[g ~] l]))) 293 | :: pre-flatten 294 | :: 295 | :: get a list of elements by preorder traversal 296 | :: 297 | ++ pre-flatten 298 | ^- marl 299 | (flop (pre-fold |=([g=marx l=marl] [[g ~] l]))) 300 | :: lvl-flatten 301 | :: 302 | :: get a list of elements by level order traversal 303 | :: 304 | ++ lvl-flatten 305 | ^- marl 306 | (flop (lvl-fold |=([g=marx l=marl] [[g ~] l]))) 307 | :: post-get-text 308 | :: 309 | :: get a list of plain text by postorder traversal 310 | :: 311 | ++ post-get-text 312 | ^- wall 313 | %- flop 314 | %- post-fold 315 | |= [g=marx l=wall] 316 | ?. ?=(%$ n.g) l 317 | ?~ a.g l 318 | ?. ?=(%$ n.i.a.g) l 319 | ?^ t.a.g l 320 | :- v.i.a.g l 321 | :: pre-get-text 322 | :: 323 | :: get a list of plain text by preorder traversal 324 | :: 325 | ++ pre-get-text 326 | ^- wall 327 | %- flop 328 | %- pre-fold 329 | |= [g=marx l=wall] 330 | ?. ?=(%$ n.g) l 331 | ?~ a.g l 332 | ?. ?=(%$ n.i.a.g) l 333 | ?^ t.a.g l 334 | :- v.i.a.g l 335 | :: lvl-get-text 336 | :: 337 | :: get a list of plain text by level order traversal 338 | :: 339 | ++ lvl-get-text 340 | ^- wall 341 | %- flop 342 | %- lvl-fold 343 | |= [g=marx l=wall] 344 | ?. ?=(%$ n.g) l 345 | ?~ a.g l 346 | ?. ?=(%$ n.i.a.g) l 347 | ?^ t.a.g l 348 | :- v.i.a.g l 349 | :: search-text 350 | :: 351 | :: find plain text containing the given cord 352 | :: 353 | ++ search-text 354 | |= b=@t 355 | ^- wall 356 | %- flop 357 | %- post-fold 358 | |= [g=marx l=wall] 359 | ?. ?=(%$ n.g) l 360 | ?~ a.g l 361 | ?. ?=(%$ n.i.a.g) l 362 | ?^ t.a.g l 363 | =+ par=(cury (jest b) *hair) 364 | ?. |- 365 | ?~ v.i.a.g %.n 366 | ?^ (tail (par v.i.a.g)) 367 | %.y 368 | $(v.i.a.g t.v.i.a.g) 369 | l 370 | [v.i.a.g l] 371 | -- 372 | 373 | -------------------------------------------------------------------------------- /desk/lib/mip.hoon: -------------------------------------------------------------------------------- 1 | ../../base-dev/lib/mip.hoon 2 | -------------------------------------------------------------------------------- /desk/lib/number-to-words.hoon: -------------------------------------------------------------------------------- 1 | :: |number-to-words: conversion of unsigned integers to a tape 2 | :: 3 | :: returns a unit because not all numbers can always be represented 4 | :: 5 | |% 6 | ++ numbers 7 | |% 8 | ++ ten 10 9 | ++ one-hundred 100 10 | ++ one-thousand (pow 10 3) 11 | ++ one-million (pow 10 6) 12 | ++ one-billion (pow 10 9) 13 | ++ one-trillion (pow 10 12) 14 | ++ one-quadrillion (pow 10 15) 15 | ++ one-quintillion (pow 10 18) 16 | ++ one-sextillion (pow 10 21) 17 | ++ one-septillion (pow 10 24) 18 | ++ one-octillion (pow 10 27) 19 | ++ one-nonillion (pow 10 30) 20 | ++ one-decillion (pow 10 33) 21 | ++ one-undecillion (pow 10 36) 22 | ++ one-duodecillion (pow 10 39) 23 | ++ one-tredecillion (pow 10 42) 24 | ++ one-quattuordecillion (pow 10 45) 25 | ++ one-quindecillion (pow 10 48) 26 | ++ one-sexdecillion (pow 10 51) 27 | ++ one-septendecillion (pow 10 54) 28 | ++ one-octodecillion (pow 10 57) 29 | ++ one-novemdecillion (pow 10 60) 30 | ++ one-vigintillion (pow 10 63) 31 | ++ max (pow 10 66) 32 | -- 33 | ++ eng-us 34 | |% 35 | ++ to-words 36 | |= num=@u 37 | ^- (unit tape) 38 | =+ numbers 39 | ?: (gte num max) 40 | ~ 41 | :- ~ 42 | |- 43 | ^- tape 44 | :: 0-19 45 | ?: =(num 0) "zero" 46 | ?: =(num 1) "one" 47 | ?: =(num 2) "two" 48 | ?: =(num 3) "three" 49 | ?: =(num 4) "four" 50 | ?: =(num 5) "five" 51 | ?: =(num 6) "six" 52 | ?: =(num 7) "seven" 53 | ?: =(num 8) "eight" 54 | ?: =(num 9) "nine" 55 | ?: =(num 10) "ten" 56 | ?: =(num 11) "eleven" 57 | ?: =(num 12) "twelve" 58 | ?: =(num 13) "thirteen" 59 | ?: =(num 14) "fourteen" 60 | ?: =(num 15) "fifteen" 61 | ?: =(num 16) "sixteen" 62 | ?: =(num 17) "seventeen" 63 | ?: =(num 18) "eighteen" 64 | ?: =(num 19) "nineteen" 65 | :: 20-99 66 | :: 67 | :: tpl: tens place 68 | :: rem: ones place 69 | :: sfx: suffix 70 | :: 71 | =/ tpl (div num ten) 72 | =/ rem (mod num ten) 73 | =/ sfx 74 | ?: |(=(rem 0) (gte tpl 10)) 75 | ~ 76 | ['-' $(num rem)] 77 | ?: =(tpl 2) (weld "twenty" sfx) 78 | ?: =(tpl 3) (weld "thirty" sfx) 79 | ?: =(tpl 4) (weld "forty" sfx) 80 | ?: =(tpl 5) (weld "fifty" sfx) 81 | ?: =(tpl 6) (weld "sixty" sfx) 82 | ?: =(tpl 7) (weld "seventy" sfx) 83 | ?: =(tpl 8) (weld "eighty" sfx) 84 | ?: =(tpl 9) (weld "ninety" sfx) 85 | :: 100-max 86 | :: 87 | :: num-break: repeated pattern from 100 on 88 | :: 89 | =/ num-break 90 | :: 91 | :: min: minimum to qualify for this break 92 | :: str: english word for this break 93 | :: 94 | |= [min=@u str=tape] 95 | =/ rem (mod num min) 96 | ;: weld 97 | ^$(num (div num min)) 98 | [' ' str] 99 | ?: =(rem 0) 100 | ~ 101 | %+ weld 102 | ?:((lth rem one-hundred) " and " ", ") 103 | ^$(num rem) 104 | == 105 | :: 106 | ?: (lth num one-thousand) 107 | (num-break one-hundred "hundred") 108 | ?: (lth num one-million) 109 | (num-break one-thousand "thousand") 110 | ?: (lth num one-billion) 111 | (num-break one-million "million") 112 | ?: (lth num one-trillion) 113 | (num-break one-billion "billion") 114 | ?: (lth num one-quadrillion) 115 | (num-break one-trillion "trillion") 116 | ?: (lth num one-quintillion) 117 | (num-break one-quadrillion "quadrillion") 118 | ?: (lth num one-sextillion) 119 | (num-break one-quintillion "quintillion") 120 | ?: (lth num one-septillion) 121 | (num-break one-sextillion "sextillion") 122 | ?: (lth num one-octillion) 123 | (num-break one-septillion "septillion") 124 | ?: (lth num one-nonillion) 125 | (num-break one-octillion "octillion") 126 | ?: (lth num one-decillion) 127 | (num-break one-nonillion "nonillion") 128 | ?: (lth num one-undecillion) 129 | (num-break one-decillion "decillion") 130 | ?: (lth num one-duodecillion) 131 | (num-break one-undecillion "undecillion") 132 | ?: (lth num one-tredecillion) 133 | (num-break one-duodecillion "duodecillion") 134 | ?: (lth num one-quattuordecillion) 135 | (num-break one-tredecillion "tredecillion") 136 | ?: (lth num one-quindecillion) 137 | (num-break one-quattuordecillion "quattuordecillion") 138 | ?: (lth num one-sexdecillion) 139 | (num-break one-quindecillion "quindecillion") 140 | ?: (lth num one-septendecillion) 141 | (num-break one-sexdecillion "sexdecillion") 142 | ?: (lth num one-octodecillion) 143 | (num-break one-septendecillion "septendecillion") 144 | ?: (lth num one-novemdecillion) 145 | (num-break one-octodecillion "octodecillion") 146 | ?: (lth num one-vigintillion) 147 | (num-break one-novemdecillion "novemdecillion") 148 | (num-break one-vigintillion "vigintillion") 149 | -- 150 | -- 151 | -------------------------------------------------------------------------------- /desk/lib/pprint.hoon: -------------------------------------------------------------------------------- 1 | ../../arvo/lib/pprint.hoon 2 | -------------------------------------------------------------------------------- /desk/lib/regex.hoon: -------------------------------------------------------------------------------- 1 | => 2 | |% 3 | +$ range (pair pint tape) 4 | +$ match (map @u range) 5 | -- 6 | =< 7 | |% 8 | :: 9 | :: This outer core represents the main interface for executing regular 10 | :: expressions. Most of its arms produce a +$range (a tape annotated 11 | :: with location data) or a +$match (a map from capture numbers to 12 | :: +$range). These functions should serve your basic purposes, but for 13 | :: more complex operations you may use the inner core ++on (see below). 14 | :: 15 | ++ valid :: Determine if a regular expression is valid 16 | |= [regex=tape] ^- ? 17 | !=(~ (purse:on regex)) 18 | :: 19 | ++ run :: Find the first match of a pattern in a subject 20 | |= [regex=tape text=tape] ^- (unit match) 21 | =+ pan=(parse:on regex) 22 | =+ ini=(init:on text) 23 | |- 24 | =+ sat=(long:on (pan ini)) 25 | ?~ sat 26 | ?~ q.tub.ini ~ 27 | $(ini (skip:on ini)) 28 | `gru.u.sat 29 | :: 30 | ++ ran :: Find the first match; crash if there is none 31 | |= [regex=tape text=tape] ^- match 32 | =+ mat=(run regex text) 33 | ?~(mat !! u.mat) 34 | :: 35 | ++ rut :: Find the text of the first match 36 | |= [regex=tape text=tape] ^- (unit range) 37 | =+ mat=(run regex text) 38 | ?~(mat ~ `(~(got by u.mat) 0)) 39 | :: 40 | ++ rat :: Find the text of the first match; crash if there is none 41 | |= [regex=tape text=tape] ^- range 42 | =+ mat=(ran regex text) 43 | (~(got by mat) 0) 44 | :: 45 | ++ all :: Find all non-empty, non-overlapping matches 46 | |= [regex=tape text=tape] ^- (list match) 47 | =+ pan=(parse:on regex) 48 | =+ ini=(init:on text) 49 | =+ lis=`(list match)`~ 50 | |- 51 | =+ sat=(long:on (pan ini)) 52 | ?~ sat 53 | ?~ q.tub.ini (flop lis) 54 | $(ini (skip:on ini)) 55 | ?: =(p.tub.ini p.tub.u.sat) 56 | ?~ q.tub.ini (flop lis) 57 | $(ini (skip:on ini)) 58 | $(ini u.sat(gru ~), lis [gru.u.sat lis]) 59 | :: 60 | ++ alt :: Find the text of all non-empty, non-overlapping matches 61 | |= [regex=tape text=tape] ^- (list range) 62 | %+ turn (all regex text) 63 | |= [mat=match] (~(got by mat) 0) 64 | :: 65 | ++ is :: If regex validates text, produces nil; otherwise, produces 66 | :: the location of the first non-matching character 67 | |= [regex=tape text=tape] ^- (unit hair) 68 | =+ pan=(parse:on regex) 69 | =+ ini=(init:on text) 70 | |- 71 | ?~ q.tub.ini ~ 72 | =+ sat=(long:on (pan ini)) 73 | ?~ sat `p.tub.ini 74 | $(ini u.sat(gru ~)) 75 | :: 76 | ++ as :: Produce nil, crashing if regex does not validate text 77 | |= [regex=tape text=tape] ^- ~ 78 | ?~((is regex text) ~ !!) 79 | :: 80 | ++ has :: Determine whether a pattern has a match 81 | |= [regex=tape text=tape] ^- ? 82 | ?~ (run regex text) 83 | %.n 84 | %.y 85 | :: 86 | ++ from :: Find the next match after a certain point 87 | |= [regex=tape where=hair text=tape] ^- (unit match) 88 | =+ pan=(parse:on regex) 89 | =+ ini=(init:on text) 90 | |- 91 | ?: (past:of p.tub.ini where) 92 | ?~ q.tub.ini ~ 93 | $(ini (skip:on ini)) 94 | |- 95 | =+ sat=(long:on (pan ini)) 96 | ?~ sat 97 | ?~ q.tub.ini ~ 98 | $(ini (skip:on ini)) 99 | `gru.u.sat 100 | :: 101 | ++ fort :: Find the text of the next match after a certain point 102 | |= [regex=tape where=hair text=tape] ^- (unit range) 103 | =+ mat=(from regex where text) 104 | ?~(mat ~ `(~(got by u.mat) 0)) 105 | :: 106 | ++ sub :: Replace the first match with a string 107 | |= [regex=tape repl=tape text=tape] ^- tape 108 | (subf regex |=(* repl) text) 109 | :: 110 | ++ gsub :: Replace all matches with a string 111 | |= [regex=tape repl=tape text=tape] ^- tape 112 | (gsubf regex |=(* repl) text) 113 | :: 114 | ++ subf :: Replace the first match by a function 115 | |= [regex=tape repl=$-(tape tape) text=tape] ^- tape 116 | =+ mat=(rut regex text) 117 | ?~ mat text 118 | %+ weld q:(lant:of p.p.u.mat [[1 1] text]) 119 | %+ weld (repl q.u.mat) 120 | q:(whet:of q.p.u.mat [[1 1] text]) 121 | :: 122 | ++ gsubf :: Replace all matches by a function 123 | |= [regex=tape repl=$-(tape tape) text=tape] ^- tape 124 | =+ lis=(alt regex text) 125 | =+ tub=`nail`[[1 1] text] 126 | |- ^- tape 127 | ?~ lis q.tub 128 | %+ weld q:(lant:of p.p.i.lis tub) 129 | %+ weld (repl q.i.lis) 130 | $(tub (whet:of q.p.i.lis tub), lis t.lis) 131 | -- 132 | :: 133 | |% :: Internal operations 134 | :: 135 | :: Patterns are construed as a function that produces a promise-based 136 | :: stream of successive matches. This function accepts a +$state which 137 | :: is somewhat more complex than a tape; the ++on core is used for 138 | :: creating and operating on these states and patterns. 139 | :: 140 | :: Applying a pattern to a match state produces a +$promise, which is a 141 | :: trap producing a +$product. +$product is either nil or a tuple, 142 | :: containing the state of the next match that was detected, alongside 143 | :: another promise that will produce the next +$product. The first 144 | :: match state is not necessarily the correct match; use ++long:on to 145 | :: extract the leftmost-longest match from a promise, according to 146 | :: Posix rules. 147 | :: 148 | :: ++parse:of is the main entry point for creating patterns, but it 149 | :: needs an appropriate sample constructed by ++start:of; this logic 150 | :: is handled by ++parse:on. 151 | :: 152 | :: When using patterns directly, remember that they only match text 153 | :: beginning at the given state. Use ++init:on and ++skip:on to test 154 | :: matches downstream in the subject text. 155 | :: 156 | +$ state 157 | $: tub=nail :: Remaining text to be matched 158 | las=(unit @t) :: The previous character in the subject text 159 | gru=match :: Capture groups that have been matched so far 160 | == 161 | +$ product (unit (pair state promise)) 162 | +$ promise _^&(|.(`(unit (pair state _^&(.)))``[*state .])) 163 | +$ pattern _^|(|=(state *promise)) 164 | :: 165 | ++ on :: Basic operations on patterns and states 166 | |% 167 | ++ parse :: Parse regex string 168 | |= [regex=tape] ^- pattern 169 | parse:(start:of regex) 170 | :: 171 | ++ purse :: Unitized parse 172 | |= [regex=tape] ^- (unit pattern) 173 | purse:(start:of regex) 174 | :: 175 | ++ init :: Create an initial state for subject text 176 | |= [sut=tape] ^- state 177 | =| sat=state 178 | %= sat 179 | tub [[1 1] sut] 180 | gru ~ 181 | == 182 | :: 183 | ++ skip :: Advance a state's subject text by one character 184 | |= [sat=state] ^- state 185 | ?~ q.tub.sat sat 186 | sat(tub (skip:of tub.sat), las `i.q.tub.sat) 187 | :: 188 | ++ long :: Get the leftmost-longest match from a promise 189 | |= [per=promise] ^- (unit state) 190 | =+ pro=(per) 191 | ?~ pro ~ 192 | =+ sat=p.u.pro 193 | =. per q.u.pro 194 | |- ^- (unit state) 195 | =+ pro=`product`(per) 196 | ?~ pro `sat 197 | %= $ 198 | per q.u.pro 199 | sat =| n=@ud 200 | =/ lim=@ud 201 | .+ %+ max 202 | (roll ~(tap in ~(key by gru.sat)) max) 203 | (roll ~(tap in ~(key by gru.p.u.pro)) max) 204 | |- 205 | ?: =(n lim) sat 206 | =+ a=(~(get by gru.sat) n) 207 | ?~ a 208 | ?: (~(has by gru.p.u.pro) n) 209 | p.u.pro 210 | $(n +(n)) 211 | =+ b=(~(get by gru.p.u.pro) n) 212 | ?~ b sat 213 | ?: (past:of p.p.u.a p.p.u.b) sat 214 | ?: (past:of p.p.u.b p.p.u.a) p.u.pro 215 | ?: (past:of q.p.u.a q.p.u.b) p.u.pro 216 | ?: (past:of q.p.u.b q.p.u.a) sat 217 | $(n +(n)) 218 | == 219 | -- 220 | :: 221 | ++ of :: Pattern parsing operations 222 | :: 223 | :: Parsing is done by constructing an initial sample with ++start 224 | :: and evaluating the ++parse arm. ++parse begins at the top level 225 | :: with ++top, making reference to the middle level ++mid and the 226 | :: bottom level ++bot, which recurs back to ++top in the case of 227 | :: capture groups. 228 | :: 229 | :: The least tightly-binding regex operator is |, but there is also 230 | :: the case-sensitivity operator (?i), which is effective beyond 231 | :: subsequent | operators but not outside an enclosing group of (). 232 | :: Because (?i) can occur in the middle of an alternated pattern, 233 | :: like "a|b(?i)c|d", we parse the top level into a list of lists, 234 | :: then join the ends of these lists together by catenation into a 235 | :: flat list, which is then joined by alternation. 236 | :: 237 | :: "a|b(?i)c|d" -> {(a or b), ([Cc] or [Dd])} 238 | :: -> (a or b[Cc] or [Dd]} 239 | :: 240 | :: The middle level of parsing handles catenated sequences; for 241 | :: example "a(bcd)*e" is a sequence of three bottom-level regexes: 242 | :: a, (bcd)*, and e. The bottom level of parsing handles everything 243 | :: else (characters, anchors, capture groups, etc) with optional 244 | :: repetition. Capture groups recur to the top level, containing 245 | :: the effects of any case-sensitivity operators. 246 | :: 247 | |_ $: reg=tape :: The pattern being parsed 248 | cas=? :: Are we parsing a case-sensitive pattern? 249 | arp=? :: Will a `)` in the pattern match literally? 250 | == 251 | ++ start 252 | |= [regex=tape] ^- _..start 253 | ..start(reg regex) 254 | ++ parse ^- pattern 255 | (capt 0 (scan reg top)) 256 | ++ purse ^- (unit pattern) 257 | =+ pan=(rust reg top) 258 | ?~ pan ~ 259 | `(capt 0 u.pan) 260 | :: 261 | +$ posix 262 | $: neg=? 263 | $? %ascii %alpha %alnum %blank 264 | %cntrl %digit %graph %lower 265 | %print %punct %space %upper 266 | %word %xdigit 267 | == 268 | == 269 | :: 270 | ++ skip :: Advance a nail by one character 271 | |= [tub=nail] ^- nail 272 | ?~ q.tub tub 273 | [(lust i.q.tub p.tub) t.q.tub] 274 | :: 275 | ++ none :: Promise that produces nothing 276 | ^& |. `(unit (pair state _^&(.)))`~ 277 | :: 278 | ++ once :: Empty pattern (matches "" once) 279 | ^- pattern 280 | |= [sat=state] `promise`|.(`[sat none]) 281 | :: 282 | ++ cont :: Combine two patterns sequentially 283 | |= [pan=pattern pun=pattern] ^- pattern 284 | |= [sat=state] ^- promise 285 | =+ per=(pan sat) 286 | |. ^- product 287 | =+ for=(per) 288 | ?~ for ~ 289 | =+ mid=(pun p.u.for) 290 | |- ^- product 291 | =+ aft=(mid) 292 | ?~ aft ^$(per q.u.for) 293 | `[p.u.aft ..$(mid q.u.aft)] 294 | :: 295 | ++ fork :: Combine two patterns alternatively 296 | |= [pan=pattern pun=pattern] ^- pattern 297 | |= [sat=state] ^- promise 298 | =+ per=(pan sat) 299 | |. ^- product 300 | =+ pro=(per) 301 | ?~ pro ((pun sat)) 302 | `[p.u.pro ..$(per q.u.pro)] 303 | :: 304 | ++ some :: Repeat a pattern 305 | |= [pan=pattern lo=@u hi=(unit @u)] ^- pattern 306 | =| n=@u 307 | |- ^- pattern 308 | ?: =(lo n) 309 | ?~(hi (many pan) (much pan (sub u.hi lo))) 310 | (cont pan $(n +(n))) 311 | :: 312 | ++ much :: Repeat a pattern, bounded 313 | |= [pan=pattern hi=@u] ^- pattern 314 | =| n=@u 315 | |- ^- pattern 316 | ?: =(hi n) once 317 | (cont (fork pan once) $(n +(n))) 318 | :: 319 | ++ many :: Repeat a pattern, unbounded 320 | |= [pan=pattern] ^- pattern 321 | |= [sat=state] ^- promise 322 | =+ per=(pan sat) 323 | |. ^- product 324 | =+ for=(per) 325 | ?~ for `[sat none] 326 | ?: =(p.tub.sat p.tub.p.u.for) 327 | `[p.u.for ..$(per q.u.for)] 328 | =+ mid=^$(sat p.u.for) 329 | |- ^- product 330 | =+ aft=(mid) 331 | ?~ aft `[p.u.for ..^$(per q.u.for)] 332 | `[p.u.aft ..$(mid q.u.aft)] 333 | ++ text :: Create a pattern that matches literal text 334 | |= [tet=tape] ^- pattern 335 | ?: cas 336 | |= [sat=state] ^- promise 337 | |. ^- product 338 | ?~ tet `[sat none] 339 | ?~ q.tub.sat ~ 340 | ?. =(i.tet i.q.tub.sat) ~ 341 | $(tet t.tet, sat (skip:on sat)) 342 | =. tet (cass tet) 343 | |= [sat=state] ^- promise 344 | |. ^- product 345 | ?~ tet `[sat none] 346 | ?~ q.tub.sat ~ 347 | ?. .= i.tet 348 | ?: &((gte i.q.tub.sat 'A') (lte i.q.tub.sat 'Z')) 349 | (add i.q.tub.sat 32) 350 | i.q.tub.sat 351 | ~ 352 | $(tet t.tet, sat (skip:on sat)) 353 | ++ capt :: Capture a pattern's matched text 354 | |= [n=@u pan=pattern] ^- pattern 355 | |= [sat=state] ^- promise 356 | =+ per=(pan sat) 357 | |. 358 | =+ pro=(per) 359 | ?~ pro ~ 360 | :+ ~ 361 | %= p.u.pro 362 | gru 363 | %- ~(put by gru.p.u.pro) 364 | :+ n [p.tub.sat p.tub.p.u.pro] 365 | q:(lant p.tub.p.u.pro tub.sat) 366 | == 367 | ..$(per q.u.pro) 368 | ++ back :: Create a backreference pattern 369 | |= [n=@u] ^- pattern 370 | |= [sat=state] 371 | =+ mat=(~(get by gru.sat) n) 372 | ?~ mat none 373 | ((text q.u.mat) sat) 374 | :: 375 | :: 376 | :: Helper functions 377 | :: 378 | ++ rant 379 | :: Determine if an atom is in a certain range 380 | |= [n=@ lo=@ hi=@] 381 | &((gte n lo) (lte n hi)) 382 | ++ past 383 | :: Determine whether hair `b` comes after hair `a` 384 | |= [a=hair b=hair] ^- ? 385 | ?| (lth p.a p.b) 386 | &(=(p.a p.b) (lth q.a q.b)) 387 | == 388 | ++ prev 389 | :: Get the last character before a certain point 390 | |= [har=hair tub=nail] ^- (unit @t) 391 | ?~ q.tub ~ 392 | ?. (past p.tub har) ~ 393 | =+ c=i.q.tub 394 | %. tub 395 | |= [tub=nail] 396 | ?. (past p.tub har) `c 397 | ?~ q.tub `c 398 | $(c i.q.tub, tub (skip tub)) 399 | ++ lant :: Get the text of a nail up to a certain hair 400 | |= [wer=hair tub=nail] ^- nail 401 | :- p.tub 402 | =+ beh="" 403 | |- 404 | ?~ q.tub (flop beh) 405 | ?. (past p.tub wer) (flop beh) 406 | $(tub (skip tub), beh [i.q.tub beh]) 407 | ++ whet :: Get the text of a nail after a certain heir 408 | |= [wer=hair tub=nail] ^- nail 409 | ?. (past p.tub wer) tub 410 | $(tub (skip tub)) 411 | ++ bond :: Determine if a state is at a word boundary 412 | |= [sat=state] ^- ? 413 | ?~ las.sat 414 | ?~ q.tub.sat %.n 415 | (memb i.q.tub.sat [| %word]) 416 | ?~ q.tub.sat (memb u.las.sat [| %word]) 417 | ?! .= 418 | (memb i.q.tub.sat [| %word]) 419 | (memb u.las.sat [| %word]) 420 | ++ left :: Determine if a state is at the beginning of a word 421 | |= [sat=state] ^- ? 422 | ?~ q.tub.sat %.n 423 | ?& (memb i.q.tub.sat [| %word]) 424 | |(?=(~ las.sat) (memb u.las.sat [& %word])) 425 | == 426 | ++ rite :: Determine if a state is at the end of a word 427 | |= [sat=state] ^- ? 428 | ?~ las.sat %.n 429 | ?& (memb u.las.sat [| %word]) 430 | |(?=(~ q.tub.sat) (memb i.q.tub.sat [& %word])) 431 | == 432 | ++ what :: Determine a group's capture number by hair position 433 | |= [wer=hair] ^- @u 434 | =| n=@u 435 | =+ tub=`nail`[[1 1] reg] 436 | |^ 437 | ?. (past p.tub wer) n 438 | ?~ q.tub n 439 | =+ vex=(non tub) 440 | ?~ q.vex 441 | $(tub (skip tub), n ?:(=('(' i.q.tub) +(n) n)) 442 | $(tub q.u.q.vex) 443 | ++ non :: Skip over a non-capturing (?...) expression 444 | %+ knee *~ 445 | |. ~+ 446 | %+ cold ~ 447 | ;~(pose (ifix [(jest '(?') par] nom) cla) 448 | ++ nom :: Skip over the contents of a non-capturing expression 449 | %+ knee *~ 450 | |. ~+ 451 | %+ cold ~ 452 | ;~ pose 453 | ;~ plug 454 | ;~ pose 455 | (ifix [pal par] nom) 456 | ;~(plug bas next) 457 | ;~(less (mask "\\()[") next) 458 | cla 459 | == 460 | :: 461 | nom 462 | == 463 | :: 464 | (easy ~) 465 | == 466 | -- 467 | ++ memb :: Determine if a character is a member of a POSIX class 468 | |= [=char =posix] ^- ? 469 | .= !neg.posix 470 | ?- +.posix 471 | %ascii (rant char 0 127) 472 | %alnum ?| (rant char 'A' 'Z') 473 | (rant char 'a' 'z') 474 | (rant char '0' '9') 475 | == 476 | %alpha ?| (rant char 'A' 'Z') 477 | (rant char 'a' 'z') 478 | == 479 | %blank |(=(char ' ') =(char '\09')) 480 | %cntrl |((rant char '\00' '\1f') =(char '\7f')) 481 | %digit (rant char '0' '9') 482 | %graph (rant char '!' '~') 483 | %lower (rant char 'a' 'z') 484 | %print (rant char ' ' '~') 485 | %punct ?| (rant char '!' '/') 486 | (rant char ':' '@') 487 | (rant char '[' '`') 488 | (rant char '{' '~') 489 | == 490 | %space |(=(char ' ') (rant char '\09' '\0d')) 491 | %upper (rant char 'A' 'Z') 492 | %word ?| (rant char 'A' 'Z') 493 | (rant char 'a' 'z') 494 | (rant char '0' '9') 495 | =('_' char) 496 | == 497 | %xdigit ?| (rant char '0' '9') 498 | (rant char 'A' 'F') 499 | (rant char 'a' 'f') 500 | == 501 | == 502 | ++ top :: Top-level parsing: alternation and regex mode 503 | %+ cook 504 | |= [lis=(lest (lest pattern))] 505 | =; end=(lest pattern) 506 | |- ^- pattern 507 | ?~ t.end i.end 508 | (fork i.end $(end t.end)) 509 | |- ^- (lest pattern) 510 | ?~ t.lis i.lis 511 | =/ sal=(lest pattern) ?~(t.t.lis i.t.lis $(lis t.lis)) 512 | |- ^- (lest pattern) 513 | ?~ t.i.lis [(cont i.i.lis i.sal) t.sal] 514 | [i.i.lis $(i.lis t.i.lis)] 515 | |- 516 | %+ knee *(lest (lest pattern)) 517 | |. ~+ 518 | ;~ plug 519 | (most bar mid) 520 | :: 521 | ;~ pose 522 | ;~(pfix (jest '(?i)') %=(^$ cas %.n)) 523 | ;~(pfix (jest '(?-i)') %=(^$ cas %.y)) 524 | (easy ~) 525 | == 526 | == 527 | ++ mid :: Mid-level parsing: catenation 528 | %+ knee *pattern 529 | |. ~+ 530 | ;~ pose 531 | (cook cont ;~(plug ;~(pose str bot) mid)) 532 | nil 533 | == 534 | ++ bot :: Bottom-level parsing element 535 | %+ cook 536 | |= [pan=pattern ran=(unit [@u (unit @u)])] 537 | ?~ ran pan 538 | (some pan u.ran) 539 | ;~ plug 540 | ;~ pose 541 | (cook text ;~(plug lit (easy ~))) :: literal or escaped character 542 | cap :: capture group 543 | bak :: backtrack 544 | cla :: character class 545 | ank :: control chars 546 | luk :: lookahead 547 | (cold any dot) :: match forward 548 | (cook text ;~(pfix bas ;~(plug next (easy ~)))) :: non-special escape 549 | == 550 | :: 551 | (punt rep) 552 | == 553 | ++ bak 554 | (cook back ;~(pfix bas dit)) 555 | ++ any ^- pattern 556 | |= [sat=state] ^- promise 557 | |. ^- product 558 | ?~ q.tub.sat ~ 559 | `[(skip:on sat) none] 560 | ++ ank 561 | ;~ pose 562 | %- cold :_ ket 563 | ^- pattern 564 | |= [sat=state] ^- promise 565 | |. ^- product 566 | ?~(las.sat `[sat none] ~) 567 | :: 568 | %- cold :_ buc 569 | ^- pattern 570 | |= [sat=state] ^- promise 571 | |. ^- product 572 | ?~(q.tub.sat `[sat none] ~) 573 | :: 574 | %- cold :_ (jest '\\b') 575 | ^- pattern 576 | |= [sat=state] ^- promise 577 | |. ^- product 578 | ?:((bond sat) `[sat none] ~) 579 | :: 580 | %- cold :_ (jest '\\B') 581 | ^- pattern 582 | |= [sat=state] ^- promise 583 | |. ^- product 584 | ?:((bond sat) ~ `[sat none]) 585 | :: 586 | %- cold :_ (jest '\\<') 587 | ^- pattern 588 | |= [sat=state] ^- promise 589 | |. ^- product 590 | ?:((left sat) `[sat none] ~) 591 | :: 592 | %- cold :_ (jest '\\>') 593 | ^- pattern 594 | |= [sat=state] ^- promise 595 | |. ^- product 596 | ?:((rite sat) `[sat none] ~) 597 | == 598 | ++ nil :: Parse empty pattern 599 | (easy once) 600 | ++ str :: Parse a long string of literal text 601 | (cook text (plus ;~(less ;~(sfix lit rep) lit))) 602 | ++ lit ;~(pose cha esc) 603 | ++ cha :: Literal character 604 | ;~ less 605 | ?: arp 606 | (mask "^$.|?+*([\{\\") 607 | (mask "^$.|?+*()[\{\\") 608 | :: 609 | next 610 | == 611 | ++ esc :: Escape code 612 | ;~ pfix bas 613 | ;~ pose 614 | %- sear :_ next 615 | %~ get by 616 | %- malt 617 | :~ ['a' '\07'] :: Bell 618 | ['t' '\09'] :: Horizontal tab 619 | ['n' '\0a'] :: Newline 620 | ['v' '\0b'] :: Vertical tab 621 | ['f' '\0c'] :: Form feed 622 | ['r' '\0d'] :: Carriage return 623 | ['e' '\1b'] :: Escape 624 | == 625 | :: 626 | ;~ pfix (jest 'x') 627 | %- cook :_ ;~(plug hit hit) 628 | |= [a=@u b=@u] ^- @t 629 | (add (mul 16 a) b) 630 | == 631 | :: 632 | ;~ pfix (jest '0') 633 | %- cook :_ ;~(plug cit cit cit) 634 | |= [a=@u b=@u c=@u] ^- @t 635 | (add (add (mul 64 a) (mul 8 b)) c) 636 | == 637 | :: 638 | ;~ pfix (jest 'c') 639 | %- cook :_ (shim '\00' '\7f') 640 | |= [c=@t] 641 | =. c ?:((rant c 'a' 'z') (sub c 32) c) 642 | ?: =(0 (dis c '\40')) 643 | (add c '\40') 644 | (sub c '\40') 645 | == 646 | == 647 | == 648 | ++ rep :: Repetition quantifier 649 | ;~ pose 650 | (cold [0 `1] wut) 651 | (cold [0 ~] tar) 652 | (cold [1 ~] lus) 653 | :: 654 | %+ ifix [kel ker] 655 | ;~ pose 656 | ;~(plug ;~(pose dem (easy 0)) ;~(pfix com (punt dem))) 657 | (cook |=(n=@u [n `n]) dem) 658 | == 659 | == 660 | ++ cap :: Capture group 661 | %+ cook 662 | |= [wer=hair pan=pattern] 663 | (capt (what wer) pan) 664 | %+ ifix [pal par] 665 | ;~ plug 666 | (here |=([a=pint *] p.a) (easy ~)) 667 | top(arp %.n) 668 | == 669 | ++ cla :: Character class 670 | |^ 671 | %+ sear 672 | |= [neg=? lis=(list elem)] ^- (unit pattern) 673 | =* ok=(unit pattern) `(make neg lis) 674 | ?: |- 675 | ?~ lis %.y 676 | ?@ i.lis $(lis t.lis) 677 | ?^ +.i.lis $(lis t.lis) 678 | ?: (lte -.i.lis +.i.lis) $(lis t.lis) 679 | %.n 680 | `(make neg lis) 681 | ~ 682 | ;~ pose 683 | (cook |=(pos=[~ posix] [| ~[pos]]) ;~(less sel pec)) 684 | (ifix [sel ser] ;~(plug (fuss '^' '') hed)) 685 | == 686 | ++ hed 687 | ;~ pose 688 | ;~ plug 689 | ;~ less 690 | ;~(pfix ser hep pec) 691 | ;~(pfix ser hep cil hep ;~(pose pec cil)) 692 | ;~(pose ;~(plug ser ;~(pfix hep cil)) ser) 693 | == 694 | :: 695 | tel 696 | == 697 | :: 698 | tel 699 | == 700 | ++ tel 701 | %+ knee *(list elem) 702 | |. ~+ 703 | ;~ pose 704 | ;~ plug 705 | ;~ pose 706 | ;~(less ;~(pfix pec hep ;~(pose pec cil)) pec) 707 | :: 708 | ;~ less 709 | pec 710 | puc 711 | ;~(pfix cil hep pec) 712 | ;~(pfix cil hep cil hep ;~(pose pec cil)) 713 | ;~(pose ;~(plug cil ;~(pfix hep cil)) cil) 714 | == 715 | == 716 | :: 717 | tel 718 | == 719 | :: 720 | (easy ~) 721 | == 722 | ++ cil :: Literal character for character classes 723 | ;~(pose esc sec ;~(less bas ser next)) 724 | ++ sec :: Special escape character in this context 725 | ;~(pose (cold '\08' (jest '\\b')) ;~(pfix bas next)) 726 | +$ elem ?(@t [@t @t] [~ posix]) 727 | ++ make 728 | |= [neg=? lis=(list elem)] ^- pattern 729 | |= [sat=state] ^- promise 730 | |. ^- product 731 | ?~ q.tub.sat ~ 732 | ?: .= neg 733 | |- 734 | ?~ lis %.n 735 | ?: (pass i.q.tub.sat i.lis) %.y 736 | $(lis t.lis) 737 | ~ 738 | `[sat(tub (skip tub.sat)) none] 739 | ++ pass 740 | ?: cas 741 | |= [=char =elem] ^- ? 742 | ?- elem 743 | @ =(elem char) 744 | [@ @] &((lte -.elem char) (lte char +.elem)) 745 | [~ posix] (memb char +.elem) 746 | == 747 | |= [=char =elem] ^- ? 748 | =+ p=pass(cas %.y) 749 | ?| (p char elem) 750 | &((rant char 'A' 'Z') (p (add char 32) elem)) 751 | &((rant char 'a' 'z') (p (sub char 32) elem)) 752 | == 753 | ++ pec :: Perl- or POSIX-style class 754 | ;~ pose 755 | %- sear :_ ;~(pfix bas next) 756 | %~ get by ^- (map @t [~ posix]) 757 | %- malt ^- (list [@t ~ posix]) 758 | :~ ['d' `|^%digit] ['D' `&^%digit] 759 | ['w' `|^%word] ['W' `&^%word] 760 | ['s' `|^%space] ['S' `&^%space] 761 | ['u' `|^%upper] ['U' `&^%upper] 762 | ['l' `|^%lower] ['L' `&^%lower] 763 | == 764 | :: 765 | %+ ifix [(jest '[:') (jest ':]')] 766 | ;~ plug (easy ~) (fuss '^' '') 767 | %- perk 768 | :~ %ascii %alpha %alnum %blank 769 | %cntrl %digit %graph %lower 770 | %print %punct %space %upper 771 | %word %xdigit 772 | == 773 | == 774 | == 775 | ++ puc :: Invalid POSIX-style class 776 | %+ ifix [(jest '[:') (jest ':]')] 777 | ;~(plug (fuss '^' '') (star ;~(less col next))) 778 | -- 779 | ++ luk :: Lookahead, positive or negative 780 | ;~ pose 781 | %+ ifix [(jest '(?=') par] 782 | %- cook :_ top(arp %.n) 783 | |= [pan=pattern] ^- pattern 784 | |= [sat=state] ^- promise 785 | |. ^- product 786 | ?~ ((pan sat)) ~ 787 | `[sat none] 788 | :: 789 | %+ ifix [(jest '(?!') par] 790 | %- cook :_ top(arp %.n) 791 | |= [pan=pattern] ^- pattern 792 | |= [sat=state] ^- promise 793 | |. ^- product 794 | ?~ ((pan sat)) `[sat none] 795 | ~ 796 | == 797 | -- 798 | -- 799 | 800 | -------------------------------------------------------------------------------- /desk/lib/rudder.hoon: -------------------------------------------------------------------------------- 1 | :: rudder: framework for routing & serving simple web frontends 2 | :: 3 | :: v1.0.2: newborn helmsman 4 | :: 5 | :: the primary usage pattern involves your app calling steer:rudder 6 | :: with a configuration, then calling the resulting gate with an 7 | :: incoming request and relevant context. 8 | :: 9 | :: %. [bowl [eyre-id inbound-request] dat] 10 | :: %- (steer:rudder _dat cmd) 11 | :: [pages route adlib solve] 12 | :: 13 | :: dat is app state passed into and transformed by the frontend code. 14 | :: cmd is the type of app actions that the frontend may produce. 15 | :: pages is a (map term (page _dat cmd)), contains per-view frontend logic. 16 | :: route is a routing function, turning a url query into a $place. 17 | :: adlib gets called with the full request when no route is found. 18 | :: solve is a function that applies a cmd resulting from a POST request. 19 | :: 20 | :: the library provides some default implementations for route and adlib, 21 | :: which you can construct using +point and +fours respectively. 22 | :: 23 | :: for examples and a more detailed description of handling http requests, 24 | :: see /lib/rudder/poke-example.hoon 25 | :: 26 | :: pages implement a bundle of view logic, each implementing a door 27 | :: with three arms. 28 | :: 29 | :: +build gets called for GET requests, producing a $reply to render. 30 | :: +argue gets called for POST requests, turning it into a cmd. 31 | :: +final gets called after POST requests, producing a $reply to render. 32 | :: 33 | :: for examples and a more detailed description of implementing a page, 34 | :: see /lib/rudder/page-example.hoon 35 | :: 36 | ::TODO 37 | :: - should rudder really be falling back to generic error messages when 38 | :: calling +final after failure? what if apps/pages want to provide 39 | :: their own generic error message? 40 | :: - in the full-default setup, the behavior of +alert is a little bit 41 | :: awkward. because +point forces routes to omit trailing slashes, 42 | :: you cannot refer to "the current page" in a consistent way. 43 | :: you have to either hardcode the page name, or pass the full url 44 | :: from the inbound-request. 45 | :: a router that forces inclusion of trailing slashes would let you 46 | :: use '.', but has unconventional url semantics, and doesn't mesh 47 | :: nicely with single-level routing. 48 | :: - some inconsistency between the expected output of +adlib and +solve. 49 | :: "briefless" +solve results may be common, so it's nice that they're 50 | :: easy to write. for +adlib that probably isn't as relevant, and 51 | :: the current factoring makes for a nice =^ in the lib code, but... 52 | :: on the other hand, they're still different output types semantically, 53 | :: so inconsistency isn't the end of the world. would have to see how 54 | :: this ends up looking in practice. 55 | :: - +argue is awkward because its function signature doesn't really work 56 | :: if the cmd type is an atom. 57 | :: - maybe unsupported methods should go to the fallback too? 58 | :: - currently ambiguous: do you catch would-fail actions during +argue, 59 | :: or in +solve? might be best to catch earlier, but this splits 60 | :: or duplicates business logic between app and pages... 61 | :: 62 | |% 63 | +| %types :: outputs, inputs, function signatures 64 | :: 65 | +$ reply 66 | $% [%page bod=manx] :: html page 67 | [%xtra hed=header-list:http bod=manx] :: html page w/ heads 68 | [%next loc=@t msg=brief] :: 303, succeeded 69 | [%move loc=@t] :: 308, use other 70 | [%auth loc=@t] :: 307, please log in 71 | [%code cod=@ud msg=brief] :: error code page 72 | [%full ful=simple-payload:http] :: full payload 73 | == 74 | :: 75 | +$ place 76 | $% [%page ath=? nom=term] :: serve from pages 77 | [%away loc=(list @t)] :: 308, redirect 78 | == 79 | :: 80 | +$ query 81 | $: trail 82 | args=(list [key=@t value=@t]) 83 | == 84 | :: 85 | +$ trail 86 | [ext=(unit @ta) site=(list @t)] 87 | :: 88 | +$ order [id=@ta inbound-request:eyre] 89 | +$ route $-(trail (unit place)) 90 | +$ brief ?(~ @t) 91 | :: 92 | ++ page 93 | |* [dat=mold cmd=mold] 94 | $_ ^| 95 | |_ [bowl:gall order dat] 96 | ++ build |~([(list [k=@t v=@t]) (unit [? @t])] *reply) 97 | ++ argue |~([header-list:http (unit octs)] *$@(brief cmd)) 98 | ++ final |~([success=? msg=brief] *reply) 99 | -- 100 | :: 101 | +$ card card:agent:gall 102 | :: pilot: core server logic 103 | :: 104 | +| %pilot 105 | :: 106 | ++ steer :: main helper constructor 107 | |* [dat=mold cmd=mold] 108 | |^ serve 109 | +$ page (^page dat cmd) 110 | +$ adlib $-(order [[(unit reply) (list card)] dat]) 111 | +$ solve $-(cmd $@(brief [brief (list card) dat])) 112 | :: 113 | ++ serve :: main helper 114 | |= [pages=(map @ta page) =route =adlib =solve] 115 | |= [=bowl:gall =order =dat] 116 | ^- (quip card _dat) 117 | =* id id.order 118 | =+ (purse url.request.order) 119 | =/ target=(unit place) 120 | (route -<) 121 | :: if there is no route, fall back to adlib 122 | :: 123 | ?~ target 124 | =^ [res=(unit reply) caz=(list card)] dat 125 | (adlib order) 126 | :_ dat 127 | ?~ res caz 128 | (weld (spout id (paint u.res)) caz) 129 | :: route might be a redirect 130 | :: 131 | ?: ?=(%away -.u.target) 132 | =+ (rap 3 '/' (join '/' loc.u.target)) 133 | [(spout id (paint %move -)) dat] 134 | :: route might require authentication 135 | :: 136 | ?: &(ath.u.target !authenticated.order) 137 | [(spout id (paint %auth url.request.order)) dat] 138 | :: route might have messed up and pointed to nonexistent page 139 | :: 140 | ?. (~(has by pages) nom.u.target) 141 | [(spout id (issue 404 (cat 3 'no such page: ' nom.u.target))) dat] 142 | :: 143 | %. [bowl order dat] 144 | (apply (~(got by pages) nom.u.target) solve) 145 | :: 146 | ++ apply :: page usage helper 147 | |= [=page =solve] 148 | |= [=bowl:gall =order =dat] 149 | ^- (quip card _dat) 150 | =. page ~(. page bowl order dat) 151 | =* id id.order 152 | ?+ method.request.order 153 | [(spout id (issue 405 ~)) dat] 154 | :: 155 | %'GET' 156 | :_ dat 157 | =+ (purse url.request.order) 158 | =^ msg args 159 | ::NOTE as set by %next replies 160 | ?~ msg=(get-header:http 'rmsg' args) [~ args] 161 | [`[& u.msg] (delete-header:http 'rmsg' args)] 162 | %+ spout id 163 | (paint (build:page args msg)) 164 | :: 165 | %'POST' 166 | ?@ act=(argue:page [header-list body]:request.order) 167 | :_ dat 168 | =? act ?=(~ act) 'failed to parse request' 169 | (spout id (paint (final:page | act))) 170 | ?@ res=(solve act) 171 | :_ dat 172 | =? act ?=(~ act) 'failed to process request' 173 | (spout id (paint (final:page | res))) 174 | :_ +>.res 175 | =. +<+>.page +>.res 176 | (weld (spout id (paint (final:page & -.res))) +<.res) 177 | == 178 | -- 179 | :: easy: hands-off steering behavior 180 | :: 181 | +| %easy 182 | :: 183 | ++ point :: simple single-level routing, +route 184 | |= [base=(lest @t) auth=? have=(set term)] 185 | ^- route 186 | |= trail 187 | ^- (unit place) 188 | ?~ site=(decap base site) ~ 189 | ?- u.site 190 | ~ `[%page auth %index] 191 | [~ ~] `[%away (snip ^site)] 192 | [%index ~] `[%away (snip ^site)] 193 | [@ ~] ?:((~(has in have) i.u.site) `[%page auth i.u.site] ~) 194 | [@ ~ ~] `[%away (snip ^site)] 195 | * ~ 196 | == 197 | :: 198 | ++ fours :: simple 404 responses, +adlib 199 | |* dat=* 200 | :: ^- adlib:(rest * _dat) 201 | |= * 202 | [[`[%code 404 'no route found'] ~] dat] 203 | :: 204 | ++ alert :: simple redirecting +final handler 205 | |= [next=@t build=$-([(list [@t @t]) (unit [? @t])] reply)] 206 | |= [done=? =brief] 207 | ^- reply 208 | ?: done [%next next brief] 209 | (build ~ `[| `@t`brief]) 210 | :: cargo: payload generation 211 | :: 212 | +| %cargo 213 | :: 214 | ++ paint :: render response 215 | |= =reply 216 | ^- simple-payload:http 217 | ?- -.reply 218 | %page [[200 ['content-type' 'text/html']~] `(press bod.reply)] 219 | %xtra =? hed.reply ?=(~ (get-header:http 'content-type' hed.reply)) 220 | ['content-type'^'text/html' hed.reply] 221 | [[200 hed.reply] `(press bod.reply)] 222 | %next =; loc [[303 ['location' loc]~] ~] 223 | ?~ msg.reply loc.reply 224 | %+ rap 3 225 | :~ loc.reply 226 | ?:(?=(^ (find "?" (trip loc.reply))) '&' '?') 227 | 'rmsg=' 228 | (crip (en-urlt:html (trip msg.reply))) 229 | == 230 | %move [[308 ['location' loc.reply]~] ~] 231 | %auth =/ loc (crip (en-urlt:html (trip loc.reply))) 232 | [[307 ['location' (cat 3 '/~/login?redirect=' loc)]~] ~] 233 | %code (issue +.reply) 234 | %full ful.reply 235 | == 236 | :: 237 | ++ issue :: render status code page 238 | |= [cod=@ud msg=brief] 239 | ^- simple-payload:http 240 | :- [cod ~] 241 | =; nom=@t 242 | `(as-octs:mimes:html (rap 3 ~[(scot %ud cod) ': ' nom '\0a' msg])) 243 | ?+ cod '' 244 | %400 'bad request' 245 | %404 'not found' 246 | %405 'method not allowed' 247 | %500 'internal server error' 248 | == 249 | :: utils: fidgeting 250 | :: 251 | +| %utils 252 | :: 253 | ++ decap :: strip leading base from full site path 254 | |= [base=(list @t) site=(list @t)] 255 | ^- (unit (list @t)) 256 | ?~ base `site 257 | ?~ site ~ 258 | ?. =(i.base i.site) ~ 259 | $(base t.base, site t.site) 260 | :: 261 | ++ frisk :: parse url-encoded form args 262 | |= body=@t 263 | %- ~(gas by *(map @t @t)) 264 | (fall (rush body yquy:de-purl:html) ~) 265 | :: 266 | ::NOTE the below (and $query) are also available in /lib/server.hoon, 267 | :: but we reimplement them here for independence's sake. 268 | :: 269 | ++ purse :: url cord to query 270 | |= url=@t 271 | ^- query 272 | (fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~]) 273 | :: 274 | ++ press :: manx to octs 275 | (cork en-xml:html as-octs:mimes:html) 276 | :: 277 | ++ spout :: build full response cards 278 | |= [eyre-id=@ta simple-payload:http] 279 | ^- (list card) 280 | =/ =path /http-response/[eyre-id] 281 | :~ [%give %fact ~[path] [%http-response-header !>(response-header)]] 282 | [%give %fact ~[path] [%http-response-data !>(data)]] 283 | [%give %kick ~[path] ~] 284 | == 285 | -- 286 | 287 | -------------------------------------------------------------------------------- /desk/lib/schooner.hoon: -------------------------------------------------------------------------------- 1 | :: /lib/schooner.hoon 2 | :::: Dalten Collective, with modifications by ~hanfel-dovned & ~lagrev-nocfep 3 | :: Version ~2023.8.7 4 | :: 5 | :: Schooner is a Hoon library intended to de-clutter raw HTTP handling 6 | :: in Gall agents. 7 | :: 8 | :: It expects to receive a [=eyre-id =http-status =headers =resource] 9 | :: which are conveniently defined below. 10 | :: 11 | /+ server 12 | :: 13 | |% 14 | :: 15 | +$ eyre-id @ta 16 | +$ header [key=@t value=@t] 17 | +$ headers (list header) 18 | :: 19 | +$ resource 20 | $% 21 | [%application-javascript p=@] :: js 22 | [%application-json p=@] :: json 23 | [%application-pdf p=@] :: pdf 24 | [%application-rtf p=@] :: rtf 25 | [%application-xml p=@] :: xml 26 | [%audio-aac p=@] :: aac 27 | [%audio-flac p=@] :: flac 28 | [%audio-mid p=@] :: mid, midi 29 | [%audio-mpeg p=@] :: mp3 30 | [%audio-ogg p=@] :: oga 31 | [%audio-wav p=@] :: wav 32 | [%audio-webm p=@] :: weba 33 | [%font-otf p=@] :: otf 34 | [%font-ttf p=@] :: ttf 35 | [%font-woff2 p=@] :: woff2 36 | [%html h=cord] :: htm, html 37 | [%image-bmp p=@] :: bmp 38 | [%image-gif p=@] :: gif 39 | [%image-ico p=@] :: ico 40 | [%image-jpeg p=@] :: jpg, jpeg 41 | [%image-png p=@] :: png 42 | [%image-svg p=@] :: svg 43 | [%image-tiff p=@] :: tiff 44 | [%image-webp p=@] :: webp 45 | [%json j=json] :: json (type not mark) 46 | [%manx m=manx] :: manx (type not mark) 47 | [%plain p=tape] :: txt 48 | [%text-css p=@] :: css 49 | [%text-csv p=@] :: csv 50 | [%text-javascript p=@] :: js 51 | [%text-plain p=@] :: txt 52 | [%text-xml p=@] :: xml 53 | [%video-avi p=@] :: avi 54 | [%video-mp4 p=@] :: mp4 55 | [%video-mpeg p=@] :: mpeg 56 | [%video-ogg p=@] :: ogv 57 | [%video-webm p=@] :: webm 58 | :: 59 | [%login-redirect l=cord] :: 60 | [%none ~] 61 | [%redirect o=cord] 62 | [%stock ~] 63 | == 64 | :: 65 | +$ http-status @ud 66 | :: 67 | ++ response 68 | |= [=eyre-id =http-status =headers =resource] 69 | ^- (list card:agent:gall) 70 | %+ give-simple-payload:app:server 71 | eyre-id 72 | ^- simple-payload:http 73 | ?- -.resource 74 | :: 75 | %application-javascript 76 | :_ `(as-octs:mimes:html p.resource) 77 | :- http-status 78 | (weld headers ['content-type'^'application/javascript']~) 79 | :: 80 | %application-json 81 | :_ `(as-octs:mimes:html p.resource) 82 | :- http-status 83 | (weld headers ['content-type'^'application/json']~) 84 | :: 85 | %application-pdf 86 | :_ `(as-octs:mimes:html p.resource) 87 | :- http-status 88 | (weld headers ['content-type'^'application/pdf']~) 89 | :: 90 | %application-rtf 91 | :_ `(as-octs:mimes:html p.resource) 92 | :- http-status 93 | (weld headers ['content-type'^'application/rtf']~) 94 | :: 95 | %application-xml 96 | :_ `(as-octs:mimes:html p.resource) 97 | :- http-status 98 | (weld headers ['content-type'^'application/xml']~) 99 | :: 100 | %audio-aac 101 | :_ `(as-octs:mimes:html p.resource) 102 | :- http-status 103 | (weld headers ['content-type'^'audio/aac']~) 104 | :: 105 | %audio-flac 106 | :_ `(as-octs:mimes:html p.resource) 107 | :- http-status 108 | (weld headers ['content-type'^'audio/flac']~) 109 | :: 110 | %audio-mid 111 | :_ `(as-octs:mimes:html p.resource) 112 | :- http-status 113 | (weld headers ['content-type'^'audio/midi']~) 114 | :: 115 | %audio-mpeg 116 | :_ `(as-octs:mimes:html p.resource) 117 | :- http-status 118 | (weld headers ['content-type'^'audio/mpeg']~) 119 | :: 120 | %audio-ogg 121 | :_ `(as-octs:mimes:html p.resource) 122 | :- http-status 123 | (weld headers ['content-type'^'audio/ogg']~) 124 | :: 125 | %audio-wav 126 | :_ `(as-octs:mimes:html p.resource) 127 | :- http-status 128 | (weld headers ['content-type'^'audio/wav']~) 129 | :: 130 | %audio-webm 131 | :_ `(as-octs:mimes:html p.resource) 132 | :- http-status 133 | (weld headers ['content-type'^'audio/webm']~) 134 | :: 135 | %font-otf 136 | :_ `(as-octs:mimes:html p.resource) 137 | :- http-status 138 | (weld headers ['content-type'^'font/otf']~) 139 | :: 140 | %font-ttf 141 | :_ `(as-octs:mimes:html p.resource) 142 | :- http-status 143 | (weld headers ['content-type'^'font/ttf']~) 144 | :: 145 | %font-woff2 146 | :_ `(as-octs:mimes:html p.resource) 147 | :- http-status 148 | (weld headers ['content-type'^'fonts/woff2']~) 149 | :: 150 | %html 151 | :- :- http-status 152 | (weld headers ['content-type'^'text/html']~) 153 | `(as-octs:mimes:html h.resource) 154 | :: 155 | %image-bmp 156 | :_ `(as-octs:mimes:html p.resource) 157 | :- http-status 158 | (weld headers ['content-type'^'image/bmp']~) 159 | :: 160 | %image-gif 161 | :_ `(as-octs:mimes:html p.resource) 162 | :- http-status 163 | (weld headers ['content-type'^'image/gif']~) 164 | :: 165 | %image-ico 166 | :_ `(as-octs:mimes:html p.resource) 167 | :- http-status 168 | (weld headers ['content-type'^'image/vnd.microsoft.icon']~) 169 | :: 170 | %image-jpeg 171 | :_ `(as-octs:mimes:html p.resource) 172 | :- http-status 173 | (weld headers ['content-type'^'image/jpeg']~) 174 | :: 175 | %image-png 176 | :_ `(as-octs:mimes:html p.resource) 177 | :- http-status 178 | (weld headers ['content-type'^'image/png']~) 179 | :: 180 | %image-svg 181 | :_ `(as-octs:mimes:html p.resource) 182 | :- http-status 183 | (weld headers ['content-type'^'image/svg+xml']~) 184 | :: 185 | %image-tiff 186 | :_ `(as-octs:mimes:html p.resource) 187 | :- http-status 188 | (weld headers ['content-type'^'image/tiff']~) 189 | :: 190 | %image-webp 191 | :_ `(as-octs:mimes:html p.resource) 192 | :- http-status 193 | (weld headers ['content-type'^'image/webp']~) 194 | :: 195 | %json 196 | :- :- http-status 197 | %+ weld headers 198 | ['content-type'^'application/json']~ 199 | `(as-octt:mimes:html (trip (en:json:html j.resource))) 200 | :: 201 | %manx 202 | :- :- http-status 203 | (weld headers ['content-type'^'text/html']~) 204 | `(as-octt:mimes:html (en-xml:html m.resource)) 205 | :: 206 | %plain 207 | :_ `(as-octt:mimes:html p.resource) 208 | :- http-status 209 | (weld headers ['content-type'^'text/plain']~) 210 | :: 211 | %text-css 212 | :_ `(as-octs:mimes:html p.resource) 213 | :- http-status 214 | (weld headers ['content-type'^'text/css']~) 215 | :: 216 | %text-csv 217 | :_ `(as-octs:mimes:html p.resource) 218 | :- http-status 219 | (weld headers ['content-type'^'text/csv']~) 220 | :: 221 | %text-javascript 222 | :_ `(as-octs:mimes:html p.resource) 223 | :- http-status 224 | (weld headers ['content-type'^'text/javascript']~) 225 | :: 226 | %text-plain 227 | :_ `(as-octs:mimes:html p.resource) 228 | :- http-status 229 | (weld headers ['content-type'^'text/plain']~) 230 | :: 231 | %text-xml :: overrides text/ 232 | :_ `(as-octs:mimes:html p.resource) 233 | :- http-status 234 | (weld headers ['content-type'^'application/xml']~) 235 | :: 236 | %video-avi 237 | :_ `(as-octs:mimes:html p.resource) 238 | :- http-status 239 | (weld headers ['content-type'^'video/x-msvideo']~) 240 | :: 241 | %video-mp4 242 | :_ `(as-octs:mimes:html p.resource) 243 | :- http-status 244 | (weld headers ['content-type'^'video/mp4']~) 245 | :: 246 | %video-mpeg 247 | :_ `(as-octs:mimes:html p.resource) 248 | :- http-status 249 | (weld headers ['content-type'^'video/mpeg']~) 250 | :: 251 | %video-ogg 252 | :_ `(as-octs:mimes:html p.resource) 253 | :- http-status 254 | (weld headers ['content-type'^'video/ogg']~) 255 | :: 256 | %video-webm 257 | :_ `(as-octs:mimes:html p.resource) 258 | :- http-status 259 | (weld headers ['content-type'^'video/webm']~) 260 | :: 261 | :: 262 | %login-redirect 263 | =+ %^ cat 3 264 | '/~/login?redirect=' 265 | l.resource 266 | :_ ~ 267 | :- http-status 268 | (weld headers [['location' -]]~) 269 | :: 270 | %none 271 | [[http-status headers] ~] 272 | :: 273 | %redirect 274 | :_ ~ 275 | :- http-status 276 | (weld headers ['location'^o.resource]~) 277 | :: 278 | %stock 279 | (stock-error headers http-status) 280 | :: 281 | == 282 | :: 283 | :: response when MIME type is not pre-configured as in +response (just octs) 284 | :: 285 | ++ general-response 286 | |= [=eyre-id =http-status =headers resource=[term @]] 287 | ^- (list card:agent:gall) 288 | %+ give-simple-payload:app:server 289 | eyre-id 290 | ^- simple-payload:http 291 | :_ `(as-octs:mimes:html +.resource) 292 | :- http-status 293 | =/ a (trip -.resource) 294 | =/ b (need (find "-" a)) 295 | =/ c (crip (snap a b '/')) 296 | (weld headers ['content-type'^c]~) 297 | :: 298 | ++ stock-error 299 | |= [=headers code=@ud] 300 | ^- simple-payload:http 301 | :- :- code 302 | (weld headers ['content-type'^'text/html']~) 303 | :- ~ 304 | =+ (title-content code) 305 | %- as-octt:mimes:html 306 | %- en-xml:html 307 | ;html 308 | ;head 309 | ;title:"{-.-}" 310 | ;meta(name "viewport", content "width=device-width, initial-scale=1", charset "utf-8"); 311 | ;style:"{(trip style)}" 312 | == 313 | ;body 314 | ;span(class "blur-banner") 315 | ;h2:"{-.-}" 316 | ;p:"{+.-}" 317 | == 318 | == 319 | == 320 | :: 321 | ++ title-content 322 | |= status=@ud 323 | ~& status 324 | ?+ status 325 | :- "500 Error - Internal Server Error" 326 | ;: weld "This urbit is experiencing presence. " 327 | "You might try back later, or ask again. " 328 | "Sorry for the inconvenience." 329 | == 330 | :: 331 | %403 332 | :- "403 Error - FORBIDDEN!" 333 | ;: weld "Another one of them new worlds. " 334 | "No beer, no women, no pool partners, nothin'. " 335 | "Nothin' to do but throw rocks at tin cans, and we have to bring our own tin cans." 336 | == 337 | :: 338 | %404 339 | :- "404 Error - Page Not Found" 340 | %+ weld "You've attempted to access absence. " 341 | "Impossible. Try a different path. Sorry for the inconvenience." 342 | :: 343 | %405 344 | :- "405 Error - Method Not Allowed" 345 | %+ weld "Something went wrong with your request. " 346 | "You should probably just go back. Sorry for the inconvenience." 347 | :: 348 | == 349 | :: 350 | ++ style 351 | ''' 352 | .blur-banner { 353 | position: relative; 354 | top: 60%; 355 | left: 0%; 356 | right: 0%; 357 | bottom: 0%; 358 | height: auto; 359 | width: 80%; 360 | padding: 15px 15px 15px 15px; 361 | margin: 0px auto 0px auto; 362 | display: block; 363 | background: rgba(255, 255, 255, 1.0); 364 | font-size: 14pt; 365 | color: #997300; 366 | font-family: Menlo, Consolas, Monaco, "Lucida Console", monospace; 367 | border: 6px #997300 dashed; 368 | border-radius: 20px; 369 | filter: blur(2px) sepia(25%) brightness(100%) saturate(173%); 370 | -webkit-filter: blur(1.5px) sepia(25%) brightness(100%) saturate(175%); 371 | -moz-filter: blur(1.5px) sepia(25%) brightness(100%) saturate(175%); 372 | -ms-filter: blur(1.5px) sepia(25%) brightness(100%) saturate(175%); 373 | -o-filter: blur(1.5px) sepia(25%) brightness(100%) saturate(175%); 374 | } 375 | ''' 376 | -- 377 | -------------------------------------------------------------------------------- /desk/lib/server.hoon: -------------------------------------------------------------------------------- 1 | =, eyre 2 | |% 3 | +$ request-line 4 | $: [ext=(unit @ta) site=(list @t)] 5 | args=(list [key=@t value=@t]) 6 | == 7 | :: +parse-request-line: take a cord and parse out a url 8 | :: 9 | ++ parse-request-line 10 | |= url=@t 11 | ^- request-line 12 | (fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~]) 13 | :: 14 | ++ manx-to-octs 15 | |= man=manx 16 | ^- octs 17 | (as-octt:mimes:html (en-xml:html man)) 18 | :: 19 | ++ json-to-octs 20 | |= jon=json 21 | ^- octs 22 | (as-octt:mimes:html (en-json:html jon)) 23 | :: 24 | ++ app 25 | |% 26 | :: 27 | :: +require-authorization: 28 | :: redirect to the login page when unauthenticated 29 | :: otherwise call handler on inbound request 30 | :: 31 | ++ require-authorization 32 | |= $: =inbound-request:eyre 33 | handler=$-(inbound-request:eyre simple-payload:http) 34 | == 35 | ^- simple-payload:http 36 | :: 37 | ?: authenticated.inbound-request 38 | ~! this 39 | ~! +:*handler 40 | (handler inbound-request) 41 | :: 42 | =- [[307 ['location' -]~] ~] 43 | %^ cat 3 44 | '/~/login?redirect=' 45 | url.request.inbound-request 46 | :: 47 | :: +require-authorization-simple: 48 | :: redirect to the login page when unauthenticated 49 | :: otherwise pass through simple-paylod 50 | :: 51 | ++ require-authorization-simple 52 | |= [=inbound-request:eyre =simple-payload:http] 53 | ^- simple-payload:http 54 | :: 55 | ?: authenticated.inbound-request 56 | ~! this 57 | simple-payload 58 | :: 59 | =- [[307 ['location' -]~] ~] 60 | %^ cat 3 61 | '/~/login?redirect=' 62 | url.request.inbound-request 63 | :: 64 | ++ give-simple-payload 65 | |= [eyre-id=@ta =simple-payload:http] 66 | ^- (list card:agent:gall) 67 | =/ header-cage 68 | [%http-response-header !>(response-header.simple-payload)] 69 | =/ data-cage 70 | [%http-response-data !>(data.simple-payload)] 71 | :~ [%give %fact ~[/http-response/[eyre-id]] header-cage] 72 | [%give %fact ~[/http-response/[eyre-id]] data-cage] 73 | [%give %kick ~[/http-response/[eyre-id]] ~] 74 | == 75 | -- 76 | ++ gen 77 | |% 78 | :: 79 | ++ max-1-da ['cache-control' 'max-age=86400'] 80 | ++ max-1-wk ['cache-control' 'max-age=604800'] 81 | :: 82 | ++ html-response 83 | =| cache=? 84 | |= =octs 85 | ^- simple-payload:http 86 | :_ `octs 87 | [200 [['content-type' 'text/html'] ?:(cache [max-1-wk ~] ~)]] 88 | :: 89 | ++ css-response 90 | =| cache=? 91 | |= =octs 92 | ^- simple-payload:http 93 | :_ `octs 94 | [200 [['content-type' 'text/css'] ?:(cache [max-1-wk ~] ~)]] 95 | :: 96 | ++ js-response 97 | =| cache=? 98 | |= =octs 99 | ^- simple-payload:http 100 | :_ `octs 101 | [200 [['content-type' 'text/javascript'] ?:(cache [max-1-wk ~] ~)]] 102 | :: 103 | ++ png-response 104 | =| cache=? 105 | |= =octs 106 | ^- simple-payload:http 107 | :_ `octs 108 | [200 [['content-type' 'image/png'] ?:(cache [max-1-wk ~] ~)]] 109 | :: 110 | ++ svg-response 111 | =| cache=? 112 | |= =octs 113 | ^- simple-payload:http 114 | :_ `octs 115 | [200 [['content-type' 'image/svg+xml'] ?:(cache [max-1-wk ~] ~)]] 116 | :: 117 | ++ ico-response 118 | |= =octs 119 | ^- simple-payload:http 120 | [[200 [['content-type' 'image/x-icon'] max-1-wk ~]] `octs] 121 | :: 122 | ++ woff2-response 123 | =| cache=? 124 | |= =octs 125 | ^- simple-payload:http 126 | [[200 [['content-type' 'font/woff2'] max-1-wk ~]] `octs] 127 | :: 128 | ++ json-response 129 | =| cache=_| 130 | |= =json 131 | ^- simple-payload:http 132 | :_ `(json-to-octs json) 133 | [200 [['content-type' 'application/json'] ?:(cache [max-1-da ~] ~)]] 134 | :: 135 | ++ manx-response 136 | =| cache=_| 137 | |= man=manx 138 | ^- simple-payload:http 139 | :_ `(manx-to-octs man) 140 | [200 [['content-type' 'text/html'] ?:(cache [max-1-da ~] ~)]] 141 | :: 142 | ++ not-found 143 | ^- simple-payload:http 144 | [[404 ~] ~] 145 | :: 146 | ++ login-redirect 147 | |= =request:http 148 | ^- simple-payload:http 149 | =- [[307 ['location' -]~] ~] 150 | %^ cat 3 151 | '/~/login?redirect=' 152 | url.request 153 | :: 154 | ++ redirect 155 | |= redirect=cord 156 | ^- simple-payload:http 157 | [[307 ['location' redirect]~] ~] 158 | -- 159 | -- 160 | -------------------------------------------------------------------------------- /desk/lib/skeleton.hoon: -------------------------------------------------------------------------------- 1 | :: Similar to default-agent except crashes everywhere 2 | ^- agent:gall 3 | |_ bowl:gall 4 | ++ on-init 5 | ^- (quip card:agent:gall agent:gall) 6 | !! 7 | :: 8 | ++ on-save 9 | ^- vase 10 | !! 11 | :: 12 | ++ on-load 13 | |~ old-state=vase 14 | ^- (quip card:agent:gall agent:gall) 15 | !! 16 | :: 17 | ++ on-poke 18 | |~ in-poke-data=cage 19 | ^- (quip card:agent:gall agent:gall) 20 | !! 21 | :: 22 | ++ on-watch 23 | |~ path 24 | ^- (quip card:agent:gall agent:gall) 25 | !! 26 | :: 27 | ++ on-leave 28 | |~ path 29 | ^- (quip card:agent:gall agent:gall) 30 | !! 31 | :: 32 | ++ on-peek 33 | |~ path 34 | ^- (unit (unit cage)) 35 | !! 36 | :: 37 | ++ on-agent 38 | |~ [wire sign:agent:gall] 39 | ^- (quip card:agent:gall agent:gall) 40 | !! 41 | :: 42 | ++ on-arvo 43 | |~ [wire =sign-arvo] 44 | ^- (quip card:agent:gall agent:gall) 45 | !! 46 | :: 47 | ++ on-fail 48 | |~ [term tang] 49 | ^- (quip card:agent:gall agent:gall) 50 | !! 51 | -- 52 | -------------------------------------------------------------------------------- /desk/lib/string.hoon: -------------------------------------------------------------------------------- 1 | :: /lib/string 2 | :::: ~lagrev-nocfep 3 | :: Version ~2023.8.14 4 | :: 5 | :: A string library supporting common operations for mortals. 6 | :: Gates assume tape input unless suffixed with `-c`. 7 | :: 8 | |% 9 | ++ alphabet ^~ `tape`(weld (gulf 65 90) (gulf 97 122)) 10 | ++ alpha-lower ^~ `tape`(slag 26 alphabet) 11 | ++ alpha-upper ^~ `tape`(scag 26 alphabet) 12 | ++ digits ^~ `tape`(gulf 48 57) 13 | ++ alpha-digits ^~ `tape`(weld alphabet digits) 14 | ++ hexdigits ^~ `tape`:(weld digits (gulf 65 70) (gulf 97 102)) 15 | ++ octdigits ^~ `tape`(gulf 48 55) 16 | ++ punctuation ^~ `tape`:(weld (gulf 32 47) (gulf 58 64) (gulf 91 96) (gulf 123 126)) 17 | ++ whitespace ^~ `tape`:(weld " " ~['\0a'] ~['\09']) 18 | ++ ascii ^~ `tape`:(weld alphabet digits punctuation whitespace) 19 | :: Utility sets 20 | ++ set-alphabet ^~ (~(gas in *(set @tD)) alphabet) 21 | ++ set-alpha-lower ^~ (~(gas in *(set @tD)) alpha-lower) 22 | ++ set-alpha-upper ^~ (~(gas in *(set @tD)) alpha-upper) 23 | ++ set-digits ^~ (~(gas in *(set @tD)) digits) 24 | ++ set-alpha-digits ^~ (~(gas in *(set @tD)) alpha-digits) 25 | ++ set-hexdigits ^~ (~(gas in *(set @tD)) hexdigits) 26 | ++ set-octdigits ^~ (~(gas in *(set @tD)) octdigits) 27 | ++ set-punctuation ^~ (~(gas in *(set @tD)) punctuation) 28 | ++ set-whitespace ^~ (~(gas in *(set @tD)) whitespace) 29 | ++ set-ascii ^~ (~(gas in *(set @tD)) ascii) 30 | :: 31 | ++ is-alpha |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-alphabet))) 32 | ++ is-lower |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-alpha-lower))) 33 | ++ is-upper |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-alpha-upper))) 34 | ++ is-digit |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-digits))) 35 | ++ is-alnum |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-alpha-digits))) 36 | ++ is-hex |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-hexdigits))) 37 | ++ is-octal |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-octdigits))) 38 | ++ is-ascii |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-ascii))) 39 | ++ is-decimal is-digit 40 | ++ is-numeric is-digit 41 | ++ is-space |=(=tape =(~ (~(dif in (~(gas in *(set @tD)) tape)) set-whitespace))) 42 | ++ is-title |=(=tape =((title tape) tape)) 43 | :: 44 | ++ is-knot |=(=tape ((sane %ta) (crip tape))) 45 | ++ is-tas is-term 46 | ++ is-ta is-knot 47 | ++ is-term |=(=tape ((sane %tas) (crip tape))) 48 | ++ is-uc 49 | |= =tape 50 | ^- ? 51 | =/ p (bisk:so [[1 1] tape]) 52 | &(=(+((lent tape)) +>+<+:p) =(%uc +>-<:p)) 53 | ++ is-ud 54 | |= =tape 55 | ^- ? 56 | =/ p (bisk:so [[1 1] tape]) 57 | &(=(+((lent tape)) +>+<+:p) =(%ud +>-<:p)) 58 | ++ is-ui 59 | |= =tape 60 | ^- ? 61 | =/ p (bisk:so [[1 1] tape]) 62 | &(=(+((lent tape)) +>+<+:p) =(%ui +>-<:p)) 63 | ++ is-uv 64 | |= =tape 65 | ^- ? 66 | =/ p (bisk:so [[1 1] tape]) 67 | &(=(+((lent tape)) +>+<+:p) =(%uv +>-<:p)) 68 | ++ is-uw 69 | |= =tape 70 | ^- ? 71 | =/ p (bisk:so [[1 1] tape]) 72 | &(=(+((lent tape)) +>+<+:p) =(%uw +>-<:p)) 73 | ++ is-ux 74 | |= =tape 75 | ^- ? 76 | =/ p (bisk:so [[1 1] tape]) 77 | &(=(+((lent tape)) +>+<+:p) =(%ux +>-<:p)) 78 | :: 79 | :: Convert the string to all upper case. Synonymous with ++cuss. 80 | ++ upper cuss 81 | :: Convert the string to all lower case. Synonymous with ++cass. 82 | ++ lower cass 83 | :: Convert the first character to upper case. 84 | ++ capitalize |=(=tape (weld (upper (scag 1 tape)) (slag 1 tape))) 85 | :: Center the string in spaces. 86 | ++ center 87 | |= [=tape wid=@ud] 88 | ^- ^tape 89 | ?. (gth wid (lent tape)) tape 90 | =/ lof (div (sub wid (lent tape)) 2) 91 | =/ rof (sub wid (add lof (lent tape))) 92 | :(weld `^tape`(zing (reap lof " ")) tape `^tape`(zing (reap rof " "))) 93 | :: Count the number of times a value occurs in the string. 94 | ++ count |=([nedl=tape hstk=tape] (lent (fand nedl hstk))) 95 | :: Produce the index of every match of nedl in hstk as a list of atoms. 96 | ++ find-all fand 97 | :: Does the string start with the given substring? 98 | ++ starts-with |=([=tape subs=tape] ^-(? =(subs (scag (lent subs) tape)))) 99 | :: Does the string end with the given substring? 100 | ++ ends-with |=([=tape subs=tape] ^-(? =(subs (slag (lent subs) tape)))) 101 | :: Tape-based version of ++join. 102 | ++ link 103 | |= [sep=tape =(list tape)] 104 | ^- tape 105 | =/ res (snag 0 list) 106 | =/ list (slag 1 list) 107 | |- 108 | ?~ list res 109 | %= $ 110 | list t.list 111 | res :(weld res sep i.list) 112 | == 113 | :: Repeat a tape as a tape (rather than as (list tape)). 114 | ++ echo |=([=tape n=@ud] ^-(^tape (zing (reap n tape)))) 115 | :: Left-justify text with whitespace 116 | ++ ljust 117 | |= [=tape wid=@ud] 118 | ^- ^tape 119 | ?. (gth wid (lent tape)) tape 120 | =/ rof (sub wid (lent tape)) 121 | (weld tape `^tape`(zing (reap rof " "))) 122 | :: Right-justify text with whitespace 123 | ++ rjust 124 | |= [=tape wid=@ud] 125 | ^- ^tape 126 | ?. (gth wid (lent tape)) tape 127 | =/ lof (sub wid (lent tape)) 128 | (weld `^tape`(zing (reap lof " ")) tape) 129 | :: Strip whitespace from the left-hand side. 130 | ++ lstrip 131 | |= =tape 132 | ^- ^tape 133 | |- 134 | ?. (is-space ~[(snag 0 tape)]) 135 | tape 136 | $(tape (slag 1 tape)) 137 | :: Strip whitespace from the right-hand side. 138 | ++ rstrip 139 | |= =tape 140 | ^- ^tape 141 | |- 142 | ?. (is-space ~[(snag 0 tape)]) 143 | tape 144 | $(tape (slag 1 tape)) 145 | :: Strip whitespace on both ends. 146 | ++ strip |=(=tape (lstrip (rstrip tape))) 147 | :: 148 | ++ partition 149 | |= [nedl=tape hstk=tape] 150 | ^- [l=tape n=tape r=tape] 151 | =/ l (scag (need (find nedl hstk)) hstk) 152 | =/ nr (slag (need (find nedl hstk)) hstk) 153 | =/ n (scag (lent nedl) nr) 154 | =/ r (slag (lent nedl) nr) 155 | [l=l n=n r=r] 156 | :: 157 | ++ replace 158 | |= [bit=tape bot=tape =tape] 159 | ^- ^tape 160 | |- 161 | =/ off (find bit tape) 162 | ?~ off tape 163 | =/ clr (oust [(need off) (lent bit)] tape) 164 | $(tape :(weld (scag (need off) clr) bot (slag (need off) clr))) 165 | :: 166 | ++ split 167 | |= [sep=tape =tape] 168 | ^- (list ^tape) 169 | =| res=(list ^tape) 170 | |- 171 | ?~ tape (flop res) 172 | =/ off (find sep tape) 173 | ?~ off (flop [`^tape`tape `(list ^tape)`res]) 174 | %= $ 175 | res [(scag `@ud`(need off) `^tape`tape) res] 176 | tape (slag +(`@ud`(need off)) `^tape`tape) 177 | == 178 | :: 179 | ++ rfind |=([seq=tape =tape] ?~((find seq (flop tape)) ~ `(dec (sub (lent tape) (need (find seq (flop tape))))))) 180 | :: 181 | ++ title |=(=tape (link " " (turn (split " " (zing (turn tape (cork trip lower)))) capitalize))) 182 | :: 183 | ++ zfill 184 | |= [=tape wid=@ud] 185 | ^- ^tape 186 | ?. (gth wid (lent tape)) tape 187 | =/ lof (sub wid (lent tape)) 188 | (weld `^tape`(zing (reap lof "0")) tape) 189 | ++ grab |=([n=@ud =tape] ^-(^tape ~[(snag n tape)])) 190 | -- 191 | -------------------------------------------------------------------------------- /desk/lib/test.hoon: -------------------------------------------------------------------------------- 1 | :: testing utilities meant to be directly used from files in %/tests 2 | :: 3 | |% 4 | :: +expect-eq: compares :expected and :actual and pretty-prints the result 5 | :: 6 | ++ expect-eq 7 | |= [expected=vase actual=vase] 8 | ^- tang 9 | :: 10 | =| result=tang 11 | :: 12 | =? result !=(q.expected q.actual) 13 | %+ weld result 14 | ^- tang 15 | :~ [%palm [": " ~ ~ ~] [leaf+"expected" (sell expected) ~]] 16 | [%palm [": " ~ ~ ~] [leaf+"actual " (sell actual) ~]] 17 | == 18 | :: 19 | =? result !(~(nest ut p.actual) | p.expected) 20 | %+ weld result 21 | ^- tang 22 | :~ :+ %palm [": " ~ ~ ~] 23 | :~ [%leaf "failed to nest"] 24 | (~(dunk ut p.actual) %actual) 25 | (~(dunk ut p.expected) %expected) 26 | == == 27 | result 28 | :: +expect: compares :actual to %.y and pretty-prints anything else 29 | :: 30 | ++ expect 31 | |= actual=vase 32 | (expect-eq !>(%.y) actual) 33 | :: +expect-fail: kicks a trap, expecting crash. pretty-prints if succeeds 34 | :: 35 | ++ expect-fail 36 | |= a=(trap) 37 | ^- tang 38 | =/ b (mule a) 39 | ?- -.b 40 | %| ~ 41 | %& ['expected failure - succeeded' ~] 42 | == 43 | :: +expect-runs: kicks a trap, expecting success; returns trace on failure 44 | :: 45 | ++ expect-success 46 | |= a=(trap) 47 | ^- tang 48 | =/ b (mule a) 49 | ?- -.b 50 | %& ~ 51 | %| ['expected success - failed' p.b] 52 | == 53 | :: $a-test-chain: a sequence of tests to be run 54 | :: 55 | :: NB: arms shouldn't start with `test-` so that `-test % ~` runs 56 | :: 57 | +$ a-test-chain 58 | $_ 59 | |? 60 | ?: =(0 0) 61 | [%& p=*tang] 62 | [%| p=[tang=*tang next=^?(..$)]] 63 | :: +run-chain: run a sequence of tests, stopping at first failure 64 | :: 65 | ++ run-chain 66 | |= seq=a-test-chain 67 | ^- tang 68 | =/ res $:seq 69 | ?- -.res 70 | %& p.res 71 | %| ?. =(~ tang.p.res) 72 | tang.p.res 73 | $(seq next.p.res) 74 | == 75 | :: +category: prepends a name to an error result; passes successes unchanged 76 | :: 77 | ++ category 78 | |= [a=tape b=tang] ^- tang 79 | ?: =(~ b) ~ :: test OK 80 | :- leaf+"in: '{a}'" 81 | (turn b |=(c=tank rose+[~ " " ~]^~[c])) 82 | -- -------------------------------------------------------------------------------- /desk/lib/twoc.hoon: -------------------------------------------------------------------------------- 1 | |% 2 | :: 3 | ++ twoc 4 | |_ =bloq 5 | :: 6 | ++ len (bex bloq) 7 | ++ msb 8 | |= a=@ 9 | ?: (^lth (xeb a) len) 10 | 0 11 | 1 12 | ++ ones (dec len) 13 | :: 14 | :: 15 | :: https://gist.github.com/mfuerstenau/ba870a29e16536fdbaba#file-zigzag-encoding-readme-L53 16 | :: (i >>> 1) ^ (~(i & 1) + 1) 17 | :: 18 | :: Test cases 19 | :: > (~(s-to-twoc twoc:twoc 2) --2) 20 | :: 2 21 | :: > (~(s-to-twoc twoc:twoc 2) --1) 22 | :: 1 23 | :: > (~(s-to-twoc twoc:twoc 2) --8) 24 | :: /lib/twoc/hoon:<[19 5].[22 45]> 25 | :: > (~(s-to-twoc twoc:twoc 3) -14) 26 | :: 242 27 | ++ s-to-twoc 28 | |= a=@s 29 | ^- @ 30 | ?> (lte `@`a (dec ~(out fe bloq))) 31 | %+ mix 32 | (rsh 0 a) 33 | (~(sum fe bloq) (not 0 len (dis a 1)) 1) 34 | :: 35 | :: 1001 is -7 in int4 36 | :: 1111 - 1001 = 0110 37 | :: 0110 + 0001 = 0111 (7) 38 | ++ twoc-to-s 39 | |= a=@ 40 | ^- @s 41 | ?: =(1 (msb a)) 42 | (new:si | +((sub (dec (bex len)) a))) 43 | (new:si & a) 44 | :: 45 | :: 46 | ++ add 47 | |= [a=@ b=@] 48 | =/ res (^add a b) 49 | ?. (^gth (xeb res) len) 50 | res 51 | =/ rez=@ (rep 0 (snip (rip [0 1] res))) 52 | ?: !(overflow a b rez) 53 | rez 54 | ~|('signed int overflow' !!) 55 | :: 56 | ++ overflow 57 | |= [a=@ b=@ c=@] 58 | ?| &(=(0 (msb c)) =(1 (msb a)) =(1 (msb b))) 59 | &(=(1 (msb c)) =(0 (msb a)) =(0 (msb a))) 60 | == 61 | :: 62 | ++ mul 63 | :: 64 | :: https://stackoverflow.com/questions/20793701/how-to-do-two-complement-multiplication-and-division-of-integers 65 | |= [a=@ b=@] 66 | =/ ae (rep bloq ~[a (extend a)]) 67 | =/ be (rep bloq ~[b (extend b)]) 68 | =/ c (cut 0 [0 (^mul 2 len)] (^mul ae be)) 69 | ?: (lte (xeb c) len) 70 | c 71 | ?: !=((dec (bex len)) (cut 0 [len len] c)) 72 | ~|('signed int overflow' !!) 73 | (cut 0 [0 len] c) 74 | :: 75 | :: 76 | ++ extend 77 | |= a=@ 78 | ^- @ 79 | ?: =((msb a) 0) 80 | 0 81 | (dec (bex len)) 82 | :: 83 | :: 84 | :: > (~(gth twoc:twoc 3) `@ub`0b1010.1111 `@ub`0b1010.1110) 85 | :: %.y 86 | :: 87 | :: > (~(gth twoc:twoc 3) 256 126) 88 | :: %.n 89 | :: 90 | ++ gth 91 | |= [a=@ b=@] 92 | :: 93 | :: check for different signs 94 | ?: =(1 (mix (msb a) (msb b))) 95 | :: 96 | :: if different, choose the one that is positive 97 | =(0 (msb a)) 98 | :: 99 | :: if signs same, use the default gth 100 | (^gth a b) 101 | :: 102 | ++ lth |=([a=@ b=@] !(gth a b)) 103 | -- 104 | -- -------------------------------------------------------------------------------- /desk/mar/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/urbit/yard/500a46840eb891539a3b69aea9fb8d7c7b6797f2/desk/mar/.gitkeep -------------------------------------------------------------------------------- /desk/mar/aac.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/aac (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/atom.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/atom/mar 3 | :: 4 | /? 310 5 | :: 6 | :::: A minimal atom mark 7 | :: 8 | =, mimes:html 9 | |_ ato=@ 10 | ++ grab |% 11 | ++ noun @ 12 | ++ mime |=([* p=octs] q.p) 13 | -- 14 | ++ grow |% 15 | ++ mime [/application/x-urb-unknown (as-octs ato)] 16 | -- 17 | ++ grad %mime 18 | -- 19 | -------------------------------------------------------------------------------- /desk/mar/avi.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/video/x-msvideo (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/belt.hoon: -------------------------------------------------------------------------------- 1 | :: belt: runtime belt structure 2 | :: 3 | /+ dill 4 | :: 5 | |_ =belt:dill 6 | ++ grad %noun 7 | :: +grab: convert from 8 | :: 9 | ++ grab 10 | |% 11 | ++ noun belt:dill 12 | ++ json belt:dejs:dill 13 | -- 14 | :: +grow: convert to 15 | :: 16 | ++ grow 17 | |% 18 | ++ noun belt 19 | -- 20 | -- 21 | -------------------------------------------------------------------------------- /desk/mar/bill.hoon: -------------------------------------------------------------------------------- 1 | |_ bil=(list dude:gall) 2 | ++ grow 3 | |% 4 | ++ mime `^mime`[/text/x-bill (as-octs:mimes:html hoon)] 5 | ++ noun bil 6 | ++ hoon 7 | ^- @t 8 | |^ (crip (of-wall:format (wrap-lines (spit-duz bil)))) 9 | :: 10 | ++ wrap-lines 11 | |= taz=wall 12 | ^- wall 13 | ?~ taz ["~"]~ 14 | :- (weld ":~ " i.taz) 15 | %- snoc :_ "==" 16 | (turn t.taz |=(t=tape (weld " " t))) 17 | :: 18 | ++ spit-duz 19 | |= duz=(list dude:gall) 20 | ^- wall 21 | (turn duz |=(=dude:gall ['%' (trip dude)])) 22 | -- 23 | ++ txt (to-wain:format hoon) 24 | -- 25 | ++ grab 26 | |% 27 | ++ noun (list dude:gall) 28 | ++ mime 29 | |= [=mite len=@ud tex=@] 30 | ~_ tex 31 | !<((list dude:gall) (slap !>(~) (ream tex))) 32 | -- 33 | ++ grad %noun 34 | -- 35 | -------------------------------------------------------------------------------- /desk/mar/blit.hoon: -------------------------------------------------------------------------------- 1 | :: blit: runtime blit structure 2 | :: 3 | /+ dill 4 | :: 5 | |_ =blit:dill 6 | ++ grad %noun 7 | :: +grab: convert from 8 | :: 9 | ++ grab 10 | |% 11 | ++ noun blit:dill 12 | -- 13 | :: +grow: convert to 14 | :: 15 | ++ grow 16 | |% 17 | ++ noun blit 18 | ++ json (blit:enjs:dill blit) 19 | -- 20 | -- 21 | -------------------------------------------------------------------------------- /desk/mar/bmp.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/bmp (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/css.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/css/mar 3 | :: 4 | /? 310 5 | =, eyre 6 | =, mimes:html 7 | |_ mud=@t 8 | ++ grow :: convert to 9 | |% ++ mime [/text/css (as-octs mud)] :: convert to %mime 10 | ++ elem ;style :: convert to %hymn 11 | ;- (trip mud) 12 | == 13 | ++ hymn ;html:(head:"{elem}" body) 14 | -- 15 | ++ grab 16 | |% :: convert from 17 | ++ mime |=([p=mite q=octs] (@t q.q)) 18 | ++ noun @t :: clam from %noun 19 | -- 20 | ++ grad %mime 21 | -- 22 | -------------------------------------------------------------------------------- /desk/mar/csv.hoon: -------------------------------------------------------------------------------- 1 | =, format 2 | =, mimes:html 3 | |_ csv=wain 4 | :: 5 | ++ grab :: convert from 6 | |% 7 | ++ mime |=((pair mite octs) (to-wain q.q)) 8 | ++ noun wain :: clam from %noun 9 | -- 10 | ++ grow 11 | |% 12 | ++ mime [/text/csv (as-octs (of-wain csv))] 13 | -- 14 | ++ grad %mime 15 | -- 16 | -------------------------------------------------------------------------------- /desk/mar/docket-0.hoon: -------------------------------------------------------------------------------- 1 | /+ dock=docket 2 | |_ =docket:dock 3 | ++ grow 4 | |% 5 | ++ mime 6 | ^- ^mime 7 | [/text/x-docket (as-octt:mimes:html (spit-docket:mime:dock docket))] 8 | ++ noun docket 9 | ++ json (docket:enjs:dock docket) 10 | -- 11 | ++ grab 12 | |% 13 | :: 14 | ++ mime 15 | |= [=mite len=@ud tex=@] 16 | ^- docket:dock 17 | %- need 18 | %- from-clauses:mime:dock 19 | !<((list clause:dock) (slap !>(~) (ream tex))) 20 | 21 | :: 22 | ++ noun docket:dock 23 | -- 24 | ++ grad %noun 25 | -- 26 | -------------------------------------------------------------------------------- /desk/mar/flac.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/flac (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/gif.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/gif (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/hash.hoon: -------------------------------------------------------------------------------- 1 | |_ hash=@uv 2 | :: 3 | ++ grad %noun 4 | ++ grow 5 | |% 6 | ++ noun hash 7 | ++ json 8 | s+(rsh [3 2] (scot %uv hash)) 9 | -- 10 | ++ grab 11 | |% 12 | ++ noun @uv 13 | -- 14 | -- 15 | -------------------------------------------------------------------------------- /desk/mar/hoon.hoon: -------------------------------------------------------------------------------- 1 | :::: /hoon/hoon/mar 2 | :: 3 | /? 310 4 | :: 5 | =, eyre 6 | |_ own=@t 7 | :: 8 | ++ grow :: convert to 9 | |% 10 | ++ mime `^mime`[/text/x-hoon (as-octs:mimes:html own)] :: convert to %mime 11 | ++ elem :: convert to %html 12 | ;div:pre(urb_codemirror "", mode "hoon"):"{(trip own)}" 13 | :: =+ gen-id="src-{<`@ui`(mug own)>}" 14 | :: ;div 15 | :: ;textarea(id "{gen-id}"):"{(trip own)}" 16 | :: ;script:""" 17 | :: CodeMirror.fromTextArea( 18 | :: window[{}], 19 | :: \{lineNumbers:true, readOnly:true} 20 | :: ) 21 | :: """ 22 | :: == 23 | ++ hymn 24 | :: ;html:(head:title:"Source" "+{elem}") 25 | ;html 26 | ;head 27 | ;title:"Source" 28 | ;script@"//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.js"; 29 | ;script@"/lib/syntax/hoon.js"; 30 | ;link(rel "stylesheet", href "//cdnjs.cloudflare.com/ajax/libs/". 31 | "codemirror/4.3.0/codemirror.min.css"); 32 | ;link/"/lib/syntax/codemirror.css"(rel "stylesheet"); 33 | == 34 | ;body 35 | ;textarea#src:"{(trip own)}" 36 | ;script:'CodeMirror.fromTextArea(src, {lineNumbers:true, readOnly:true})' 37 | == 38 | == 39 | ++ txt 40 | (to-wain:format own) 41 | -- 42 | ++ grab 43 | |% :: convert from 44 | ++ mime |=([p=mite q=octs] q.q) 45 | ++ noun @t :: clam from %noun 46 | ++ txt of-wain:format 47 | -- 48 | ++ grad %txt 49 | -- 50 | -------------------------------------------------------------------------------- /desk/mar/htm.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/htm/mar 3 | :: 4 | /? 310 5 | |_ own=manx 6 | :: 7 | ++ grad %noun 8 | ++ grow :: convert to 9 | |% 10 | ++ noun own 11 | ++ hymn own 12 | -- 13 | ++ grab |% :: convert from 14 | ++ noun manx :: clam from %noun 15 | -- -- 16 | -------------------------------------------------------------------------------- /desk/mar/html.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/html/mar 3 | :: 4 | /? 310 5 | :: 6 | :::: compute 7 | :: 8 | =, html 9 | |_ htm=@t 10 | ++ grow :: convert to 11 | ^? 12 | |% :: 13 | ++ mime [/text/html (met 3 htm) htm] :: to %mime 14 | ++ hymn (need (de-xml htm)) :: to %hymn 15 | -- :: 16 | ++ grab ^? 17 | |% :: convert from 18 | ++ noun @t :: clam from %noun 19 | ++ mime |=([p=mite q=octs] q.q) :: retrieve form %mime 20 | -- 21 | ++ grad %mime 22 | -- 23 | -------------------------------------------------------------------------------- /desk/mar/httr.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/httr/mar 3 | :: 4 | /? 310 5 | :: 6 | =, eyre 7 | =, format 8 | |_ hit=httr 9 | ++ grad %noun 10 | ++ grow |% ++ wall (turn wain trip) 11 | ++ wain (to-wain cord) 12 | ++ json (need (de:json:html cord)) 13 | ++ cord q:octs 14 | ++ noun hit 15 | ++ octs 16 | ~| hit 17 | ?> =(2 (div p.hit 100)) 18 | (need r.hit) 19 | -- 20 | ++ grab :: convert from 21 | |% 22 | ++ noun httr :: clam from %noun 23 | -- 24 | -- 25 | -------------------------------------------------------------------------------- /desk/mar/hymn.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/hymn/mar 3 | :: 4 | /? 310 5 | =, mimes:html 6 | =, html 7 | |_ own=manx 8 | :: 9 | ++ grad %noun 10 | ++ grow :: convert to 11 | |% 12 | ++ html (crip (en-xml own)) :: convert to %html 13 | ++ mime [/text/html (as-octs html)] :: convert to %mime 14 | -- 15 | ++ grab |% :: convert from 16 | ++ noun manx :: clam from %noun 17 | -- -- 18 | -------------------------------------------------------------------------------- /desk/mar/ico.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/x-icon (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/jam.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/jam/mar 3 | :: 4 | /? 310 5 | :: 6 | =, mimes:html 7 | |_ mud=@ 8 | ++ grow 9 | |% 10 | ++ mime [/application/x-urb-jam (as-octs mud)] 11 | -- 12 | ++ grab 13 | |% :: convert from 14 | ++ noun @ :: clam from %noun 15 | -- 16 | ++ grad %mime 17 | -- 18 | -------------------------------------------------------------------------------- /desk/mar/jpeg.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/jpeg (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/jpg.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/jpeg (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/js.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/js/mar 3 | :: 4 | /? 310 5 | :: 6 | =, eyre 7 | |_ mud=@ 8 | ++ grow 9 | |% 10 | ++ mime [/application/javascript (as-octs:mimes:html (@t mud))] 11 | ++ elem ;script 12 | ;- (trip (@t mud)) 13 | == 14 | ++ hymn ;html:(head:"+{elem}" body) 15 | -- 16 | ++ grab 17 | |% :: convert from 18 | ++ mime |=([p=mite q=octs] (@t q.q)) 19 | ++ noun cord :: clam from %noun 20 | -- 21 | ++ grad %mime 22 | -- 23 | -------------------------------------------------------------------------------- /desk/mar/json.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/json/mar 3 | :: 4 | /? 310 5 | :: 6 | :::: compute 7 | :: 8 | =, eyre 9 | =, format 10 | =, html 11 | |_ jon=^json 12 | :: 13 | ++ grow :: convert to 14 | |% 15 | ++ mime [/application/json (as-octs:mimes -:txt)] :: convert to %mime 16 | ++ txt [(en:json jon)]~ 17 | -- 18 | ++ grab 19 | |% :: convert from 20 | ++ mime |=([p=mite q=octs] (fall (de:json (@t q.q)) *^json)) 21 | ++ noun ^json :: clam from %noun 22 | ++ numb numb:enjs 23 | ++ time time:enjs 24 | -- 25 | ++ grad %mime 26 | -- 27 | -------------------------------------------------------------------------------- /desk/mar/kelvin.hoon: -------------------------------------------------------------------------------- 1 | |_ kal=waft:clay 2 | ++ grow 3 | |% 4 | ++ mime `^mime`[/text/x-kelvin (as-octs:mimes:html hoon)] 5 | ++ noun kal 6 | ++ hoon 7 | %+ rap 3 8 | %+ turn 9 | %+ sort 10 | ~(tap in (waft-to-wefts:clay kal)) 11 | |= [a=weft b=weft] 12 | ?: =(lal.a lal.b) 13 | (gte num.a num.b) 14 | (gte lal.a lal.b) 15 | |= =weft 16 | (rap 3 '[%' (scot %tas lal.weft) ' ' (scot %ud num.weft) ']\0a' ~) 17 | :: 18 | ++ txt (to-wain:format hoon) 19 | -- 20 | ++ grab 21 | |% 22 | ++ noun waft:clay 23 | ++ mime 24 | |= [=mite len=@ud tex=@] 25 | (cord-to-waft:clay tex) 26 | -- 27 | ++ grad %noun 28 | -- 29 | -------------------------------------------------------------------------------- /desk/mar/loob.hoon: -------------------------------------------------------------------------------- 1 | |_ loob=? 2 | ++ grad %noun 3 | ++ grow 4 | |% 5 | ++ noun loob 6 | ++ json b+loob 7 | -- 8 | ++ grab 9 | |% 10 | ++ noun ? 11 | -- 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/map.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/map/mar 3 | :: Mark for js source maps 4 | /? 310 5 | :: 6 | =, eyre 7 | |_ mud=@ 8 | ++ grow 9 | |% 10 | ++ mime [/application/octet-stream (as-octs:mimes:html (@t mud))] 11 | -- 12 | ++ grab 13 | |% :: convert from 14 | ++ mime |=([p=mite q=octs] (@t q.q)) 15 | ++ noun cord :: clam from %noun 16 | -- 17 | ++ grad %mime 18 | -- 19 | -------------------------------------------------------------------------------- /desk/mar/mid.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/mid (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/mime.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/mime/mar 3 | :: 4 | /? 310 5 | :: 6 | |_ own=mime 7 | ++ grow 8 | ^? 9 | |% 10 | ++ jam `@`q.q.own 11 | -- 12 | :: 13 | ++ grab :: convert from 14 | ^? 15 | |% 16 | ++ noun mime :: clam from %noun 17 | ++ tape 18 | |=(a=_"" [/application/x-urb-unknown (as-octt:mimes:html a)]) 19 | -- 20 | ++ grad 21 | ^? 22 | |% 23 | ++ form %mime 24 | ++ diff |=(mime +<) 25 | ++ pact |=(mime +<) 26 | ++ join |=([mime mime] `(unit mime)`~) 27 | ++ mash 28 | |= [[ship desk mime] [ship desk mime]] 29 | ^- mime 30 | ~|(%mime-mash !!) 31 | -- 32 | -- 33 | -------------------------------------------------------------------------------- /desk/mar/mp3.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/mpeg (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/mp4.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/video/mp4 (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/mpeg.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/video/mpeg (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/noun.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/noun/mar 3 | :: 4 | /? 310 5 | !: 6 | :::: A minimal noun mark 7 | |_ non=* 8 | ++ grab |% 9 | ++ noun * 10 | -- 11 | ++ grow |% 12 | ++ mime [/application/x-urb-jam (as-octs:mimes:html (jam non))] 13 | -- 14 | ++ grad 15 | |% 16 | ++ form %noun 17 | ++ diff |=(* +<) 18 | ++ pact |=(* +<) 19 | ++ join |=([* *] *(unit *)) 20 | ++ mash |=([[ship desk *] [ship desk *]] `*`~|(%noun-mash !!)) 21 | -- 22 | -- 23 | -------------------------------------------------------------------------------- /desk/mar/oga.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/ogg (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/ogg.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/ogg (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/ogv.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/video/ogg (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/otf.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=octs 2 | ++ grow 3 | |% 4 | ++ mime [/font/otf dat] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([=mite =octs] octs) 9 | ++ noun octs 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/path.hoon: -------------------------------------------------------------------------------- 1 | |_ pax=path 2 | ++ grad %noun 3 | ++ grow 4 | |% 5 | ++ noun pax 6 | -- 7 | ++ grab 8 | |% 9 | ++ noun path 10 | -- 11 | -- 12 | -------------------------------------------------------------------------------- /desk/mar/pdf.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/application/pdf (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/pem.hoon: -------------------------------------------------------------------------------- 1 | :: .pem file to list of lines 2 | :: 3 | =, format 4 | =, mimes:html 5 | |_ pem=wain 6 | :: 7 | ++ grab :: convert from 8 | |% 9 | ++ mime |=((pair mite octs) (to-wain q.q)) 10 | ++ noun wain :: clam from %noun 11 | -- 12 | ++ grow 13 | => v=. 14 | |% 15 | ++ mime => v [/text/plain (as-octs (of-wain pem))] 16 | ++ elem => v ;pre: {(trip (of-wain pem))} 17 | -- 18 | ++ grad %mime 19 | -- 20 | -------------------------------------------------------------------------------- /desk/mar/pill.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/pill/mar 3 | :: 4 | /+ *pill 5 | =, mimes:html 6 | |_ pil=pill 7 | ++ grow 8 | |% 9 | ++ mime [/application/octet-stream (as-octs (jam pil))] 10 | -- 11 | ++ grab 12 | |% 13 | ++ noun pill 14 | ++ mime 15 | |= (pair mite octs) 16 | =+ o=(pair ,* ,*) :: ,*) 17 | =+ (,[%pill nam=term boot-ova=(list) kernel-ova=(list o) userspace-ova=(list o)] (cue q.q)) 18 | =/ convert 19 | |= ova=(list o) 20 | ^- (list unix-event) 21 | %+ turn ova 22 | |= ovo=o 23 | =/ sof ((soft unix-event) ovo) 24 | ?~ sof 25 | ~& [%unknown-event p.ovo] 26 | !! 27 | ~& [%known-event (wire p.ovo) (@tas -.q.ovo)] 28 | u.sof 29 | :: =/ boot-ova (convert boot-ova) 30 | =/ kernel-ova (convert kernel-ova) 31 | =/ userspace-ova (convert userspace-ova) 32 | [%pill nam boot-ova kernel-ova userspace-ova] 33 | -- 34 | ++ grad %mime 35 | -- 36 | -------------------------------------------------------------------------------- /desk/mar/png.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/png (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/purl.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/purl/mar 3 | :: 4 | /? 310 5 | =, eyre 6 | |_ url=purl 7 | ++ grad %noun 8 | :: 9 | ++ grow 10 | |% 11 | ++ noun url 12 | ++ hiss [url %get ~ ~] 13 | -- 14 | ++ grab :: convert from 15 | |% 16 | ++ noun purl :: clam from %noun 17 | -- 18 | -- 19 | -------------------------------------------------------------------------------- /desk/mar/ship.hoon: -------------------------------------------------------------------------------- 1 | |_ s=ship 2 | ++ grad %noun 3 | ++ grow 4 | |% 5 | ++ noun s 6 | ++ json s+(scot %p s) 7 | ++ mime 8 | ^- ^mime 9 | [/text/x-ship (as-octt:mimes:html (scow %p s))] 10 | 11 | -- 12 | ++ grab 13 | |% 14 | ++ noun ship 15 | ++ json (su:dejs:format ;~(pfix sig fed:ag)) 16 | ++ mime 17 | |= [=mite len=@ tex=@] 18 | (slav %p (snag 0 (to-wain:format tex))) 19 | -- 20 | -- 21 | -------------------------------------------------------------------------------- /desk/mar/snip.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/snip/mar 3 | :: 4 | /? 310 5 | =, html 6 | |% 7 | ++ words 1 8 | ++ hedtal 9 | =| met=marl 10 | |= a=marl ^- [hed=marl tal=marl] 11 | ?~ a [~ ~] 12 | ?. ?=(%h1 n.g.i.a) 13 | ?: ?=(%meta n.g.i.a) 14 | $(a t.a, met [i.a met]) 15 | =+ had=$(a c.i.a) 16 | ?^ -.had had 17 | $(a t.a) 18 | [c.i.a (weld (flop met) (limit words t.a))] 19 | :: 20 | ++ limit 21 | |= [lim=@u mal=marl] 22 | =< res 23 | |- ^- [rem=@u res=marl] 24 | ?~ mal [lim ~] 25 | ?~ lim [0 ~] 26 | =/ [lam=@u hed=manx] 27 | ?: ?=(_;/(**) i.mal) 28 | [lim ;/(tay)]:(deword lim v.i.a.g.i.mal) 29 | [rem ele(c res)]:[ele=i.mal $(mal c.i.mal)] 30 | [rem - res]:[hed $(lim lam, mal t.mal)] 31 | :: 32 | ++ deword 33 | |= [lim=@u tay=tape] ^- [lim=@u tay=tape] 34 | ?~ tay [lim tay] 35 | ?~ lim [0 ~] 36 | =+ wer=(dot 1^1 tay) 37 | ?~ q.wer 38 | [lim - tay]:[i.tay $(tay t.tay)] 39 | =+ nex=$(lim (dec lim), tay q.q.u.q.wer) 40 | [-.nex [(wonk wer) +.nex]] 41 | -- 42 | :: 43 | :: 44 | =, mimes:html 45 | |_ [hed=marl tal=marl] 46 | ++ grad %noun 47 | :: 48 | ++ grow :: convert to 49 | |% 50 | ++ mime 51 | =< mime 52 | |% 53 | ++ elem ;div:(h1:"*{hed}" div:"*{tal}") :: convert to %elem 54 | ++ hymn ;html:(head:title:"snip" body:"+{elem}") :: convert to %hymn 55 | ++ html (crip (en-xml hymn)) :: convert to %html 56 | ++ mime [/text/html (as-octs html)] :: convert to %mime 57 | -- 58 | ++ noun [hed tal] 59 | -- 60 | ++ grab |% :: convert from 61 | ++ noun ,[marl marl] :: clam from %noun 62 | ++ elem |=(a=manx (hedtal +.a)) 63 | -- -- 64 | -------------------------------------------------------------------------------- /desk/mar/story.hoon: -------------------------------------------------------------------------------- 1 | /- *story 2 | /+ *story 3 | |_ tale=story 4 | ++ grad 5 | |% 6 | ++ form %story-diff 7 | ++ diff 8 | |= tory=story 9 | ^- story-diff 10 | :: Given new story (tory), old story (tale), compute the diff 11 | :: additions = new - old 12 | :: deletions = old - new 13 | [(dif-ju tory tale) (dif-ju tale tory)] 14 | ++ pact 15 | |= dif=story-diff 16 | :: Compute the new story after applying dif to tale. 17 | :: 18 | ^- story 19 | =. tale (uni-ju tale additions.dif) 20 | =. tale (dif-ju tale deletions.dif) 21 | tale 22 | ++ join 23 | |= [ali=story-diff bob=story-diff] 24 | ^- (unit story-diff) 25 | =/ joined-additions (uni-ju additions.ali additions.bob) 26 | =/ joined-deletions (uni-ju deletions.ali deletions.bob) 27 | :: 28 | :: In a true join, we'd do a set intersection on the keys. 29 | :: If they're not equal, we have a conflict. 30 | :: In this case, we'd produce null and kick the flow to +mash 31 | :: 32 | %- some 33 | [joined-additions joined-deletions] 34 | ++ mash 35 | :: called by meld, force merge, annotating conflicts 36 | |= $: [als=ship ald=desk ali=story-diff] 37 | [bos=ship bod=desk bob=story-diff] 38 | == 39 | ^- story-diff 40 | (need (join ali bob)) :: XX temporary, only because join doesn't fail 41 | -- 42 | :: 43 | ++ grow :: convert to 44 | |% :: 45 | ++ mime :: to %mime 46 | [/text/x-urb-story (as-octs:mimes:html (of-wain:format txt))] 47 | ++ txt 48 | ^- wain 49 | %- zing 50 | %+ join `wain`~['---'] 51 | %+ murn ~(tap by tale) 52 | |= [=tako:clay =proses] 53 | ^- (unit wain) 54 | ?~ proses ~ 55 | (some (chapter-to-text tako proses)) 56 | -- 57 | ++ grab 58 | |% :: convert from 59 | ++ noun story :: clam from %noun 60 | ++ mime :: retrieve from %mime 61 | |= [p=mite q=octs] 62 | =/ story-text `@t`q.q 63 | `story`(rash story-text parse-story) 64 | -- 65 | -- 66 | -------------------------------------------------------------------------------- /desk/mar/svg.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/'svg+xml' (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/tang.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/tang/mar 3 | :: 4 | /? 310 5 | :: 6 | =, format 7 | |_ tan=(list tank) 8 | ++ grad %noun 9 | ++ grow 10 | |% 11 | ++ noun tan 12 | ++ json 13 | =/ result=(each (list ^json) tang) 14 | (mule |.((turn tan tank:enjs:format))) 15 | ?- -.result 16 | %& a+p.result 17 | %| a+[a+[%s '[[output rendering error]]']~]~ 18 | == 19 | :: 20 | ++ elem 21 | =- ;pre:code:"{(of-wall -)}" 22 | ^- wall %- zing ^- (list wall) 23 | (turn (flop tan) |=(a=tank (wash 0^160 a))) 24 | -- 25 | ++ grab :: convert from 26 | |% 27 | ++ noun (list ^tank) :: clam from %noun 28 | ++ tank |=(a=^tank [a]~) 29 | -- 30 | -- 31 | -------------------------------------------------------------------------------- /desk/mar/tape.hoon: -------------------------------------------------------------------------------- 1 | |_ tap=tape 2 | ++ grad %noun 3 | ++ grow 4 | |% 5 | ++ noun tap 6 | ++ json s+(crip tap) 7 | -- 8 | ++ grab 9 | |% 10 | ++ noun tape 11 | -- 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/thread-done.hoon: -------------------------------------------------------------------------------- 1 | |_ res=* 2 | ++ grab 3 | |% 4 | ++ noun * 5 | -- 6 | ++ grow 7 | |% 8 | ++ noun res 9 | -- 10 | ++ grad %noun 11 | -- 12 | -------------------------------------------------------------------------------- /desk/mar/thread-fail.hoon: -------------------------------------------------------------------------------- 1 | |_ err=* 2 | ++ grab 3 | |% 4 | ++ noun (pair term tang) 5 | -- 6 | ++ grow 7 | |% 8 | ++ noun err 9 | -- 10 | ++ grad %noun 11 | -- 12 | -------------------------------------------------------------------------------- /desk/mar/tiff.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/tiff (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/ttf.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=octs 2 | ++ grow 3 | |% 4 | ++ mime [/font/ttf dat] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([=mite =octs] octs) 9 | ++ noun octs 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/txt-diff.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/txt-diff/mar 3 | :: 4 | /? 310 5 | |_ txt-diff=(urge:clay cord) 6 | :: 7 | ++ grad %noun 8 | ++ grow 9 | |% 10 | ++ noun txt-diff 11 | -- 12 | ++ grab :: convert from 13 | |% 14 | ++ noun (urge:clay cord) :: make from %noun 15 | -- 16 | -- 17 | -------------------------------------------------------------------------------- /desk/mar/txt.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/txt/mar 3 | :: 4 | /? 310 5 | :: 6 | =, clay 7 | =, differ 8 | =, format 9 | =, mimes:html 10 | |_ txt=wain 11 | :: 12 | ++ grab :: convert from 13 | |% 14 | ++ mime |=((pair mite octs) (to-wain q.q)) 15 | ++ noun wain :: clam from %noun 16 | -- 17 | ++ grow 18 | => v=. 19 | |% 20 | ++ mime => v [/text/plain (as-octs (of-wain txt))] 21 | ++ elem => v ;pre: {(trip (of-wain txt))} 22 | -- 23 | ++ grad 24 | |% 25 | ++ form %txt-diff 26 | ++ diff 27 | |= tyt=wain 28 | ^- (urge cord) 29 | (lusk txt tyt (loss txt tyt)) 30 | :: 31 | ++ pact 32 | |= dif=(urge cord) 33 | ~| [%pacting dif] 34 | ^- wain 35 | (lurk txt dif) 36 | :: 37 | ++ join 38 | |= [ali=(urge cord) bob=(urge cord)] 39 | ^- (unit (urge cord)) 40 | |^ 41 | =. ali (clean ali) 42 | =. bob (clean bob) 43 | |- ^- (unit (urge cord)) 44 | ?~ ali `bob 45 | ?~ bob `ali 46 | ?- -.i.ali 47 | %& 48 | ?- -.i.bob 49 | %& 50 | ?: =(p.i.ali p.i.bob) 51 | %+ bind $(ali t.ali, bob t.bob) 52 | |=(cud=(urge cord) [i.ali cud]) 53 | ?: (gth p.i.ali p.i.bob) 54 | %+ bind $(p.i.ali (sub p.i.ali p.i.bob), bob t.bob) 55 | |=(cud=(urge cord) [i.bob cud]) 56 | %+ bind $(ali t.ali, p.i.bob (sub p.i.bob p.i.ali)) 57 | |=(cud=(urge cord) [i.ali cud]) 58 | :: 59 | %| 60 | ?: =(p.i.ali (lent p.i.bob)) 61 | %+ bind $(ali t.ali, bob t.bob) 62 | |=(cud=(urge cord) [i.bob cud]) 63 | ?: (gth p.i.ali (lent p.i.bob)) 64 | %+ bind $(p.i.ali (sub p.i.ali (lent p.i.bob)), bob t.bob) 65 | |=(cud=(urge cord) [i.bob cud]) 66 | ~ 67 | == 68 | :: 69 | %| 70 | ?- -.i.bob 71 | %| 72 | ?. =(i.ali i.bob) 73 | ~ 74 | %+ bind $(ali t.ali, bob t.bob) 75 | |=(cud=(urge cord) [i.ali cud]) 76 | :: 77 | %& 78 | ?: =(p.i.bob (lent p.i.ali)) 79 | %+ bind $(ali t.ali, bob t.bob) 80 | |=(cud=(urge cord) [i.ali cud]) 81 | ?: (gth p.i.bob (lent p.i.ali)) 82 | %+ bind $(ali t.ali, p.i.bob (sub p.i.bob (lent p.i.ali))) 83 | |=(cud=(urge cord) [i.ali cud]) 84 | ~ 85 | == 86 | == 87 | ++ clean :: clean 88 | |= wig=(urge cord) 89 | ^- (urge cord) 90 | ?~ wig ~ 91 | ?~ t.wig wig 92 | ?: ?=(%& -.i.wig) 93 | ?: ?=(%& -.i.t.wig) 94 | $(wig [[%& (add p.i.wig p.i.t.wig)] t.t.wig]) 95 | [i.wig $(wig t.wig)] 96 | ?: ?=(%| -.i.t.wig) 97 | $(wig [[%| (welp p.i.wig p.i.t.wig) (welp q.i.wig q.i.t.wig)] t.t.wig]) 98 | [i.wig $(wig t.wig)] 99 | -- 100 | :: 101 | ++ mash 102 | |= $: [als=ship ald=desk ali=(urge cord)] 103 | [bos=ship bod=desk bob=(urge cord)] 104 | == 105 | ^- (urge cord) 106 | |^ 107 | =. ali (clean ali) 108 | =. bob (clean bob) 109 | |- ^- (urge cord) 110 | ?~ ali bob 111 | ?~ bob ali 112 | ?- -.i.ali 113 | %& 114 | ?- -.i.bob 115 | %& 116 | ?: =(p.i.ali p.i.bob) 117 | [i.ali $(ali t.ali, bob t.bob)] 118 | ?: (gth p.i.ali p.i.bob) 119 | [i.bob $(p.i.ali (sub p.i.ali p.i.bob), bob t.bob)] 120 | [i.ali $(ali t.ali, p.i.bob (sub p.i.bob p.i.ali))] 121 | :: 122 | %| 123 | ?: =(p.i.ali (lent p.i.bob)) 124 | [i.bob $(ali t.ali, bob t.bob)] 125 | ?: (gth p.i.ali (lent p.i.bob)) 126 | [i.bob $(p.i.ali (sub p.i.ali (lent p.i.bob)), bob t.bob)] 127 | =/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)] 128 | (resolve ali bob) 129 | [fic $(ali ali, bob bob)] 130 | :: ~ :: here, alice is good for a while, but not for the whole 131 | == :: length of bob's changes 132 | :: 133 | %| 134 | ?- -.i.bob 135 | %| 136 | =/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)] 137 | (resolve ali bob) 138 | [fic $(ali ali, bob bob)] 139 | :: 140 | %& 141 | ?: =(p.i.bob (lent p.i.ali)) 142 | [i.ali $(ali t.ali, bob t.bob)] 143 | ?: (gth p.i.bob (lent p.i.ali)) 144 | [i.ali $(ali t.ali, p.i.bob (sub p.i.bob (lent p.i.ali)))] 145 | =/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)] 146 | (resolve ali bob) 147 | [fic $(ali ali, bob bob)] 148 | == 149 | == 150 | :: 151 | ++ annotate :: annotate conflict 152 | |= $: ali=(list @t) 153 | bob=(list @t) 154 | bas=(list @t) 155 | == 156 | ^- (list @t) 157 | %- zing 158 | ^- (list (list @t)) 159 | %- flop 160 | ^- (list (list @t)) 161 | :- :_ ~ 162 | %^ cat 3 '<<<<<<<<<<<<' 163 | %^ cat 3 ' ' 164 | %^ cat 3 `@t`(scot %p bos) 165 | %^ cat 3 '/' 166 | bod 167 | 168 | :- bob 169 | :- ~['------------'] 170 | :- bas 171 | :- ~['++++++++++++'] 172 | :- ali 173 | :- :_ ~ 174 | %^ cat 3 '>>>>>>>>>>>>' 175 | %^ cat 3 ' ' 176 | %^ cat 3 `@t`(scot %p als) 177 | %^ cat 3 '/' 178 | ald 179 | ~ 180 | :: 181 | ++ clean :: clean 182 | |= wig=(urge cord) 183 | ^- (urge cord) 184 | ?~ wig ~ 185 | ?~ t.wig wig 186 | ?: ?=(%& -.i.wig) 187 | ?: ?=(%& -.i.t.wig) 188 | $(wig [[%& (add p.i.wig p.i.t.wig)] t.t.wig]) 189 | [i.wig $(wig t.wig)] 190 | ?: ?=(%| -.i.t.wig) 191 | $(wig [[%| (welp p.i.wig p.i.t.wig) (welp q.i.wig q.i.t.wig)] t.t.wig]) 192 | [i.wig $(wig t.wig)] 193 | :: 194 | ++ resolve 195 | |= [ali=(urge cord) bob=(urge cord)] 196 | ^- [fic=[%| p=(list cord) q=(list cord)] ali=(urge cord) bob=(urge cord)] 197 | =- [[%| bac (annotate alc boc bac)] ali bob] 198 | |- ^- $: $: bac=(list cord) 199 | alc=(list cord) 200 | boc=(list cord) 201 | == 202 | ali=(urge cord) 203 | bob=(urge cord) 204 | == 205 | ?~ ali [[~ ~ ~] ali bob] 206 | ?~ bob [[~ ~ ~] ali bob] 207 | ?- -.i.ali 208 | %& 209 | ?- -.i.bob 210 | %& [[~ ~ ~] ali bob] :: no conflict 211 | %| 212 | =+ lob=(lent p.i.bob) 213 | ?: =(lob p.i.ali) 214 | [[p.i.bob p.i.bob q.i.bob] t.ali t.bob] 215 | ?: (lth lob p.i.ali) 216 | [[p.i.bob p.i.bob q.i.bob] [[%& (sub p.i.ali lob)] t.ali] t.bob] 217 | =+ wat=(scag (sub lob p.i.ali) p.i.bob) 218 | =+ ^= res 219 | %= $ 220 | ali t.ali 221 | bob [[%| (scag (sub lob p.i.ali) p.i.bob) ~] t.bob] 222 | == 223 | :* :* (welp bac.res wat) 224 | (welp alc.res wat) 225 | (welp boc.res q.i.bob) 226 | == 227 | ali.res 228 | bob.res 229 | == 230 | == 231 | :: 232 | %| 233 | ?- -.i.bob 234 | %& 235 | =+ loa=(lent p.i.ali) 236 | ?: =(loa p.i.bob) 237 | [[p.i.ali q.i.ali p.i.ali] t.ali t.bob] 238 | ?: (lth loa p.i.bob) 239 | [[p.i.ali q.i.ali p.i.ali] t.ali [[%& (sub p.i.bob loa)] t.bob]] 240 | =+ wat=(slag (sub loa p.i.bob) p.i.ali) 241 | =+ ^= res 242 | %= $ 243 | ali [[%| (scag (sub loa p.i.bob) p.i.ali) ~] t.ali] 244 | bob t.bob 245 | == 246 | :* :* (welp bac.res wat) 247 | (welp alc.res q.i.ali) 248 | (welp boc.res wat) 249 | == 250 | ali.res 251 | bob.res 252 | == 253 | :: 254 | %| 255 | =+ loa=(lent p.i.ali) 256 | =+ lob=(lent p.i.bob) 257 | ?: =(loa lob) 258 | [[p.i.ali q.i.ali q.i.bob] t.ali t.bob] 259 | =+ ^= res 260 | ?: (gth loa lob) 261 | $(ali [[%| (scag (sub loa lob) p.i.ali) ~] t.ali], bob t.bob) 262 | ~& [%scagging loa=loa pibob=p.i.bob slag=(scag loa p.i.bob)] 263 | $(ali t.ali, bob [[%| (scag (sub lob loa) p.i.bob) ~] t.bob]) 264 | :* :* (welp bac.res ?:((gth loa lob) p.i.bob p.i.ali)) 265 | (welp alc.res q.i.ali) 266 | (welp boc.res q.i.bob) 267 | == 268 | ali.res 269 | bob.res 270 | == 271 | == 272 | == 273 | -- 274 | -- 275 | -- 276 | -------------------------------------------------------------------------------- /desk/mar/udon.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/udon/mar 3 | :: 4 | /+ cram 5 | :: 6 | |_ mud=@t 7 | ++ grow 8 | |% 9 | ++ mime [/text/x-unmark (as-octs:mimes:html mud)] 10 | ++ txt 11 | (to-wain:format mud) 12 | ++ elem 13 | ^- manx 14 | =, cram 15 | elm:(static (ream mud)) 16 | ++ front :: XX performance, types 17 | ^- (map term knot) 18 | %- ~(run by inf:(static:cram (ream mud))) 19 | |= a=dime ^- cord 20 | ?+ (end 3 p.a) (scot a) 21 | %t q.a 22 | == 23 | -- 24 | ++ grab 25 | |% 26 | ++ mime |=((pair mite octs) q.q) 27 | ++ noun @t 28 | ++ txt of-wain:format 29 | -- 30 | ++ grad %txt 31 | -- 32 | -------------------------------------------------------------------------------- /desk/mar/umd.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/umd/mar 3 | :: 4 | /+ cram 5 | :: 6 | |_ mud=@t 7 | ++ grow 8 | |% 9 | ++ mime [/text/x-unmark (as-octs:mimes:html mud)] 10 | ++ txt 11 | (to-wain:format mud) 12 | ++ elem 13 | ^- manx 14 | =, cram 15 | elm:(static (ream mud)) 16 | ++ front :: XX performance, types 17 | ^- (map term knot) 18 | %- ~(run by inf:(static:cram (ream mud))) 19 | |= a=dime ^- cord 20 | ?+ (end 3 p.a) (scot a) 21 | %t q.a 22 | == 23 | -- 24 | ++ grab 25 | |% 26 | ++ mime |=((pair mite octs) q.q) 27 | ++ noun @t 28 | ++ txt of-wain:format 29 | -- 30 | ++ grad %txt 31 | ++ garb /down 32 | -- 33 | -------------------------------------------------------------------------------- /desk/mar/urb.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/elem/urb/mar 3 | :: 4 | /? 310 5 | =, mimes:html 6 | =, html 7 | |_ own=manx 8 | :: 9 | ++ grad %noun 10 | ++ grow :: convert to 11 | |% 12 | ++ hymn ;html:(head body:"+{own}") :: convert to %hymn 13 | ++ html (crip (en-xml hymn)) :: convert to %html 14 | ++ mime [/text/html (as-octs html)] :: convert to %mime 15 | -- 16 | ++ grab |% :: convert from 17 | ++ noun manx :: clam from %noun 18 | -- -- 19 | -------------------------------------------------------------------------------- /desk/mar/urbit.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/urbit/mar 3 | :: 4 | /? 310 5 | :::: A minimal urbit mark 6 | :: 7 | |_ her=@p 8 | ++ grab 9 | |% 10 | ++ noun @p 11 | -- 12 | ++ grow 13 | |% 14 | ++ noun her 15 | -- 16 | ++ grad %noun 17 | -- 18 | -------------------------------------------------------------------------------- /desk/mar/vere.hoon: -------------------------------------------------------------------------------- 1 | |_ v=vere 2 | ++ grab 3 | |% 4 | ++ noun vere 5 | -- 6 | ++ grow 7 | |% 8 | ++ json 9 | %- pairs:enjs:format 10 | :- [%non s+non.v] 11 | :- [%rev (path:enjs:format rev.v)] 12 | %+ turn kel.v 13 | |= w=weft 14 | [lal.w (numb:enjs:format num.w)] 15 | -- 16 | ++ grad %noun 17 | -- 18 | -------------------------------------------------------------------------------- /desk/mar/wav.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/wav (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/weba.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/audio/weba (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/webm.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/video/webm (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | 14 | -------------------------------------------------------------------------------- /desk/mar/webp.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=@ 2 | ++ grow 3 | |% 4 | ++ mime [/image/webp (as-octs:mimes:html dat)] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([p=mite q=octs] q.q) 9 | ++ noun @ 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/woff2.hoon: -------------------------------------------------------------------------------- 1 | |_ dat=octs 2 | ++ grow 3 | |% 4 | ++ mime [/font/woff2 dat] 5 | -- 6 | ++ grab 7 | |% 8 | ++ mime |=([=mite =octs] octs) 9 | ++ noun octs 10 | -- 11 | ++ grad %mime 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/x-htm.hoon: -------------------------------------------------------------------------------- 1 | |_ a=manx 2 | ++ grad %noun 3 | ++ grab 4 | |% 5 | ++ noun manx 6 | -- 7 | ++ grow 8 | |% 9 | ++ htm a 10 | ++ noun a 11 | -- 12 | -- 13 | -------------------------------------------------------------------------------- /desk/mar/xml.hoon: -------------------------------------------------------------------------------- 1 | :: 2 | :::: /hoon/xml/mar 3 | :: 4 | /? 310 5 | :: 6 | :::: compute 7 | :: 8 | =, mimes:html 9 | =, html 10 | |_ xml=@t 11 | :: 12 | ++ grad %mime 13 | ++ grow :: convert to 14 | |% :: 15 | ++ mime [/application/xml (as-octs xml)] :: to %mime 16 | ++ hymn (need (de-xml xml)) :: to %hymn 17 | -- :: 18 | ++ grab |% :: convert from 19 | ++ noun @t :: clam from %noun 20 | ++ mime |=([p=mite q=octs] q.q) :: retrieve form %mime 21 | -- -- 22 | -------------------------------------------------------------------------------- /desk/sur/docket.hoon: -------------------------------------------------------------------------------- 1 | |% 2 | :: 3 | +$ version 4 | [major=@ud minor=@ud patch=@ud] 5 | :: 6 | +$ glob (map path mime) 7 | :: 8 | +$ url cord 9 | :: $glob-location: How to retrieve a glob 10 | :: 11 | +$ glob-reference 12 | [hash=@uvH location=glob-location] 13 | :: 14 | +$ glob-location 15 | $% [%http =url] 16 | [%ames =ship] 17 | == 18 | :: $href: Where a tile links to 19 | :: 20 | +$ href 21 | $% [%glob base=term =glob-reference] 22 | [%site =path] 23 | == 24 | :: $chad: State of a docket 25 | :: 26 | +$ chad 27 | $~ [%install ~] 28 | $% :: Done 29 | [%glob =glob] 30 | [%site ~] 31 | :: Waiting 32 | [%install ~] 33 | [%suspend glob=(unit glob)] 34 | :: Error 35 | [%hung err=cord] 36 | == 37 | :: 38 | :: $charge: A realized $docket 39 | :: 40 | +$ charge 41 | $: =docket 42 | =chad 43 | == 44 | :: 45 | :: $clause: A key and value, as part of a docket 46 | :: 47 | :: Only used to parse $docket 48 | :: 49 | +$ clause 50 | $% [%title title=@t] 51 | [%info info=@t] 52 | [%color color=@ux] 53 | [%glob-http url=cord hash=@uvH] 54 | [%glob-ames =ship hash=@uvH] 55 | [%image =url] 56 | [%site =path] 57 | [%base base=term] 58 | [%version =version] 59 | [%website website=url] 60 | [%license license=cord] 61 | == 62 | :: 63 | :: $docket: A description of JS bundles for a desk 64 | :: 65 | +$ docket 66 | $: %1 67 | title=@t 68 | info=@t 69 | color=@ux 70 | =href 71 | image=(unit url) 72 | =version 73 | website=url 74 | license=cord 75 | == 76 | :: 77 | +$ charge-update 78 | $% [%initial initial=(map desk charge)] 79 | [%add-charge =desk =charge] 80 | [%del-charge =desk] 81 | == 82 | -- 83 | -------------------------------------------------------------------------------- /desk/sys.kelvin: -------------------------------------------------------------------------------- 1 | [%zuse 413] 2 | [%zuse 412] 3 | [%zuse 411] 4 | -------------------------------------------------------------------------------- /desk/ted/naive-csv.hoon: -------------------------------------------------------------------------------- 1 | :: naive-csv: produces csv file containing L2 transaction data 2 | :: 3 | :: takes in the network to use and the ethereum node url to grab data from. 4 | :: it starts with the azimuth snapshot and scries the logs from %azimuth. 5 | :: it then produces a csv file containing the following data on L2 6 | :: transactions: 7 | :: 8 | :: - block number 9 | :: - timestamp 10 | :: - roller address 11 | :: - roll hash 12 | :: - tx hash 13 | :: - sending ship 14 | :: - sending proxy 15 | :: - nonce 16 | :: - gas price 17 | :: - length of input data 18 | :: - success or failure 19 | :: - function name 20 | :: - spawning ship (^sein:title) 21 | :: 22 | :: A lot of the data-scrounging here is stuff that %roller already keeps track 23 | :: of. We could just scry it from there, but then this thread needs to be run 24 | :: on the roller ship. So we rebuild the list of historical transactions 25 | :: ourselves so that this can run from any ship. 26 | :: 27 | /- dice, 28 | spider 29 | :: 30 | /+ dice, 31 | ethereum, 32 | ethio, 33 | naive, 34 | naive-tx=naive-transactions, 35 | *strandio 36 | :: 37 | =, strand=strand:spider 38 | =, jael 39 | :: 40 | ^- thread:spider 41 | =< process-logs 42 | => 43 | |% 44 | :: imported logs is cast as $events 45 | +$ events (list event-log:rpc:ethereum) 46 | +$ address address:naive :: @ux 47 | +$ keccak @ux :: used for transaction and roll hashes 48 | +$ blocknum number:block :: @udblocknumber 49 | +$ net net:dice :: ?(%mainnet %goerli %local %default) 50 | +$ roll-dat :: all data required for each roll 51 | [[gas=@ud sender=address] =effects:naive] 52 | +$ block-dat :: all data required for each block 53 | [timestamp=@da rolls=(map keccak roll-dat)] 54 | +$ block-map (map blocknum block-dat) 55 | +$ rolls-map (map blocknum (map keccak effects:naive)) 56 | :: 57 | +$ action 58 | $? %transfer-point 59 | %spawn 60 | %configure-keys 61 | %escape 62 | %cancel-escape 63 | %adopt 64 | %reject 65 | %detach 66 | %set-management-proxy 67 | %set-spawn-proxy 68 | %set-transfer-proxy 69 | == 70 | :: 71 | +$ tx-data 72 | $: =blocknum 73 | timestamp=@da 74 | roller=address 75 | roll-hash=keccak 76 | tx-hash=keccak 77 | sender=ship 78 | proxy=proxy:naive 79 | nonce=nonce:naive 80 | gas=@ud 81 | length=@ux 82 | suc=? 83 | =action 84 | parent=ship 85 | == 86 | -- 87 | :: 88 | |% 89 | :: +process-logs is the main process. it grabs the azimuth snapshop, runs 90 | :: +naive on the logs, grabs the timestamps and gas costs for each roll, 91 | :: then flattens them into a list of $tx-data and saves them to disk. 92 | :: 93 | ++ process-logs 94 | |= arg=vase 95 | =+ !<([~ =net node-url=@t] arg) 96 | =/ pax=path /naive-exports/csv :: data will be saved here 97 | =/ m (strand ,vase) 98 | ^- form:m 99 | ;< =events bind:m (scry events /gx/azimuth/logs/noun) 100 | =/ [naive-contract=address chain-id=@] 101 | [naive chain-id]:(get-network:dice net) 102 | ;< =bowl:spider bind:m get-bowl 103 | =/ snap=snap-state:dice 104 | .^ snap-state:dice %gx 105 | /(scot %p our.bowl)/azimuth/(scot %da now.bowl)/last-snap/noun 106 | == 107 | :: 108 | ;< ~ bind:m 109 | %- flog-text %+ weld "naive-csv: processing {} ethereum logs " 110 | "with {<(lent events)>} events" 111 | =/ =rolls-map 112 | (compute-effects nas.snap events net naive-contract chain-id) 113 | ;< ~ bind:m (flog-text "naive-csv: getting timestamps") 114 | ;< tim=thread-result bind:m 115 | %+ await-thread %eth-get-timestamps 116 | !>([node-url ~(tap in ~(key by rolls-map))]) 117 | =/ timestamps %- ~(gas by *(map blocknum @da)) 118 | ?- tim 119 | [%.y *] ;;((list [@ud @da]) q.p.tim) 120 | [%.n *] 121 | => (mean 'naive-csv: %eth-get-timestamps failed' p.tim) 122 | !! 123 | == 124 | ;< ~ bind:m (flog-text "naive-csv: got timestamps") 125 | ;< ~ bind:m (flog-text "naive-csv: getting tx receipts") 126 | ;< gaz=thread-result bind:m 127 | %+ await-thread %eth-get-tx-receipts 128 | !>([node-url (get-roll-hashes rolls-map)]) 129 | =/ gas-sender %- ~(gas by *(map keccak [gas=@ud sender=address])) 130 | ?- gaz 131 | [%.y *] (parse-gas-sender ;;((list [@t json]) q.p.gaz)) 132 | [%.n *] 133 | => (mean 'naive-csv: %eth-tx-receipts failed' p.gaz) 134 | !! 135 | == 136 | ;< ~ bind:m (flog-text "naive-csv: got tx receipts") 137 | =/ csv=(list cord) 138 | (make-csv (flatten (collate-roll-data rolls-map timestamps gas-sender))) 139 | ;< ~ bind:m (export-csv csv pax) 140 | ;< ~ bind:m (flog-text :(weld "naive-csv: csv saved to %" (spud pax) "/")) 141 | :: 142 | (pure:m !>(~)) 143 | :: +collate-roll-data throws naive:effects, timestamps, and gas costs into 144 | :: one $block-map 145 | :: 146 | ++ collate-roll-data 147 | |= $: =rolls-map 148 | timestamps=(map blocknum @da) 149 | roll-receipts=(map keccak [gas=@ud sender=address]) 150 | == 151 | =/ blocknums=(list blocknum) ~(tap in ~(key by rolls-map)) 152 | =| =block-map 153 | ^+ block-map 154 | |- 155 | ?~ blocknums block-map 156 | =/ =blocknum i.blocknums 157 | =/ rolls=(map keccak [[gas=@ud sender=address] =effects:naive]) 158 | %- ~(gas by *(map keccak [[gas=@ud sender=address] =effects:naive])) 159 | %+ turn ~(tap in ~(key by (~(got by rolls-map) blocknum))) 160 | |= txh=keccak 161 | :+ txh 162 | (~(got by roll-receipts) txh) 163 | (~(got by (~(got by rolls-map) blocknum)) txh) 164 | %= $ 165 | blocknums t.blocknums 166 | block-map %+ ~(put by block-map) 167 | blocknum 168 | [(~(got by timestamps) blocknum) rolls] 169 | == 170 | :: +flatten takes a $block-map and creates a $tx-data for every transaction 171 | :: in every roll, returned as a (list tx-data) 172 | :: 173 | ++ flatten 174 | |= =block-map 175 | =/ blocks=(list [blocknum block-dat]) ~(tap by block-map) 176 | =| tx-list=(list tx-data) 177 | ^+ tx-list 178 | :: recurse through the list of blocks, getting the rolls submitted in that 179 | :: block, their timestamp, and the gas price of that roll 180 | :: 181 | |- 182 | =* block-loop $ 183 | ?~ blocks tx-list 184 | =/ block=[=blocknum =block-dat] i.blocks 185 | =/ roll-list=(list [=keccak =roll-dat]) ~(tap by rolls.block-dat.block) 186 | =| block-tx-list=(list tx-data) 187 | :: recurse through each roll, getting the transaction data from the effects 188 | :: 189 | |- 190 | =* roll-loop $ 191 | ?~ roll-list 192 | %= block-loop 193 | blocks t.blocks 194 | tx-list (welp tx-list block-tx-list) 195 | == 196 | =/ roll=[=keccak =roll-dat] i.roll-list 197 | :: recurse through the list of effects, building up transaction data as we 198 | :: go. there's a choice here to use the effects, or the submitted 199 | :: raw-tx. the effects include whether or not a transaction failed, 200 | :: which is important data not a part of the submitted raw-tx. we 201 | :: could determine this ourselves, but we build the effects anyways when 202 | :: computing the state transitions, so we may as well use them. 203 | :: 204 | :: an individual transaction results in up to 3 diffs: a %nonce, a %tx, and 205 | :: a %point. they always appear in this order. successful transactions 206 | :: always have all 3, while failed transactions only have %nonce and %tx. 207 | :: note that the nonce listed is always the expected nonce - we can't know 208 | :: what nonce was actually submitted without the private key of the signer. 209 | :: 210 | =| roll-tx-list=(list tx-data) 211 | =| =tx-data 212 | =| nonce-and-tx=[_| _|] 213 | |- 214 | =* effect-loop $ 215 | :: if we are processing a new transaction, initialize the parts of tx-data 216 | :: that are identical for every transaction in the roll 217 | =? tx-data =([| |] nonce-and-tx) 218 | :* blocknum.block timestamp.block-dat.block sender.roll-dat.roll 219 | keccak.roll *keccak *ship *proxy:naive *nonce:naive 220 | gas.roll-dat.roll *@ | *action *ship 221 | == 222 | :: if we've gotten both the %nonce and %tx diff from a transaction, add the 223 | :: tx-data to the list of tx for the roll 224 | :: 225 | ?: =([& &] nonce-and-tx) 226 | %= effect-loop 227 | nonce-and-tx [| |] 228 | roll-tx-list (snoc roll-tx-list tx-data) 229 | == 230 | :: if we've finished looping through the effects, add the tx list from the 231 | :: roll to the list of tx for the block 232 | :: 233 | ?~ effects.roll-dat.roll 234 | %= roll-loop 235 | roll-list t.roll-list 236 | block-tx-list (welp block-tx-list roll-tx-list) 237 | == 238 | :: 239 | =/ =diff:naive i.effects.roll-dat.roll 240 | :: we ignore %operator, %dns, %point diffs 241 | :: 242 | ?+ diff 243 | $(effects.roll-dat.roll t.effects.roll-dat.roll) 244 | :: %nonce is always the first diff from a given transaction. 245 | :: 246 | [%nonce *] 247 | %= effect-loop 248 | -.nonce-and-tx & 249 | sender.tx-data ship.diff 250 | nonce.tx-data nonce.diff 251 | proxy.tx-data proxy.diff 252 | parent.tx-data (^sein:title ship.diff) 253 | effects.roll-dat.roll t.effects.roll-dat.roll 254 | == 255 | :: %tx is always the second diff from a given transaction. 256 | :: 257 | [%tx *] 258 | %= effect-loop 259 | +.nonce-and-tx & 260 | effects.roll-dat.roll t.effects.roll-dat.roll 261 | action.tx-data +<.tx.raw-tx.diff 262 | suc.tx-data ?~ err.diff & | 263 | length.tx-data `@`-.raw.raw-tx.diff 264 | tx-hash.tx-data (hash-raw-tx:naive-tx raw-tx.diff) 265 | == 266 | == 267 | :: 268 | ++ parse-gas-sender 269 | |= res=(list [@t json]) 270 | ^- (list [=keccak [gas=@ud sender=address]]) 271 | %+ turn res 272 | |= [id=@t =json] 273 | ^- [=keccak [gas=@ud sender=address]] 274 | :- (hex-to-num:ethereum id) 275 | :- %- parse-hex-result:rpc:ethereum 276 | ~| json 277 | ?> ?=(%o -.json) 278 | (~(got by p.json) 'effectiveGasPrice') :: gas used in wei 279 | %- parse-hex-result:rpc:ethereum 280 | ~| json 281 | ?> ?=(%o -.json) 282 | (~(got by p.json) 'from') 283 | :: +get-roll-hashes makes a list of hashes of all transactions from $rolls-map 284 | :: 285 | ++ get-roll-hashes 286 | |= =rolls-map ^- (list keccak) 287 | %- zing 288 | %+ turn ~(val by rolls-map) 289 | |= a=(map keccak effects:naive) 290 | ~(tap in ~(key by a)) 291 | :: +compute-effects calls +naive to compute the state transitions for all 292 | :: logs, but it returns a map that only has the effects for L2 transactions, 293 | :: leaving out L1 transactions. we need to compute all of them in order to 294 | :: determine whether the transactions were valid. 295 | :: 296 | ++ compute-effects 297 | |= $: nas=^state:naive 298 | =events 299 | =net 300 | naive-contract=address 301 | chain-id=@ud 302 | == 303 | =| out=rolls-map 304 | ^+ out 305 | :: 306 | |- 307 | ?~ events out 308 | =/ log=event-log:rpc:ethereum i.events 309 | ?~ mined.log 310 | ~& >> 'naive-csv: empty log' 311 | $(events t.events) 312 | =/ =blocknum block-number.u.mined.log 313 | =/ =^input:naive 314 | :- blocknum 315 | ?. =(naive-contract address.log) 316 | :- %log 317 | [address.log (data-to-hex:dice data.log) topics.log] 318 | ?~ input.u.mined.log 319 | ~& >> 'naive-csv: empty L2 transaction' 320 | [%bat *@] 321 | [%bat u.input.u.mined.log] 322 | =^ =effects:naive nas 323 | (%*(. naive lac |) verifier:naive-tx chain-id nas input) 324 | %= $ 325 | events t.events 326 | out ?. =(%bat +<.input) 327 | out :: skip L1 logs 328 | =/ cur (~(get by out) blocknum) 329 | ?~ cur 330 | %+ ~(put by out) blocknum 331 | (my [[transaction-hash.u.mined.log effects]~]) 332 | %+ ~(put by out) blocknum 333 | (~(put by u.cur) transaction-hash.u.mined.log effects) 334 | == 335 | :: +export-csv writes a (list cord) as csv to disk at .pax 336 | :: 337 | ++ export-csv 338 | |= [in=(list cord) pax=path] 339 | =/ m (strand ,~) 340 | ^- form:m 341 | ;< =bowl:spider bind:m get-bowl 342 | =- (send-raw-card %pass / %arvo %c %info -) 343 | %+ foal:space:userlib 344 | ;: weld 345 | /(scot %p our.bowl)/base/(scot %da now.bowl) 346 | pax 347 | /(scot %da now.bowl)/txt 348 | == 349 | [%txt !>(in)] 350 | :: +make-csv takes in a (list tx-data) and makes it into a (list cord) to be 351 | :: saved as a csv file 352 | :: 353 | ++ make-csv 354 | |= in=(list tx-data) 355 | ^- (list cord) 356 | :- %- crip 357 | ;: weld 358 | "block number," 359 | "timestamp," 360 | "roller address," 361 | "roll hash," 362 | "tx hash," 363 | "sending ship," 364 | "sending proxy," 365 | "nonce," 366 | "gas price," 367 | "length of input data," 368 | "success or failure," 369 | "function name," 370 | "parent" 371 | == 372 | %+ turn in 373 | |= =tx-data 374 | %- crip 375 | ;: weld 376 | (scow %ud blocknum.tx-data) "," 377 | (scow %da timestamp.tx-data) "," 378 | (scow %ux roller.tx-data) "," 379 | (scow %ux roll-hash.tx-data) "," 380 | (scow %ux tx-hash.tx-data) "," 381 | (scow %p sender.tx-data) "," 382 | (scow %tas proxy.tx-data) "," 383 | (scow %ud nonce.tx-data) "," 384 | (scow %ud gas.tx-data) "," 385 | (scow %ux length.tx-data) "," 386 | (scow %f suc.tx-data) "," 387 | (scow %tas action.tx-data) "," 388 | (scow %p parent.tx-data) 389 | == 390 | -- 391 | -------------------------------------------------------------------------------- /desk/tests/lib/math.hoon: -------------------------------------------------------------------------------- 1 | :: tests/lib/math/hoon 2 | /+ math, 3 | *test 4 | |% 5 | :: +rs 6 | ++ test-rs-sea 7 | ;: weld 8 | %+ expect-eq 9 | !> [%f s=%.y e=-23 a=8.388.608] 10 | !> (sea:rs:math .1) 11 | %+ expect-eq 12 | !> [%f s=%.y e=-23 a=9.227.469] 13 | !> (sea:rs:math .1.1) 14 | == 15 | ++ test-rs-bit 16 | ;: weld 17 | %+ expect-eq 18 | !> .1 19 | !> (bit:rs:math [%f s=%.y e=-23 a=8.388.608]) 20 | %+ expect-eq 21 | !> .1.1 22 | !> (bit:rs:math [%f s=%.y e=-23 a=9.227.469]) 23 | == 24 | ++ test-rs-sun 25 | ;: weld 26 | %+ expect-eq 27 | !> .1 28 | !> (sun:rs:math 1) 29 | %+ expect-eq 30 | !> .1e3 31 | !> (sun:rs:math 1.000) 32 | == 33 | ++ test-rs-san 34 | ;: weld 35 | %+ expect-eq 36 | !> .1 37 | !> (san:rs:math --1) 38 | %+ expect-eq 39 | !> .-1 40 | !> (san:rs:math -1) 41 | == 42 | ++ test-rs-toi 43 | ;: weld 44 | %+ expect-eq 45 | !> `--1 46 | !> (toi:rs:math .1) 47 | %+ expect-eq 48 | !> `-1 49 | !> (toi:rs:math .-1) 50 | == 51 | ++ test-rs-drg 52 | ;: weld 53 | %+ expect-eq 54 | !> [%d s=%.y e=--0 a=1] 55 | !> (drg:rs:math .1) 56 | %+ expect-eq 57 | !> [%d s=%.y e=-1 a=11] 58 | !> (drg:rs:math .1.1) 59 | == 60 | ++ test-rs-grd 61 | ;: weld 62 | %+ expect-eq 63 | !> .1 64 | !> (grd:rs:math [%d s=%.y e=--0 a=1]) 65 | %+ expect-eq 66 | !> .1.1 67 | !> (grd:rs:math [%d s=%.y e=-1 a=11]) 68 | == 69 | ++ test-rs-lth 70 | ;: weld 71 | %+ expect-eq 72 | !> %.y 73 | !> (lth:rs:math .1 .2) 74 | %+ expect-eq 75 | !> %.n 76 | !> (lth:rs:math .2 .1) 77 | %+ expect-eq 78 | !> %.n 79 | !> (lth:rs:math .1 .1) 80 | == 81 | ++ test-rs-lte 82 | ;: weld 83 | %+ expect-eq 84 | !> %.y 85 | !> (lte:rs:math .1 .2) 86 | %+ expect-eq 87 | !> %.n 88 | !> (lte:rs:math .2 .1) 89 | %+ expect-eq 90 | !> %.y 91 | !> (lte:rs:math .1 .1) 92 | == 93 | ++ test-rs-leq 94 | ;: weld 95 | %+ expect-eq 96 | !> %.y 97 | !> (leq:rs:math .1 .2) 98 | %+ expect-eq 99 | !> %.n 100 | !> (leq:rs:math .2 .1) 101 | %+ expect-eq 102 | !> %.y 103 | !> (leq:rs:math .1 .1) 104 | == 105 | ++ test-rs-equ 106 | ;: weld 107 | %+ expect-eq 108 | !> %.n 109 | !> (equ:rs:math .1 .2) 110 | %+ expect-eq 111 | !> %.n 112 | !> (equ:rs:math .2 .1) 113 | %+ expect-eq 114 | !> %.y 115 | !> (equ:rs:math .1 .1) 116 | == 117 | ++ test-rs-gth 118 | ;: weld 119 | %+ expect-eq 120 | !> %.n 121 | !> (gth:rs:math .1 .2) 122 | %+ expect-eq 123 | !> %.y 124 | !> (gth:rs:math .2 .1) 125 | %+ expect-eq 126 | !> %.n 127 | !> (gth:rs:math .1 .1) 128 | == 129 | ++ test-rs-gte 130 | ;: weld 131 | %+ expect-eq 132 | !> %.n 133 | !> (gte:rs:math .1 .2) 134 | %+ expect-eq 135 | !> %.y 136 | !> (gte:rs:math .2 .1) 137 | %+ expect-eq 138 | !> %.y 139 | !> (gte:rs:math .1 .1) 140 | == 141 | ++ test-rs-geq 142 | ;: weld 143 | %+ expect-eq 144 | !> %.n 145 | !> (geq:rs:math .1 .2) 146 | %+ expect-eq 147 | !> %.y 148 | !> (geq:rs:math .2 .1) 149 | %+ expect-eq 150 | !> %.y 151 | !> (geq:rs:math .1 .1) 152 | == 153 | ++ test-rs-neq 154 | ;: weld 155 | %+ expect-eq 156 | !> %.y 157 | !> (neq:rs:math .1 .2) 158 | %+ expect-eq 159 | !> %.y 160 | !> (neq:rs:math .2 .1) 161 | %+ expect-eq 162 | !> %.n 163 | !> (neq:rs:math .1 .1) 164 | == 165 | ++ test-rs-isclose 166 | ;: weld 167 | %+ expect-eq 168 | !> %.y 169 | !> (isclose:rs:math .1 .1) 170 | %+ expect-eq 171 | !> %.n 172 | !> (isclose:rs:math .1 .1.1) 173 | == 174 | ++ test-rs-allclose 175 | ;: weld 176 | %+ expect-eq 177 | !> %.n 178 | !> (~(allclose rs:math [%z .1e-8]) .1 ~[.1 .1.000001]) 179 | %+ expect-eq 180 | !> %.n 181 | !> (~(allclose rs:math [%z .1e-8]) .1 ~[.1 .1.000001]) 182 | %+ expect-eq 183 | !> %.y 184 | !> (allclose:rs:math .1 ~[.1]) 185 | == 186 | ++ test-rs-isint 187 | ;: weld 188 | %+ expect-eq 189 | !> %.y 190 | !> (isint:rs:math .1) 191 | %+ expect-eq 192 | !> %.n 193 | !> (isint:rs:math .1.1) 194 | == 195 | ++ test-rs-add 196 | ;: weld 197 | %+ expect-eq 198 | !> .3 199 | !> (add:rs:math .1 .2) 200 | == 201 | ++ test-rs-sub 202 | ;: weld 203 | %+ expect-eq 204 | !> .-1 205 | !> (sub:rs:math .1 .2) 206 | == 207 | ++ test-rs-mul 208 | ;: weld 209 | %+ expect-eq 210 | !> .2 211 | !> (mul:rs:math .1 .2) 212 | == 213 | ++ test-rs-div 214 | ;: weld 215 | %+ expect-eq 216 | !> .0.5 217 | !> (div:rs:math .1 .2) 218 | == 219 | ++ test-rs-fma 220 | ;: weld 221 | %+ expect-eq 222 | !> .5 223 | !> (fma:rs:math .1 .2 .3) 224 | %+ expect-eq 225 | !> .10 226 | !> (fma:rs:math .2 .3 .4) 227 | == 228 | ++ test-rs-sig 229 | ;: weld 230 | %+ expect-eq 231 | !> %.y 232 | !> (sig:rs:math .1) 233 | %+ expect-eq 234 | !> %.n 235 | !> (sig:rs:math .-1) 236 | == 237 | ++ test-rs-sgn 238 | ;: weld 239 | %+ expect-eq 240 | !> %.y 241 | !> (sgn:rs:math .1) 242 | %+ expect-eq 243 | !> %.n 244 | !> (sgn:rs:math .-1) 245 | == 246 | ++ test-rs-neg 247 | ;: weld 248 | %+ expect-eq 249 | !> .-1 250 | !> (neg:rs:math .1) 251 | %+ expect-eq 252 | !> .1 253 | !> (neg:rs:math .-1) 254 | == 255 | ++ test-rs-factorial 256 | ;: weld 257 | %+ expect-eq 258 | !> .1 259 | !> (factorial:rs:math .1) 260 | %+ expect-eq 261 | !> .2 262 | !> (factorial:rs:math .2) 263 | %+ expect-eq 264 | !> .6 265 | !> (factorial:rs:math .3) 266 | %+ expect-eq 267 | !> .24 268 | !> (factorial:rs:math .4) 269 | %+ expect-eq 270 | !> .120 271 | !> (factorial:rs:math .5) 272 | == 273 | ++ test-rs-abs 274 | ;: weld 275 | %+ expect-eq 276 | !> .1 277 | !> (abs:rs:math .1) 278 | %+ expect-eq 279 | !> .1 280 | !> (abs:rs:math .-1) 281 | == 282 | ++ test-rs-exp 283 | ;: weld 284 | %+ expect-eq 285 | !> .2.7182808 286 | !> (exp:rs:math .1) 287 | %+ expect-eq 288 | !> .7.389052 289 | !> (exp:rs:math .2) 290 | %+ expect-eq 291 | !> .7.389053 292 | !> (~(exp rs:math [%z .1e-8]) .2) 293 | %+ expect-eq 294 | !> .inf 295 | !> (exp:rs:math .inf) 296 | == 297 | ++ test-rs-sin 298 | ;: weld 299 | %+ expect-eq 300 | !> .0.84147096 301 | !> (sin:rs:math .1) 302 | %+ expect-eq 303 | !> .0.9092974 304 | !> (sin:rs:math .2) 305 | %+ expect-eq 306 | !> .3.1609193e-7 307 | !> (sin:rs:math pi:rs:math) 308 | %+ expect-eq 309 | !> .0.90929735 310 | !> (~(sin rs:math [%z .1e-8]) .2) 311 | == 312 | ++ test-rs-cos 313 | ;: weld 314 | %+ expect-eq 315 | !> .0.5403022 316 | !> (cos:rs:math .1) 317 | %+ expect-eq 318 | !> .-0.41614664 319 | !> (cos:rs:math .2) 320 | %+ expect-eq 321 | !> .-0.9999998 322 | !> (cos:rs:math pi:rs:math) 323 | %+ expect-eq 324 | !> .-0.41614679 325 | !> (~(cos rs:math [%z .1e-8]) .2) 326 | == 327 | ++ test-rs-tan 328 | ;: weld 329 | %+ expect-eq 330 | !> .1.5574079 331 | !> (tan:rs:math .1) 332 | %+ expect-eq 333 | !> .-2.1850407 334 | !> (tan:rs:math .2) 335 | %+ expect-eq 336 | !> .-3.1609196e-7 337 | !> (tan:rs:math pi:rs:math) 338 | %+ expect-eq 339 | !> .-2.1850398 340 | !> (~(tan rs:math [%z .1e-8]) .2) 341 | == 342 | ++ test-rs-pow-n 343 | ;: weld 344 | %+ expect-eq 345 | !> .1 346 | !> (pow-n:rs:math .1 .2) 347 | %+ expect-eq 348 | !> .4 349 | !> (pow-n:rs:math .2 .2) 350 | %+ expect-eq 351 | !> .8 352 | !> (pow-n:rs:math .2 .3) 353 | == 354 | ++ test-rs-log 355 | ;: weld 356 | %+ expect-eq 357 | !> .0 358 | !> (log:rs:math .1) 359 | %+ expect-eq 360 | !> .0.69314677 361 | !> (log:rs:math .2) 362 | %+ expect-eq 363 | !> .0.6931469 364 | !> (~(log rs:math [%z .1e-8]) .2) 365 | %+ expect-eq 366 | !> .inf 367 | !> (log:rs:math .inf) 368 | %+ expect-eq 369 | !> .0.999998 370 | !> (log:rs:math e:rs:math) 371 | %+ expect-eq 372 | !> .0.9999994 373 | !> (~(log rs:math [%z .1e-8]) e:rs:math) 374 | == 375 | ++ test-rs-pow 376 | ;: weld 377 | %+ expect-eq 378 | !> .1 379 | !> (pow:rs:math .1 .2) 380 | %+ expect-eq 381 | !> .4 382 | !> (pow:rs:math .2 .2) 383 | %+ expect-eq 384 | !> .11.313682 385 | !> (pow:rs:math .2 .3.5) 386 | %+ expect-eq 387 | !> .11.313687 388 | !> (~(pow rs:math [%z .1e-8]) .2 .3.5) 389 | == 390 | ++ test-rs-sqrt 391 | ;: weld 392 | %+ expect-eq 393 | !> .1 394 | !> (sqrt:rs:math .1) 395 | %+ expect-eq 396 | !> .1.4142128 397 | !> (sqrt:rs:math .2) 398 | %+ expect-eq 399 | !> .1.414213 400 | !> (~(sqrt rs:math [%z .1e-8]) .2) 401 | == 402 | ++ test-rs-sqt 403 | ;: weld 404 | %+ expect-eq 405 | !> .1 406 | !> (sqt:rs:math .1) 407 | %+ expect-eq 408 | !> .1.4142128 409 | !> (sqt:rs:math .2) 410 | %+ expect-eq 411 | !> .1.414213 412 | !> (~(sqt rs:math [%z .1e-8]) .2) 413 | == 414 | ++ test-rs-cbrt 415 | ;: weld 416 | %+ expect-eq 417 | !> .1 418 | !> (cbrt:rs:math .1) 419 | %+ expect-eq 420 | !> .1.2599205 421 | !> (cbrt:rs:math .2) 422 | %+ expect-eq 423 | !> .1.2599207 424 | !> (~(cbrt rs:math [%z .1e-8]) .2) 425 | == 426 | ++ test-rs-cbt 427 | ;: weld 428 | %+ expect-eq 429 | !> .1 430 | !> (cbt:rs:math .1) 431 | %+ expect-eq 432 | !> .1.2599205 433 | !> (cbt:rs:math .2) 434 | %+ expect-eq 435 | !> .1.2599207 436 | !> (~(cbt rs:math [%z .1e-8]) .2) 437 | == 438 | ++ test-rs-arg 439 | ;: weld 440 | %+ expect-eq 441 | !> .1 442 | !> (arg:rs:math .1) 443 | %+ expect-eq 444 | !> .1 445 | !> (arg:rs:math .-1) 446 | == 447 | -- 448 | -------------------------------------------------------------------------------- /desk/tests/lib/regex.hoon: -------------------------------------------------------------------------------- 1 | /+ *test, regex 2 | 3 | |% 4 | ++ has-match 5 | |= [reg=tape pass=(list tape) fail=(list tape)] ^- tang 6 | |^ 7 | %+ weld 8 | ^- tang 9 | %+ roll pass 10 | |= [a=tape b=tang] ^- tang 11 | (weld b (run a %.y)) 12 | ^- tang 13 | %+ roll fail 14 | |= [a=tape b=tang] ^- tang 15 | (weld b (run a %.n)) 16 | :: 17 | ++ run 18 | |= [a=tape res=?] ^- tang 19 | =+ result=(expect-eq !>(res) !>((has:regex reg a))) 20 | ?~ result result 21 | %+ weld result 22 | ^- tang 23 | :~ [%palm [": " ~ ~ ~] [leaf+"pattern" (sell !>(reg)) ~]] 24 | [%palm [": " ~ ~ ~] [leaf+"subject" (sell !>(a)) ~]] 25 | == 26 | -- 27 | ++ invalid-regex 28 | |= [reg=tape] ^- tang 29 | =/ result=tang (expect !>(!(valid:regex reg))) 30 | =/ result=tang 31 | %+ weld 32 | (expect !>(!(valid:regex reg))) 33 | (expect-fail |.((run:regex reg ""))) 34 | ?~ result result 35 | :_ ~ 36 | :+ %palm 37 | [": " ~ ~ ~] 38 | [leaf+"expected pattern to fail" (sell !>(reg)) ~] 39 | ++ capture-groups 40 | |= [reg=tape tex=tape res=(list (pair @u tape))] 41 | =/ result=tang 42 | %+ expect-eq !>(res) 43 | !> ^- (list (pair @u tape)) 44 | %+ turn 45 | %+ sort ~(tap by (ran:regex reg tex)) 46 | |= [a=(pair @u range:regex) b=(pair @u range:regex)] 47 | (lth p.a p.b) 48 | |= [a=(pair @u range:regex)] ^- (pair @u tape) 49 | [p.a q.q.a] 50 | ?~ result result 51 | %+ weld result 52 | ^- tang 53 | :~ [%palm [": " ~ ~ ~] [leaf+"pattern" (sell !>(reg)) ~]] 54 | [%palm [": " ~ ~ ~] [leaf+"subject" (sell !>(tex)) ~]] 55 | == 56 | -- 57 | 58 | |% 59 | ++ test-empty 60 | ;: weld 61 | (has-match "" ~["" "a" "abc" "\0a"] ~) 62 | (has-match "a|" ~["" "a" "abc" "\0a"] ~) 63 | (has-match "()" ~["" "a" "abc" "\0a"] ~) 64 | (has-match "a()b" ~["ab"] ~["" "a" "b"]) 65 | (has-match "a?" ~["" "a" "b"] ~) 66 | (has-match "(a?)b\\1c" ~["abc" "abac" "bc"] ~["" "bac"]) 67 | == 68 | ++ test-basic-matching 69 | ;: weld 70 | %^ has-match "a" 71 | ~["a" " \0aa" "a \0a"] 72 | ~["" "\0a" "bcdef"] 73 | :: 74 | %^ has-match "123\0a" 75 | ~["123\0a" " \0a123\0a" "123\0a \0a"] 76 | ~["" "\0a" "123" "\0a123"] 77 | :: 78 | %^ has-match "quick brown fox" 79 | ~["quick brown fox" "the quick brown fox"] 80 | ~["Quick brown fox"] 81 | :: 82 | %^ has-match "\\^\\$\\.\\|\\?\\+\\*\\()\\[]\\\{}\\\\" 83 | ~["^$.|?+*()[]\{}\\"] 84 | ~["^$.|?+*\{}\\" "^$." "?+*()[]\{}"] 85 | :: 86 | %^ has-match "." 87 | ~["." "a" "^" "$" "(" ")" "\0a"] 88 | ~[""] 89 | :: 90 | %^ has-match "a.c" 91 | ~["abc" "a-c" "a\\c" "a\00c"] 92 | ~["ac"] 93 | :: 94 | %^ has-match "^\00+$" 95 | ~["\00" "\00\00\00"] 96 | ~[""] 97 | :: 98 | %^ has-match "\\x00\\x01\\x02\\x03\\x04\\x05\\x06\\x07\\x08\\x09\\x0a\\x0b\\x0c\\x0d\\x0e\\x0f\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x80\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x8a\\x8b\\x8c\\x8d\\x8e\\x8f\\x90\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\x9a\\x9b\\x9c\\x9d\\x9e\\x9f\\xa0\\xa1\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xaa\\xab\\xac\\xad\\xae\\xaf\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\xba\\xbb\\xbc\\xbd\\xbe\\xbf\\xc0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\xcc\\xcd\\xce\\xcf\\xd0\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xda\\xdb\\xdc\\xdd\\xde\\xdf\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef" 99 | ~["\00\01\02\03\04\05\06\07\08\09\0a\0b\0c\0d\0e\0f\10\11\12\13\14\15\16\17\18\19\1a\1b\1c\1d\1e\1f\20\21\22\23\24\25\26\27\28\29\2a\2b\2c\2d\2e\2f\30\31\32\33\34\35\36\37\38\39\3a\3b\3c\3d\3e\3f\40\41\42\43\44\45\46\47\48\49\4a\4b\4c\4d\4e\4f\50\51\52\53\54\55\56\57\58\59\5a\5b\5c\5d\5e\5f\60\61\62\63\64\65\66\67\68\69\6a\6b\6c\6d\6e\6f\70\71\72\73\74\75\76\77\78\79\7a\7b\7c\7d\7e\7f\80\81\82\83\84\85\86\87\88\89\8a\8b\8c\8d\8e\8f\90\91\92\93\94\95\96\97\98\99\9a\9b\9c\9d\9e\9f\a0\a1\a2\a3\a4\a5\a6\a7\a8\a9\aa\ab\ac\ad\ae\af\b0\b1\b2\b3\b4\b5\b6\b7\b8\b9\ba\bb\bc\bd\be\bf\c0\c1\c2\c3\c4\c5\c6\c7\c8\c9\ca\cb\cc\cd\ce\cf\d0\d1\d2\d3\d4\d5\d6\d7\d8\d9\da\db\dc\dd\de\df\e0\e1\e2\e3\e4\e5\e6\e7\e8\e9\ea\eb\ec\ed\ee\ef\f0\f1\f2\f3\f4\f5\f6\f7\f8\f9\fa\fb\fc\fd\fe\ff"] 100 | ~ 101 | == 102 | ++ test-case-sensitivity 103 | ;: weld 104 | %^ has-match "(?i)abc(?-i)def" 105 | ~["abcdef" "ABCdef" "Abcdef"] 106 | ~["abcDEF" "ABCDEF"] 107 | :: 108 | %^ has-match "a|(?i)(?-i)b|c" 109 | ~["a" "b" "c"] 110 | ~["" "A" "C"] 111 | :: 112 | %^ has-match "a|(?i)b|c" 113 | ~["a" "b" "B" "c" "C"] 114 | ~["" "A"] 115 | :: 116 | %^ has-match "a(?i)|b|c" 117 | ~["a" "b" "B" "c" "C"] 118 | ~["" "A"] 119 | :: 120 | %^ has-match "(?i)a((?-i)b|c)d" 121 | ~["abd" "acd" "AbD" "AcD"] 122 | ~["aBd" "aCd"] 123 | :: 124 | %^ has-match "a((?i)bc)d" 125 | ~["abcd" "aBCd"] 126 | ~["Abcd" "abcD"] 127 | == 128 | ++ test-unmatched-braces 129 | ;: weld 130 | %^ has-match "abc)+def" 131 | ~["abc)def" "abc))def" "abc)))def"] 132 | ~["abcdef"] 133 | :: 134 | %^ has-match "(abc))def)" 135 | ~["abc)def)"] 136 | ~["abcdef)" "abc)def" "abcdef"] 137 | :: 138 | (has-match "a)]}b" ~["a)]}b"] ~["ab"]) 139 | == 140 | ++ test-anchors 141 | ;: weld 142 | %^ has-match "^abc$" 143 | ~["abc"] 144 | ~["xabc" "abcy" "x\0aabc" "x\0aabc\0ay" "abc\0ay"] 145 | :: 146 | %^ has-match "^$" 147 | ~[""] 148 | ~["a" "\0a" "a\0a" "a\0a\0ab" "a\0ab"] 149 | :: 150 | %^ has-match "(abc|^)def" 151 | ~["abcdef" "def"] 152 | ~["bcdef"] 153 | :: 154 | %^ has-match "\\ba\\b" 155 | ~["a-" "-a" "-a-"] 156 | ~["a_" "_a" "_a_"] 157 | :: 158 | %^ has-match "\\by\\b" 159 | ~ 160 | ~["xy" "yz" "xyz"] 161 | :: 162 | %^ has-match "\\Ba\\B" 163 | ~["_a_"] 164 | ~["a_" "_a" "a-" "-a" "-a-"] 165 | :: 166 | %^ has-match "\\By\\b" 167 | ~["xy"] 168 | ~["xyz"] 169 | :: 170 | %^ has-match "\\by\\B" 171 | ~["yz"] 172 | ~["xyz"] 173 | :: 174 | %^ has-match "\\By\\B" 175 | ~["xyz"] 176 | ~["yz"] 177 | :: 178 | %^ has-match "\\b" 179 | ~["a" " a" ".a"] 180 | ~["" " " ". ."] 181 | :: 182 | %^ has-match "\\B" 183 | ~["" "aa" "a.aa"] 184 | ~["a" "a.a"] 185 | :: 186 | %^ has-match "\\<" 187 | ~["a" "-a" "_" "-_"] 188 | ~["" "-"] 189 | :: 190 | %^ has-match "\\>" 191 | ~["a" "a-" "_" "_-"] 192 | ~["" "-"] 193 | :: 194 | %^ has-match "b.*\\<" 195 | ~["b a" "bcd a"] 196 | ~["b"] 197 | :: 198 | %^ has-match "\\>.*b" 199 | ~["a b" "a ab"] 200 | ~["b" "b " "ab"] 201 | == 202 | ++ test-alternation 203 | ;: weld 204 | %^ has-match "((a|bc)d)|xyz" 205 | ~["ad" "bcd" "xyz"] 206 | ~["abc" "abcxy"] 207 | :: 208 | %^ has-match "(a|^)bc(d|$)" 209 | ~["bc" "xabc" "bcdy" "xabcdy"] 210 | ~["xbc" "bcy" "xbcy" "xabcy"] 211 | :: 212 | %^ has-match "^a*b" 213 | ~["b" "ab" "aab" "aab"] 214 | ~["xb" "axb" "axab"] 215 | :: 216 | %^ has-match "^(a|ab)+$" 217 | ~["a" "ab" "aababaaaaaababaab"] 218 | ~["b" "abb" "aaaaabbaa"] 219 | :: 220 | %^ has-match "^a+(abcd|xy)$" 221 | ~["aabcd" "aaabcd" "axy" "aaxy"] 222 | ~["abcd" "xy"] 223 | :: 224 | %^ has-match "^(foo|ba.)+$" 225 | ~["foobarbaz"] 226 | ~["" "fodbar"] 227 | :: 228 | %^ has-match "^(abc|)*xyz$" 229 | ~["xyz" "abcxyz" "abcabcxyz"] 230 | ~["abccxyz"] 231 | :: 232 | %^ has-match "^(abc|)+xyz$" 233 | ~["xyz" "abcxyz" "abcabcxyz"] 234 | ~["abccxyz"] 235 | :: 236 | %^ has-match "^(a|)+" 237 | ~["" "a" "aa" "aaa" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"] 238 | ~ 239 | == 240 | ++ test-repetition 241 | ;: weld 242 | %^ has-match "^(abc)\{1,2}zz" 243 | ~["abczz" "abcabczz"] 244 | ~["zz" "abcabcabczz" ">>abczz"] 245 | :: 246 | %^ has-match "^(b+|a)\{1,2}c" 247 | ~["bc" "bbc" "bbbc" "bac" "bbac" "aac" "abbbbbbbbbbbc" "bbbbbbbbbbbac"] 248 | ~["aaac" "abbbbbbbbbbbac"] 249 | :: 250 | %^ has-match "A\\x00\{2,3}Z" 251 | ~["The A\00\00Z" "An A\00\00\00Z"] 252 | ~["A\00Z"] 253 | :: 254 | %^ has-match "ab\{1,3}bc" 255 | ~["abbbbc" "abbbc" "abbc"] 256 | ~["abc" "abbbbbc"] 257 | :: 258 | %^ has-match "a+b+c" 259 | ~["aabbabc"] 260 | ~ 261 | :: 262 | %^ has-match "a\{1,}b\{1,}c" 263 | ~["aabbabc"] 264 | ~ 265 | :: 266 | %^ has-match "(a+|b)*" 267 | ~["ab"] 268 | ~ 269 | :: 270 | %^ has-match "(a+|b)\{0,}" 271 | ~["ab"] 272 | ~ 273 | :: 274 | %^ has-match "(a+|b)+" 275 | ~["ab"] 276 | ~ 277 | :: 278 | %^ has-match "(a+|b)\{1,}" 279 | ~["ab"] 280 | ~[""] 281 | :: 282 | %^ has-match "(a+|b)?" 283 | ~["ab" "a" "b"] 284 | ~ 285 | :: 286 | %^ has-match "^(a+|b)\{0,1}$" 287 | ~["" "a" "aaa" "b"] 288 | ~["ab"] 289 | :: 290 | %^ has-match "^(\\d*(\\s+|\\s*$))*$" 291 | ~["123" "123 " "123 456" "123 456 " "123 456 789"] 292 | ~["123abc"] 293 | :: 294 | (invalid-regex "?") 295 | (invalid-regex "*") 296 | (invalid-regex "+") 297 | (invalid-regex "(?.)") 298 | (invalid-regex "(*.)") 299 | (invalid-regex "(+.)") 300 | == 301 | ++ test-character-classes 302 | ;: weld 303 | %^ has-match "[.]" 304 | ~["." "a."] 305 | ~["a" "b" "c" "\0a"] 306 | :: 307 | %^ has-match "[^.]" 308 | ~["a" "b" "c" "\0a" ".a"] 309 | ~["."] 310 | :: 311 | %^ has-match "[^]]" 312 | ~["a" "-"] 313 | ~["]" ""] 314 | :: 315 | %^ has-match "[^]-]" 316 | ~["a" " "] 317 | ~["]" "-" ""] 318 | :: 319 | %^ has-match "[^-]" 320 | ~["a" "]"] 321 | ~["-" ""] 322 | :: 323 | %^ has-match "[^-]]" 324 | ~["a]" "]]" " ]"] 325 | ~["]" "-]" "] "] 326 | :: 327 | %^ has-match "[^][]" 328 | ~["a" " " "-"] 329 | ~["[" "]" ""] 330 | :: 331 | %^ has-match "^[X-c]+$" 332 | ~["XYZ_^abc"] 333 | ~["xyz_^ABC" "xyz" "ABC"] 334 | :: 335 | %^ has-match "(?i)^[X-c]+$" 336 | ~["XYZ_^abc" "xyz_^ABC" "xyz" "ABC"] 337 | ~["!" "\"" "#" "$" "%" "&" "'" "(" ")" "+" "," "-" "." "/"] 338 | :: 339 | %^ has-match "^[[:ascii:]]+$" 340 | ~["\00\0aabc\7f"] 341 | ~["\80"] 342 | :: 343 | %^ has-match "^[[:alnum:]]+$" 344 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"] 345 | ~["-" "." "~" "\0a" "\09"] 346 | :: 347 | %^ has-match "^[[:alpha:]]+$" 348 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"] 349 | ~["-" "." "~" "\0a" "\09" "0" "9"] 350 | :: 351 | %^ has-match "^[[:blank:]]+$" 352 | ~[" \09"] 353 | ~["\0a" "\0d"] 354 | :: 355 | %^ has-match "^[[:cntrl:]]+$" 356 | ~["\00\01\02\03\04\05\06\07\08\09\0a\0b\0c\0d\0e\0f\10\11\12\13\14\15\16\17\18\19\1a\1b\1c\1d\1e\1f\7f"] 357 | ~[" " "a" "\7e" "\ff"] 358 | :: 359 | %^ has-match "^[[:digit:]]+$" 360 | ~["0123456789"] 361 | ~["a"] 362 | :: 363 | %^ has-match "^\\d+$" 364 | ~["0123456789"] 365 | ~["a"] 366 | :: 367 | %^ has-match "^\\D+$" 368 | ~["abcdef"] 369 | ~["0" "9" "a123456789"] 370 | :: 371 | %^ has-match "^[\\d]+$" 372 | ~["0123456789"] 373 | ~["a"] 374 | :: 375 | %^ has-match "^[\\D]+$" 376 | ~["abcdef"] 377 | ~["0" "9" "a123456789"] 378 | :: 379 | %^ has-match "^[[:graph:]]+$" 380 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!\"#$%&'()*+,-./:;<=>?@[\\]^_`\{|}~"] 381 | ~["\00" "\09" "\0a"] 382 | :: 383 | %^ has-match "^[[:lower:]]+$" 384 | ~["abcdefghijklmnopqrstuvwxyz"] 385 | ~["A"] 386 | :: 387 | %^ has-match "^\\l+$" 388 | ~["abcdefghijklmnopqrstuvwxyz"] 389 | ~["A"] 390 | :: 391 | %^ has-match "\\L" 392 | ~["A"] 393 | ~["abcdefghijklmnopqrstuvwxyz"] 394 | :: 395 | %^ has-match "^[\\l]+$" 396 | ~["abcdefghijklmnopqrstuvwxyz"] 397 | ~["A"] 398 | :: 399 | %^ has-match "[\\L]" 400 | ~["A"] 401 | ~["abcdefghijklmnopqrstuvwxyz"] 402 | :: 403 | %^ has-match "^[[:print:]]+$" 404 | ~["abcdef "] 405 | ~["\00" "\0a"] 406 | :: 407 | %^ has-match "^[[:punct:]]+$" 408 | ~["!\"#$%&'()*+,-./:;<=>?@[\\]^_`\{|}~"] 409 | ~["a" "b" "c" "\00" "\0a"] 410 | :: 411 | %^ has-match "^[[:space:]]+$" 412 | ~[" \09\0a\0b\0c\0d"] 413 | ~["A" "a"] 414 | :: 415 | %^ has-match "^\\s+$" 416 | ~[" \09\0a\0b\0c\0d"] 417 | ~["A" "a"] 418 | :: 419 | %^ has-match "\\S" 420 | ~["A" "a"] 421 | ~[" \09\0a\0b\0c\0d"] 422 | :: 423 | %^ has-match "^[\\s]+$" 424 | ~[" \09\0a\0b\0c\0d"] 425 | ~["A" "a"] 426 | :: 427 | %^ has-match "[\\S]" 428 | ~["A" "a"] 429 | ~[" \09\0a\0b\0c\0d"] 430 | :: 431 | %^ has-match "^[[:upper:]]+$" 432 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZ"] 433 | ~["a"] 434 | :: 435 | %^ has-match "^\\u+$" 436 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZ"] 437 | ~["a"] 438 | :: 439 | %^ has-match "\\U" 440 | ~["a"] 441 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZ"] 442 | :: 443 | %^ has-match "^[\\u]+$" 444 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZ"] 445 | ~["a"] 446 | :: 447 | %^ has-match "[\\U]" 448 | ~["a"] 449 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZ"] 450 | :: 451 | %^ has-match "^[[:xdigit:]]+$" 452 | ~["ABCDEFabcdef0123456789"] 453 | ~["G" "g" "\00" "\0a"] 454 | :: 455 | %^ has-match "^[[:word:]]+$" 456 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"] 457 | ~["-" "." "~" "\0a" "\09"] 458 | :: 459 | %^ has-match "^[\\w]+$" 460 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"] 461 | ~["-" "." "~" "\0a" "\09"] 462 | :: 463 | %^ has-match "[\\W]" 464 | ~["-" "." "~" "\0a" "\09"] 465 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"] 466 | :: 467 | %^ has-match "^[[:alpha:][:digit:]]+$" 468 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"] 469 | ~["-" "." "~" "\0a" "\09"] 470 | :: 471 | %^ has-match "[[:^alpha:]]" 472 | ~["-" "." "~" "\0a" "\09" "1" "2" "3"] 473 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"] 474 | :: 475 | %^ has-match "[[:^alpha:][:digit:]]" 476 | ~["-" "." "~" "\0a" "\09" "1" "2" "3"] 477 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"] 478 | :: 479 | %^ has-match "^[\\U\\L]+$" 480 | ~["ABC" "abc" "0123456789" "-"] 481 | ~[""] 482 | :: 483 | %^ has-match "(?i)^[[:upper:]]+$" 484 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"] 485 | ~ 486 | :: 487 | %^ has-match "(?i)^[[:lower:]]+$" 488 | ~["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"] 489 | ~ 490 | :: 491 | %^ has-match "^[:alpha:]+$" 492 | ~[":alpha:" "aaaa:aaaa:aaaa:aaaa"] 493 | ~["abc" "[alpha]"] 494 | :: 495 | %^ has-match "^[abc\\]def]+$" 496 | ~["abc]def"] 497 | ~["[abc\\]def]"] 498 | :: 499 | %^ has-match "^[]^$.|?+*()[\{}\\\\]+$" 500 | ~["^$.|?+*()[]\{}\\"] 501 | ~ 502 | :: 503 | %^ has-match "^[\\^$.|?+*()[\{}\\\\\\]]+$" 504 | ~["^$.|?+*()[]\{}\\"] 505 | ~ 506 | :: 507 | %^ has-match "[^]^$.|?+*()[\{}\\\\]" 508 | ~["^$.|?+*()[]\{}\\a"] 509 | ~["^$.|?+*()[]\{}\\"] 510 | :: 511 | %^ has-match "\\a\\t\\n\\v\\f\\r\\e" 512 | ~["\07\09\0a\0b\0c\0d\1b"] 513 | ~ 514 | :: 515 | %^ has-match "[\\a][\\b][\\t][\\n][\\v][\\f][\\r][\\e]" 516 | ~["\07\08\09\0a\0b\0c\0d\1b"] 517 | ~ 518 | :: 519 | %^ has-match "^[\\x00-\\b]+$" 520 | ~["\00" "\00\01\02\03\04\05\06\07\08"] 521 | ~["\09" "\0a"] 522 | :: 523 | %^ has-match "^[ --]+$" 524 | ~[" !\"#$%&'()+,-"] 525 | ~["." "/" "a" "b" "c"] 526 | :: 527 | %^ has-match "[-ac]" 528 | ~["-" "a" "c"] 529 | ~["b"] 530 | :: 531 | %^ has-match "[ac-]" 532 | ~["-" "a" "c"] 533 | ~["b"] 534 | :: 535 | %^ has-match "[-ac-]" 536 | ~["-" "a" "c"] 537 | ~["b"] 538 | :: 539 | %^ has-match "[-a-c-]" 540 | ~["-" "a" "b" "c"] 541 | ~ 542 | :: 543 | %^ has-match "[---]" 544 | ~["-"] 545 | ~["+" "," "." "/"] 546 | :: 547 | %^ has-match "[\\B]" 548 | ~["B"] 549 | ~["ab"] 550 | :: 551 | (invalid-regex "[a--]") 552 | (invalid-regex "[a--z]") 553 | (invalid-regex "[a-[:digit]]") 554 | (invalid-regex "[a-\\w]") 555 | (invalid-regex "[[:digit:]-a]") 556 | (invalid-regex "[a-b-c]") 557 | (invalid-regex "[a---c]") 558 | (invalid-regex "[]") 559 | (invalid-regex "[^]") 560 | (invalid-regex "[[::]]") 561 | (invalid-regex "[[:a:]]") 562 | == 563 | ++ test-backreferences 564 | ;: weld 565 | %^ has-match "(abc|xyz)\\1" 566 | ~["abcabc" "xyzxyz"] 567 | ~["abcxyz" "xyzabc"] 568 | :: 569 | %^ has-match "(((((((((a|)))))))))\\8\\9" 570 | ~["" "a" "aa" "aaa"] 571 | ~ 572 | :: 573 | %^ has-match "(a)(b)(c)(d)(e)(f)(g)(h)(i)\\8\\9" 574 | ~["abcdefghihi"] 575 | ~["abcdefgh"] 576 | :: 577 | %^ has-match "(foo|ba.)\\1" 578 | ~["foofoo" "barbar" "bazbaz"] 579 | ~["foobar" "barbaz"] 580 | :: 581 | %^ has-match "^(11+)\\1+$" 582 | ~["1111" "111111" "11111111" "111111111" "1111111111" "111111111111"] 583 | ~["1" "11" "111" "11111" "1111111" "11111111111" "1111111111111"] 584 | :: 585 | %^ has-match "^(a|)\\1*b" 586 | ~["ab" "aaaab" "b"] 587 | ~["acb"] 588 | :: 589 | %^ has-match "^(a|)\\1+b" 590 | ~["aab" "aaaab" "b"] 591 | ~["ab"] 592 | :: 593 | %^ has-match "^(a|)\\1?b" 594 | ~["ab" "aab" "b"] 595 | ~["acb"] 596 | :: 597 | %^ has-match "^(a|)\\1\{2}b" 598 | ~["aaab" "b"] 599 | ~["ab" "aab" "aaaab"] 600 | :: 601 | %^ has-match "^(a|)\\1\{2,3}b" 602 | ~["aaab" "aaaab" "b"] 603 | ~["ab" "aab" "aaaaab"] 604 | :: 605 | %^ has-match "^(((a+)|b)(\\>\\s*))*\\3$" 606 | ~["aaa b aaa" "aaa b aa aa" "b a a"] 607 | ~["aaa b aa aaa"] 608 | :: 609 | %^ has-match "(?i)(abc|def)\\1" 610 | ~["abcABC" "ABCabc" "defDEF" "DEFdef"] 611 | ~["abcdef" "defabc"] 612 | :: 613 | %^ has-match "(abc)(?i)\\1" 614 | ~["abcABC" "abcAbc"] 615 | ~["ABCabc" "Abcabc" "AbcAbc"] 616 | == 617 | ++ test-lookahead 618 | ;: weld 619 | %^ has-match "(?=abc)abc" 620 | ~["abc"] 621 | ~["ABC"] 622 | :: 623 | %^ has-match "(?=(?i)abc)abc" 624 | ~["abc"] 625 | ~["ABC"] 626 | :: 627 | %^ has-match "(?i)(?=ABC)abc" 628 | ~["abc" "ABC"] 629 | ~ 630 | :: 631 | %^ has-match "(?=abc(?!abcdef))(abc)\\1" 632 | ~["abcabc" "abcabcde" "abcabc def"] 633 | ~["abcabcdef"] 634 | == 635 | ++ test-capture-groups 636 | ;: weld 637 | %^ capture-groups "(foo)" "foo" 638 | ~[[0 "foo"] [1 "foo"]] 639 | :: 640 | %^ capture-groups "a|b+" "abbb" 641 | ~[[0 "a"]] 642 | :: 643 | %^ capture-groups "(a|b+)*" "abbb" 644 | ~[[0 "abbb"] [1 "bbb"]] 645 | :: 646 | %^ capture-groups "(bb|bbb)bb" "bbbb" 647 | ~[[0 "bbbb"] [1 "bb"]] 648 | :: 649 | %^ capture-groups "(a)|(aa)" "aa" 650 | ~[[0 "aa"] [2 "aa"]] 651 | :: 652 | %^ capture-groups "(a)a|(aa)" "aa" 653 | ~[[0 "aa"] [1 "a"]] 654 | :: 655 | %^ capture-groups "(a?)b" "b" 656 | ~[[0 "b"] [1 ""]] 657 | :: 658 | %^ capture-groups "(([[:alnum:]]*)( *))*" "100 ABC" 659 | ~[[0 "100 ABC"] [1 "ABC"] [2 "ABC"] [3 ""]] 660 | :: 661 | %^ capture-groups "(([[:alnum:]]*)( *))*" "100 ABC " 662 | ~[[0 "100 ABC "] [1 "ABC "] [2 "ABC"] [3 " "]] 663 | :: 664 | %^ capture-groups "(abc|abcd)(d|d\{5})" "abcdddd" 665 | ~[[0 "abcdd"] [1 "abcd"] [2 "d"]] 666 | :: 667 | %^ capture-groups "(abc|abcd)(d|d\{5})" "abcddddd" 668 | ~[[0 "abcddddd"] [1 "abc"] [2 "ddddd"]] 669 | :: 670 | %^ capture-groups "(abc|abcd)(d|d\{5})" "abcdddddd" 671 | ~[[0 "abcdddddd"] [1 "abcd"] [2 "ddddd"]] 672 | :: 673 | %^ capture-groups "(abc|abcd)(|d\{4,5})" "abcddddd" 674 | ~[[0 "abcddddd"] [1 "abcd"] [2 "dddd"]] 675 | :: 676 | %^ capture-groups "(abc|abcd)(|d\{4,5})" "abcdddddd" 677 | ~[[0 "abcdddddd"] [1 "abcd"] [2 "ddddd"]] 678 | == 679 | ++ test-convenience-functions 680 | ;: weld 681 | (expect-fail |.((run:regex "?" ""))) 682 | (expect-fail |.((ran:regex "a" ""))) 683 | (expect-fail |.((rut:regex "?" ""))) 684 | (expect-fail |.((rat:regex "a" ""))) 685 | :: 686 | %- expect-eq :_ !>((rut:regex "abc" "abcdef")) 687 | !>(`(unit range:regex)``[[[1 1] [1 4]] "abc"]) 688 | :: 689 | %- expect-eq :_ !>((rat:regex "abc" "abcdef")) 690 | !>(`range:regex`[[[1 1] [1 4]] "abc"]) 691 | :: 692 | %- expect-eq :_ !>((alt:regex "(\\w\{3})?" "abcdefghi")) 693 | !> ^- (list range:regex) 694 | :~ [[[1 1] [1 4]] "abc"] 695 | [[[1 4] [1 7]] "def"] 696 | [[[1 7] [1 10]] "ghi"] 697 | == 698 | :: 699 | (expect-eq !>(`~`~) !>((is:regex "a" "aaa"))) 700 | (expect-eq !>(`~`~) !>((is:regex "ab" "abab"))) 701 | (expect-eq !>(`~`~) !>((is:regex "[ab]" "ab"))) 702 | (expect-eq !>(`~`~) !>((is:regex "[[:^space:]]" "a"))) 703 | (expect-eq !>(`(unit hair)``[1 4]) !>((is:regex "a" "aaab"))) 704 | (expect-eq !>(`(unit hair)``[1 5]) !>((is:regex "ab" "ababa"))) 705 | (expect-eq !>(`(unit hair)``[1 3]) !>((is:regex "[ab]" "abc"))) 706 | (expect-eq !>(`(unit hair)``[1 2]) !>((is:regex "[[:^space:]]" "a "))) 707 | (expect-eq !>(`~`~) !>((as:regex "a" "aaa"))) 708 | (expect-eq !>(`~`~) !>((as:regex "ab" "abab"))) 709 | (expect-eq !>(`~`~) !>((as:regex "[ab]" "ab"))) 710 | (expect-eq !>(`~`~) !>((as:regex "[[:^space:]]" "a"))) 711 | (expect-fail |.((as:regex "a" "aaab"))) 712 | (expect-fail |.((as:regex "ab" "ababa"))) 713 | (expect-fail |.((as:regex "[ab]" "abc"))) 714 | (expect-fail |.((as:regex "[[:^space:]]" "a "))) 715 | :: 716 | %+ expect-eq 717 | !>(`(unit range:regex)``[[[1 3] [1 4]] "a"]) 718 | !>((fort:regex "a" [1 2] "a a")) 719 | :: 720 | (expect-eq !>(`~`~) !>((fort:regex "a" [1 2] "a b"))) 721 | :: 722 | %+ expect-eq 723 | !>(`(unit range:regex)``[[[1 2] [1 2]] ""]) 724 | !>((fort:regex "a*" [1 2] "a b")) 725 | :: 726 | %+ expect-eq 727 | !>(`(unit range:regex)``[[[1 2] [1 4]] "aa"]) 728 | !>((fort:regex "a*" [1 2] "aaab")) 729 | == 730 | -- 731 | --------------------------------------------------------------------------------