stroll.sire (16278B)
1 ; Copyright 2023 The Plunder Authors 2 ; Use of this source code is governed by a BSD-style license that can be 3 ; found in the LICENSE file. 4 5 #### stroll <- sieve 6 7 ;;;; Stroll 8 ;;;; ====== 9 ;;;; 10 ;;;; A different way to Roam locally. 11 12 13 ;;; Imports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 15 :| sire 16 :| datom 17 :| gen 18 :| stew 19 20 21 ;;; Schema ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 22 23 = strollSchema 24 ^ assertTransact _ emptyDB 25 ; Page attributes 26 ++ ## ={:db/ident} {:page/title} 27 ## ={:db/unique} TRUE 28 ## ={:db/doc} 29 {When set on a block, that block is treated as a page with this title.} 30 ; Block attributes 31 ++ ## ={:db/ident} {:block/string} 32 ## ={:db/cardinality} {one} 33 ## ={:db/doc} {String content of a block} 34 ++ ## ={:db/ident} {:block/uid} 35 ## ={:db/cardinality} {one} 36 ## ={:db/unique} TRUE 37 ## ={:db/doc} {User referable text name for a block} 38 ++ ## ={:db/ident} {:block/children} 39 ## ={:db/cardinality} {many} 40 ## ={:db/valueType} {ref} 41 ## ={:db/doc} {Reference to all blocks under this block} 42 ++ ## ={:db/ident} {:block/page} 43 ## ={:db/cardinality} {one} 44 ## ={:db/valueType} {ref} 45 ## ={:db/indexed} TRUE 46 ## ={:db/doc} {Reference to the page this block is displayed on.} 47 ++ ## ={:db/ident} {:block/refs} 48 ## ={:db/cardinality} {many} 49 ## ={:db/valueType} {ref} 50 ## ={:db/doc} {Reference to all blocks `:block/string` textually refers to.} 51 ++ ## ={:db/ident} {:block/order} 52 ## ={:db/cardinality} {one} 53 ## ={:db/doc} {The order of these blocks in the list of `:block/children`.} 54 55 ; Deliberately skipping :block/parents because we have a VAE table, unlike 56 ; datascript. The data from :block/parents is derivable from :block/children, 57 ; and will give you the order instead of having to calculate that after the 58 ; fact. 59 60 61 ; TODO: The above is the minimal viable stroll. There are a TON of things we 62 ; want to look into: 63 ; 64 ; - Item filtering in the references section. 65 ; 66 ; - Roam sticks a monolithic object in `:window/filters` on the block's eid 67 ; for filtering references positively or negatively. This is more than a 68 ; little brittle and also implies that they aren't using them in :find. 69 ; 70 ; - logseq's datascript usage is ephemeral with the markdown files being 71 ; the persistent store. They just stick this data in a raw bullet point. 72 ; 73 ; - Open states 74 ; 75 ; - A block is open or not and this is stored on the block, instead of being 76 ; open or not on a specific page, which is usually what you want? 77 ; 78 ; - Hierarchy view 79 ; 80 ; - logseq's hierarchy view is just such a good feature and it's very 81 ; revealing that Roam hasn't or can't copy it. We should just verbatim 82 ; copy this feature because it's super useful and only costs a single 83 ; attribute per :page entity that participates in a hierarchy. 84 ; 85 ; - Aliases 86 ; 87 ; - Roam has refused to implement this feature for basically its entire 88 ; existence when it's the most requested feature of the product. logseq 89 ; has aliases and it's actually super trivial, just add a {:page/alias} 90 ; attribute and check for aliases every place you'd other look for 91 ; {:page/title}. 92 ; 93 ; - Journal 94 ; 95 ; - The "Daily Notes" style pages are the killer organizational feature of 96 ; both Roam, logseq and other imitators. But this involves another 97 ; attribute in ":page/" to support. 98 99 100 ;;; Utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 101 102 ;;; These are general and should be moved elsewhere 103 104 ; We need to be able to generate random uids, which are like base64 but with 105 ; {-} and {_} instead of {+} and {/}. 106 107 = base64hepbar 108 b#{ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_} 109 110 abstype#Gen 111 abstype#Error 112 abstype#Uid 113 114 > Gen > [Gen Nat] 115 = (genUid gen) 116 @ [gen l] 117 ^ foldl _ [gen NIL] [0 1 2 3 4 5 6 7 8 9] 118 & ([gen xs] i) 119 @ [gen res] | genBitsNat 6 gen 120 [gen (CONS (barIdx res base64hepbar) xs)] 121 @ uid | listFoldl strWeld {} l 122 [gen uid] 123 124 = (assertRight x) 125 | fromRight ({assertion failed} x) x 126 127 128 ;;; Database Record ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 129 130 # record StrollDb 131 | STROLL_DB gen:Rand db:Db 132 133 > Nat > StrollDb 134 = (emptyStrollDb seed) 135 @ gen | mkRand seed 136 | STROLL_DB gen strollSchema 137 138 > Any > StrollDb > > Either (Row Error) StrollDb 139 = (transactStrollDb txn strollDb) 140 @ STROLL_DB(..) strollDb 141 ;| trk [%txn db] 142 # case | transact txn db 143 - LEFT l | LEFT l 144 - RIGHT r | RIGHT | STROLL_DB gen r 145 146 > Any > StrollDb > StrollDb 147 = (assertTransactStrollDb txn strollDb) 148 # case (transactStrollDb txn strollDb) 149 - LEFT l 150 | trk [%l l] 151 | {stroll transaction failed: } l 152 - RIGHT r r 153 154 ; Generates a unique id, checking that the uid isn't in the database 155 ; 156 > StrollDb > [uid StrollDb] 157 = (generateUniqueID strollDb) 158 @ STROLL_DB(..) strollDb 159 ; generate a unique uid that doesn't exist in the database yet. 160 @ [gen uid] 161 ^ _ gen 162 ? (loop gen) 163 @ [gen uid] | genUid gen 164 @ matches | lookupByAV {:block/uid} uid db 165 | if | setIsEmpty matches 166 [gen uid] 167 | loop gen 168 [uid (STROLL_DB gen db)] 169 170 171 ;;; Queries ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 172 173 ; Imagine you are writing a web frontend for the above and you want to deal 174 ; with it entirely with pulls. This is contrived, since at least logseq's 175 ; implementation of a Roam-like uses complex :find queries all over the place 176 ; with comparatively few pulls. (I did pull first since the datascript designer 177 ; said he doesn't reach for pulls in normal webapps, but the one example app I 178 ; can find actually makes extensive use of them.) 179 180 childrenQuery=[{:block/children}=[{:block/uid} {:block/order}]] 181 182 ; Find the implicit block that make up a page, along with all its children. 183 = (findPageBlock pageTitle strollDb) 184 @ STROLL_DB(..) strollDb 185 | pull ++ {:block/uid} 186 ++ childrenQuery 187 [{:page/title} pageTitle] 188 db 189 190 ; Given a row of all the child blocks sorted by order, list the data for each 191 ; block for display. 192 > Row Any > Db > Either (List Error) (List (Tab Any Any)) 193 = (findBlocksContent q strollDb) 194 @ STROLL_DB(..) strollDb 195 | pullMany ++ {:block/uid} 196 ++ {:block/string} 197 ++ childrenQuery 198 q 199 db 200 201 = (sortRowTabByOrder t) 202 ^ sortOn _ t 203 & x 204 | fromSome 0 | tabLookup {:block/order} x 205 206 ; Given any result map which contains a childrenQuery, produce an ordered list 207 ; of uids to lookup sorted on order. 208 = (makeOrderedChildrenQuery s) 209 @ rowOfTab | fromSome [] | tabLookup {:block/children} s 210 : r < foreach (sortRowTabByOrder rowOfTab) 211 [{:block/uid} (fromSome ({missing uid} 0) | tabLookup {:block/uid} r)] 212 213 = (findBlocksChildrenUnsorted uid strollDb) 214 @ STROLL_DB(..) strollDb 215 # case | pull [childrenQuery] [{:block/uid} uid] db 216 - LEFT l | [] 217 - RIGHT r | fromSome [] 218 | tabLookup {:block/children} r 219 220 221 ; Given a block, find all blocks which reference this block and the page 222 ; they're on. 223 ; 224 ; The output of this pull is why the normal query interface is so nice: instead 225 ; of returning a list of tuples, this returns a weird large nested structure of 226 ; tabs and sets and rows. The data is in there, but it's pretty cumbersome to 227 ; work with. 228 ; 229 = (findPageBlocksReferencing x strollDb) 230 @ STROLL_DB(..) strollDb 231 @ uid | fromSome {} | tabLookup {:block/uid} x 232 | pull ++ ## ={:block/_refs} ++ {:block/uid} 233 ++ ## ={:block/page} ++ {:block/uid} 234 ++ {:page/title} 235 [{:block/uid} uid] 236 db 237 238 = (getEidOf uid strollDb) 239 @ STROLL_DB(..) strollDb 240 | setMin 241 | lookupByAV {:block/uid} uid db 242 243 ; Returns the uid of the parent 244 ; 245 = (getParentOf uid strollDb) 246 @ STROLL_DB(..) strollDb 247 | fromSome {} 248 | tabLookup {:block/uid} 249 | idx 0 250 | fromSome [] 251 | tabLookup {:block/children} 252 | assertRight 253 | pull [[{:block/_children}=[{:block/uid}]]] 254 [{:block/uid} uid] 255 db 256 257 ; Get the block order by eid. 258 ; 259 = (getOrderByEid eid strollDb) 260 @ STROLL_DB(..) strollDb 261 | setMin 262 | lookupByAE {:block/order} eid db 263 264 = (getPageByEid eid strollDb) 265 @ STROLL_DB(..) strollDb 266 ; if this eid has a :page/title, it is a page. 267 | ifNot (setIsEmpty | lookupByAE {:page/title} eid db) eid 268 | setMin | lookupByAE {:block/page} eid db 269 270 ; Given a uid, find all the eids of all the blocks this uid forward references 271 ; 272 ; TODO: this is another function where query would be cleaner 273 = (findAllRefEids uid strollDb) 274 @ STROLL_DB(..) strollDb 275 | map [k v]&v 276 | catMap tabToPairs 277 | fromSome [] ; catMap expects a row of tabs 278 | tabLookup {:block/refs} 279 | assertRight 280 | pull ++ ## ={:block/refs} ++ {:db/id} 281 [{:block/uid} uid] 282 db 283 284 ; Given a uid, find all the uids of all the blocks this uid forward references 285 = (findAllRefUids uid strollDb) 286 @ STROLL_DB(..) strollDb 287 | map [k v]&v 288 | catMap tabToPairs 289 | fromSome [] ; catMap expects a row of tabs 290 | tabLookup {:block/refs} 291 | assertRight 292 | pull [[{:block/refs}=[{:block/uid}]]] 293 [{:block/uid} uid] 294 db 295 296 = (findAllChildUids uid strollDb) 297 | map x&(fromSome {} | tabLookup {:block/uid} x) 298 | findBlocksChildrenUnsorted uid strollDb 299 300 > (Nat -> Nat) > Str > Nat > StrollDb > StrollDb 301 = (childrenUpdatesAfter fun parentUid pos strollDb) 302 ; all children pulled from the database 303 @ children | findBlocksChildrenUnsorted parentUid strollDb 304 ^ mapMaybe _ children 305 & node 306 : uid < maybeCase (tabLookup {:block/uid} node) NONE 307 : order < maybeCase (tabLookup {:block/order} node) NONE 308 | if (lth order pos) 309 | NONE 310 ; TODO: If I allow reading of raw EID numbers during a pull via a virtual 311 ; {:db/id} like Datomic, we can get rid of the overhead of this lookup 312 ; here, which is probably small in this one instance, but is a unneeded 313 ; repeated lookup over all queries. 314 | SOME [%add [{:block/uid} uid] {:block/order} (fun order)] 315 316 ; Create entries for a transaction which changes each block to a different page 317 ; uid. 318 ; 319 > Str > Nat > StrollDb > Row Any 320 = (mkPageUpdates uid dstEid strollDb) 321 | cat 322 | rowCons [[%add [{:block/uid} uid] {:block/page} dstEid]] 323 | map u&(mkPageUpdates u dstEid strollDb) 324 | findAllChildUids uid strollDb 325 326 ; Given a block, add a new empty child at position X. 327 ; 328 ; This involves increasing the order of every block after pos and creating a 329 ; new block at pos. 330 = (insertEmptyBlock parentUid pos strollDb) 331 @ [uid strollDb] | generateUniqueID strollDb 332 @ STROLL_DB(..) strollDb 333 ; new tuples for child nodes that must be updated. 334 @ childUpdates | childrenUpdatesAfter inc parentUid pos strollDb 335 ; 336 @ page 337 ; TODO: this would work better as a query, since that would just return the 338 ; eid directly. 339 | fromSome ({missing :block/page} 0) 340 | tabLookup {:block/page} 341 | idx 1 342 | pull [{:block/page}] [{:block/uid} parentUid] db 343 @ newItem 344 ## ={:block/uid} uid 345 ## ={:block/string} {} 346 ## ={:block/order} pos 347 ## ={:block/page} page 348 ; 349 @ addChild 350 ## ={:db/id} [{:block/uid} parentUid] 351 ## ={:block/children} newItem 352 @ total | rowCons addChild childUpdates 353 # case | transact total db 354 - LEFT l | LEFT l 355 - RIGHT r | RIGHT | STROLL_DB gen r 356 357 ; Creates a new page with a new single empty bullet on it and returns the uid 358 ; of the created page. 359 ; 360 > Str > StrollDb > [Uid StrollDb] 361 = (makeNewPage pageTitle strollDb) 362 @ [pointUid strollDb] | generateUniqueID strollDb 363 @ [pageUid strollDb] | generateUniqueID strollDb 364 ^ [pageUid _] 365 ^ assertTransactStrollDb _ strollDb 366 ++ ## ={:db/id} %[{newpage}] 367 ## ={:page/title} pageTitle 368 ## ={:block/uid} pageUid 369 ## ={:block/children} 370 ++ ## ={:block/string} {} 371 ## ={:block/uid} pointUid 372 ## ={:block/order} 0 373 ## ={:block/page} %[{newpage}] 374 375 ; Given a page title, resolves it to a uid, creating the page if necessary. 376 ; 377 > Str > StrollDb > [Uid StrollDb] 378 = (pageToUid pageTitle strollDb) 379 @ STROLL_DB(..) strollDb 380 @ eids | lookupByAV {:page/title} pageTitle db 381 | if | setIsEmpty eids 382 | makeNewPage pageTitle strollDb 383 @ uids | lookupByAE {:block/uid} (setMin eids) db 384 [(setMin uids) strollDb] 385 386 ; Parses a string for things which look like references. 387 ; 388 > Str > List Str 389 = (parseRefs txt) 390 @ bar | natBar txt 391 @ len | barLen bar 392 | listToRow 393 ^ _ 0 bar NIL 394 ? (loop i bar out) 395 | if | gth i len 396 out 397 | if | rowAnd ++ | eql (barIdx i bar) {(} 398 ++ | eql (barIdx (inc i) bar) {(} 399 ++ | eql (barIdx (add 11 i) bar) {)} 400 ++ | eql (barIdx (add 12 i) bar) {)} 401 ; todo: additionally validate that its base64 402 @ ref | barNat | barSlice (add i 2) 9 bar 403 | loop (add i 12) bar (CONS ref out) 404 | loop (inc i) bar out 405 406 =?= [%bbCCddEE1 %aaBBccDD9] 407 | parseRefs {One ((aaBBccDD9)) Three ((bbCCddEE1))} 408 409 ; Parse inside links 410 =?= [%bbCCddEE1] 411 | parseRefs {Yesterday, [I wrote this](((bbCCddEE1)))} 412 413 ; Parses titles out of the data 414 ; 415 ; This is tricky because you have to deal with page titles that contain page 416 ; titles, and have to deal with malformed ones. (We deal with extra [[ or ]] 417 ; on either side of the title.) 418 ; 419 > Str > List Str 420 = (parseTitles txt) 421 @ bar | natBar txt 422 @ len | barLen bar 423 | listToRow 424 ^ _ 0 bar NIL NIL 425 ? (loop i bar stack out) 426 | if | gth i len 427 out 428 | if | rowAnd ++ | eql (barIdx i bar) {[} 429 ++ | eql (barIdx (inc i) bar) {[} 430 ; we mark that this is where we have the beginning of a mark 431 | loop (add 2 i) bar (CONS (add 2 i) stack) out 432 | if | rowAnd ++ | eql (barIdx i bar) {]} 433 ++ | eql (barIdx (inc i) bar) {]} 434 : x xs < listCase stack 435 ; extra unmatched right close. ignore it 436 | loop (add 2 i) bar stack out 437 @ title | barNat | barSlice x (sub i x) bar 438 | loop (add 2 i) bar xs (CONS title out) 439 | loop (inc i) bar stack out 440 441 ; Simple case 442 =?= [%Iceman] 443 | parseTitles {[[Iceman]]} 444 445 ;; Parse in links 446 =?= [%Iceman] 447 | parseTitles {[This dude]([[Iceman]])} 448 449 ;; Simple recursive case 450 =?= [{[[Word]] More} %Word] 451 | parseTitles {[[[[Word]] More]]} 452 453 ;; Extra {[[} on left 454 =?= [{[[Word]] More} %Word] 455 | parseTitles {[[ [[[[Word]] More]]} 456 457 ;; Extra {]]} on right 458 =?= [{[[Word]] More} %Word] 459 | parseTitles {[[[[Word]] More]] ]]} 460 461 ;; Parallel references 462 =?= [{[[One]] and [[Two]]} {Two} {One}] 463 | parseTitles {[[[[One]] and [[Two]]]]} 464 465 466 ; Sets the text content of a block to a given string, extracting page titles 467 ; and block references and then updating the correct ref attributes. 468 ; 469 > Str > Str > StrollDb > StrollDb 470 = (setBlockText textUid text strollDb) 471 @ STROLL_DB(..) strollDb 472 ; Calculate all the uid references that text refers to. 473 @ refs | parseRefs text 474 @ [titleRefs strollDb] 475 ^ foldl _ [NIL strollDb] | parseTitles text 476 & ([titleRefs strollDb] i) 477 @ [uid strollDb] | pageToUid i strollDb 478 [(CONS uid titleRefs) strollDb] 479 ; 480 @ newRefUids | weld refs | listToRow titleRefs 481 @ newRefEids 482 | setCatRow 483 | map uid&(lookupByAV {:block/uid} uid db) newRefUids 484 ; 485 ; Fetch the current references uids from textUid. 486 @ currentRefEids | setFromRow | findAllRefEids textUid strollDb 487 ; 488 @ toAdd | setToRow | setSub newRefEids currentRefEids 489 @ toDel | setToRow | setSub currentRefEids newRefEids 490 ; 491 ^ assertTransactStrollDb (cat _) strollDb 492 ++ [[%add [{:block/uid} textUid] {:block/string} text]] 493 ++ | map a&[%add [{:block/uid} textUid] {:block/refs} a] toAdd 494 ++ | map r&[%rm [{:block/uid} textUid] {:block/refs} r] toDel 495 496 ; Moves a bullet point to a new parent, updating all references and page 497 ; entries. 498 ; 499 > Str > Str > Nat > StrollDb > StrollDb 500 = (reparent nodeUid newParentUid newOrder strollDb) 501 @ nodeEid | getEidOf nodeUid strollDb 502 @ curParentUid | getParentOf nodeUid strollDb 503 @ curOrder | getOrderByEid nodeEid strollDb 504 @ prevReorders | childrenUpdatesAfter dec curParentUid curOrder strollDb 505 @ newReorders | childrenUpdatesAfter inc newParentUid newOrder strollDb 506 ; 507 @ pageChanges 508 @ curPage | getPageByEid nodeEid strollDb 509 @ dstPage 510 ^ getPageByEid _ strollDb 511 | getEidOf newParentUid strollDb 512 | if (curPage == dstPage) [] 513 ; 514 ; we must reassign the page of the block and of every child block 515 ; recursively. 516 | mkPageUpdates nodeUid dstPage strollDb 517 ; 518 ^ assertTransactStrollDb (cat _) strollDb 519 ++ [[%rm [{:block/uid} curParentUid] {:block/children} nodeEid]] 520 ++ [[%add [{:block/uid} newParentUid] {:block/children} nodeEid]] 521 ++ [[%add nodeEid {:block/order} newOrder]] 522 ++ prevReorders 523 ++ newReorders 524 ++ pageChanges