euphoria 0.6.0.1 → 0.8.0.0

raw patch · 22 files changed

+1688/−484 lines, 22 filesdep +criteriondep −data-defaultdep ~basedep ~elereadep ~enummapset-thPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

Dependencies removed: data-default

Dependency ranges changed: base, elerea, enummapset-th, unordered-containers

API changes (from Hackage documentation)

Files

• FRP/Elerea/Simple/Compat.hs +11/−0
• FRP/Euphoria/Collection.hs +15/−420
• FRP/Euphoria/EnumCollection/Lazy.hs +109/−0
• FRP/Euphoria/EnumCollection/Strict.hs +109/−0
• FRP/Euphoria/Event.hs +5/−13
• FRP/Euphoria/HashCollection/Lazy.hs +109/−0
• FRP/Euphoria/HashCollection/Strict.hs +109/−0
• FRP/Euphoria/Internal/GenericCollection.hs +442/−0
• FRP/Euphoria/Internal/Maplike.hs +81/−31
• FRP/Euphoria/Update.hs +1/−0
• benchmarks/FRP/Euphoria/EnumCollection/Lazy/Bench.hs +92/−0
• benchmarks/FRP/Euphoria/EnumCollection/Strict/Bench.hs +92/−0
• benchmarks/FRP/Euphoria/HashCollection/Lazy/Bench.hs +92/−0
• benchmarks/FRP/Euphoria/HashCollection/Strict/Bench.hs +92/−0
• benchmarks/Main.hs +16/−0
• euphoria.cabal +38/−6
• tests/FRP/Euphoria/EnumCollection/Lazy/Test.hs +50/−0
• tests/FRP/Euphoria/Event/Test.hs +61/−0
• tests/FRP/Euphoria/HashCollection/Strict/Test.hs +50/−0
• tests/FRP/Euphoria/Update/Test.hs +98/−0
• tests/Main.hs +16/−0
• tests/Tests.hs +0/−14

@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}+module FRP.Elerea.Simple.Compat+    ( module FRP.Elerea.Simple+    , module FRP.Elerea.Simple.Compat+    ) where+import FRP.Elerea.Simple++#if !MIN_VERSION_elerea(2, 9, 0)+till :: Signal Bool -> SignalGen (Signal Bool)+till = FRP.Elerea.Simple.until+#endif

@@ -1,440 +1,35 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE RecursiveDo #-}-{-# OPTIONS_GHC -Wall #-} ---- | Collection signals with incremental updates.+-- | A re-export of FRP.Euphoria.Collection.Enum for API compatability.+-- `Collection.Enum.mapToCollection` is renamed to `enummapToCollection`,+-- and `Collection.Hashable.mapToCollection` is exported as+-- `hashmapToCollection`. module FRP.Euphoria.Collection-( CollectionUpdate (..)-, Collection--- * creating collections-, simpleCollection-, accumCollection-, collectionToUpdates-, emptyCollection-, collectionFromList-, collectionFromDiscreteList-, makeCollection-, mapToCollection-, enummapToCollection-, hashmapToCollection--- * observing collections-, watchCollection-, followCollectionKey-, collectionToDiscreteList-, openCollection--- * other functions-, mapCollection-, mapCollectionWithKey-, filterCollection-, filterCollectionWithKey-, justCollection-, 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+    ( module FRP.Euphoria.EnumCollection.Lazy+    , enummapToCollection+    , hashmapToCollection+    ) where -import Control.Monad (join) import Data.EnumMap.Lazy (EnumMap)-import qualified Data.EnumMap.Lazy as EnumMap-import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap)-import Data.List hiding (insert, lookup)-import Data.Map (Map)-import Data.Maybe (mapMaybe)-import Data.Proxy (Proxy(..))--import FRP.Euphoria.Event-import qualified FRP.Euphoria.Internal.Maplike as M----- | Represents an incremental change to a collection of items.-data CollectionUpdate k a-    = AddItem k a-    | RemoveItem k-    deriving (Functor, Eq, Show, Foldable, Traversable)---- | 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---- | 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 :: (Enum k, MonadSignalGen m) => (a -> Bool) -> Collection k a -> m (Collection k a)-filterCollection = filterCollectionWithKey . const--filterCollectionWithKey :: forall m k a. (Enum k, MonadSignalGen m) => (k -> a -> Bool) -> Collection k a -> m (Collection k a)-filterCollectionWithKey f aC = mapCollectionWithKey f' aC >>= justCollection where-    f' k v-        | f k v = Just v-        | otherwise = Nothing--justCollection :: forall m k a. (Enum k, MonadSignalGen m) => Collection k (Maybe a) -> m (Collection k a)--- Inefficient, quick-hack implementation-justCollection c = do-    upds <- collectionToUpdates c-    let f :: CollectionUpdate k (Maybe a) -> EnumMap k () -> (EnumMap k (), Maybe (CollectionUpdate k a))-        f (AddItem k Nothing) m = (EnumMap.insert k () m, Nothing)-        f (AddItem k (Just a)) m = (m, Just (AddItem k a))-        f (RemoveItem k) m = case EnumMap.lookup k m of-            Just () -> (EnumMap.delete k m, Nothing)-            Nothing -> (m, Just (RemoveItem k))-    upds' <- scanAccumE EnumMap.empty (f <$> upds)-    accumCollection =<< 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-    :: (Enum k, MonadSignalGen m)-    => Collection k (SignalGen a)-    -> m (Collection k a)-sequenceCollection col = collectionToUpdates col-  >>= generatorE . fmap sequenceA-  >>= accumCollection---- | A collection whose items are created by an event, and removed by--- another event.-simpleCollection :: (Enum k, MonadSignalGen m)-                 => k-                 -- ^ The initial value for the unique keys. 'succ'-                 -- will be used to get further keys.-                 -> Event (a, Event ())-                 -- ^ 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 initialK evs =-    simpleCollectionUpdates initialK evs >>= accumCollection--simpleCollectionUpdates :: (Enum k, MonadSignalGen m) => 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) = EnumMap.insert k ev-    rec-        removalEvent' <- delayE removalEvent-        removalEvents <- accumD EnumMap.empty-            ((addItem <$> newEvents) `mappend` (EnumMap.delete <$> removalEvent'))-        removalEvent <- switchD $ EnumMap.foldrWithKey-            (\k ev ev' -> (k <$ ev) `mappend` ev') mempty <$> removalEvents-    let -- updateAddItem :: (Enum k) => (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-    :: (Enum k, MonadSignalGen m)-    => Event (CollectionUpdate k a)-    -> m (Collection k a)-accumCollection =-    genericAccumCollection (Proxy :: Proxy (EnumMap k))---- | Like "accumCollection", but uses any "Maplike" to maintain the--- internal state. This allows the user accumulate collections in the--- context of a wider variety of key constrints. The caller must specify--- the desired underyling "Maplike" type by providing a "Proxy".-genericAccumCollection-    :: forall m c k a. (M.Maplike c k, MonadSignalGen m)-    => Proxy (c k)-    -> Event (CollectionUpdate k a)-    -> m (Collection k a)-genericAccumCollection _ 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-    :: (Enum k, Eq a, MonadSignalGen m)-    => k-    -> Discrete [a]-    -> m (Collection k a)-collectionFromDiscreteList initialK valsD = do-    valsE <- preservesD valsD-    evs <- scanAccumE (initialK, EnumMap.empty) (stepListCollState <$> valsE)-    accumCollection (flattenE evs)+import Data.Hashable (Hashable) --- This could obviously be implemented more efficiently.-stepListCollState :: (Enum k, Eq a) => [a]-                  -> (k, EnumMap k a)-                  -> ((k, EnumMap k a), [CollectionUpdate k a])-stepListCollState xs (initialK, existingMap) = ((k', newMap'), removeUpdates ++ addUpdates)-  where-    keyvals = EnumMap.toList existingMap-    newItems = xs \\ map snd keyvals-    removedKeys = map fst $ deleteFirstsBy-        (\(_, x) (_, y) -> x == y)-        keyvals-        (map (\x -> (initialK, x)) xs)-    (newMap, removeUpdates) = foldl-        (\(em, upds) k -> (EnumMap.delete k em, upds ++ [RemoveItem k]))-        (existingMap, []) removedKeys-    (k', newMap', addUpdates) = foldl-        (\(k, em, upds) x -> (succ k, EnumMap.insert k x em, upds ++ [AddItem k x]))-        (initialK, newMap, []) newItems+import FRP.Euphoria.EnumCollection.Lazy hiding (mapToCollection) ----------------------------------------------------------------------------------- Converting Discrete Maps into Collections+import qualified FRP.Euphoria.EnumCollection.Lazy   as Enum+import qualified FRP.Euphoria.HashCollection.Strict as Hashable -mapToCollection-    :: (Eq k, Eq a, Ord k, MonadSignalGen m)-    => Discrete (Map k a)-    -> m (Collection k (Discrete a))-mapToCollection = genericMapToCollection+import FRP.Euphoria.Event  enummapToCollection     :: (Eq k, Eq a, Enum k, MonadSignalGen m)     => Discrete (EnumMap k a)     -> m (Collection k (Discrete a))-enummapToCollection = genericMapToCollection+enummapToCollection = Enum.mapToCollection  hashmapToCollection     :: (Eq k, Eq a, Hashable k, MonadSignalGen m)     => Discrete (HashMap k a)     -> m (Collection k (Discrete a))-hashmapToCollection = genericMapToCollection+hashmapToCollection = Hashable.mapToCollection --- Generic implementation--------------------------- -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.-genericMapToCollection-    :: forall c m k a. (Eq k, Eq a, M.Maplike c k, MonadSignalGen m)-    => Discrete (c k a)-    -> m (Collection k (Discrete a))-genericMapToCollection 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 mapProxy 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)-    genericAccumCollection mapProxy 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

