FWIW a first experiment in traversing the tree of Tinderbox 8 notes with Applescript.
(Counting all notes, childless leaf notes, and nesting layers, as well as listing all note titles)
Runs in macOS Script Editor, etc:
use AppleScript version "2.4" -- Yosemite (10.10) or later
use scripting additions
-- nodeCount :: Tree a -> Int
on nodeCount(_, xs)
-- One more than the total number of descendants.
-- (With foldTree, returns the total number of nodes in the note tree,
-- including the document/root node)
1 + sum(xs)
end nodeCount
-- treeWidth :: Tree a -> Int
on treeWidth(_, xs)
-- Sum of widths of any children, or a minimum of 1.
-- (With foldTree, returns the total count of
-- childless leaf notes in the tree)
if xs ≠ {} then
sum(xs)
else
1
end if
end treeWidth
-- treeDepth :: Tree a -> Int
on treeDepth(_, xs)
-- One more than that of the deepest child.
-- (With foldTree, returns the total number of levels in the tree)
if xs ≠ {} then
1 + maximum(xs)
else
0
end if
end treeDepth
-- preorder :: a -> [[a]] -> [a]
on preorder(x, xs)
-- Name of this node followed by the rest.
-- (With foldTree, returns an ordered list of note names)
{name of x} & concat(xs)
end preorder
on run
tell application "Tinderbox 8"
set ds to documents
if 0 < (count of ds) then
set lrDoc to my |Right|(item 1 of ds)
else
set lrDoc to my |Left|("No documents open in " & name)
end if
script asTree
on |λ|(x)
my pureTreeTBX(x)
end |λ|
end script
set oTree to my bindLR(lrDoc, asTree)
end tell
-- TESTING TRAVERSAL OF THE TINDERBOX NOTE TREE
-- Total number of notes traversed, total number of childless leaf notes,
-- depth of tree (number of nesting levels)
{notesTotal:foldTree(nodeCount, oTree) - 1 ¬
, leavesTotal:foldTree(treeWidth, oTree) ¬
, levelsTotal:foldTree(treeDepth, oTree) ¬
, noteTitles:unlines(foldTree(preorder, oTree))}
end run
-- TINDERBOX ----------------------------------------------
-- pureTreeTBX :: Note -> Tree Note
on pureTreeTBX(oNote)
using terms from application "Tinderbox 8"
script go
on |λ|(x)
Node(x, my map(go, notes of x))
end |λ|
end script
|λ|(oNote) of go
end using terms from
end pureTreeTBX
-- GENERIC ------------------------------------------------
-- https://github.com/RobTrew/prelude-applescript
-- Left :: a -> Either a b
on |Left|(x)
{type:"Either", |Left|:x, |Right|:missing value}
end |Left|
-- Right :: b -> Either a b
on |Right|(x)
{type:"Either", |Left|:missing value, |Right|:x}
end |Right|
-- Just :: a -> Maybe a
on Just(x)
{type:"Maybe", Nothing:false, Just:x}
end Just
-- Nothing :: Maybe a
on Nothing()
{type:"Maybe", Nothing:true}
end Nothing
-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
{type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
-- Node :: a -> [Tree a] -> Tree a
on Node(v, xs)
{type:"Node", root:v, nest:xs}
end Node
-- bindLR (>>=) :: Either a -> (a -> Either b) -> Either b
on bindLR(m, mf)
if missing value is not |Right| of m then
|λ|(|Right| of m) of mReturn(mf)
else
m
end if
end bindLR
-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
set lng to length of xs
if 0 < lng and string is class of (item 1 of xs) then
set acc to ""
else
set acc to {}
end if
repeat with i from 1 to lng
set acc to acc & item i of xs
end repeat
acc
end concat
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- foldl1 :: (a -> a -> a) -> [a] -> a
on foldl1(f, xs)
if length of xs > 1 then
tell mReturn(f)
set v to {item 1 of xs}
set lng to length of xs
repeat with i from 2 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
else
item 1 of xs
end if
end foldl1
-- foldMapTree :: Monoid m => (a -> m) -> Tree a -> m
on foldMapTree(f, tree)
script go
property g : |λ| of mReturn(f)
on |λ|(x)
if length of (nest of x) > 0 then
mappend(g(root of x), ¬
foldl1(my mappend, (map(go, nest of x))))
else
g(root of x)
end if
end |λ|
end script
|λ|(tree) of go
end foldMapTree
-- foldTree :: (a -> [b] -> b) -> Tree a -> b
on foldTree(f, tree)
script go
property g : |λ| of mReturn(f)
on |λ|(oNode)
g(root of oNode, map(go, nest of oNode))
end |λ|
end script
|λ|(tree) of go
end foldTree
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- mappend (<>) :: Monoid a => a -> a -> a
on mappend(a, b)
set ca to class of a
if record is ca then
script instanceMay
on |λ|(strType)
set mb to lookup(strType, ¬
{Maybe:mappendMaybe, Ordering:mappendOrdering, Tuple:mappendTuple})
end |λ|
end script
set mbi to bindMay(lookup("type", a), instanceMay)
if Nothing of mbi then
a & b
else
|λ|(a, b) of mReturn(Just of mbi)
end if
else if handler is ca then
mappendFn(a, b)
else
a & b
end if
end mappend
-- maximum :: Ord a => [a] -> a
on maximum(xs)
script
on |λ|(a, b)
if a is missing value or b > a then
b
else
a
end if
end |λ|
end script
foldl(result, missing value, xs)
end maximum
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- str :: a -> String
on str(x)
x as string
end str
-- sum :: [Num] -> Num
on sum(xs)
script add
on |λ|(a, b)
a + b
end |λ|
end script
foldl(add, 0, xs)
end sum
-- > unfoldl (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- > [1,2,3,4,5,6,7,8,9,10]
-- unfoldl :: (b -> Maybe (b, a)) -> b -> [a]
on unfoldl(f, v)
set xr to Tuple(v, v) -- (value, remainder)
set xs to {}
tell mReturn(f)
repeat -- Function applied to remainder.
set mb to |λ|(|2| of xr)
if Nothing of mb then
exit repeat
else -- New (value, remainder) tuple,
set xr to Just of mb
-- and value appended to output list.
set xs to (xs & {|1| of xr})
end if
end repeat
end tell
return xs
end unfoldl
-- unlines :: [String] -> String
on unlines(xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set str to xs as text
set my text item delimiters to dlm
str
end unlines