module RealTimeQueue exposing
  (Queue, empty, isEmpty, enqueue, dequeue, peek)

import ThunkList exposing
  ( Thunk, lazy, force
  , ThunkList, ThunkListCell(..)
  )

----------------------------------------------------------------------

-- invariants:
--    |front| >= |back|
--    |sched|  = |front| - |back|
--
type Queue a =
  Q { front : ThunkList a
    , back : List a
    , sched : ThunkList a
    }

appendFrontRevBack : ThunkList a -> List a -> ThunkList a
appendFrontRevBack front back =
  let
    rotate : ThunkList a -> List a -> ThunkList a -> ThunkList a
    rotate xs ys acc =
      case (force xs, ys) of
        (Nil, y::[]) ->
          lazy (\_ -> Cons y acc)
        (Cons x xs_ , y::ys_) ->
          lazy (\_ -> Cons x (rotate xs_ ys_ (lazy (\_ -> Cons y acc))))
        _ ->
          Debug.todo "rotate should be called with |ys| = |xs| + 1"
  in
  rotate front back (lazy (\() -> Nil))

empty : Queue a
empty =
  Q { front = lazy (\() -> Nil)
    , back = []
    , sched = lazy (\() -> Nil)
    }

isEmpty : Queue a -> Bool
isEmpty (Q {front}) =
  force front == Nil

peek : Queue a -> Maybe a
peek (Q {front}) =
  case force front of
    Nil -> Nothing
    Cons a _ -> Just a

enqueue : a -> Queue a -> Queue a
enqueue a (Q {front, back, sched}) =
  exec front (a::back) sched

dequeue : Queue a -> Maybe (Queue a)
dequeue (Q {front, back, sched}) =
  case force front of
    Nil ->
      Nothing
    Cons _ frontRest ->
      Just (exec frontRest back sched)

exec front back sched =
  case force sched of
    Nil ->
      let newFront = appendFrontRevBack front back in
      Q { front = newFront, back = [], sched = newFront }
    Cons _ schedRest ->
      Q { front = front, back = back, sched = schedRest }

----------------------------------------------------------------------

enqueue_ : a -> Queue a -> Queue a
enqueue_ a (Q {front, back, sched}) =
  case force sched of
    Nil ->
      let newFront = appendFrontRevBack front (a::back) in
      Q { front = newFront, back = [], sched = newFront }
    Cons _ schedRest ->
      Q { front = front, back = a::back, sched = schedRest } 

dequeue_ : Queue a -> Maybe (Queue a)
dequeue_ (Q {front, back, sched}) =
  case force front of
    Nil ->
      Nothing
    Cons a frontRest ->
      case force sched of
        Nil ->
          let newFront = appendFrontRevBack frontRest back in
          Just (Q { front = newFront, back = [], sched = newFront })
        Cons _ schedRest ->
          Just (Q { front = frontRest, back = back, sched = schedRest })