module QuickQueueFunctor (Q : Prioqueue.CYCLE_QUEUE) : (Prioqueue.PRIOQUEUE) =
struct

  (* this is here only because of tester. you can
     delete fhis line, if you won't be using PRIOQUEUE 
     module type, because Q.priority is used instead *)

  type priority = int

  type 'a t =
      Node of 'a node
    | Leaf of 'a Q.queue
  and 'a node =
      { priority : priority;
        left     : 'a t ref;
        right    : 'a t ref;
      }

  (* A lot of code here is imperative, and so 
     the queue itself is temporary, it changes 
     in time, unlike fully functional data 
     structures *)

  type 'a queue =
      Root of 'a Q.queue ref * 'a t ref

  (* this code might look better if translated into objects... for future *)

  (* for sake of my sanity - i declare to all thou readers, all functins available 
     outside this module take no references as parameters. 
     BUT! it doesn't mean, that objects passed as their parameters do preserve their
     status quo. mostly they do change and propably become useless. only funtions
     results are proper *)

  let empty() =
    let q = ref (Q.empty())
    in
      Root (q, ref (Leaf !q))

  exception Unproper_use_of_queue

  let is_empty = function
      Root (_, q) ->
          match !q with
              Leaf p -> Q.is_empty p
            | _      -> false


  exception Queue_is_full

  (* Tricky come's into action! *)

  (* sometimes I wonder how come this code works... *)

  (* ---------- I N S E R T ----------- *)

  let insert = fun ( Root(min,que) ) p a ->
    (* takes a leaf reference and divides it into a node and dwo leafs *)
    let divide nod =
      ( function (prio, l, r) ->
          Node { priority = prio;
                 left     = ref (Leaf l);
                 right    = ref (Leaf r);
               }
      )
        ( Q.divide ( match !(nod) with
                         Leaf q -> q
                       | _      -> raise Unproper_use_of_queue ) )

(* when dividing most left leaf and afterwards if inserting not into 
   new most left leaf, ins doesnt remember that most left leaf was changed *)
    and divided_most_left_leaf nod =
      match !(nod) with
          Node e ->
            begin
              match !(e.left) with
                  Leaf q -> (ref q, true)
                | _      -> raise Unproper_use_of_queue
            end
        | _       -> raise Unproper_use_of_queue

    in
      (* returns reference to cycle queue into whitch it added new element *)
      (* first parameter is where it should insert, second is if most left leaf 
         was changed *)
    let ins nodi mmi =
      let rec rec_ins nd mm =
        begin
          match !nd with
              Leaf q   ->
                begin
                  (ref (Q.insert q p a), mm); (* might end with an exception *)
                end
            | Node nod ->
                if p < nod.priority then
                  try
                    rec_ins nod.left mm
                  with Q.Queue_is_full -> (* so nod.left is a leaf! *)
                    begin
                      nod.left := divide nod.left;
                      let ins_result = rec_ins nod.left mm in
                        if mm then
                          divided_most_left_leaf nod.left
                        else
                          ins_result
                    end
                else
                  try
                    rec_ins nod.right false
                  with Q.Queue_is_full -> (* so nod.right is a leaf! *)
                    begin
                      nod.right := divide nod.right;
                      rec_ins nod.right false;
                    end
        end
      in
        try
          rec_ins nodi mmi
        with Q.Queue_is_full -> (* so ins was taken on a leaf at first *)
          begin
            nodi := divide nodi;
            let _ = rec_ins nodi true
            in
              divided_most_left_leaf nodi
          end;
    in
    let (new_min, modified_min) = ins que true
    in
      (* now it's time to check if the minimum has changed *)
      if modified_min then
        Root(new_min, que)
      else
        Root(min, que)
        (* take last updated and check if it's a minimum *)


  (* ----- end of I N S E R T ------- *)

  exception Queue_is_empty

  (* ---- D E L E T E    M I N ----- *)

  let rec delete_min =
    let rec give_most_left_node q =
      match !q with
          Leaf _ -> raise Queue_is_empty
        | Node n ->
            match !(n.left) with
                Leaf _ -> q
              | _      -> give_most_left_node n.left

    in
    (* erase most left leaf from the tree (rearranging nodes) 
       and return reference to new most left leaf *)
    let rec rebuild q =
      let nod = give_most_left_node q
      in
        match !nod with
            Node n ->
              begin
                nod := !(n.right);
                (* leaf erased. now let's find another min *)
                match !nod with
                    Leaf _ -> nod
                  | Node m ->
                      try
                        match !(give_most_left_node nod) with
                            Node e -> e.left
                          | _      -> raise Unproper_use_of_queue
                      with Queue_is_empty -> nod
              end
          | _     -> raise Unproper_use_of_queue

    in

      function ( Root(min,que) ) ->
        try
          let (p, e, _) = Q.delete_min !min
          in
            (* the idea of this part is that min should 
               never be empty, if que is not just a leaf *)
            match !que with
                Leaf _ ->
                  (p, e, Root(min,que))
              | _     ->
                  begin
                    if Q.is_empty !min then
                      (* so we have an empty min with, let's rebuild *)
                      let new_min = rebuild que
                      in
                        match !new_min with
                            Leaf c -> (p, e, Root(ref c, que))
                          | _      -> raise Unproper_use_of_queue
                    else (* min isn't empty *)
                      (p, e, Root(min,que))
                  end
        with
            Q.Queue_is_empty ->
              (* if queue is really empty en exception will be raised:
                 se fuction give_most_left_node *)
              let new_min = rebuild que
              in
                match !new_min with
                    Leaf c -> delete_min ( Root(ref c, que) )
                  | _      -> raise Unproper_use_of_queue

  (* --- end of D E L E T E    M I N --- *)


  let find_min =
    function ( Root(min,que) ) ->
      ( (function ((p, e, _ ), q) -> (p, e, q))
        ((Q.find_min !min), Root(min,que)) )

  let rec union q1 q2 =
    if is_empty q2 then q1 else
      ( function (p, e, q) -> union (insert q1 p e) q )
        ( delete_min q2 )

end

(* todo -> 
   parameter names *)