#lang scheme

(define-struct single (content))
(define-struct a-join (left-lst right-lst) #:mutable)

;; join-list?: any/c -> boolean
;; takes a datum and returns true if it is a join list
;; false otherwise
(define (join-list? dat)
  (or (empty? dat)
      (single? dat)
      (a-join? dat)))

;; new-cons: any/c list -> list
;; redefines cons to throw an error when used with append lists
;; to be exported as "cons"
(define (new-cons elt lst)
  (cond
    [(or (single? lst) (a-join? lst))
     (error 'cons "do not use cons with join lists! given ~a and ~a" elt lst)]
    [(list? lst) (cons elt lst)]
    [else (error 'cons "second argument must be of type <list>, given ~a and ~a" elt lst)]))

;; retrieve: single -> any/c
;; consumes a singleton join list and returns the data contained within
(define (retrieve lst)
  (if (single? lst)
      (single-content lst)
      (error 'get "expected one-element join list, found ~a" lst)))

;; put-together: join-list join-list -> join-list
;; consumes two join lists and joins them together into a single list
(define (put-together lst1 lst2)
  (cond
    [(not (join-list? lst1))
     (error 'join
            "expected first argument of type <join-list>, found ~a. other argument: ~a"
            lst1
            lst2)]
    [(not (join-list? lst2))
     (error 'join
            "expected second argument of type <join-list>, found ~a. other argument: ~a"
            lst2
            lst1)]
    [(empty? lst1) lst2]
    [(empty? lst2) lst1]
    [else (make-a-join lst1 lst2)]))

;; divide: join-list (join-list join-list -> a) -> a
;; consumes a join-list with multiple elements and a handler
;; the handler takes two halves of a list and does a computation
(define (divide lst proc)
  (if (not (a-join? lst))
      (error 'split "expected first argument of type <join-list> with multiple elements, found ~a. other argument: ~a" lst proc)
      (let* ([left (a-join-left-lst lst)]
             [right (a-join-right-lst lst)]
             [move (lambda (dir)
                     (cond
                       [(and (= 1 dir)
                             (a-join? left))
                        (begin
                          (set-a-join-right-lst! lst (put-together (a-join-right-lst left) right))
                          (set-a-join-left-lst! lst (a-join-left-lst left)))]
                       [(and (= 2 dir)
                             (a-join? right))
                        (begin
                          (set-a-join-left-lst! lst (put-together left (a-join-left-lst right)))
                          (set-a-join-right-lst! lst (a-join-right-lst right)))]
                       [else (void)]))])
        (begin
          (move (random 2))
          (proc (a-join-left-lst lst) (a-join-right-lst lst))))))

;; join-list-from-list: (listof any/c) -> join-list
;; consumes a scheme list and outputs a mostly-balanced join list representation
;;    of that same list
(define (join-list-from-list lst)
  (when (not (list? lst)) (error 'list->join-list
                                 "expected argument of type <list>, found ~a"
                                 lst))
  (local
    [(define (list->join-list-help a-list len)
       (cond
         [(= len 0) (list empty a-list)]
         [(= len 1) (list (make-single (first a-list)) (rest a-list))]
         [(> len 1)
          (let* ([left-output (list->join-list-help a-list (floor (/ len 2)))]
                 [right-output (list->join-list-help (second left-output)
                                                     (ceiling (/ len 2)))])
            (list (put-together (first left-output) (first right-output))
                  (second right-output)))]))]
    (first (list->join-list-help lst (length lst)))))

;; list-from-join-list: join-list -> list
;; consumes a join list and converts it into a scheme list representation
;; note: this does not call split
(define (list-from-join-list lst)
  (if (join-list? lst)
      (local [(define (join-list->list-help a-list acc)
                (cond
                  [(empty? a-list) acc]
                  [(single? a-list) (cons (retrieve a-list) acc)]
                  [else (join-list->list-help (a-join-left-lst a-list)
                                              (join-list->list-help (a-join-right-lst a-list)
                                                                    acc))]))]
        (join-list->list-help lst empty))
      (error 'join-list->list "expected argument of type <join-list>, found ~a" lst)))

;; join-list-equal?: join-list join-list -> boolean
;; consumes two join-lists and returns true if they have the same elements in the same order
(define (join-list-equal? lst1 lst2)
  (cond
    [(not (join-list? lst1))
     (error 'join-list=?
            "expected first argument of type <join-list>, found ~a. other argument: ~a"
            lst1
            lst2)]
    [(not (join-list? lst2))
     (error 'join-list=?
            "expected second argument of type <join-list>, found ~a. other argument: ~a"
            lst2
            lst1)]
    [else (equal? (list-from-join-list lst1) (list-from-join-list lst2))]))

;; provide statement
(provide (rename-out (new-cons cons)
                     (make-single one)
                     (single? one?)
                     (retrieve get)
                     (put-together join)
                     (divide split)
                     (a-join? join?)
                     (join-list-equal? join-list=?)
                     (join-list-from-list list->join-list)
                     (list-from-join-list join-list->list))
         join-list?)