# LANGUAGE CPP #
# LANGUAGE DeriveFoldable #
# LANGUAGE DeriveFunctor #
{-# LANGUAGE DeriveTraversable #-}
# LANGUAGE DeriveGeneric #
# LANGUAGE ScopedTypeVariables #
# LANGUAGE RecursiveDo #
# OPTIONS_GHC -Wall #

-- | Collection signals with incremental updates.
--
  The interface exposed by this module uses " Maplike " extensively . This
-- allows it to be used in the context of a wider variety of key
-- constrints, at the cost of requiring the caller to provide a "Proxy".
  This is pretty inconvenient , so it 's recommended that people use one of
-- the specialised modules:
--
-- - FRP.Euphoria.Collection.Enum
-- - FRP.Euphoria.Collection.Hashable
--
module FRP.Euphoria.Internal.GenericCollection
    ( CollectionUpdate (..)
    , Collection
    -- * creating collections
    , simpleCollection
    , accumCollection
    , collectionToUpdates
    , emptyCollection
    , collectionFromList
    , collectionFromDiscreteList
    , makeCollection
    , mapToCollection
    -- * observing collections
    , watchCollection
    , followCollectionKey
    , collectionToDiscreteList
    , openCollection
    -- * other functions
    , mapCollection
    , mapCollectionWithKey
    , filterCollection
    , filterCollectionWithKey
    , justCollection
    , mapCollectionM
    , sequenceCollection
    ) where

import Prelude hiding (lookup)

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>), (<$), pure)
import Data.Foldable (Foldable)
import Data.Monoid (mappend, mempty)
import Data.Traversable (Traversable, sequenceA)
#endif

import Control.Monad (join)
import Control.DeepSeq
import qualified Data.List as List
import Data.Maybe (mapMaybe)
import Data.Proxy (Proxy(..))

import FRP.Euphoria.Event
import qualified FRP.Euphoria.Internal.Maplike as M

import GHC.Generics

-- | Represents an incremental change to a collection of items.
data CollectionUpdate k a
    = AddItem k a
    | RemoveItem k
    deriving (Functor, Eq, Show, Foldable, Traversable, Generic)

instance (NFData k, NFData v) => NFData (CollectionUpdate k v)

-- | An FRP interface for representing an incrementally updated
-- collection of items. The items are identified by a unique key.
-- Items may be added or removed from the current collection.
--
-- This type is useful because it allows you to manage the incremental
-- state updates to something that needs a collection of items without
-- having to rebuild it completely every time the collection changes.
-- Consider the type Signal [a] -- functionally, it also represents a
-- collection of items that changes over time. However, there is no
-- state carried between changes. If, for example, we have a GUI
  widget that lists items whose content is represented as a Signal
-- [a], we would have to destroy and rebuild the widget's internal
-- state every time the list contents change. But with the Collection
-- type, we can add or remove from the GUI widget only the necessary
-- items. This is useful both from a performance (most existing GUI
-- toolkits exhibit worse performance when adding and removing all
-- items with every change) and behavior standpoint, because the GUI
-- toolkit can, for example, remember which items the user had
-- selected between list updates.
--
-- Usage of 'Collection' implies there could be some caching/state by
-- the consumer of the Events, otherwise one might as well use a
-- Signal [a].
newtype Collection k a = Collection {
  unCollection :: Discrete ([(k, a)], Event (CollectionUpdate k a))
  }

instance SignalSet (Collection k a) where
    basicSwitchD dis0 = do
        dis <- memoD dis0
        listD <- memoD $ join (fmap fst . unCollection <$> dis)
        listS <- discreteToSignal listD
        prevListS <- delayS [] listS

        chE <- dropStepE $ changesD dis
        (_, initialUpdatesE) <- openCollection =<< snapshotD dis
        updatesE <- generatorD' =<< stepperD (return initialUpdatesE)
            (updates <$> prevListS <*> listS <@> chE)

        makeCollection listD updatesE
        where
            updates prevList list (Collection newCol) = do
                rebuild <- flattenE <$> onCreation (map remove prevList ++ map add list)
                (_, newUpdates) <- snapshotD newCol
                memoE $ rebuild `mappend` newUpdates
            remove (k, _) = RemoveItem k
            add (k, v) = AddItem k v

    memoizeSignalSet (Collection dis)= Collection <$> memoD dis

-- | Like 'fmap', but the Collection and interior 'Event' stream are memoized
mapCollection :: MonadSignalGen m => (a -> b) -> Collection k a -> m (Collection k b)
mapCollection = mapCollectionWithKey . const

