-- | FMQueue handles finite maps of delete queues, so that we
-- can implement EqGuard.
module Events.FMQueue(
   FMQueue,
   emptyFMQueue,
      -- :: FMQueue key contents
   addFMQueue,
      -- :: Ord key => FMQueue key contents -> key -> contents ->
      --    IO (FMQueue key contents,IO ())
      -- adds an item, returning the new queue and an invalidate action.
   removeFMQueue,
      -- :: Ord key => FMQueue key contents -> key ->
      -- IO (Maybe (contents,FMQueue key contents),FMQueue key contents)
   removeFMQueueAny
      -- :: Ord key => FMQueue key contents ->
      -- IO (Maybe (key,contents,FMQueue key contents),FMQueue key contents)
   ) where

import qualified Data.Map as Map

import Events.DeleteQueue

data Ord key => FMQueue key contents =
   FMQueue {
      FMQueue key contents -> Map key (DeleteQueue contents)
dqMap :: Map.Map key (DeleteQueue contents),
      FMQueue key contents -> [key]
cleanList :: [key]
      -- To clear out the map, we go through the keys in cleanList
      -- each time we add an item, and check for empty deleteQueues.
      }

emptyFMQueue :: Ord key => FMQueue key contents
emptyFMQueue :: FMQueue key contents
emptyFMQueue = FMQueue :: forall key contents.
Map key (DeleteQueue contents) -> [key] -> FMQueue key contents
FMQueue {
   dqMap :: Map key (DeleteQueue contents)
dqMap = Map key (DeleteQueue contents)
forall k a. Map k a
Map.empty,
   cleanList :: [key]
cleanList = []
   }

addFMQueue :: Ord key => FMQueue key contents -> key -> contents ->
   IO (FMQueue key contents,IO ())
addFMQueue :: FMQueue key contents
-> key -> contents -> IO (FMQueue key contents, IO ())
addFMQueue FMQueue key contents
fmQueue key
key contents
contents =
  do
      let
         fmMap :: Map key (DeleteQueue contents)
fmMap = (FMQueue key contents -> Map key (DeleteQueue contents)
forall key contents.
Ord key =>
FMQueue key contents -> Map key (DeleteQueue contents)
dqMap FMQueue key contents
fmQueue)
         deleteQueue :: DeleteQueue contents
deleteQueue = DeleteQueue contents
-> key -> Map key (DeleteQueue contents) -> DeleteQueue contents
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault DeleteQueue contents
forall v. DeleteQueue v
emptyQueue key
key Map key (DeleteQueue contents)
fmMap
      (DeleteQueue contents
deleteQueue2,IO ()
invalidate) <-
         DeleteQueue contents
-> contents -> IO (DeleteQueue contents, IO ())
forall v. DeleteQueue v -> v -> IO (DeleteQueue v, IO ())
addQueue DeleteQueue contents
deleteQueue contents
contents
      let
         fmMap2 :: Map key (DeleteQueue contents)
fmMap2 = key
-> DeleteQueue contents
-> Map key (DeleteQueue contents)
-> Map key (DeleteQueue contents)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key DeleteQueue contents
deleteQueue2 Map key (DeleteQueue contents)
fmMap
         fmQueue2 :: FMQueue key contents
fmQueue2 = FMQueue key contents
fmQueue {dqMap :: Map key (DeleteQueue contents)
dqMap = Map key (DeleteQueue contents)
fmMap2}
      FMQueue key contents
fmQueue3 <- FMQueue key contents -> IO (FMQueue key contents)
forall key contents.
Ord key =>
FMQueue key contents -> IO (FMQueue key contents)
doClean FMQueue key contents
fmQueue2
      (FMQueue key contents, IO ()) -> IO (FMQueue key contents, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FMQueue key contents
fmQueue3,IO ()
invalidate)

removeFMQueue :: Ord key => FMQueue key contents -> key ->
   IO (Maybe (contents,FMQueue key contents),FMQueue key contents)
   -- The last returned item is the queue WITHOUT an item removed.
removeFMQueue :: FMQueue key contents
-> key
-> IO
     (Maybe (contents, FMQueue key contents), FMQueue key contents)
removeFMQueue FMQueue key contents
fmQueue key
key=
   do
      let fmMap :: Map key (DeleteQueue contents)
