guile-examples/web-development/using-guile-webserver/tree-routing/simple-tree.scm

(define-module (simple-tree)
  #:export (make-node
            node?
            node-key
            node-val
            node-children
            get-node-by-path
            leaf?
            inner-node?
            list->tree))


(use-modules (srfi srfi-9)  ; structs
             (srfi srfi-9 gnu))  ; for functional structs (not part of srfi-9 directly)

(define-immutable-record-type <node>
  ;; define constructor
  (make-node key val children)
  ;; define predicate
  node?
  ;; define accessors and functional setters
  (key node-key set-node-key)
  (val node-val set-node-val)
  (children node-children set-node-children))

(define* (get-node-by-path node path #:optional (default #f) #:key (use-longest-prefix #f))
  "Returns the node from the tree of nodes given as NODE for which the
sequence of node keys from the root to that node is the list given as
PATH. If a DEFAULT is given, that DEFAULT is returned, whenever there
is no node with the given PATH. If the keyword argument
USE-LONGEST-PREFIX is provided, the function will return the node,
which was the last node while traversing the tree, before the PATH
diverged from the node keys in the tree."
  (define* (get-child-by-key children key #:optional (default #f))
    (cond [(null? children) (make-node 'result default '())]
          [(equal? (node-key (car children)) key)
           (car children)]
          [else (get-child-by-key (cdr children) key)]))

  #;(display (simple-format #f "current node:~s\n" node))
  #;(display (simple-format #f "current path:~s\n" path))
  (define* (search-tree node path #:optional (default #f) #:key (use-longest-prefix #f))
    (cond [(null? path) node]
          [(equal? (car path) (node-key node))
           #;(display (simple-format #f "part of path is equal to node key\n"))
           (cond
            ;; if there are no more path segments we arrived at the
            ;; target node
            [(null? (cdr path)) node]
            ;; if there are no more children but still some path
            ;; elements
            [(null? (node-children node))
             #;(display (simple-format #f "no children!\n"))
             #;(display (simple-format #f "default: ~s\n" default))
             #;(display (simple-format #f "use-longest-prefix: ~s\n" use-longest-prefix))
             (if use-longest-prefix node default)]
            ;; otherwise we need to get the next child to go deeper
            [else
             #;(display (simple-format #f "getting the next child node\n"))
             (let ([next-node (get-child-by-key (node-children node) (cadr path))])
               (if next-node
                   (search-tree next-node
                                (cdr path)
                                default
                                #:use-longest-prefix use-longest-prefix)
                   ;; if there are no more nodes, but we still have some
                   ;; path left
                   (if use-longest-prefix node default)))])]
          [else default]))

  ;; wrap default in a result node so that always a node is returned
  (search-tree node
               path
               (make-node 'default-result default '())
               #:use-longest-prefix use-longest-prefix))

(define (leaf? node)
  (null? (node-children node)))

(define (inner-node? node)
  (not (leaf? node)))

(define (list->tree nested-list)
  (define (get-key lst)
    (car lst))
  (define (get-val lst)
    (cadr lst))
  (define (get-children lst)
    (caddr lst))
  (cond [(null? nested-list) '()]
        [else (make-node (get-key nested-list)
                         (get-val nested-list)
                         (map list->tree (get-children nested-list)))]))