-- | @mapCollectionM p fn = mapCollection fn >=> sequenceCollection p@
mapCollectionM
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> (a -> SignalGen b) -> Collection k a -> m (Collection k b)
mapCollectionM p fn coll = do
    updatesE0 <- collectionToUpdates coll
    updatesE1 <- generatorE $ traverse fn <$> updatesE0
    updatesE2 <- memoE updatesE1
    accumCollection p updatesE2

-- | A version of 'mapCollection' which provides access to the key
mapCollectionWithKey
    :: MonadSignalGen m
    => (k -> a -> b) -> Collection k a -> m (Collection k b)
mapCollectionWithKey f aC = do
    updateE    <- snd <$> openCollection aC
    newCurD    <- memoD $ fmap (fmap ft . fst) $ unCollection aC
    newUpdateE <- memoE $ fmap fcu updateE
    makeCollection newCurD newUpdateE
  where
    -- f applied to tuples and collection updates
    ft (k, x)          = (k, f k x)
    fcu (AddItem k x)  = AddItem k (f k x)
    fcu (RemoveItem k) = RemoveItem k

filterCollection
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> (a -> Bool) -> Collection k a -> m (Collection k a)
filterCollection p =
    filterCollectionWithKey p . const

filterCollectionWithKey
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> (k -> a -> Bool) -> Collection k a -> m (Collection k a)
filterCollectionWithKey p f aC =
     justCollection p =<< mapCollectionWithKey f' aC
  where
    f' k v
        | f k v = Just v
        | otherwise = Nothing