fmMap = FMQueue key contents -> Map key (DeleteQueue contents)
forall key contents.
Ord key =>
FMQueue key contents -> Map key (DeleteQueue contents)
dqMap FMQueue key contents
fmQueue
      case key
-> Map key (DeleteQueue contents) -> Maybe (DeleteQueue contents)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key (DeleteQueue contents)
fmMap of
         Maybe (DeleteQueue contents)
Nothing -> (Maybe (contents, FMQueue key contents), FMQueue key contents)
-> IO
     (Maybe (contents, FMQueue key contents), FMQueue key contents)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (contents, FMQueue key contents)
forall a. Maybe a
Nothing,FMQueue key contents
fmQueue)
         Just DeleteQueue contents
deleteQueue ->
            do
               Maybe (contents, DeleteQueue contents, DeleteQueue contents)
pop <- DeleteQueue contents
-> IO
     (Maybe (contents, DeleteQueue contents, DeleteQueue contents))
forall v.
DeleteQueue v -> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
removeQueue DeleteQueue contents
deleteQueue
               case Maybe (contents, DeleteQueue contents, DeleteQueue contents)
pop of
                  Maybe (contents, DeleteQueue contents, DeleteQueue contents)
Nothing ->
                     (Maybe (contents, FMQueue key contents), FMQueue key contents)
-> IO
     (Maybe (contents, FMQueue key contents), FMQueue key contents)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (contents, FMQueue key contents)
forall a. Maybe a
Nothing,FMQueue key contents
fmQueue {dqMap :: Map key (DeleteQueue contents)
dqMap = key
-> Map key (DeleteQueue contents) -> Map key (DeleteQueue contents)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete key
key Map key (DeleteQueue contents)
fmMap})
                  Just (contents
contents,DeleteQueue contents
deleteQueue2,DeleteQueue contents
deleteQueue0) ->
                     do
                        let updateQueue :: DeleteQueue contents -> FMQueue key contents
updateQueue DeleteQueue contents
queue =
                              FMQueue key contents
fmQueue {dqMap :: Map key (DeleteQueue contents)
dqMap = key
-> DeleteQueue contents
-> Map key (DeleteQueue contents)
-> Map key (DeleteQueue contents)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key DeleteQueue contents
queue Map key (DeleteQueue contents)
fmMap}
                        (Maybe (contents, FMQueue key contents), FMQueue key contents)
-> IO
     (Maybe (contents, FMQueue key contents), FMQueue key contents)
forall (m :: * -> *) a. Monad m => a -> m a
return ((contents, FMQueue key contents)
-> Maybe (contents, FMQueue key contents)
forall a. a -> Maybe a
Just (contents
contents,DeleteQueue contents -> FMQueue key contents
updateQueue DeleteQueue contents
deleteQueue2),
                           DeleteQueue contents -> FMQueue key contents
updateQueue DeleteQueue contents
deleteQueue0)

removeFMQueueAny :: Ord key => FMQueue key contents ->
   IO (Maybe (key,contents,FMQueue key contents),FMQueue key contents)
   -- Like removeFMQueue, but matches any key, and returns it.
