content: -- Vertically centered textual tree using UTF8 monospaced
  -- box-drawing characters, with options for compacting
  -- and pruning.
  
  --               ┌── Gamma
  --       ┌─ Beta ┼── Delta
  --       │       └ Epsilon
  -- Alpha ┼─ Zeta ───── Eta
  --       │       ┌─── Iota
  --       └ Theta ┼── Kappa
  --               └─ Lambda
  
  -- TESTS --------------------------------------------------
  on run
      set tree to Node(1, ¬
          {Node(2, ¬
              {Node(4, {Node(7, {})}), ¬
                  Node(5, {})}), ¬
              Node(3, ¬
                  {Node(6, ¬
                      {Node(8, {}), Node(9, {})})})})
  
      set tree2 to Node("Alpha", ¬
          {Node("Beta", ¬
              {Node("Gamma", {}), ¬
                  Node("Delta", {}), ¬
                  Node("Epsilon", {})}), ¬
              Node("Zeta", {Node("Eta", {})}), ¬
              Node("Theta", ¬
                  {Node("Iota", {}), Node("Kappa", {}), ¬
                      Node("Lambda", {})})})
  
      set strTrees to unlines({"(NB – view in mono-spaced font)\n\n", ¬
          "Compacted (not all parents vertically centered):\n", ¬
          drawTree2(true, false, tree), ¬
          "\nFully expanded and vertically centered:\n", ¬
          drawTree2(false, false, tree2), ¬
          "\nVertically centered, with nodeless lines pruned out:\n", ¬
          drawTree2(false, true, tree2)})
      set the clipboard to strTrees
      strTrees
  end run
  
  
  -- drawTree2 :: Bool -> Bool -> Tree String -> String
  on drawTree2(blnCompressed, blnPruned, tree)
      -- Tree design and algorithm inspired by the Haskell snippet at:
      -- https://doisinkidney.com/snippets/drawing-trees.html
      script measured
          on |λ|(t)
              script go
                  on |λ|(x)
                      set s to " " & x & " "
                      Tuple(length of s, s)
                  end |λ|
              end script
              fmapTree(go, t)
          end |λ|
      end script
      set measuredTree to |λ|(tree) of measured
  
      script levelMax
          on |λ|(a, level)
              a & maximum(map(my fst, level))
          end |λ|
      end script
      set levelWidths to foldl(levelMax, {}, ¬
          init(levels(measuredTree)))
  
      -- Lefts, Mid, Rights
      script lmrFromStrings
          on |λ|(xs)
              set {ls, rs} to items 2 thru -2 of ¬
                  (splitAt((length of xs) div 2, xs) as list)
              Tuple3(ls, item 1 of rs, rest of rs)
          end |λ|
      end script
  
      script stringsFromLMR
          on |λ|(lmr)
              script add
                  on |λ|(a, x)
                      a & x
                  end |λ|
              end script
              foldl(add, {}, items 2 thru -2 of (lmr as list))
          end |λ|
      end script
  
      script fghOverLMR
          on |λ|(f, g, h)
              script
                  property mg : mReturn(g)
                  on |λ|(lmr)
                      set {ls, m, rs} to items 2 thru -2 of (lmr as list)
                      Tuple3(map(f, ls), |λ|(m) of mg, map(h, rs))
                  end |λ|
              end script
          end |λ|
      end script
  
      script lmrBuild
          on leftPad(n)
              script
                  on |λ|(s)
                      replicateString(n, space) & s
                  end |λ|
              end script
          end leftPad
  
          -- lmrBuild main
          on |λ|(w, f)
              script
                  property mf : mReturn(f)
                  on |λ|(wsTree)
                      set xs to nest of wsTree
                      set lng to length of xs
                      set {nChars, x} to items 2 thru -2 of ¬
                          ((root of wsTree) as list)
                      set _x to replicateString(w - nChars, "─") & x
  
                      -- LEAF NODE ------------------------------------
                      if 0 = lng then
                          Tuple3({}, _x, {})
  
                      else if 1 = lng then
                          -- NODE WITH SINGLE CHILD ---------------------
                          set indented to leftPad(1 + w)
                          script lineLinked
                              on |λ|(z)
                                  _x & "─" & z
                              end |λ|
                          end script
                          |λ|(|λ|(item 1 of xs) of mf) of ¬
                              (|λ|(indented, lineLinked, indented) of ¬
                                  fghOverLMR)
                      else
                          -- NODE WITH CHILDREN -------------------------
                          script treeFix
                              on cFix(x)
                                  script
                                      on |λ|(xs)
                                          x & xs
                                      end |λ|
                                  end script
                              end cFix
  
                              on |λ|(l, m, r)
                                  compose(stringsFromLMR, ¬
                                      |λ|(cFix(l), cFix(m), cFix(r)) of ¬
                                      fghOverLMR)
                              end |λ|
                          end script
  
                          script linked
                              on |λ|(s)
                                  set c to text 1 of s
                                  set t to tail(s)
                                  if "┌" = c then
                                      _x & "┬" & t
                                  else if "│" = c then
                                      _x & "┤" & t
                                  else if "├" = c then
                                      _x & "┼" & t
                                  else
                                      _x & "┴" & t
                                  end if
                              end |λ|
                          end script
  
                          set indented to leftPad(w)
                          set lmrs to map(f, xs)
                          if blnCompressed then
                              set sep to {}
                          else
                              set sep to {"│"}
                          end if
  
                          tell lmrFromStrings
                              set tupleLMR to |λ|(intercalate(sep, ¬
                                  {|λ|(item 1 of lmrs) of ¬
                                      (|λ|(" ", "┌", "│") of treeFix)} & ¬
                                  map(|λ|("│", "├", "│") of treeFix, ¬
                                      init(tail(lmrs))) & ¬
                                  {|λ|(item -1 of lmrs) of ¬
                                      (|λ|("│", "└", " ") of treeFix)}))
                          end tell
  
                          |λ|(tupleLMR) of ¬
                              (|λ|(indented, linked, indented) of fghOverLMR)
                      end if
                  end |λ|
              end script
          end |λ|
      end script
  
      set treeLines to |λ|(|λ|(measuredTree) of ¬
          foldr(lmrBuild, 0, levelWidths)) of stringsFromLMR
      if blnPruned then
          script notEmpty
              on |λ|(s)
                  script isData
                      on |λ|(c)
                          "│ " does not contain c
                      end |λ|
                  end script
                  any(isData, characters of s)
              end |λ|
          end script
          set xs to filter(notEmpty, treeLines)
      else
          set xs to treeLines
      end if
      unlines(xs)
  end drawTree2
  
  
  -- GENERIC ------------------------------------------------
  
  -- Node :: a -> [Tree a] -> Tree a
  on Node(v, xs)
      {type:"Node", root:v, nest:xs}
  end Node
  
  -- Tuple (,) :: a -> b -> (a, b)
  on Tuple(a, b)
      -- Constructor for a pair of values, possibly of two different types.
      {type:"Tuple", |1|:a, |2|:b, length:2}
  end Tuple
  
  -- Tuple3 (,,) :: a -> b -> c -> (a, b, c)
  on Tuple3(x, y, z)
      {type:"Tuple3", |1|:x, |2|:y, |3|:z, length:3}
  end Tuple3
  
  -- Applied to a predicate and a list,
  -- |any| returns true if at least one element of the
  -- list satisfies the predicate.
  -- any :: (a -> Bool) -> [a] -> Bool
  on any(f, xs)
      tell mReturn(f)
          set lng to length of xs
          repeat with i from 1 to lng
              if |λ|(item i of xs) then return true
          end repeat
          false
      end tell
  end any
  
  -- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
  on compose(f, g)
      script
          property mf : mReturn(f)
          property mg : mReturn(g)
          on |λ|(x)
              |λ|(|λ|(x) of mg) of mf
          end |λ|
      end script
  end compose
  
  -- 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
  
  -- concatMap :: (a -> [b]) -> [a] -> [b]
  on concatMap(f, xs)
      set lng to length of xs
      set acc to {}
      tell mReturn(f)
          repeat with i from 1 to lng
              set acc to acc & (|λ|(item i of xs, i, xs))
          end repeat
      end tell
      return acc
  end concatMap
  
  -- filter :: (a -> Bool) -> [a] -> [a]
  on filter(f, xs)
      tell mReturn(f)
          set lst to {}
          set lng to length of xs
          repeat with i from 1 to lng
              set v to item i of xs
              if |λ|(v, i, xs) then set end of lst to v
          end repeat
          return lst
      end tell
  end filter
  
  -- fmapTree :: (a -> b) -> Tree a -> Tree b
  on fmapTree(f, tree)
      script go
          property g : |λ| of mReturn(f)
          on |λ|(x)
              set xs to nest of x
              if xs ≠ {} then
                  set ys to map(go, xs)
              else
                  set ys to xs
              end if
              Node(g(root of x), ys)
          end |λ|
      end script
      |λ|(tree) of go
  end fmapTree
  
  -- 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
  
  -- foldr :: (a -> b -> b) -> b -> [a] -> b
  on foldr(f, startValue, xs)
      tell mReturn(f)
          set v to startValue
          set lng to length of xs
          repeat with i from lng to 1 by -1
              set v to |λ|(item i of xs, v, i, xs)
          end repeat
          return v
      end tell
  end foldr
  
  -- fst :: (a, b) -> a
  on fst(tpl)
      if class of tpl is record then
          |1| of tpl
      else
          item 1 of tpl
      end if
  end fst
  
  -- identity :: a -> a
  on identity(x)
      -- The argument unchanged.
      x
  end identity
  
  -- init :: [a] -> [a]
  -- init :: [String] -> [String]
  on init(xs)
      set blnString to class of xs = string
      set lng to length of xs
  
      if lng > 1 then
          if blnString then
              text 1 thru -2 of xs
          else
              items 1 thru -2 of xs
          end if
      else if lng > 0 then
          if blnString then
              ""
          else
              {}
          end if
      else
          missing value
      end if
  end init
  
  -- intercalate :: [a] -> [[a]] -> [a]
  -- intercalate :: String -> [String] -> String
  on intercalate(sep, xs)
      concat(intersperse(sep, xs))
  end intercalate
  
  -- intersperse(0, [1,2,3]) -> [1, 0, 2, 0, 3]
  -- intersperse :: a -> [a] -> [a]
  -- intersperse :: Char -> String -> String
  on intersperse(sep, xs)
      set lng to length of xs
      if lng > 1 then
          set acc to {item 1 of xs}
          repeat with i from 2 to lng
              set acc to acc & {sep, item i of xs}
          end repeat
          if class of xs is string then
              concat(acc)
          else
              acc
          end if
      else
          xs
      end if
  end intersperse
  
  -- isNull :: [a] -> Bool
  -- isNull :: String -> Bool
  on isNull(xs)
      if class of xs is string then
          "" = xs
      else
          {} = xs
      end if
  end isNull
  
  -- iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
  on iterateUntil(p, f, x)
      script
          property mp : mReturn(p)'s |λ|
          property mf : mReturn(f)'s |λ|
          property lst : {x}
          on |λ|(v)
              repeat until mp(v)
                  set v to mf(v)
                  set end of lst to v
              end repeat
              return lst
          end |λ|
      end script
      |λ|(x) of result
  end iterateUntil
  
  -- levels :: Tree a -> [[a]]
  on levels(tree)
      script nextLayer
          on |λ|(xs)
              script
                  on |λ|(x)
                      nest of x
                  end |λ|
              end script
              concatMap(result, xs)
          end |λ|
      end script
  
      script roots
          on |λ|(xs)
              script
                  on |λ|(x)
                      root of x
                  end |λ|
              end script
              map(result, xs)
          end |λ|
      end script
  
      map(roots, iterateUntil(my isNull, nextLayer, {tree}))
  end levels
  
  -- map :: (a -> b) -> [a] -> [b]
  on map(f, xs)
      -- The list obtained by applying f
      -- to each element of 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
  
  -- 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
  
  -- mReturn :: First-class m => (a -> b) -> m (a -> b)
  on mReturn(f)
      -- 2nd class handler function lifted into 1st class script wrapper.
      if script is class of f then
          f
      else
          script
              property |λ| : f
          end script
      end if
  end mReturn
  
  -- replicateString :: Int -> String -> String
  on replicateString(n, s)
      set out to ""
      if n < 1 then return out
      set dbl to s
  
      repeat while (n > 1)
          if (n mod 2) > 0 then set out to out & dbl
          set n to (n div 2)
          set dbl to (dbl & dbl)
      end repeat
      return out & dbl
  end replicateString
  
  -- snd :: (a, b) -> b
  on snd(tpl)
      if class of tpl is record then
          |2| of tpl
      else
          item 2 of tpl
      end if
  end snd
  
  -- splitAt :: Int -> [a] -> ([a], [a])
  on splitAt(n, xs)
      if n > 0 and n < length of xs then
          if class of xs is text then
              Tuple(items 1 thru n of xs as text, items (n + 1) thru -1 of xs as text)
          else
              Tuple(items 1 thru n of xs, items (n + 1) thru -1 of xs)
          end if
      else
          if n < 1 then
              Tuple({}, xs)
          else
              Tuple(xs, {})
          end if
      end if
  end splitAt
  
  -- tail :: [a] -> [a]
  on tail(xs)
      set blnText to text is class of xs
      if blnText then
          set unit to ""
      else
          set unit to {}
      end if
      set lng to length of xs
      if 1 > lng then
          missing value
      else if 2 > lng then
          unit
      else
          if blnText then
              text 2 thru -1 of xs
          else
              rest of xs
          end if
      end if
  end tail
  
  -- unlines :: [String] -> String
  on unlines(xs)
      -- A single string formed by the intercalation
      -- of a list of strings with the newline character.
      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
  