@@ -0,0 +1,109 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall #-}++-- | FRP.Euphoria.Internal.GenericCollection, with an interface specialised for+-- "Enum" keys.+module FRP.Euphoria.EnumCollection.Lazy+    ( 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 Data.EnumMap.Lazy (EnumMap)+import Data.Proxy (Proxy(..))++import FRP.Euphoria.Event+import qualified FRP.Euphoria.Internal.GenericCollection as Gen+import FRP.Euphoria.Internal.GenericCollection hiding (filterCollection+        , filterCollectionWithKey, justCollection, sequenceCollection+        , accumCollection, mapToCollection, simpleCollection+        , collectionFromDiscreteList, mapCollectionM)+import FRP.Euphoria.Internal.Maplike++filterCollection+    :: (Enum k, MonadSignalGen m)+    => (a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollection =+    Gen.filterCollection (Proxy :: Proxy (Lazy EnumMap k))++filterCollectionWithKey+    :: (Enum k, MonadSignalGen m)+    => (k -> a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollectionWithKey =+    Gen.filterCollectionWithKey (Proxy :: Proxy (Lazy EnumMap k))++justCollection+    :: (Enum k, MonadSignalGen m)+    => Collection k (Maybe a)+    -> m (Collection k a)+justCollection =+    Gen.justCollection (Proxy :: Proxy (Lazy EnumMap k))++mapCollectionM+    :: (Enum k, MonadSignalGen m)+    => (a -> SignalGen b) -> Collection k a -> m (Collection k b)+mapCollectionM = Gen.mapCollectionM (Proxy :: Proxy (Lazy EnumMap k))++sequenceCollection+    :: (Enum k, MonadSignalGen m)+    => Collection k (SignalGen a)+    -> m (Collection k a)+sequenceCollection =+    Gen.sequenceCollection (Proxy :: Proxy (Lazy EnumMap k))++-- Adds the necessary state for holding the existing [(k, a)] and creating+-- the unique Event stream for each change of the collection.+accumCollection+    :: (Enum k, MonadSignalGen m)+    => Event (CollectionUpdate k a)+    -> m (Collection k a)+accumCollection =+    Gen.accumCollection (Proxy :: Proxy (Lazy EnumMap k))++mapToCollection+    :: (Eq k, Eq a, Enum k, MonadSignalGen m)+    => Discrete (EnumMap k a)+    -> m (Collection k (Discrete a))+mapToCollection xsD =+    Gen.mapToCollection (Lazy <$> xsD)++simpleCollection+    :: (Enum k, MonadSignalGen m)+    => k+    -> Event (a, Event ())+    -> m (Collection k a)+simpleCollection =+    Gen.simpleCollection (Proxy :: Proxy (Lazy EnumMap k))++collectionFromDiscreteList+    :: (Enum k, Eq a, MonadSignalGen m)+    => k+    -> Discrete [a]+    -> m (Collection k a)+collectionFromDiscreteList =+    Gen.collectionFromDiscreteList (Proxy :: Proxy (Lazy EnumMap k))

@@ -0,0 +1,109 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall #-}++-- | FRP.Euphoria.Internal.GenericCollection, with an interface specialised for+-- "Enum" keys.+module FRP.Euphoria.EnumCollection.Strict+    ( 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 Data.EnumMap.Strict (EnumMap)+import Data.Proxy (Proxy(..))++import FRP.Euphoria.Event+import qualified FRP.Euphoria.Internal.GenericCollection as Gen+import FRP.Euphoria.Internal.GenericCollection hiding (filterCollection+        , filterCollectionWithKey, justCollection, sequenceCollection+        , accumCollection, mapToCollection, simpleCollection+        , collectionFromDiscreteList, mapCollectionM)+import FRP.Euphoria.Internal.Maplike++filterCollection+    :: (Enum k, MonadSignalGen m)+    => (a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollection =+    Gen.filterCollection (Proxy :: Proxy (Strict EnumMap k))++filterCollectionWithKey+    :: (Enum k, MonadSignalGen m)+    => (k -> a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollectionWithKey =+    Gen.filterCollectionWithKey (Proxy :: Proxy (Strict EnumMap k))++justCollection+    :: (Enum k, MonadSignalGen m)+    => Collection k (Maybe a)+    -> m (Collection k a)+justCollection =+    Gen.justCollection (Proxy :: Proxy (Strict EnumMap k))++mapCollectionM+    :: (Enum k, MonadSignalGen m)+    => (a -> SignalGen b) -> Collection k a -> m (Collection k b)+mapCollectionM = Gen.mapCollectionM (Proxy :: Proxy (Strict EnumMap k))++sequenceCollection+    :: (Enum k, MonadSignalGen m)+    => Collection k (SignalGen a)+    -> m (Collection k a)+sequenceCollection =+    Gen.sequenceCollection (Proxy :: Proxy (Strict EnumMap k))++-- Adds the necessary state for holding the existing [(k, a)] and creating+-- the unique Event stream for each change of the collection.+accumCollection+    :: (Enum k, MonadSignalGen m)+    => Event (CollectionUpdate k a)+    -> m (Collection k a)+accumCollection =+    Gen.accumCollection (Proxy :: Proxy (Strict EnumMap k))++mapToCollection+    :: (Eq k, Eq a, Enum k, MonadSignalGen m)+    => Discrete (EnumMap k a)+    -> m (Collection k (Discrete a))+mapToCollection xsD =+    Gen.mapToCollection (Strict <$> xsD)++simpleCollection+    :: (Enum k, MonadSignalGen m)+    => k+    -> Event (a, Event ())+    -> m (Collection k a)+simpleCollection =+    Gen.simpleCollection (Proxy :: Proxy (Strict EnumMap k))++collectionFromDiscreteList+    :: (Enum k, Eq a, MonadSignalGen m)+    => k+    -> Discrete [a]+    -> m (Collection k a)+collectionFromDiscreteList =+    Gen.collectionFromDiscreteList (Proxy :: Proxy (Strict EnumMap k))

