{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | This implements a SinkSource with keyed changes.
module Util.KeyedChanges(
   KeyedChanges,

   -- The idea is to keep track of changes to which a key is attached.
   -- When a new sink is attached, only the most recent changes for each
   -- key are returned.

   -- Producer's interface
   newKeyedChanges,
      -- :: Ord key => IO (KeyedChanges key delta)
   sendKeyedChanges,
      -- :: Ord key => key -> delta -> KeyedChanges key delta -> IO ()

   -- Used for sending changes which restore the situation to its default.
   -- If there is no entry for the key, nothing is done.  Otherwise the
   -- given delta is sent, and the entry is deleted.
   deleteKeyedChange,
      -- :: Ord key => key -> delta -> KeyedChanges key delta -> IO ()

   -- Consumer's interface
   -- instance Ord key => HasSource (KeyedChanges key delta) [delta] delta
   ) where

import qualified Data.Map as Map

import Util.Sources
import Util.Broadcaster

newtype KeyedChanges key delta
   = KeyedChanges (Broadcaster (Map.Map key delta) delta)

-- ------------------------------------------------------------------------
-- Producer's interface
-- ------------------------------------------------------------------------

newKeyedChanges :: Ord key => IO (KeyedChanges key delta)
newKeyedChanges :: IO (KeyedChanges key delta)
newKeyedChanges =
   do
      Broadcaster (Map key delta) delta
broadcaster <- Map key delta -> IO (Broadcaster (Map key delta) delta)
forall x d. x -> IO (Broadcaster x d)
newBroadcaster Map key delta
forall k a. Map k a
Map.empty
      KeyedChanges key delta -> IO (KeyedChanges key delta)
forall (m :: * -> *) a. Monad m => a -> m a
return (Broadcaster (Map key delta) delta -> KeyedChanges key delta
forall key delta.
Broadcaster (Map key delta) delta -> KeyedChanges key delta
KeyedChanges Broadcaster (Map key delta) delta
broadcaster)

sendKeyedChanges :: Ord key => key -> delta -> KeyedChanges key delta -> IO ()
sendKeyedChanges :: key -> delta -> KeyedChanges key delta -> IO ()
sendKeyedChanges key
key delta
delta (KeyedChanges Broadcaster (Map key delta) delta
broadcaster) =
   Broadcaster (Map key delta) delta
-> (Map key delta -> (Map key delta, [delta])) -> IO ()
forall x d. Broadcaster x d -> (x -> (x, [d])) -> IO ()
applyUpdate Broadcaster (Map key delta) delta
broadcaster (\ Map key delta
map -> (key -> delta -> Map key delta -> Map key delta
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key delta
delta Map key delta
map,[delta
delta]))

deleteKeyedChange :: Ord key => key -> delta -> KeyedChanges key delta -> IO ()
deleteKeyedChange :: key -> delta -> KeyedChanges key delta -> IO ()
deleteKeyedChange key
key delta
delta (KeyedChanges Broadcaster (Map key delta) delta
broadcaster) =
   Broadcaster (Map key delta) delta
-> (Map key delta -> (Map key delta, [delta])) -> IO ()
forall x d. Broadcaster x d -> (x -> (x, [d])) -> IO ()
applyUpdate Broadcaster (Map key delta) delta
broadcaster (\ Map key delta
map -> case key -> Map key delta -> Maybe delta
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key delta
map of
      Maybe delta
Nothing -> (Map key delta
map,[])
      Just delta
_ -> (key -> Map key delta -> Map key delta
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete key
key Map key delta
map,[delta
delta])
      )

-- ------------------------------------------------------------------------
-- Consumer's interface
-- ------------------------------------------------------------------------

instance Ord key => HasSource (KeyedChanges key delta) [delta] delta where
   toSource :: KeyedChanges key delta -> Source [delta] delta
toSource (KeyedChanges Broadcaster (Map key delta) delta
broadcaster) = (Map key delta -> [delta])
-> Source (Map key delta) delta -> Source [delta] delta
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 Map key delta -> [delta]
forall k a. Map k a -> [a]
Map.elems (Broadcaster (Map key delta) delta -> Source (Map key delta) delta
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource Broadcaster (Map key delta) delta
broadcaster)