#lang racket/base

(require
  "stored-objects.rkt")

(provide
  ; Accessors
  hierarchy-parent-of hierarchy-children-of hierarchy-path
  ; Creation/update
  update-hierarchy
  ; Removal
  delete-from-hierarchy
  ; Init repo
  hierarchy-init-repository
  )

; Hierarchy table between notes
; A hierarchy is the relation parent <> child
; The hierarchy must be a partial order
; When moving the hierarchy, a check is done to verify there's no loop
; Notes with no parent are at the top of a hierarchy

; Structure
(stored-class notepadhierarchy
  (parent : integer?) ; Id of the parent note
  (child : integer?) ; Id of the child note
  )

; Repo initialization
(define (hierarchy-init-repository repo)
  (init-repository repo
    notepadhierarchy))

; Create or update a hierarchy relation, and return it, or return #f if the new hierarchy cannot be created or updated
(define (update-hierarchy
          #:parent parent
          #:child child)
  (if (hierarchy-can-be-child-of? parent child)
      ; Find if a hierarchy already exists for the given child
      (let* ((hierarchies (find-instances notepadhierarchy `((child . ,child))))
             (hierarchy
                (if (null? hierarchies)
                    (instanciate notepadhierarchy)
                    (car hierarchies))))
        (set-notepadhierarchy-parent! hierarchy parent)
        (set-notepadhierarchy-child! hierarchy child)
        (save-instance hierarchy)
        hierarchy)
      #f))

; Check if a note can be a child of given note
(define (hierarchy-can-be-child-of? parent child)
  (or (not parent) ; OK if parent does not exist
      (and
        (not (eq? parent child)) ; parent and child must be different
        (hierarchy-can-be-child-of? (hierarchy-parent-of parent) child)))) ; child can be a child of its grand-parent

; Get the parent of a given item
(define (hierarchy-parent-of elem)
  (define hierarchies (find-instances notepadhierarchy `((child . ,elem))))
  (and (not (null? hierarchies))
       (notepadhierarchy-parent (car hierarchies))))

; Get the children of a given item
(define (hierarchy-children-of elem)
  (define hierarchies (find-instances notepadhierarchy `((parent . ,elem))))
  (map notepadhierarchy-child hierarchies))

; Get the path of a given item
; The path is the list of item + its ancestors, from the first ancestor. So the first item of the returned list has no parent.
(define (hierarchy-path elem (children '()))
  (define current (cons elem children))
  (define parent (hierarchy-parent-of elem))
  (if parent
      (hierarchy-path parent current)
      current))

; Remove an element in the hierarchy
(define (delete-from-hierarchy elem)
  ; Retrive the associated hierarchy
  (define hierarchies (find-instances notepadhierarchy `((child . ,elem))))
  (define hierarchy (and (not (null? hierarchies)) (car hierarchies)))
  ; Attach all the children of elem to its parent if it exists, or else remove all the relations
  (define children (find-instances notepadhierarchy `((parent . ,elem))))
  (define parent (and hierarchy (notepadhierarchy-parent hierarchy)))
  (map
    (lambda (x)
      (if parent
        (begin
          (set-notepadhierarchy-parent! x parent)
          (save-instance x))
        (delete-instance x)))
      children)
  ; Remove the hierarchy if it exists
  (when hierarchy
    (delete-instance hierarchy)))