@@ -71,7 +71,6 @@  -- ** Accumulation , stepperD-, stepperDefD , stepperMaybeD , justD , accumD@@ -126,7 +125,6 @@ import Control.Monad (join, replicateM) import Control.Monad.Fix import Control.Monad.IO.Class-import Data.Default import Data.Either (partitionEithers, lefts, rights) import Data.List (foldl') import Data.Monoid@@ -134,7 +132,7 @@ import Data.Typeable import Debug.Trace import FRP.Euphoria.Signal-import FRP.Elerea.Simple (externalMulti, effectful1, until, stateful)+import FRP.Elerea.Simple.Compat (externalMulti, effectful1, till, stateful) import Prelude hiding (until)  -- | @Event a@ represents a stream of events whose occurrences carry@@ -400,7 +398,7 @@   -> m (Event a) generalPrefixE prefixTaker (Event evt) = do     rec-        done <- liftSignalGen $ until $ not . fst <$> active_occs+        done <- liftSignalGen $ till $ not . fst <$> active_occs         prevDone <- delayS False done         eventSource <- transferS evt upd prevDone         active_occs <- prefixTaker (join eventSource)@@ -516,14 +514,10 @@     upd [] (_, old) = (False, old)     upd occs _ = (True, last occs) --- | Use a 'Default' instance to supply the initial value.-stepperDefD :: (Default a, MonadSignalGen m) => Event a -> m (Discrete a)-stepperDefD = stepperD def- -- | Use 'Nothing' to supply the initial value, and wrap the returned -- type in 'Maybe'. stepperMaybeD :: MonadSignalGen m => Event a -> m (Discrete (Maybe a))-stepperMaybeD ev = stepperDefD (Just <$> ev)+stepperMaybeD ev = stepperD Nothing (Just <$> ev)  -- | Given an initial value, filter out the Nothings. justD :: MonadSignalGen m => a -> Discrete (Maybe a) -> m (Discrete a)@@ -631,11 +625,9 @@ freezeD :: MonadSignalGen m => Event () -> Discrete a -> m (Discrete a) freezeD evt dis = do     dis' <- memoD dis-    now <- onCreation ()     sig <- discreteToSignal dis'-    initialization <- takeE 1 $ const <$> sig <@> now-    filteredChanges <- switchD =<< stepperD (changesD dis') (mempty <$ evt)-    stepperD (error "freezeD: not initialized") $ initialization `mappend` filteredChanges+    evt1 <- takeE 1 evt+    switchD =<< stepperD dis' (pure <$> sig <@ evt1)  -- | Convert a 'Signal' to an equivalent 'Discrete'. The resulting discrete -- is always considered to \'possibly have changed\'.