justCollection
    :: forall m c k a. (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> Collection k (Maybe a) -> m (Collection k a)
-- Inefficient, quick-hack implementation
justCollection p c = do
    upds <- collectionToUpdates c
    let f :: CollectionUpdate k (Maybe a) -> c k () -> (c k (), Maybe (CollectionUpdate k a))
        f (AddItem k Nothing) m = (M.insert k () m, Nothing)
        f (AddItem k (Just a)) m = (m, Just (AddItem k a))
        f (RemoveItem k) m = case M.lookup k m of
            Just () -> (M.delete k m, Nothing)
            Nothing -> (m, Just (RemoveItem k))
    upds' <- scanAccumE M.empty (f <$> upds)
    accumCollection p =<< memoE (justE upds')

-- | Create an 'Event' stream of all updates from a collection, including
-- the items currently in it.
collectionToUpdates
    :: forall m k a. MonadSignalGen m
    => Collection k a
    -> m (Event (CollectionUpdate k a))
collectionToUpdates aC = do
    (cur,updateE) <- openCollection aC
    initE  <- onCreation (map (uncurry AddItem) cur)
    initE' <- memoE $ flattenE initE
    return (updateE `mappend` initE')

sequenceCollection
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> Collection k (SignalGen a)
    -> m (Collection k a)
sequenceCollection p coll =
    mapCollectionM p id coll

-- | A collection whose items are created by an event, and removed by
-- another event.
simpleCollection
    :: (M.Maplike c k, Enum k, MonadSignalGen m)
    => Proxy (c k)
    -> k                    -- ^ The initial value for the unique keys.
                            -- 'succ' will be used to get further keys.
  ^ An Event that introduces a new item and
                            -- its subsequent removal Event. The item will
                            -- be removed from the collection when the
                            -- Event () fires.
    -> m (Collection k a)
simpleCollection p initialK evs =
    simpleCollectionUpdates p initialK evs >>= accumCollection p

simpleCollectionUpdates
    :: forall m c k a. (M.Maplike c k, Enum k, MonadSignalGen m)
    => Proxy (c k)
    -> k
    -> Event (a, Event ())
    -> m (Event (CollectionUpdate k a))
simpleCollectionUpdates _ initialK evs = do
    let addKey (a, ev) k = (succ k, (k, a, ev))
    newEvents <- scanAccumE initialK (addKey <$> evs)
    let addItem (k, _a, ev) = M.insert k ev
    rec
        removalEvent' <- delayE removalEvent
        removalEvents <- accumD (M.empty :: c k (Event ()))
            ((addItem <$> newEvents) `mappend` (M.delete <$> removalEvent'))
        removalEvent <- switchD $ M.foldrWithKey
            (\k ev ev' -> (k <$ ev) `mappend` ev') mempty <$> removalEvents
    let updateAddItem :: (k, a, Event ()) -> CollectionUpdate k a
        updateAddItem (k, a, _) = AddItem k a
    memoE $ (updateAddItem <$> newEvents) `mappend` (RemoveItem <$> removalEvent)

-- Adds the necessary state for holding the existing [(k, a)] and creating
-- the unique Event stream for each change of the collection.
accumCollection
    :: forall m c k a. (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k)
    -> Event (CollectionUpdate k a)
    -> m (Collection k a)
accumCollection _ ev = do
    let toMapOp :: CollectionUpdate k a -> c k a -> c k a
        toMapOp (AddItem k a) = M.insert k a
        toMapOp (RemoveItem k) = M.delete k
    mapping <- accumD M.empty (toMapOp <$> ev)
    listD <- memoD $ M.toList <$> mapping
    makeCollection listD ev

  | The primitive interface for creating a ' Collection ' . The two
-- arguments must be coherent, i.e. the value of the discrete at
-- time /t+1/ should be obtained by applying the updates
-- at /t+1/ to the value of the discrete at /t/. This invariant
-- is not checked.
makeCollection
    :: MonadSignalGen m
    => Discrete [(k, a)]
    -> Event (CollectionUpdate k a)
    -> m (Collection k a)
makeCollection listD updE = Collection <$> generatorD (gen <$> listD)
    where
        gen list = do
            updE' <- dropStepE updE
            return (list, updE')

-- | Prints add/remove diagnostics for a Collection. Useful for debugging
watchCollection :: (Show k, Show a, MonadSignalGen m)
                => Collection k a -> m (Event (IO ()))
watchCollection (Collection coll) = do
    ev1 <- takeE 1 =<< preservesD coll
    now <- onCreation ()
    let f (items, ev) = ((putStrLn . showUpdate) <$> ev) `mappend`
            (mapM_ (putStrLn . showExisting) items <$ now)
        showUpdate (AddItem k a) = "Add: " ++ show k ++ ", " ++ show a
        showUpdate (RemoveItem k) = "Remove: " ++ show k
        showExisting (k, a) = "Existing: " ++ show k ++ ", " ++ show a
    switchD =<< stepperD mempty (f <$> ev1)

-- | An empty, unchanging Collection.
emptyCollection :: Collection k a
emptyCollection = collectionFromList []

-- | A pure function to create a Collection from key-value pairs. This
-- collection will never change.
collectionFromList :: [(k, a)] -> Collection k a
collectionFromList kvs = Collection $ pure (kvs, mempty)

-- | A somewhat inefficient but easy-to-use way of turning a list of
-- items into a Collection. Probably should only be used for temporary
-- hacks. Will perform badly with large lists.
collectionFromDiscreteList
    :: forall m c k a. (M.Maplike c k, Enum k, Eq a, MonadSignalGen m)
    => Proxy (c k)
    -> k
    -> Discrete [a]
    -> m (Collection k a)
collectionFromDiscreteList p initialK valsD = do
    valsE <- preservesD valsD
    evs <- scanAccumE (initialK, M.empty :: c k a) (stepListCollState <$> valsE)
    accumCollection p (flattenE evs)

-- This could obviously be implemented more efficiently.
stepListCollState
    :: (M.Maplike c k, Enum k, Eq a)
    => [a]
    -> (k, c k a)
    -> ((k, c k a), [CollectionUpdate k a])
stepListCollState xs (initialK, existingMap) =
    ((k', newMap'), removeUpdates ++ addUpdates)
  where
    keyvals = M.toList existingMap
    newItems = xs List.\\ map snd keyvals
    removedKeys = map fst $ List.deleteFirstsBy
        (\(_, x) (_, y) -> x == y)
        keyvals
        (map (\x -> (initialK, x)) xs)
    (newMap, removeUpdates) = foldl
        (\(em, upds) k -> (M.delete k em, upds ++ [RemoveItem k]))
        (existingMap, []) removedKeys
    (k', newMap', addUpdates) = foldl
        (\(k, em, upds) x -> (succ k, M.insert k x em, upds ++ [AddItem k x]))
        (initialK, newMap, []) newItems

-------------------------------------------------------------------------------
-- Converting Discrete Maps into Collections

data MapCollEvent k a
    = MCNew k a
    | MCChange k a
    | MCRemove k

  | Turns mapping of values into a collection of first - class FRP
  values that are updated . If items are added to the EnumMap , then
-- they will be added to the Collection. Likewise, if they are removed
-- from the mapping, they will be removed from the collection. Keys
-- that are present in both but have new values will have their
-- Discrete value updated, and keys with values that are still present
-- will not have their Discrete values updated.
mapToCollection
    :: forall c m k a. (Eq k, Eq a, M.Maplike c k, MonadSignalGen m)
    => Discrete (c k a)
    -> m (Collection k (Discrete a))
mapToCollection mapD = do
    m0 <- delayD M.empty mapD
    let diffsD = diffMaps <$> m0 <*> mapD
    diffsE <- flattenE <$> preservesD diffsD
    dispatchCollEvent (Proxy :: Proxy (c k)) diffsE

-- | Given a pair of generic maps, compute a sequence of "MapCollEvent"s
  which would transform the first into the second .
diffMaps
    :: (Eq a, M.Maplike c k)
    => c k a
    -> c k a
    -> [MapCollEvent k a]
diffMaps prevmap newmap = concat
    [ map (uncurry MCNew   ) newStuff
    , map (MCRemove . fst  ) removedStuff
    , map (uncurry MCChange) changedStuff
    ]
  where
    newStuff     = M.toList $ newmap `M.difference` prevmap
    removedStuff = M.toList $ prevmap `M.difference` newmap
    keptStuff    = M.toList $ newmap `M.intersection` prevmap
    changedStuff = mapMaybe justChanges keptStuff
    justChanges (k, v1) = case M.lookup k prevmap of
        Just v2 | v1 /= v2  -> Just (k, v1)
        _ -> Nothing

dispatchCollEvent
    :: (Eq k, M.Maplike c k, MonadSignalGen m)
    => Proxy (c k)
    -> Event (MapCollEvent k a)
    -> m (Collection k (Discrete a))
dispatchCollEvent p mapcollE = do
    let f (MCNew k a) = Just $
            AddItem k <$> discreteForKey k a mapcollE
        f (MCRemove k) = Just $ return $ RemoveItem k
        f (MCChange _ _) = Nothing
    updateEv <- generatorE $ justE (f <$> mapcollE)
    accumCollection p updateEv

discreteForKey :: (Eq k, MonadSignalGen m) => k -> a -> Event (MapCollEvent k a) -> m (Discrete a)
discreteForKey targetKey v0 mapcollE =
    stepperD v0 $ justE $ relevantValue <$> mapcollE
  where
    relevantValue collEvent = case collEvent of
        MCChange k v | k == targetKey -> Just v
        _ -> Nothing

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

-- | Look for a key in a collection, and give its (potentially
-- nonexistant) value over time.
followCollectionKey :: forall m k a. (Eq k, MonadSignalGen m)
                    => k
                    -> Collection k a
                    -> m (Discrete (Maybe a))
followCollectionKey k (Collection coll) = do
    collAsNow <- takeE 1 =<< preservesD coll
        :: m (Event ([(k, a)], Event (CollectionUpdate k a)))
    let existing :: Event (CollectionUpdate k a)
        existing = flattenE $ initialAdds . fst <$> collAsNow
        further :: Event (Event (CollectionUpdate k a))
        further  = snd <$> collAsNow
    further' <- switchD =<< stepperD mempty further
        :: m (Event (CollectionUpdate k a))
    accumMatchingItem (== k) (existing `mappend` further')

  Turn the existing items into AddItems for our state accumulation
initialAdds :: [(k, a)] -> [CollectionUpdate k a]
initialAdds = map (uncurry AddItem)

  Accumulate CollectionUpdates , and keep the newest value whose key
-- is True for the given function.
accumMatchingItem :: forall m k a. MonadSignalGen m =>
                  (k -> Bool)
                  -> Event (CollectionUpdate k a)
                  -> m (Discrete (Maybe a))
accumMatchingItem f updateE =
    stepperD Nothing $ justE (g <$> updateE)
  where
    g :: CollectionUpdate k a -> Maybe (Maybe a)
    g (AddItem k a)  | f k       = Just (Just a)
                     | otherwise = Nothing
    g (RemoveItem k) | f k       = Just Nothing
                     | otherwise = Nothing

-- | Extracts a 'Discrete' which represents the current state of
-- a collection.
collectionToDiscreteList :: Collection k a -> Discrete [(k, a)]
collectionToDiscreteList = fmap fst . unCollection

-- | Extracts a snapshot of the current values in a collection with
-- an 'Event' stream of further updates
openCollection :: MonadSignalGen m => Collection k a -> m ([(k,a)], Event (CollectionUpdate k a))
openCollection = snapshotD . unCollection

# LANGUAGE DeriveTraversable #
 | Collection signals with incremental updates.

 allows it to be used in the context of a wider variety of key
 constrints, at the cost of requiring the caller to provide a "Proxy".
 the specialised modules:

 - FRP.Euphoria.Collection.Enum
 - FRP.Euphoria.Collection.Hashable

 * creating collections
 * observing collections
 * other functions
 | Represents an incremental change to a collection of items.
 | An FRP interface for representing an incrementally updated
 collection of items. The items are identified by a unique key.
 Items may be added or removed from the current collection.

 This type is useful because it allows you to manage the incremental
 state updates to something that needs a collection of items without
 having to rebuild it completely every time the collection changes.
 Consider the type Signal [a] -- functionally, it also represents a
 collection of items that changes over time. However, there is no
 state carried between changes. If, for example, we have a GUI
 [a], we would have to destroy and rebuild the widget's internal
 state every time the list contents change. But with the Collection
 type, we can add or remove from the GUI widget only the necessary
 items. This is useful both from a performance (most existing GUI
 toolkits exhibit worse performance when adding and removing all
 items with every change) and behavior standpoint, because the GUI
 toolkit can, for example, remember which items the user had
 selected between list updates.

 Usage of 'Collection' implies there could be some caching/state by
 the consumer of the Events, otherwise one might as well use a
 Signal [a].
 | Like 'fmap', but the Collection and interior 'Event' stream are memoized
 | @mapCollectionM p fn = mapCollection fn >=> sequenceCollection p@
 | A version of 'mapCollection' which provides access to the key
 f applied to tuples and collection updates
 Inefficient, quick-hack implementation
 | Create an 'Event' stream of all updates from a collection, including
 the items currently in it.
 | A collection whose items are created by an event, and removed by
 another event.
 ^ The initial value for the unique keys.
 'succ' will be used to get further keys.
 its subsequent removal Event. The item will
 be removed from the collection when the
 Event () fires.
 Adds the necessary state for holding the existing [(k, a)] and creating
 the unique Event stream for each change of the collection.
 arguments must be coherent, i.e. the value of the discrete at
 time /t+1/ should be obtained by applying the updates
 at /t+1/ to the value of the discrete at /t/. This invariant
 is not checked.
 | Prints add/remove diagnostics for a Collection. Useful for debugging
 | An empty, unchanging Collection.
 | A pure function to create a Collection from key-value pairs. This
 collection will never change.
 | A somewhat inefficient but easy-to-use way of turning a list of
 items into a Collection. Probably should only be used for temporary
 hacks. Will perform badly with large lists.
 This could obviously be implemented more efficiently.
-----------------------------------------------------------------------------
 Converting Discrete Maps into Collections
 they will be added to the Collection. Likewise, if they are removed
 from the mapping, they will be removed from the collection. Keys
 that are present in both but have new values will have their
 Discrete value updated, and keys with values that are still present
 will not have their Discrete values updated.
 | Given a pair of generic maps, compute a sequence of "MapCollEvent"s
-----------------------------------------------------------------------------
 | Look for a key in a collection, and give its (potentially
 nonexistant) value over time.
 is True for the given function.
 | Extracts a 'Discrete' which represents the current state of
 a collection.
 | Extracts a snapshot of the current values in a collection with
 an 'Event' stream of further updates
# LANGUAGE CPP #
# LANGUAGE DeriveFoldable #
# LANGUAGE DeriveFunctor #
# LANGUAGE DeriveGeneric #
# LANGUAGE ScopedTypeVariables #
# LANGUAGE RecursiveDo #
# OPTIONS_GHC -Wall #

  The interface exposed by this module uses " Maplike " extensively . This
  This is pretty inconvenient , so it 's recommended that people use one of
module FRP.Euphoria.Internal.GenericCollection
    ( CollectionUpdate (..)
    , Collection
    , simpleCollection
    , accumCollection
    , collectionToUpdates
    , emptyCollection
    , collectionFromList
    , collectionFromDiscreteList
    , makeCollection
    , mapToCollection
    , watchCollection
    , followCollectionKey
    , collectionToDiscreteList
    , openCollection
    , mapCollection
    , mapCollectionWithKey
    , filterCollection
    , filterCollectionWithKey
    , justCollection
    , mapCollectionM
    , sequenceCollection
    ) where

import Prelude hiding (lookup)

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>), (<$), pure)
import Data.Foldable (Foldable)
import Data.Monoid (mappend, mempty)
import Data.Traversable (Traversable, sequenceA)
#endif

import Control.Monad (join)
import Control.DeepSeq
import qualified Data.List as List
import Data.Maybe (mapMaybe)
import Data.Proxy (Proxy(..))

import FRP.Euphoria.Event
import qualified FRP.Euphoria.Internal.Maplike as M

import GHC.Generics

data CollectionUpdate k a
    = AddItem k a
    | RemoveItem k
    deriving (Functor, Eq, Show, Foldable, Traversable, Generic)

instance (NFData k, NFData v) => NFData (CollectionUpdate k v)

  widget that lists items whose content is represented as a Signal
newtype Collection k a = Collection {
  unCollection :: Discrete ([(k, a)], Event (CollectionUpdate k a))
  }

instance SignalSet (Collection k a) where
    basicSwitchD dis0 = do
        dis <- memoD dis0
        listD <- memoD $ join (fmap fst . unCollection <$> dis)
        listS <- discreteToSignal listD
        prevListS <- delayS [] listS

        chE <- dropStepE $ changesD dis
        (_, initialUpdatesE) <- openCollection =<< snapshotD dis
        updatesE <- generatorD' =<< stepperD (return initialUpdatesE)
            (updates <$> prevListS <*> listS <@> chE)

        makeCollection listD updatesE
        where
            updates prevList list (Collection newCol) = do
                rebuild <- flattenE <$> onCreation (map remove prevList ++ map add list)
                (_, newUpdates) <- snapshotD newCol
                memoE $ rebuild `mappend` newUpdates
            remove (k, _) = RemoveItem k
            add (k, v) = AddItem k v

    memoizeSignalSet (Collection dis)= Collection <$> memoD dis

mapCollection :: MonadSignalGen m => (a -> b) -> Collection k a -> m (Collection k b)
mapCollection = mapCollectionWithKey . const

mapCollectionM
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> (a -> SignalGen b) -> Collection k a -> m (Collection k b)
mapCollectionM p fn coll = do
    updatesE0 <- collectionToUpdates coll
    updatesE1 <- generatorE $ traverse fn <$> updatesE0
    updatesE2 <- memoE updatesE1
    accumCollection p updatesE2

mapCollectionWithKey
    :: MonadSignalGen m
    => (k -> a -> b) -> Collection k a -> m (Collection k b)
mapCollectionWithKey f aC = do
    updateE    <- snd <$> openCollection aC
    newCurD    <- memoD $ fmap (fmap ft . fst) $ unCollection aC
    newUpdateE <- memoE $ fmap fcu updateE
    makeCollection newCurD newUpdateE
  where
    ft (k, x)          = (k, f k x)
    fcu (AddItem k x)  = AddItem k (f k x)
    fcu (RemoveItem k) = RemoveItem k

filterCollection
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> (a -> Bool) -> Collection k a -> m (Collection k a)
filterCollection p =
    filterCollectionWithKey p . const

filterCollectionWithKey
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> (k -> a -> Bool) -> Collection k a -> m (Collection k a)
filterCollectionWithKey p f aC =
     justCollection p =<< mapCollectionWithKey f' aC
  where
    f' k v
        | f k v = Just v
        | otherwise = Nothing

justCollection
    :: forall m c k a. (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> Collection k (Maybe a) -> m (Collection k a)
justCollection p c = do
    upds <- collectionToUpdates c
    let f :: CollectionUpdate k (Maybe a) -> c k () -> (c k (), Maybe (CollectionUpdate k a))
        f (AddItem k Nothing) m = (M.insert k () m, Nothing)
        f (AddItem k (Just a)) m = (m, Just (AddItem k a))
        f (RemoveItem k) m = case M.lookup k m of
            Just () -> (M.delete k m, Nothing)
            Nothing -> (m, Just (RemoveItem k))
    upds' <- scanAccumE M.empty (f <$> upds)
    accumCollection p =<< memoE (justE upds')

collectionToUpdates
    :: forall m k a. MonadSignalGen m
    => Collection k a
    -> m (Event (CollectionUpdate k a))
collectionToUpdates aC = do
    (cur,updateE) <- openCollection aC
    initE  <- onCreation (map (uncurry AddItem) cur)
    initE' <- memoE $ flattenE initE
    return (updateE `mappend` initE')

sequenceCollection
    :: (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k) -> Collection k (SignalGen a)
    -> m (Collection k a)
sequenceCollection p coll =
    mapCollectionM p id coll

simpleCollection
    :: (M.Maplike c k, Enum k, MonadSignalGen m)
    => Proxy (c k)
  ^ An Event that introduces a new item and
    -> m (Collection k a)
simpleCollection p initialK evs =
    simpleCollectionUpdates p initialK evs >>= accumCollection p

simpleCollectionUpdates
    :: forall m c k a. (M.Maplike c k, Enum k, MonadSignalGen m)
    => Proxy (c k)
    -> k
    -> Event (a, Event ())
    -> m (Event (CollectionUpdate k a))
simpleCollectionUpdates _ initialK evs = do
    let addKey (a, ev) k = (succ k, (k, a, ev))
    newEvents <- scanAccumE initialK (addKey <$> evs)
    let addItem (k, _a, ev) = M.insert k ev
    rec
        removalEvent' <- delayE removalEvent
        removalEvents <- accumD (M.empty :: c k (Event ()))
            ((addItem <$> newEvents) `mappend` (M.delete <$> removalEvent'))
        removalEvent <- switchD $ M.foldrWithKey
            (\k ev ev' -> (k <$ ev) `mappend` ev') mempty <$> removalEvents
    let updateAddItem :: (k, a, Event ()) -> CollectionUpdate k a
        updateAddItem (k, a, _) = AddItem k a
    memoE $ (updateAddItem <$> newEvents) `mappend` (RemoveItem <$> removalEvent)

accumCollection
    :: forall m c k a. (M.Maplike c k, MonadSignalGen m)
    => Proxy (c k)
    -> Event (CollectionUpdate k a)
    -> m (Collection k a)
accumCollection _ ev = do
    let toMapOp :: CollectionUpdate k a -> c k a -> c k a
        toMapOp (AddItem k a) = M.insert k a
        toMapOp (RemoveItem k) = M.delete k
    mapping <- accumD M.empty (toMapOp <$> ev)
    listD <- memoD $ M.toList <$> mapping
    makeCollection listD ev

  | The primitive interface for creating a ' Collection ' . The two
makeCollection
    :: MonadSignalGen m
    => Discrete [(k, a)]
    -> Event (CollectionUpdate k a)
    -> m (Collection k a)
makeCollection listD updE = Collection <$> generatorD (gen <$> listD)
    where
        gen list = do
            updE' <- dropStepE updE
            return (list, updE')

watchCollection :: (Show k, Show a, MonadSignalGen m)
                => Collection k a -> m (Event (IO ()))
watchCollection (Collection coll) = do
    ev1 <- takeE 1 =<< preservesD coll
    now <- onCreation ()
    let f (items, ev) = ((putStrLn . showUpdate) <$> ev) `mappend`
            (mapM_ (putStrLn . showExisting) items <$ now)
        showUpdate (AddItem k a) = "Add: " ++ show k ++ ", " ++ show a
        showUpdate (RemoveItem k) = "Remove: " ++ show k
        showExisting (k, a) = "Existing: " ++ show k ++ ", " ++ show a
    switchD =<< stepperD mempty (f <$> ev1)

emptyCollection :: Collection k a
emptyCollection = collectionFromList []

collectionFromList :: [(k, a)] -> Collection k a
collectionFromList kvs = Collection $ pure (kvs, mempty)

collectionFromDiscreteList
    :: forall m c k a. (M.Maplike c k, Enum k, Eq a, MonadSignalGen m)
    => Proxy (c k)
    -> k
    -> Discrete [a]
    -> m (Collection k a)
collectionFromDiscreteList p initialK valsD = do
    valsE <- preservesD valsD
    evs <- scanAccumE (initialK, M.empty :: c k a) (stepListCollState <$> valsE)
    accumCollection p (flattenE evs)

stepListCollState
    :: (M.Maplike c k, Enum k, Eq a)
    => [a]
    -> (k, c k a)
    -> ((k, c k a), [CollectionUpdate k a])
stepListCollState xs (initialK, existingMap) =
    ((k', newMap'), removeUpdates ++ addUpdates)
  where
    keyvals = M.toList existingMap
    newItems = xs List.\\ map snd keyvals
    removedKeys = map fst $ List.deleteFirstsBy
        (\(_, x) (_, y) -> x == y)
        keyvals
        (map (\x -> (initialK, x)) xs)
    (newMap, removeUpdates) = foldl
        (\(em, upds) k -> (M.delete k em, upds ++ [RemoveItem k]))
        (existingMap, []) removedKeys
    (k', newMap', addUpdates) = foldl
        (\(k, em, upds) x -> (succ k, M.insert k x em, upds ++ [AddItem k x]))
        (initialK, newMap, []) newItems


data MapCollEvent k a
    = MCNew k a
    | MCChange k a
    | MCRemove k

  | Turns mapping of values into a collection of first - class FRP
  values that are updated . If items are added to the EnumMap , then
mapToCollection
    :: forall c m k a. (Eq k, Eq a, M.Maplike c k, MonadSignalGen m)
    => Discrete (c k a)
    -> m (Collection k (Discrete a))
mapToCollection mapD = do
    m0 <- delayD M.empty mapD
    let diffsD = diffMaps <$> m0 <*> mapD
    diffsE <- flattenE <$> preservesD diffsD
    dispatchCollEvent (Proxy :: Proxy (c k)) diffsE

  which would transform the first into the second .
diffMaps
    :: (Eq a, M.Maplike c k)
    => c k a
    -> c k a
    -> [MapCollEvent k a]
diffMaps prevmap newmap = concat
    [ map (uncurry MCNew   ) newStuff
    , map (MCRemove . fst  ) removedStuff
    , map (uncurry MCChange) changedStuff
    ]
  where
    newStuff     = M.toList $ newmap `M.difference` prevmap
    removedStuff = M.toList $ prevmap `M.difference` newmap
    keptStuff    = M.toList $ newmap `M.intersection` prevmap
    changedStuff = mapMaybe justChanges keptStuff
    justChanges (k, v1) = case M.lookup k prevmap of
        Just v2 | v1 /= v2  -> Just (k, v1)
        _ -> Nothing

dispatchCollEvent
    :: (Eq k, M.Maplike c k, MonadSignalGen m)
    => Proxy (c k)
    -> Event (MapCollEvent k a)
    -> m (Collection k (Discrete a))
dispatchCollEvent p mapcollE = do
    let f (MCNew k a) = Just $
            AddItem k <$> discreteForKey k a mapcollE
        f (MCRemove k) = Just $ return $ RemoveItem k
        f (MCChange _ _) = Nothing
    updateEv <- generatorE $ justE (f <$> mapcollE)
    accumCollection p updateEv

discreteForKey :: (Eq k, MonadSignalGen m) => k -> a -> Event (MapCollEvent k a) -> m (Discrete a)
discreteForKey targetKey v0 mapcollE =
    stepperD v0 $ justE $ relevantValue <$> mapcollE
  where
    relevantValue collEvent = case collEvent of
        MCChange k v | k == targetKey -> Just v
        _ -> Nothing


followCollectionKey :: forall m k a. (Eq k, MonadSignalGen m)
                    => k
                    -> Collection k a
                    -> m (Discrete (Maybe a))
followCollectionKey k (Collection coll) = do
    collAsNow <- takeE 1 =<< preservesD coll
        :: m (Event ([(k, a)], Event (CollectionUpdate k a)))
    let existing :: Event (CollectionUpdate k a)
        existing = flattenE $ initialAdds . fst <$> collAsNow
        further :: Event (Event (CollectionUpdate k a))
        further  = snd <$> collAsNow
    further' <- switchD =<< stepperD mempty further
        :: m (Event (CollectionUpdate k a))
    accumMatchingItem (== k) (existing `mappend` further')

  Turn the existing items into AddItems for our state accumulation
initialAdds :: [(k, a)] -> [CollectionUpdate k a]
initialAdds = map (uncurry AddItem)

  Accumulate CollectionUpdates , and keep the newest value whose key
accumMatchingItem :: forall m k a. MonadSignalGen m =>
                  (k -> Bool)
                  -> Event (CollectionUpdate k a)
                  -> m (Discrete (Maybe a))
accumMatchingItem f updateE =
    stepperD Nothing $ justE (g <$> updateE)
  where
    g :: CollectionUpdate k a -> Maybe (Maybe a)
    g (AddItem k a)  | f k       = Just (Just a)
                     | otherwise = Nothing
    g (RemoveItem k) | f k       = Just Nothing
                     | otherwise = Nothing

collectionToDiscreteList :: Collection k a -> Discrete [(k, a)]
collectionToDiscreteList = fmap fst . unCollection

openCollection :: MonadSignalGen m => Collection k a -> m ([(k,a)], Event (CollectionUpdate k a))
openCollection = snapshotD . unCollection
