-- | A DeleteQueue is a queue where entries can be deleted by an
-- IO action.  This is a fairly specialised implementation, designed
-- for event handling.
--
-- Queue entries are either active or invalid.  Once invalid,
-- removeQueue will not return them, but they still take up (a little) memory.
--
-- addQueue, removeQueue, isEmptyQueue, cleanQueue all take a delete queue
-- as argument.  We assume that this argument is not used again.
--
-- Either removeQueue or isEmptyQueue or cleanQueue should be run
-- occasionally, to remove invalid entries.
module Events.DeleteQueue(
   DeleteQueue,
   emptyQueue, -- :: DeleteQueue v
   addQueue, -- :: DeleteQueue v -> v -> IO (DeleteQueue v,IO ())
   -- add an item to the queue, returning the new queue + a new action which
   -- will invalidate that item.
   removeQueue,
   -- :: DeleteQueue v -> IO (Maybe (v,DeleteQueue v,DeleteQueue v))
   -- returns the next active element of the queue, and the succeeding
   -- queue.  3rd result is a queue which is identical to the original
   -- queue.
   isEmptyQueue, -- :: DeleteQueue v -> IO (Maybe (DeleteQueue v))
   -- If queue has active entries, returns it, otherwise return Nothing.
   cleanQueue, -- :: DeleteQueue v -> IO (DeleteQueue v)
   ) where

import Util.Queue
import Events.Cells

newtype DeleteQueue v = DeleteQueue (Queue (Cell v))

emptyQueue :: DeleteQueue v
emptyQueue :: DeleteQueue v
emptyQueue = Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue Queue (Cell v)
forall a. Queue a
emptyQ

addQueue :: DeleteQueue v -> v -> IO (DeleteQueue v,IO ())
addQueue :: DeleteQueue v -> v -> IO (DeleteQueue v, IO ())
addQueue (DeleteQueue Queue (Cell v)
queue) v
v =
   do
      Cell v
cell <- v -> IO (Cell v)
forall a. a -> IO (Cell a)
newCell v
v
      let deleteQueue1 :: DeleteQueue v
deleteQueue1 = Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue (Queue (Cell v) -> Cell v -> Queue (Cell v)
forall a. Queue a -> a -> Queue a
insertQ Queue (Cell v)
queue Cell v
cell)
      (DeleteQueue v, IO ()) -> IO (DeleteQueue v, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (DeleteQueue v
deleteQueue1,Cell v -> IO ()
forall a. Cell a -> IO ()
emptyCell Cell v
cell)

cleanQueue :: DeleteQueue v -> IO (DeleteQueue v)
-- cleanQueue pops empty cells from the front of the queue as long as possible
cleanQueue :: DeleteQueue v -> IO (DeleteQueue v)
cleanQueue deleteQueue :: DeleteQueue v
deleteQueue@(DeleteQueue Queue (Cell v)
queue) =
   case Queue (Cell v) -> Maybe (Cell v, Queue (Cell v))
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue (Cell v)
queue of
      Maybe (Cell v, Queue (Cell v))
Nothing -> DeleteQueue v -> IO (DeleteQueue v)
forall (m :: * -> *) a. Monad m => a -> m a
return DeleteQueue v
deleteQueue
      Just (Cell v
cell,Queue (Cell v)
queue2) ->
         do
            Maybe v
cellContents <- Cell v -> IO (Maybe v)
forall a. Cell a -> IO (Maybe a)
inspectCell Cell v
cell
            case Maybe v
cellContents of
               Maybe v
Nothing -> DeleteQueue v -> IO (DeleteQueue v)
forall v. DeleteQueue v -> IO (DeleteQueue v)
cleanQueue (Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue Queue (Cell v)
queue2)
               Just v
_ -> DeleteQueue v -> IO (DeleteQueue v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue (Queue (Cell v) -> Cell v -> Queue (Cell v)
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Cell v)
queue2 Cell v
cell))


isEmptyQueue :: DeleteQueue v -> IO (Maybe (DeleteQueue v))
-- isEmptyQueue is like cleanQueue, but if the queue is empty returns Nothing.
isEmptyQueue :: DeleteQueue v -> IO (Maybe (DeleteQueue v))
isEmptyQueue deleteQueue :: DeleteQueue v
deleteQueue@(DeleteQueue Queue (Cell v)
queue) =
   case Queue (Cell v) -> Maybe (Cell v, Queue (Cell v))
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue (Cell v)
queue of
      Maybe (Cell v, Queue (Cell v))
Nothing -> Maybe (DeleteQueue v) -> IO (Maybe (DeleteQueue v))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DeleteQueue v)
forall a. Maybe a
Nothing
      Just (Cell v
cell,Queue (Cell v)
queue2) ->
         do
            Maybe v
cellContents <- Cell v -> IO (Maybe v)
forall a. Cell a -> IO (Maybe a)
inspectCell Cell v
cell
            case Maybe v
cellContents of
               Maybe v
Nothing -> DeleteQueue v -> IO (Maybe (DeleteQueue v))
forall v. DeleteQueue v -> IO (Maybe (DeleteQueue v))
isEmptyQueue (Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue Queue (Cell v)
queue2)
               Just v
_ ->
                  Maybe (DeleteQueue v) -> IO (Maybe (DeleteQueue v))
forall (m :: * -> *) a. Monad m => a -> m a
return (DeleteQueue v -> Maybe (DeleteQueue v)
forall a. a -> Maybe a
Just (Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue (Queue (Cell v) -> Cell v -> Queue (Cell v)
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Cell v)
queue2 Cell v
cell)))

removeQueue :: DeleteQueue v -> IO (Maybe (v,DeleteQueue v,DeleteQueue v))
removeQueue :: DeleteQueue v -> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
removeQueue (DeleteQueue Queue (Cell v)
queue) =
   case Queue (Cell v) -> Maybe (Cell v, Queue (Cell v))
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue (Cell v)
queue of
      Maybe (Cell v, Queue (Cell v))
Nothing -> Maybe (v, DeleteQueue v, DeleteQueue v)
-> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (v, DeleteQueue v, DeleteQueue v)
forall a. Maybe a
Nothing
      Just (Cell v
cell,Queue (Cell v)
queue2) ->
         do
            Maybe v
vOpt <- Cell v -> IO (Maybe v)
forall a. Cell a -> IO (Maybe a)
inspectCell Cell v
cell
            case Maybe v
vOpt of
               Maybe v
Nothing -> DeleteQueue v -> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
forall v.
DeleteQueue v -> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
removeQueue (Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue Queue (Cell v)
queue2)
               Just v
v ->
                  Maybe (v, DeleteQueue v, DeleteQueue v)
-> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
forall (m :: * -> *) a. Monad m => a -> m a
return ((v, DeleteQueue v, DeleteQueue v)
-> Maybe (v, DeleteQueue v, DeleteQueue v)
forall a. a -> Maybe a
Just(v
v,Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue Queue (Cell v)
queue2,
                     Queue (Cell v) -> DeleteQueue v
forall v. Queue (Cell v) -> DeleteQueue v
DeleteQueue(Queue (Cell v) -> Cell v -> Queue (Cell v)
forall a. Queue a -> a -> Queue a
insertAtEndQ Queue (Cell v)
queue2 Cell v
cell)))