(;module:
  lux
  (lux (control [eq #+ Eq]
                [monad #+ do Monad])
       (data (coll (tree ["F" finger]))
             [number]
             [maybe])))

(type: #export Priority Nat)

(type: #export (Queue a)
  (Maybe (F;Fingers Priority a)))

(def: max-priority Priority ("lux nat max"))
(def: min-priority Priority ("lux nat min"))

(def: #export empty
  Queue
  #;None)

(def: #export (peek queue)
  (All [a] (-> (Queue a) (Maybe a)))
  (do maybe;Monad<Maybe>
    [fingers queue]
    (wrap (maybe;assume (F;search (n.= (F;tag fingers)) fingers)))))

(def: #export (size queue)
  (All [a] (-> (Queue a) Nat))
  (case queue
    #;None
    +0

    (#;Some fingers)
    (loop [node (get@ #F;tree fingers)]
      (case node
        (#F;Leaf _ _)
        +1

        (#F;Branch _ left right)
        (n.+ (recur left) (recur right))))))

(def: #export (member? Eq<a> queue member)
  (All [a] (-> (Eq a) (Queue a) a Bool))
  (case queue
    #;None
    false

    (#;Some fingers)
    (loop [node (get@ #F;tree fingers)]
      (case node
        (#F;Leaf _ reference)
        (:: Eq<a> = reference member)

        (#F;Branch _ left right)
        (or (recur left)
            (recur right))))))

(def: #export (pop queue)
  (All [a] (-> (Queue a) (Queue a)))
  (do maybe;Monad<Maybe>
    [fingers queue
     #let [highest-priority (F;tag fingers)]
     node' (loop [node (get@ #F;tree fingers)]
             (case node
               (#F;Leaf priority reference)
               (if (n.= highest-priority priority)
                 #;None
                 (#;Some node))

               (#F;Branch priority left right)
               (if (n.= highest-priority (F;tag (set@ #F;tree left fingers)))
                 (case (recur left)
                   #;None
                   (#;Some right)

                   (#;Some =left)
                   (|> (F;branch (set@ #F;tree =left fingers)
                                 (set@ #F;tree right fingers))
                       (get@ #F;tree)
                       #;Some))
                 (case (recur right)
                   #;None
                   (#;Some left)

                   (#;Some =right)
                   (|> (F;branch (set@ #F;tree left fingers)
                                 (set@ #F;tree =right fingers))
                       (get@ #F;tree)
                       #;Some))
                 )))]
    (wrap (set@ #F;tree node' fingers))))

(def: #export (push priority value queue)
  (All [a] (-> Priority a (Queue a) (Queue a)))
  (let [addition {#F;monoid number;Max@Monoid<Nat>
                  #F;tree (#F;Leaf priority value)}]
    (case queue
      #;None
      (#;Some addition)

      (#;Some fingers)
      (#;Some (F;branch fingers addition)))))