@@ -0,0 +1,109 @@+{-# OPTIONS_GHC -Wall #-}++-- | FRP.Euphoria.Internal.GenericCollection, with an interface specialised for+-- "Hashable" keys.+module FRP.Euphoria.HashCollection.Lazy+    ( 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 Data.Hashable (Hashable)+import Data.HashMap.Lazy (HashMap)+import Data.Proxy (Proxy(..))++import FRP.Euphoria.Event+import qualified FRP.Euphoria.Internal.GenericCollection as Gen+import FRP.Euphoria.Internal.GenericCollection hiding (filterCollection+        , filterCollectionWithKey, justCollection, sequenceCollection+        , accumCollection, mapToCollection, simpleCollection+        , collectionFromDiscreteList, mapCollectionM)+import FRP.Euphoria.Internal.Maplike++filterCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => (a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollection =+    Gen.filterCollection (Proxy :: Proxy (Lazy HashMap k))++filterCollectionWithKey+    :: (Hashable k, Eq k, MonadSignalGen m)+    => (k -> a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollectionWithKey =+    Gen.filterCollectionWithKey (Proxy :: Proxy (Lazy HashMap k))++justCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => Collection k (Maybe a)+    -> m (Collection k a)+justCollection =+    Gen.justCollection (Proxy :: Proxy (Lazy HashMap k))++mapCollectionM+    :: (Eq k, Hashable k, MonadSignalGen m)+    => (a -> SignalGen b) -> Collection k a -> m (Collection k b)+mapCollectionM = Gen.mapCollectionM (Proxy :: Proxy (Lazy HashMap k))++sequenceCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => Collection k (SignalGen a)+    -> m (Collection k a)+sequenceCollection =+    Gen.sequenceCollection (Proxy :: Proxy (Lazy HashMap k))++-- Adds the necessary state for holding the existing [(k, a)] and creating+-- the unique Event stream for each change of the collection.+accumCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => Event (CollectionUpdate k a)+    -> m (Collection k a)+accumCollection =+    Gen.accumCollection (Proxy :: Proxy (Lazy HashMap k))++mapToCollection+    :: (Eq k, Eq a, Hashable k, MonadSignalGen m)+    => Discrete (HashMap k a)+    -> m (Collection k (Discrete a))+mapToCollection xsD =+    Gen.mapToCollection (Lazy <$> xsD)++simpleCollection+    :: (Enum k, Eq k, Hashable k, MonadSignalGen m)+    => k+    -> Event (a, Event ())+    -> m (Collection k a)+simpleCollection =+    Gen.simpleCollection (Proxy :: Proxy (Lazy HashMap k))++collectionFromDiscreteList+    :: (Enum k, Eq k, Hashable k, Eq a, MonadSignalGen m)+    => k+    -> Discrete [a]+    -> m (Collection k a)+collectionFromDiscreteList =+    Gen.collectionFromDiscreteList (Proxy :: Proxy (Lazy HashMap k))

@@ -0,0 +1,109 @@+{-# OPTIONS_GHC -Wall #-}++-- | FRP.Euphoria.Internal.GenericCollection, with an interface specialised for+-- "Hashable" keys.+module FRP.Euphoria.HashCollection.Strict+    ( 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 Data.Hashable (Hashable)+import Data.HashMap.Strict (HashMap)+import Data.Proxy (Proxy(..))++import FRP.Euphoria.Event+import qualified FRP.Euphoria.Internal.GenericCollection as Gen+import FRP.Euphoria.Internal.GenericCollection hiding (filterCollection+        , filterCollectionWithKey, justCollection, sequenceCollection+        , accumCollection, mapToCollection, simpleCollection+        , collectionFromDiscreteList, mapCollectionM)+import FRP.Euphoria.Internal.Maplike++filterCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => (a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollection =+    Gen.filterCollection (Proxy :: Proxy (Strict HashMap k))++filterCollectionWithKey+    :: (Hashable k, Eq k, MonadSignalGen m)+    => (k -> a -> Bool)+    -> Collection k a+    -> m (Collection k a)+filterCollectionWithKey =+    Gen.filterCollectionWithKey (Proxy :: Proxy (Strict HashMap k))++justCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => Collection k (Maybe a)+    -> m (Collection k a)+justCollection =+    Gen.justCollection (Proxy :: Proxy (Strict HashMap k))++mapCollectionM+    :: (Eq k, Hashable k, MonadSignalGen m)+    => (a -> SignalGen b) -> Collection k a -> m (Collection k b)+mapCollectionM = Gen.mapCollectionM (Proxy :: Proxy (Strict HashMap k))++sequenceCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => Collection k (SignalGen a)+    -> m (Collection k a)+sequenceCollection =+    Gen.sequenceCollection (Proxy :: Proxy (Strict HashMap k))++-- Adds the necessary state for holding the existing [(k, a)] and creating+-- the unique Event stream for each change of the collection.+accumCollection+    :: (Hashable k, Eq k, MonadSignalGen m)+    => Event (CollectionUpdate k a)+    -> m (Collection k a)+accumCollection =+    Gen.accumCollection (Proxy :: Proxy (Strict HashMap k))++mapToCollection+    :: (Eq k, Eq a, Hashable k, MonadSignalGen m)+    => Discrete (HashMap k a)+    -> m (Collection k (Discrete a))+mapToCollection xsD =+    Gen.mapToCollection (Strict <$> xsD)++simpleCollection+    :: (Enum k, Eq k, Hashable k, MonadSignalGen m)+    => k+    -> Event (a, Event ())+    -> m (Collection k a)+simpleCollection =+    Gen.simpleCollection (Proxy :: Proxy (Strict HashMap k))++collectionFromDiscreteList+    :: (Enum k, Eq k, Hashable k, Eq a, MonadSignalGen m)+    => k+    -> Discrete [a]+    -> m (Collection k a)+collectionFromDiscreteList =+    Gen.collectionFromDiscreteList (Proxy :: Proxy (Strict HashMap k))

@@ -0,0 +1,442 @@+{-# 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.+    -> Event (a, Event ())  -- ^ 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

@@ -1,17 +1,27 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}  -- NOTE (asayers): I suppose this module doesn't really belong in -- euphoria... but I don't think it deserves its own package. module FRP.Euphoria.Internal.Maplike     ( Maplike(..)+    , Lazy(..)+    , Strict(..)     ) where +import Data.Function import Data.Hashable (Hashable)-import qualified Data.Map            as Map+import qualified Data.Map.Lazy       as ML+import qualified Data.Map.Strict     as MS+import qualified Data.HashMap.Lazy   as HML import qualified Data.HashMap.Strict as HMS import qualified Data.EnumMap.Lazy   as EML+import qualified Data.EnumMap.Strict as EMS +newtype Lazy c k v = Lazy (c k v)+newtype Strict c k v = Strict (c k v)+ -- | A class for types with an API similar to that of "Data.Map". class Maplike c k where     union        :: c k v -> c k v -> c k v@@ -26,36 +36,76 @@     delete :: k -> c k v -> c k v     delete k m =  m `difference` singleton k (error "bug")     toList :: c k v -> [(k, v)]+    foldrWithKey :: (k -> v -> a -> a) -> a -> c k v -> a -instance Ord k => Maplike Map.Map k where-    union        = Map.union-    intersection = Map.intersection-    difference   = (Map.\\)-    empty        = Map.empty-    lookup       = Map.lookup-    singleton    = Map.singleton-    insert       = Map.insert-    delete       = Map.delete-    toList       = Map.toList+instance Ord k => Maplike (Lazy ML.Map) k where+    union        (Lazy x) (Lazy y) = Lazy $ ML.union x y+    intersection (Lazy x) (Lazy y) = Lazy $ ML.intersection x y+    difference   (Lazy x) (Lazy y) = Lazy $ x ML.\\ y+    empty                          = Lazy ML.empty+    lookup       k (Lazy x)        = ML.lookup k x+    singleton    k v               = Lazy $ ML.singleton k v+    insert       k v (Lazy x)      = Lazy $ ML.insert k v x+    delete       k (Lazy x)        = Lazy $ ML.delete k x+    toList       (Lazy x)          = ML.toList x+    foldrWithKey f a (Lazy x)      = ML.foldrWithKey f a x -instance Enum k => Maplike EML.EnumMap k where-    union        = EML.union-    intersection = EML.intersection-    difference   = (EML.\\)-    empty        = EML.empty-    lookup       = EML.lookup-    singleton    = EML.singleton-    insert       = EML.insert-    delete       = EML.delete-    toList       = EML.toList+instance Ord k => Maplike (Strict MS.Map) k where+    union        (Strict x) (Strict y) = Strict $ MS.union x y+    intersection (Strict x) (Strict y) = Strict $ MS.intersection x y+    difference   (Strict x) (Strict y) = Strict $ x MS.\\ y+    empty                              = Strict MS.empty+    lookup       k (Strict x)          = MS.lookup k x+    singleton    k v                   = Strict $ MS.singleton k v+    insert       k v (Strict x)        = Strict $ MS.insert k v x+    delete       k (Strict x)          = Strict $ MS.delete k x+    toList       (Strict x)            = MS.toList x+    foldrWithKey f a (Strict x)        = MS.foldrWithKey f a x -instance (Eq k, Hashable k) => Maplike HMS.HashMap k where-    union        = HMS.union-    intersection = HMS.intersection-    difference   = HMS.difference-    empty        = HMS.empty-    lookup       = HMS.lookup-    singleton    = HMS.singleton-    insert       = HMS.insert-    delete       = HMS.delete-    toList       = HMS.toList+instance Enum k => Maplike (Lazy EML.EnumMap) k where+    union        (Lazy x) (Lazy y) = Lazy $ EML.union x y+    intersection (Lazy x) (Lazy y) = Lazy $ EML.intersection x y+    difference   (Lazy x) (Lazy y) = Lazy $ x EML.\\ y+    empty                          = Lazy EML.empty+    lookup       k (Lazy x)        = EML.lookup k x+    singleton    k v               = Lazy $ EML.singleton k v+    insert       k v (Lazy x)      = Lazy $ EML.insert k v x+    delete       k (Lazy x)        = Lazy $ EML.delete k x+    toList       (Lazy x)          = EML.toList x+    foldrWithKey f a (Lazy x)      = EML.foldrWithKey f a x++instance Enum k => Maplike (Strict EMS.EnumMap) k where+    union        (Strict x) (Strict y) = Strict $ EMS.union x y+    intersection (Strict x) (Strict y) = Strict $ EMS.intersection x y+    difference   (Strict x) (Strict y) = Strict $ x EMS.\\ y+    empty                              = Strict EMS.empty+    lookup       k (Strict x)          = EMS.lookup k x+    singleton    k v                   = Strict $ EMS.singleton k v+    insert       k v (Strict x)        = Strict $ EMS.insert k v x+    delete       k (Strict x)          = Strict $ EMS.delete k x+    toList       (Strict x)            = EMS.toList x+    foldrWithKey f a (Strict x)        = EMS.foldrWithKey f a x++instance (Eq k, Hashable k) => Maplike (Lazy HML.HashMap) k where+    union        (Lazy x) (Lazy y) = Lazy $ HML.union x y+    intersection (Lazy x) (Lazy y) = Lazy $ HML.intersection x y+    difference   (Lazy x) (Lazy y) = Lazy $ HML.difference x y+    empty                          = Lazy HML.empty+    lookup       k (Lazy x)        = HML.lookup k x+    singleton    k v               = Lazy $ HML.singleton k v+    insert       k v (Lazy x)      = Lazy $ HML.insert k v x+    delete       k (Lazy x)        = Lazy $ HML.delete k x+    toList       (Lazy x)          = HML.toList x+    foldrWithKey f a (Lazy x)      = HML.foldrWithKey f a x++instance (Eq k, Hashable k) => Maplike (Strict HMS.HashMap) k where+    union        (Strict x) (Strict y) = Strict $ HMS.union x y+    intersection (Strict x) (Strict y) = Strict $ HMS.intersection x y+    difference   (Strict x) (Strict y) = Strict $ HMS.difference x y+    empty                              = Strict HMS.empty+    lookup       k (Strict x)          = HMS.lookup k x+    singleton    k v                   = Strict $ HMS.singleton k v+    insert       k v (Strict x)        = Strict $ HMS.insert k v x+    delete       k (Strict x)          = Strict $ HMS.delete k x+    toList       (Strict x)            = HMS.toList x+    foldrWithKey f a (Strict x)        = HMS.foldrWithKey f a x

@@ -106,6 +106,7 @@ mappendUpdateIO :: Monoid a => Update (IO a) -> Update (IO a) -> Update (IO a) mappendUpdateIO d1 d2 = unIOMonoid <$> ((IOMonoid <$> d1) `mappend` (IOMonoid <$> d2)) {-# RULES "mappendUpdateIO/()" mappendUpdateIO = mappendUpdateIOUnit #-}+{-# INLINE[0] mappendUpdateIO #-}  -- | Do the same thing as 'mappendUpdateIO' but specialized to 'IO ()' mappendUpdateIOUnit :: Update (IO ()) -> Update (IO ()) -> Update (IO ())

@@ -0,0 +1,92 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++module FRP.Euphoria.EnumCollection.Lazy.Bench+    ( benchmarks+    ) where++import Control.DeepSeq+import Control.Monad+import Criterion+import qualified Data.EnumMap.Lazy as EML+import Data.List+import FRP.Euphoria.Event+import FRP.Euphoria.EnumCollection.Lazy+import GHC.Generics++benchmarks :: Benchmark+benchmarks = env mkEnv $ \ ~e -> bgroup "EnumCollection.Lazy"+    [ bench "mapToCollectionSmall" $ bench_mapToCollection (smallDict e)+    , bench "mapToCollectionBig"   $ bench_mapToCollection (bigDict e)+    , bench "accumSmall"           $ bench_accum (smallUpdates e)+    , bench "accumBig"             $ bench_accum (bigUpdates e)+    , bench "transformAccumSmall"  $ bench_transformAccum (smallUpdates e)+    , bench "transformAccumBig"    $ bench_transformAccum (bigUpdates e)+    , bench "fromListSmall"        $ bench_fromList (smallList e)+    , bench "fromListBig"          $ bench_fromList (bigList e)+    , bench "transformListSmall"   $ bench_transform (smallList e)+    , bench "transformListBig"     $ bench_transform (bigList e)+    ]++data BenchmarkEnv = BenchmarkEnv+    { smallList    :: [[Int]]+    , bigList      :: [[Int]]+    , smallUpdates :: [CollectionUpdate Int Int]+    , bigUpdates   :: [CollectionUpdate Int Int]+    , smallDict    :: EML.EnumMap Int Int+    , bigDict      :: EML.EnumMap Int Int+    } deriving (Generic)++instance NFData BenchmarkEnv++mkEnv :: IO BenchmarkEnv+mkEnv = do+    let smallList = map (\i -> [1..i]) [0..10]+    let bigList = map (\i -> [1..i]) [0..100]+    let smallUpdates = map (\i -> let (v,k) = 100 `divMod` i in AddItem k v) [1..101]+    let bigUpdates = map (\i -> let (v,k) = 200 `divMod` i in AddItem k v) [1..201]+    let smallDict = foldl' (\acc i -> let (v,k) = 100 `divMod` i in EML.insert k v acc) EML.empty [1..101]+    let bigDict = foldl' (\acc i -> let (v,k) = 200 `divMod` i in EML.insert k v acc) EML.empty [1..201]+    return BenchmarkEnv{..}++bench_fromList :: [[Int]] -> Benchmarkable+bench_fromList list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll <- collectionFromDiscreteList (0 :: Int) listD+        discreteToSignal $ collectionToDiscreteList coll++bench_transform :: [[Int]] -> Benchmarkable+bench_transform list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll0 <- collectionFromDiscreteList (0 :: Int) listD+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_accum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_accum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll <- accumCollection updatesE+        discreteToSignal $ collectionToDiscreteList coll++bench_transformAccum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_transformAccum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll0 <- accumCollection updatesE+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_mapToCollection :: EML.EnumMap Int Int -> Benchmarkable+bench_mapToCollection dict =+    nfIO $ networkToList 1 $ do+        coll <- mapToCollection (pure dict)+        let mangle :: Discrete [(a, Discrete b)] -> Discrete [(a, b)]+            mangle = join . fmap (sequence . map sequence)+        discreteToSignal $ mangle $ collectionToDiscreteList coll

@@ -0,0 +1,92 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++module FRP.Euphoria.EnumCollection.Strict.Bench+    ( benchmarks+    ) where++import Control.DeepSeq+import Control.Monad+import Criterion+import qualified Data.EnumMap.Strict as EMS+import Data.List+import FRP.Euphoria.Event+import FRP.Euphoria.EnumCollection.Strict+import GHC.Generics++benchmarks :: Benchmark+benchmarks = env mkEnv $ \ ~e -> bgroup "EnumCollection.Strict"+    [ bench "mapToCollectionSmall" $ bench_mapToCollection (smallDict e)+    , bench "mapToCollectionBig"   $ bench_mapToCollection (bigDict e)+    , bench "accumSmall"           $ bench_accum (smallUpdates e)+    , bench "accumBig"             $ bench_accum (bigUpdates e)+    , bench "transformAccumSmall"  $ bench_transformAccum (smallUpdates e)+    , bench "transformAccumBig"    $ bench_transformAccum (bigUpdates e)+    , bench "fromListSmall"        $ bench_fromList (smallList e)+    , bench "fromListBig"          $ bench_fromList (bigList e)+    , bench "transformListSmall"   $ bench_transform (smallList e)+    , bench "transformListBig"     $ bench_transform (bigList e)+    ]++data BenchmarkEnv = BenchmarkEnv+    { smallList    :: [[Int]]+    , bigList      :: [[Int]]+    , smallUpdates :: [CollectionUpdate Int Int]+    , bigUpdates   :: [CollectionUpdate Int Int]+    , smallDict    :: EMS.EnumMap Int Int+    , bigDict      :: EMS.EnumMap Int Int+    } deriving (Generic)++instance NFData BenchmarkEnv++mkEnv :: IO BenchmarkEnv+mkEnv = do+    let smallList = map (\i -> [1..i]) [0..10]+    let bigList = map (\i -> [1..i]) [0..100]+    let smallUpdates = map (\i -> let (v,k) = 100 `divMod` i in AddItem k v) [1..101]+    let bigUpdates = map (\i -> let (v,k) = 200 `divMod` i in AddItem k v) [1..201]+    let smallDict = foldl' (\acc i -> let (v,k) = 100 `divMod` i in EMS.insert k v acc) EMS.empty [1..101]+    let bigDict = foldl' (\acc i -> let (v,k) = 200 `divMod` i in EMS.insert k v acc) EMS.empty [1..201]+    return BenchmarkEnv{..}++bench_fromList :: [[Int]] -> Benchmarkable+bench_fromList list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll <- collectionFromDiscreteList (0 :: Int) listD+        discreteToSignal $ collectionToDiscreteList coll++bench_transform :: [[Int]] -> Benchmarkable+bench_transform list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll0 <- collectionFromDiscreteList (0 :: Int) listD+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_accum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_accum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll <- accumCollection updatesE+        discreteToSignal $ collectionToDiscreteList coll++bench_transformAccum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_transformAccum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll0 <- accumCollection updatesE+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_mapToCollection :: EMS.EnumMap Int Int -> Benchmarkable+bench_mapToCollection dict =+    nfIO $ networkToList 1 $ do+        coll <- mapToCollection (pure dict)+        let mangle :: Discrete [(a, Discrete b)] -> Discrete [(a, b)]+            mangle = join . fmap (sequence . map sequence)+        discreteToSignal $ mangle $ collectionToDiscreteList coll

@@ -0,0 +1,92 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++module FRP.Euphoria.HashCollection.Lazy.Bench+    ( benchmarks+    ) where++import Control.DeepSeq+import Control.Monad+import Criterion+import qualified Data.HashMap.Lazy as HML+import Data.List+import FRP.Euphoria.Event+import FRP.Euphoria.HashCollection.Lazy+import GHC.Generics++benchmarks :: Benchmark+benchmarks = env mkEnv $ \ ~e -> bgroup "HashCollection.Lazy"+    [ bench "mapToCollectionSmall" $ bench_mapToCollection (smallDict e)+    , bench "mapToCollectionBig"   $ bench_mapToCollection (bigDict e)+    , bench "accumSmall"           $ bench_accum (smallUpdates e)+    , bench "accumBig"             $ bench_accum (bigUpdates e)+    , bench "transformAccumSmall"  $ bench_transformAccum (smallUpdates e)+    , bench "transformAccumBig"    $ bench_transformAccum (bigUpdates e)+    , bench "fromListSmall"        $ bench_fromList (smallList e)+    , bench "fromListBig"          $ bench_fromList (bigList e)+    , bench "transformListSmall"   $ bench_transform (smallList e)+    , bench "transformListBig"     $ bench_transform (bigList e)+    ]++data BenchmarkEnv = BenchmarkEnv+    { smallList    :: [[Int]]+    , bigList      :: [[Int]]+    , smallUpdates :: [CollectionUpdate Int Int]+    , bigUpdates   :: [CollectionUpdate Int Int]+    , smallDict    :: HML.HashMap Int Int+    , bigDict      :: HML.HashMap Int Int+    } deriving (Generic)++instance NFData BenchmarkEnv++mkEnv :: IO BenchmarkEnv+mkEnv = do+    let smallList = map (\i -> [1..i]) [0..10]+    let bigList = map (\i -> [1..i]) [0..100]+    let smallUpdates = map (\i -> let (v,k) = 100 `divMod` i in AddItem k v) [1..101]+    let bigUpdates = map (\i -> let (v,k) = 200 `divMod` i in AddItem k v) [1..201]+    let smallDict = foldl' (\acc i -> let (v,k) = 100 `divMod` i in HML.insert k v acc) HML.empty [1..101]+    let bigDict = foldl' (\acc i -> let (v,k) = 200 `divMod` i in HML.insert k v acc) HML.empty [1..201]+    return BenchmarkEnv{..}++bench_fromList :: [[Int]] -> Benchmarkable+bench_fromList list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll <- collectionFromDiscreteList (0 :: Int) listD+        discreteToSignal $ collectionToDiscreteList coll++bench_transform :: [[Int]] -> Benchmarkable+bench_transform list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll0 <- collectionFromDiscreteList (0 :: Int) listD+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_accum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_accum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll <- accumCollection updatesE+        discreteToSignal $ collectionToDiscreteList coll++bench_transformAccum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_transformAccum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll0 <- accumCollection updatesE+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_mapToCollection :: HML.HashMap Int Int -> Benchmarkable+bench_mapToCollection dict =+    nfIO $ networkToList 1 $ do+        coll <- mapToCollection (pure dict)+        let mangle :: Discrete [(a, Discrete b)] -> Discrete [(a, b)]+            mangle = join . fmap (sequence . map sequence)+        discreteToSignal $ mangle $ collectionToDiscreteList coll

@@ -0,0 +1,92 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++module FRP.Euphoria.HashCollection.Strict.Bench+    ( benchmarks+    ) where++import Control.DeepSeq+import Control.Monad+import Criterion+import qualified Data.HashMap.Strict as HMS+import Data.List+import FRP.Euphoria.Event+import FRP.Euphoria.HashCollection.Strict+import GHC.Generics++benchmarks :: Benchmark+benchmarks = env mkEnv $ \ ~e -> bgroup "HashCollection.Strict"+    [ bench "mapToCollectionSmall" $ bench_mapToCollection (smallDict e)+    , bench "mapToCollectionBig"   $ bench_mapToCollection (bigDict e)+    , bench "accumSmall"           $ bench_accum (smallUpdates e)+    , bench "accumBig"             $ bench_accum (bigUpdates e)+    , bench "transformAccumSmall"  $ bench_transformAccum (smallUpdates e)+    , bench "transformAccumBig"    $ bench_transformAccum (bigUpdates e)+    , bench "fromListSmall"        $ bench_fromList (smallList e)+    , bench "fromListBig"          $ bench_fromList (bigList e)+    , bench "transformListSmall"   $ bench_transform (smallList e)+    , bench "transformListBig"     $ bench_transform (bigList e)+    ]++data BenchmarkEnv = BenchmarkEnv+    { smallList    :: [[Int]]+    , bigList      :: [[Int]]+    , smallUpdates :: [CollectionUpdate Int Int]+    , bigUpdates   :: [CollectionUpdate Int Int]+    , smallDict    :: HMS.HashMap Int Int+    , bigDict      :: HMS.HashMap Int Int+    } deriving (Generic)++instance NFData BenchmarkEnv++mkEnv :: IO BenchmarkEnv+mkEnv = do+    let smallList = map (\i -> [1..i]) [0..10]+    let bigList = map (\i -> [1..i]) [0..100]+    let smallUpdates = map (\i -> let (v,k) = 100 `divMod` i in AddItem k v) [1..101]+    let bigUpdates = map (\i -> let (v,k) = 200 `divMod` i in AddItem k v) [1..201]+    let smallDict = foldl' (\acc i -> let (v,k) = 100 `divMod` i in HMS.insert k v acc) HMS.empty [1..101]+    let bigDict = foldl' (\acc i -> let (v,k) = 200 `divMod` i in HMS.insert k v acc) HMS.empty [1..201]+    return BenchmarkEnv{..}++bench_fromList :: [[Int]] -> Benchmarkable+bench_fromList list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll <- collectionFromDiscreteList (0 :: Int) listD+        discreteToSignal $ collectionToDiscreteList coll++bench_transform :: [[Int]] -> Benchmarkable+bench_transform list =+    nfIO $ networkToList (length list) $ do+        listD <- signalToDiscrete <$> signalFromList list+        coll0 <- collectionFromDiscreteList (0 :: Int) listD+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_accum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_accum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll <- accumCollection updatesE+        discreteToSignal $ collectionToDiscreteList coll++bench_transformAccum :: [CollectionUpdate Int Int] -> Benchmarkable+bench_transformAccum updates =+    nfIO $ networkToList (length updates) $ do+        updatesE <- signalToEvent <$> signalFromList (map pure updates)+        coll0 <- accumCollection updatesE+        coll1 <- filterCollection even coll0+        coll2 <- mapCollection (\x -> if x `mod` 5 == 0 then Just x else Nothing) coll1+        coll3 <- justCollection coll2+        discreteToSignal $ collectionToDiscreteList coll3++bench_mapToCollection :: HMS.HashMap Int Int -> Benchmarkable+bench_mapToCollection dict =+    nfIO $ networkToList 1 $ do+        coll <- mapToCollection (pure dict)+        let mangle :: Discrete [(a, Discrete b)] -> Discrete [(a, b)]+            mangle = join . fmap (sequence . map sequence)+        discreteToSignal $ mangle $ collectionToDiscreteList coll

@@ -0,0 +1,16 @@+module Main where++import Criterion.Main (defaultMain)++import qualified FRP.Euphoria.EnumCollection.Lazy.Bench as ECL+import qualified FRP.Euphoria.EnumCollection.Strict.Bench as ECS+import qualified FRP.Euphoria.HashCollection.Lazy.Bench as HCL+import qualified FRP.Euphoria.HashCollection.Strict.Bench as HCS++main :: IO ()+main = defaultMain+    [ ECL.benchmarks+    , ECS.benchmarks+    , HCL.benchmarks+    , HCS.benchmarks+    ]

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                euphoria-version:             0.6.0.1+version:             0.8.0.0 synopsis:            Dynamic network FRP with events and continuous values description: @@ -67,18 +67,30 @@ build-type:          Simple cabal-version:       >=1.8 homepage:            http://github.com/tsurucapital/euphoria+tested-with:         GHC == 7.10.3+                   , GHC == 8.0.1  source-repository head   type: git   location: git://github.com/tsurucapital/euphoria.git  library-  exposed-modules:     FRP.Euphoria.Event, FRP.Euphoria.Signal, FRP.Euphoria.Update, FRP.Euphoria.Collection, FRP.Euphoria.Abbrev, FRP.Euphoria.Internal.Maplike+  exposed-modules:     FRP.Euphoria.Event+                     , FRP.Euphoria.Signal+                     , FRP.Euphoria.Update+                     , FRP.Euphoria.Collection+                     , FRP.Euphoria.EnumCollection.Lazy+                     , FRP.Euphoria.EnumCollection.Strict+                     , FRP.Euphoria.HashCollection.Lazy+                     , FRP.Euphoria.HashCollection.Strict+                     , FRP.Euphoria.Abbrev+                     , FRP.Euphoria.Internal.GenericCollection+                     , FRP.Euphoria.Internal.Maplike+  other-modules:       FRP.Elerea.Simple.Compat   -- other-modules:   build-depends:       HUnit-                     , base >= 4.7 && < 4.9-                     , elerea >= 2.7-                     , data-default+                     , base >= 4.7 && < 4.10+                     , elerea >= 2.7 && < 2.10                      , enummapset-th >= 0.6                      , deepseq                      , hashable >= 1.2@@ -88,8 +100,12 @@  test-suite tests   type:           exitcode-stdio-1.0-  main-is:        Tests.hs+  main-is:        Main.hs   hs-source-dirs: tests+  other-modules:  FRP.Euphoria.EnumCollection.Lazy.Test+                  FRP.Euphoria.Event.Test+                  FRP.Euphoria.HashCollection.Strict.Test+                  FRP.Euphoria.Update.Test   ghc-options:    -Wall   build-depends:  HUnit                 , base@@ -97,3 +113,19 @@                 , test-framework                 , test-framework-hunit                 , test-framework-th++benchmark bench+    type:           exitcode-stdio-1.0+    main-is:        Main.hs+    hs-source-dirs: benchmarks+    other-modules:  FRP.Euphoria.EnumCollection.Lazy.Bench+                    FRP.Euphoria.EnumCollection.Strict.Bench+                    FRP.Euphoria.HashCollection.Lazy.Bench+                    FRP.Euphoria.HashCollection.Strict.Bench+    ghc-options:    -Wall+    build-depends:  base+                  , criterion+                  , deepseq+                  , euphoria+                  , enummapset-th+                  , unordered-containers

@@ -0,0 +1,50 @@+{-# LANGUAGE TemplateHaskell #-}+module FRP.Euphoria.EnumCollection.Lazy.Test+    ( tests+    ) where++import Test.Framework (Test)+import Test.Framework.TH+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++import FRP.Euphoria.Event+import FRP.Euphoria.EnumCollection.Lazy++tests :: Test+tests = $(testGroupGenerator)++case_switchCollection :: Assertion+case_switchCollection = do+    result <- networkToList 5 $ do+        col0 <- collectionFromDiscreteList (0::Int) =<< mkD [[10::Int], [], [10,20,30], [20,30], [30]]+        col1 <- collectionFromDiscreteList 0 =<< mkD [[11], [], [11,21,31], [21,31], [31]]+        col2 <- collectionFromDiscreteList 0 =<< mkD [[12], [], [12,22,32], [22,32], [32]]+        colD <- stepperD col0 =<< eventFromList [[], [], [col1], [], [col2]]+        col <- switchD colD+        (_, updates) <- openCollection col+        listS <- discreteToSignal $ collectionToDiscreteList col+        return $ (,) <$> listS <*> eventToSignal updates+    result @?=+        [ ([(0, 10)]+            , [])+        , ([]+            , [RemoveItem 0])+        , ([(1, 11), (2, 21), (3, 31)]+            , [AddItem 1 11, AddItem 2 21, AddItem 3 31])+        , ([(2, 21), (3, 31)]+            , [RemoveItem 1])+        , ([(3, 32)]+            , [RemoveItem 2, RemoveItem 3, AddItem 3 32])+        ]+    where+        mkD list = signalToDiscrete <$> signalFromList list++case_mapCollection :: Assertion+case_mapCollection = do+    result <- networkToList 1 $ do+        col <- mapCollection show $+            collectionFromList [(0 :: Int, 1 :: Int), (1, 2), (2, 3)]+        discreteToSignal $ collectionToDiscreteList col++    result @?= [[(0, "1"), (1, "2"), (2, "3")]]

@@ -0,0 +1,61 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}++module FRP.Euphoria.Event.Test (tests) where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+import Data.Monoid (mempty)+#endif++import Test.Framework (Test)+import Test.Framework.TH+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++import FRP.Euphoria.Event++tests :: Test+tests = $(testGroupGenerator)++case_takeE :: Assertion+case_takeE = do+    result <- networkToList 5 $ do+        evt <- eventFromList [[1], [1::Int], [2,3], [], [4]]+        evt2 <- takeE 3 evt+        accumS 0 $ (+) <$> evt2+    result @?= [1, 2, 4, 4, 4]++case_takeWhileE :: Assertion+case_takeWhileE = do+    result <- networkToList 5 $ do+        evt <- eventFromList [[1], [1::Int], [2,3], [], [4]]+        evt2 <- takeWhileE (<3) evt+        accumS 0 $ (+) <$> evt2+    result @?= [1, 2, 4, 4, 4]++case_groupE :: Assertion+case_groupE = do+    result <- networkToList 5 $ do+        evt <- eventFromList [[1], [1::Int], [2,3], [], [3,3,4]]+        evt2 <- groupE evt+        threes <- takeE 1 =<< dropE 2 evt2+        dyn <- stepperS mempty threes+        return $ eventToSignal $ joinEventSignal dyn+    result @?= [[], [], [3], [], [3,3]]++case_splitOnE :: Assertion+case_splitOnE = do+    result <- networkToList 5 $ do+        ev1 <- eventFromList [[1::Int], [2,3,4], [], [5,6], [7,8]]+        ev2 <- eventFromList [[], [()], [], [], [()]]+        eventToSignal <$> splitOnE ev2 ev1+    result @?= [[], [[1,2,3,4]], [], [], [[5,6,7,8]]]++case_freezeD :: Assertion+case_freezeD = do+    result <- networkToList 5 $ do+        ev <- eventFromList [[], [], [()], [], [()]]+        dis <- signalToDiscrete <$> signalFromList [1..]+        discreteToSignal =<< freezeD ev dis+    result @?= [1, 2, 3, 3, 3 :: Int]

@@ -0,0 +1,50 @@+{-# LANGUAGE TemplateHaskell #-}+module FRP.Euphoria.HashCollection.Strict.Test+    ( tests+    ) where++import Test.Framework (Test)+import Test.Framework.TH+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++import FRP.Euphoria.Event+import FRP.Euphoria.HashCollection.Strict++tests :: Test+tests = $(testGroupGenerator)++case_switchCollection :: Assertion+case_switchCollection = do+    result <- networkToList 5 $ do+        col0 <- collectionFromDiscreteList (0::Int) =<< mkD [[10::Int], [], [10,20,30], [20,30], [30]]+        col1 <- collectionFromDiscreteList 0 =<< mkD [[11], [], [11,21,31], [21,31], [31]]+        col2 <- collectionFromDiscreteList 0 =<< mkD [[12], [], [12,22,32], [22,32], [32]]+        colD <- stepperD col0 =<< eventFromList [[], [], [col1], [], [col2]]+        col <- switchD colD+        (_, updates) <- openCollection col+        listS <- discreteToSignal $ collectionToDiscreteList col+        return $ (,) <$> listS <*> eventToSignal updates+    result @?=+        [ ([(0, 10)]+            , [])+        , ([]+            , [RemoveItem 0])+        , ([(1, 11), (2, 21), (3, 31)]+            , [AddItem 1 11, AddItem 2 21, AddItem 3 31])+        , ([(2, 21), (3, 31)]+            , [RemoveItem 1])+        , ([(3, 32)]+            , [RemoveItem 2, RemoveItem 3, AddItem 3 32])+        ]+    where+        mkD list = signalToDiscrete <$> signalFromList list++case_mapCollection :: Assertion+case_mapCollection = do+    result <- networkToList 1 $ do+        col <- mapCollection show $+            collectionFromList [(0 :: Int, 1 :: Int), (1, 2), (2, 3)]+        discreteToSignal $ collectionToDiscreteList col++    result @?= [[(0, "1"), (1, "2"), (2, "3")]]

@@ -0,0 +1,98 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}++module FRP.Euphoria.Update.Test (tests) where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>), (<*>))+import Data.Monoid (mappend)+#endif++import Data.Maybe (fromMaybe)++import Test.Framework (Test)+import Test.Framework.TH+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++import FRP.Euphoria.Event+import FRP.Euphoria.Update++tests :: Test+tests = $(testGroupGenerator)++case_startUpdateNetwork :: Assertion+case_startUpdateNetwork = do+    (sample, step) <- startUpdateNetwork $ do+        evt <- eventFromList [["a"], ["bc","d"], [], ["e"]]+        return $ updateUseAll evt+    step+    val0 <- sample+    val1 <- sample+    val2 <- sample++    [val0, val1, val2] @?= ["abcd", "", "e"]++case_skip :: Assertion+case_skip = do+    (sample, step) <- startUpdateNetwork $+        updateUseLast <$> eventFromList [[1], [2, 3], [], [4::Int]]+    step+    val0 <- sample+    val1 <- sample+    step+    val2 <- sample++    val0 @?= Just 3+    val1 @?= Nothing+    val2 @?= Just 4++case_mappendUpdate :: Assertion+case_mappendUpdate = do+    (sample, step) <- startUpdateNetwork $ do+        update0 <- updateUseAll <$> eventFromList [["a"], ["bc","d"], [], ["e"]]+        update1 <- updateUseAll <$> eventFromList [["f"], [], ["g"], ["hij"]]+        return $ update0 `mappend` update1+    step+    val0 <- sample+    val1 <- sample+    step+    val2 <- sample++    val0 @?= "abcdf"+    val1 @?= "g"+    val2 @?= "ehij"++case_applicativeUpdate :: Assertion+case_applicativeUpdate = do+    (sample, step) <- startUpdateNetwork $ do+        update0 <- updateUseAll <$> eventFromList [["a"], ["bc","d"], [], ["e"]]+        update1 <- updateUseAll <$> eventFromList [[[1]], [], [[2]], [[3,4],[5::Int]]]+        return $ f <$> update0 <*> update1+    step+    val0 <- sample+    val1 <- sample+    step+    val2 <- sample++    val0 @?= [([1], "abcd")]+    val1 @?= [([2], "")]+    val2 @?= [([3,4,5], "e")]+        where+        f str num = [(num, str)]++case_switchUD :: Assertion+case_switchUD = do+    (sample, step) <- startUpdateNetwork $ do+        update0 <- fmap (fromMaybe "") . updateUseLast <$>+            eventFromList [["1"], ["2", "3"], ["4"], ["5"]]+        update1 <- updateUseAll <$> eventFromList [["a"], ["bc","d"], [], ["e"]]+        updatesD <- stepperD update0 =<< eventFromList [[], [], [], [update1]]+        switchD updatesD+    val0 <- sample+    step+    step+    val1 <- sample++    val0 @?= "1"+    val1 @?= "4e"

@@ -0,0 +1,16 @@+module Main where++import Test.Framework (defaultMain)++import qualified FRP.Euphoria.EnumCollection.Lazy.Test+import qualified FRP.Euphoria.HashCollection.Strict.Test+import qualified FRP.Euphoria.Event.Test+import qualified FRP.Euphoria.Update.Test++main :: IO ()+main = defaultMain+    [ FRP.Euphoria.EnumCollection.Lazy.Test.tests+    , FRP.Euphoria.HashCollection.Strict.Test.tests+    , FRP.Euphoria.Event.Test.tests+    , FRP.Euphoria.Update.Test.tests+    ]

@@ -1,14 +0,0 @@-module Main where--import Test.Framework (defaultMain)--import Test.Collection (collectionTestGroup)-import Test.Event (eventTestGroup)-import Test.Update (updateTestGroup)--main :: IO ()-main = defaultMain-    [ collectionTestGroup-    , eventTestGroup-    , updateTestGroup-    ]