removeFMQueueAny :: FMQueue key contents
-> IO
     (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
removeFMQueueAny FMQueue key contents
fmQueue =
   let
      keyContents :: [key]
keyContents = Map key (DeleteQueue contents) -> [key]
forall k a. Map k a -> [k]
Map.keys (FMQueue key contents -> Map key (DeleteQueue contents)
forall key contents.
Ord key =>
FMQueue key contents -> Map key (DeleteQueue contents)
dqMap FMQueue key contents
fmQueue)
   in
      FMQueue key contents
-> [key]
-> IO
     (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
forall key contents.
Ord key =>
FMQueue key contents
-> [key]
-> IO
     (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
doRemove FMQueue key contents
fmQueue [key]
keyContents
   where
      doRemove :: FMQueue key contents
-> [key]
-> IO
     (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
doRemove FMQueue key contents
fmQueue [] = (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
-> IO
     (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (key, contents, FMQueue key contents)
forall a. Maybe a
Nothing,FMQueue key contents
forall key contents. Ord key => FMQueue key contents
emptyFMQueue)
      doRemove FMQueue key contents
fmQueue (key
key:[key]
keys)  =
         do
            (Maybe (contents, FMQueue key contents), FMQueue key contents)
tryRemove <- FMQueue key contents
-> key
-> IO
     (Maybe (contents, FMQueue key contents), FMQueue key contents)
forall key contents.
Ord key =>
FMQueue key contents
-> key
-> IO
     (Maybe (contents, FMQueue key contents), FMQueue key contents)
removeFMQueue FMQueue key contents
fmQueue key
key
            case (Maybe (contents, FMQueue key contents), FMQueue key contents)
tryRemove of
               (Maybe (contents, FMQueue key contents)
Nothing,FMQueue key contents
fmQueue0) -> FMQueue key contents
-> [key]
-> IO
     (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
doRemove FMQueue key contents
fmQueue0 [key]
keys
               (Just (contents
contents,FMQueue key contents
fmQueue2),FMQueue key contents
fmQueue0) ->
                  (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
-> IO
     (Maybe (key, contents, FMQueue key contents), FMQueue key contents)
forall (m :: * -> *) a. Monad m => a -> m a
return ((key, contents, FMQueue key contents)
-> Maybe (key, contents, FMQueue key contents)
forall a. a -> Maybe a
Just(key
key,contents
contents,FMQueue key contents
fmQueue2),FMQueue key contents
fmQueue0)

doClean :: Ord key => FMQueue key contents -> IO (FMQueue key contents)
doClean :: FMQueue key contents -> IO (FMQueue key contents)
doClean FMQueue key contents
fmQueue =
   case FMQueue key contents -> [key]
forall key contents. Ord key => FMQueue key contents -> [key]
cleanList FMQueue key contents
fmQueue of
      [] ->
         FMQueue key contents -> IO (FMQueue key contents)
forall (m :: * -> *) a. Monad m => a -> m a
return (FMQueue key contents
fmQueue {cleanList :: [key]
cleanList = Map key (DeleteQueue contents) -> [key]
forall k a. Map k a -> [k]
Map.keys (FMQueue key contents -> Map key (DeleteQueue contents)
forall key contents.
Ord key =>
FMQueue key contents -> Map key (DeleteQueue contents)
dqMap FMQueue key contents
fmQueue)})
      key
toClean:[key]
nextCleanList ->
         do
            let fmMap :: Map key (DeleteQueue contents)
fmMap = FMQueue key contents -> Map key (DeleteQueue contents)
forall key contents.
Ord key =>
FMQueue key contents -> Map key (DeleteQueue contents)
dqMap FMQueue key contents
fmQueue
            Map key (DeleteQueue contents)
nextMap <- case key
-> Map key (DeleteQueue contents) -> Maybe (DeleteQueue contents)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
toClean Map key (DeleteQueue contents)
fmMap of
               Maybe (DeleteQueue contents)
Nothing -> Map key (DeleteQueue contents)
-> IO (Map key (DeleteQueue contents))
forall (m :: * -> *) a. Monad m => a -> m a
return Map key (DeleteQueue contents)
fmMap
               Just DeleteQueue contents
deleteQueue ->
                  do
                     Maybe (DeleteQueue contents)
isEmpty <- DeleteQueue contents -> IO (Maybe (DeleteQueue contents))
forall v. DeleteQueue v -> IO (Maybe (DeleteQueue v))
isEmptyQueue DeleteQueue contents
deleteQueue
                     case Maybe (DeleteQueue contents)
isEmpty of
                        Maybe (DeleteQueue contents)
Nothing -> Map key (DeleteQueue contents)
-> IO (Map key (DeleteQueue contents))
forall (m :: * -> *) a. Monad m => a -> m a
return (key
-> Map key (DeleteQueue contents) -> Map key (DeleteQueue contents)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete key
toClean Map key (DeleteQueue contents)
fmMap)
                        Just DeleteQueue contents
cleaned -> Map key (DeleteQueue contents)
-> IO (Map key (DeleteQueue contents))
forall (m :: * -> *) a. Monad m => a -> m a
return (key
-> DeleteQueue contents
-> Map key (DeleteQueue contents)
-> Map key (DeleteQueue contents)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
toClean DeleteQueue contents
cleaned Map key (DeleteQueue contents)
fmMap)
            FMQueue key contents -> IO (FMQueue key contents)
forall (m :: * -> *) a. Monad m => a -> m a
return (FMQueue :: forall key contents.
Map key (DeleteQueue contents) -> [key] -> FMQueue key contents
FMQueue {
               dqMap :: Map key (DeleteQueue contents)
dqMap = Map key (DeleteQueue contents)
nextMap,
               cleanList :: [key]
cleanList = [key]
nextCleanList
               })