#lang typed/scheme

(require (prefix-in pq: "physicists-queue.ss"))
(provide filter remove
         empty empty? enqueue head tail queue queue->list Queue
         (rename-out [qmap map]) fold)

(require scheme/promise)
(define-type-alias (Mid A) (pq:Queue (Promise (Listof A))))
(define-struct: (A) IntQue ([F : (Listof A)]
                            [M : (Mid A)]
                            [LenFM : Integer]
                            [R : (Listof A)]
                            [LenR : Integer]))

(define-struct: EmptyBSQueue ())

;; An empty queue
(define empty (make-EmptyBSQueue))

(define-type-alias (Queue A) (U EmptyBSQueue (IntQue A)))

;; Checks for empty
(: empty? : (All (A) ((Queue A) -> Boolean)))
(define (empty? bsq)
  (EmptyBSQueue? bsq))

;; Maintains invarients
(: internal-queue : (All (A) ((Listof A) (Mid A) Integer (Listof A) Integer 
                                         -> (Queue A))))
(define (internal-queue f m lenfm r lenr)
  (if (<= lenr lenfm) 
      (checkF (make-IntQue f m lenfm r lenr))
      (checkF (make-IntQue f (pq:enqueue (delay (reverse r)) m) 
                          (+ lenfm lenr)
                          null 0))))

;; Inserts an element into the queue
(: enqueue : (All (A) (A (Queue A) -> (Queue A))))
(define (enqueue elem bsq)
  (if (EmptyBSQueue? bsq)
      (make-IntQue (cons elem null) pq:empty 1 null 0)
      (internal-queue (IntQue-F bsq)
                      (IntQue-M bsq)
                      (IntQue-LenFM bsq)
                      (cons elem (IntQue-R bsq))
                      (add1 (IntQue-LenR bsq)))))

;; Returns the first element of the queue
(: head : (All (A) ((Queue A) -> A)))
(define (head bsq)
  (if (EmptyBSQueue? bsq)
      (error 'head "given queue is empty")
      (car (IntQue-F bsq))))

;; Returns the rest of the queue
(: tail : (All (A) ((Queue A) -> (Queue A))))
(define (tail bsq)
  (if (EmptyBSQueue? bsq)
      (error 'tail "given queue is empty")
      (internal-queue (cdr (IntQue-F bsq)) 
                      (IntQue-M bsq) 
                      (sub1 (IntQue-LenFM bsq)) 
                      (IntQue-R bsq)
                      (IntQue-LenR bsq))))

;; Invarient check
(: checkF : (All (A) ((IntQue A) -> (Queue A))))
(define (checkF que)
  (let* ([front (IntQue-F que)]
         [mid (IntQue-M que)])
    (if (null? front) 
        (if (pq:empty? mid) 
            empty
            (make-IntQue (force (pq:head mid))
                        (pq:tail mid)
                        (IntQue-LenFM que)
                        (IntQue-R que)
                        (IntQue-LenR que)))
        que)))


;; similar to list map function
(: qmap : (All (A C B ...) 
               ((A B ... B -> C) (Queue A) (Queue B) ... B -> (Queue C))))
(define (qmap func que . ques)
  (: in-map : (All (A C B ...) 
                   ((Queue C) (A B ... B -> C) (Queue A) (Queue B) ... B -> 
                              (Queue C))))
  (define (in-map accum func que . ques)
    (if (or (empty? que) (ormap empty? ques))
        accum
        (apply in-map 
               (enqueue (apply func (head que) (map head ques)) accum)
               func 
               (tail que)
               (map tail ques))))
  (apply in-map empty func que ques))

;; similar to list fold functions
(: fold : (All (A C B ...)
               ((C A B ... B -> C) C (Queue A) (Queue B) ... B -> C)))
(define (fold func base que . ques)
  (if (or (empty? que) (ormap empty? ques))
        base
        (apply fold 
               func 
               (apply func base (head que) (map head ques))
               (tail que)
               (map tail ques))))

(: queue->list : (All (A) ((Queue A) -> (Listof A))))
(define (queue->list bsq)
  (if (EmptyBSQueue? bsq)
      null
      (cons (head bsq) (queue->list (tail bsq))))) 

;; Queue constructor
(: queue : (All (A) (A * -> (Queue A))))
(define (queue . lst)
  (foldl (inst enqueue A) empty lst))

;; similar to list filter function
(: filter : (All (A) ((A -> Boolean) (Queue A) -> (Queue A))))
(define (filter func que)
  (: inner : (All (A) ((A -> Boolean) (Queue A) (Queue A) -> (Queue A))))
  (define (inner func que accum)
    (if (empty? que)
        accum
        (let ([head (head que)]
              [tail (tail que)])
          (if (func head)
              (inner func tail (enqueue head accum))
              (inner func tail accum)))))
  (inner func que empty))

;; similar to list remove function
(: remove : (All (A) ((A -> Boolean) (Queue A) -> (Queue A))))
(define (remove func que)
  (: inner : (All (A) ((A -> Boolean) (Queue A) (Queue A) -> (Queue A))))
  (define (inner func que accum)
    (if (empty? que)
        accum
        (let ([head (head que)]
              [tail (tail que)])
          (if (func head)
              (inner func tail accum)
              (inner func tail (enqueue head accum))))))
  (inner func que empty))