packages feed

buster 1.2 → 2.0

raw patch · 4 files changed

+157/−101 lines, 4 files

Files

App/Behaviours/Exception.hs view
@@ -29,7 +29,7 @@ -- | Handle exceptions by completely ignoring them. Not recommended, really, but hey, who am I to judge? disregardExceptionsNamed :: String -> Behaviour [EData a] disregardExceptionsNamed n b = pollEventGroupWith b "Exception" $-    (\e -> return $ if name e == n then [Deletion e] else [])+    (\e -> return $ if ename e == n then [Deletion e] else [])  -- | Handle exceptions by printing them to stdout and then completely ignoring them. printAndDisregardExceptionsFromSource :: String -> Behaviour [EData a]@@ -39,7 +39,7 @@ -- | Handle exceptions by printing them to stdout and then completely ignoring them printAndDisregardExceptionsNamed :: String -> Behaviour [EData a] printAndDisregardExceptionsNamed n b = pollEventGroupWith b "Exception" $ \e ->-    if name e == n then (return . return $ [Deletion e]) =<< (putStrLn . render . renderException $ e) else return []+    if ename e == n then (return . return $ [Deletion e]) =<< (putStrLn . render . renderException $ e) else return []  -- | Handle exceptions by printing them to a handle and then completely ignoring them. logAndDisregardExceptionsFromSource :: Handle -> String -> Behaviour [EData a]@@ -49,5 +49,5 @@ -- | Handle exceptions by printing them to handle and then completely ignoring them logAndDisregardExceptionsNamed :: Handle -> String -> Behaviour [EData a] logAndDisregardExceptionsNamed h n b = pollEventGroupWith b "Exception" $ \e ->-    if name e == n then (return . return $ [Deletion e]) =<< (hPutStrLn h . render . renderException $ e) else return []+    if ename e == n then (return . return $ [Deletion e]) =<< (hPutStrLn h . render . renderException $ e) else return []
App/Behaviours/PrintEvents.hs view
@@ -15,20 +15,58 @@ 	                  text "emitTime:" <+> text (formatTime defaultTimeLocale "%T" t) $+$ 	                  (vcat.map showIfPossible $ edata)     return [])-    where showIfPossible (EString x) = text x-          showIfPossible (EByteString x) = text "ByteString"-          showIfPossible (EByteStringL x) = text "[ByteString]"-          showIfPossible (EInt x) = text (show x)-          showIfPossible (EDouble x) = text (show x)-          showIfPossible (EBool x) = text (show x)-          showIfPossible (EStringL x) = text (show x)-          showIfPossible (EIntL x) = text (show x)-          showIfPossible (EDoubleL x) = text (show x)-          showIfPossible (EBoolL x) = text (show x)-          showIfPossible (EChar x) = char x-          showIfPossible (EOther x) = text "Custom Data"-          showIfPossible (EOtherL x) = text "Custom Data List"-          showIfPossible (EAssoc (x,y)) = text "x -> " <> showIfPossible y-          showIfPossible (EAssocL assocs) = vcat (map showAssoc assocs)-          showAssoc (x, y) = text x <> showIfPossible y++showIfPossible (EString x) = text x+showIfPossible (EByteString x) = text "ByteString"+showIfPossible (EByteStringL x) = text "[ByteString]"+showIfPossible (EInt x) = text (show x)+showIfPossible (EDouble x) = text (show x)+showIfPossible (EBool x) = text (show x)+showIfPossible (EStringL x) = text (show x)+showIfPossible (EIntL x) = text (show x)+showIfPossible (EDoubleL x) = text (show x)+showIfPossible (EBoolL x) = text (show x)+showIfPossible (EChar x) = char x+showIfPossible (EOther x) = text "Custom Data"+showIfPossible (EOtherL x) = text "Custom Data List"+showIfPossible (EAssoc (x,y)) = text "x -> " <> showIfPossible y+showIfPossible (EAssocL assocs) = vcat (map showAssoc assocs)+showAssoc (x, y) = text x <> showIfPossible y 	+printEventGroupBehaviour :: String -> Behaviour [EData a]+printEventGroupBehaviour grp b = pollEventGroupWith b grp $ (\(Event n g lifetime edata source t) -> do+    putStrLn.render $ text "name:    " <+> text n $+$+	                  text "source:  " <+> text source $+$+	                  text "group:   " <+> text g $+$+	                  text "ttl:     " <+> text (show lifetime) $+$+	                  text "emitTime:" <+> text (formatTime defaultTimeLocale "%T" t) $+$+	                  (vcat.map showIfPossible $ edata)+    return [])++	+printEventNameBehaviour :: String -> Behaviour [EData a]+printEventNameBehaviour grp b = pollNamedEventsWith b grp $ (\(Event n g lifetime edata source t) -> do+    putStrLn.render $ text "name:    " <+> text n $+$+	                  text "source:  " <+> text source $+$+	                  text "group:   " <+> text g $+$+	                  text "ttl:     " <+> text (show lifetime) $+$+	                  text "emitTime:" <+> text (formatTime defaultTimeLocale "%T" t) $+$+	                  (vcat.map showIfPossible $ edata)+    return [])++	+printEventSourceBehaviour :: String -> Behaviour [EData a]+printEventSourceBehaviour grp b = pollEventsFromSourceWith b grp $ (\(Event n g lifetime edata source t) -> do+    putStrLn.render $ text "name:    " <+> text n $+$+	                  text "source:  " <+> text source $+$+	                  text "group:   " <+> text g $+$+	                  text "ttl:     " <+> text (show lifetime) $+$+	                  text "emitTime:" <+> text (formatTime defaultTimeLocale "%T" t) $+$+	                  (vcat.map showIfPossible $ edata)+    return [])++printQNameBehaviour :: Behaviour a+printQNameBehaviour bus = pollAllEventsWith bus $ \(Event n g _ _ s _) -> do+    print (g,s,n)+    return []+
App/EventBus.hs view
@@ -18,7 +18,7 @@ import Control.Concurrent import Control.Monad import Data.Maybe-import Data.List (foldl')+import Data.List (foldl', foldl1') import Data.Monoid import qualified Data.Set as Set import Data.Time.Clock@@ -26,6 +26,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import System.IO.Unsafe+import Debug.Trace  -- generic functions for key ordering.  move somewhere else later EQ />/ b = b@@ -69,7 +70,11 @@       Insertion (Event a)   -- ^ Time t1 contains all events at time t0 plus this event.     | Deletion (Event a)    -- ^ Time t1 contains all events at time t0 minus this event. +instance Show (Diff a) where+    show (Insertion a) = show ("Insertion",group a, src a, ename a, timespan a)+    show (Deletion a) = show ("Deletion",group a, src a, ename a, timespan a) + -- | Defines the data attachable to events. data EData a =       EString String@@ -112,7 +117,7 @@  -- | An discrete event in time data Event a = Event-    { name :: String            -- ^ The unique name of an event.  Group + src + name = the fully qualified name FQN of the event.+    { ename :: String            -- ^ The unique name of an event.  Group + src + name = the fully qualified name FQN of the event.     , group :: String           -- ^ The group of an event.     , timespan :: TimeSpan      -- ^ The timespan from "time" that an event exists.     , eventdata :: a    -- ^ The data attached to the event.@@ -122,12 +127,11 @@  instance Ord (Event a) where     compare l r = ((src %=> compare) l r) />/-                  ((time %=> compare) l r) />/                   ((group %=> compare) l r) />/-                  ((name %=> compare) l r)+                  ((ename %=> compare) l r)  instance Eq (Event a) where-    x == y = (name %=> (==)) x y &&+    x == y = (ename %=> (==)) x y &&              (group %=> (==)) x y &&              (src %=> (==)) x y @@ -138,6 +142,11 @@     , groupMap :: Map.Map String (Set.Set (Event a))                    -- ^ The map of just Event.group to events.     , fullyQualifiedMap :: Map.Map (String,String,String) (Event a) }   -- ^ The map of FQNs to events. +instance Show (Bus a) where+    show = concat . map showQName . Map.elems . fullyQualifiedMap++showQName ev = show (group ev, src ev, ename ev, timespan ev)+ eventsByName :: String -> Bus a -> Set.Set (Event a) eventsByName n = fromMaybe Set.empty . Map.lookup n . nameMap @@ -183,10 +192,10 @@  -- | Add an event to time within the bus addEvent :: Event a -> Bus a -> Bus a-addEvent edata b = b{ nameMap = Map.insertWith (Set.union) (name edata) (singleton edata) (nameMap b)+addEvent edata b = b{ nameMap = Map.insertWith (Set.union) (ename edata) (singleton edata) (nameMap b)                     , srcMap = Map.insertWith (Set.union) (src edata) (singleton edata) (srcMap b)                     , groupMap = Map.insertWith (Set.union) (group edata) (singleton edata) (groupMap b)-                    , fullyQualifiedMap = Map.insert (group edata, src edata, name edata) edata (fullyQualifiedMap b) }+                    , fullyQualifiedMap = Map.insert (group edata, src edata, ename edata) edata (fullyQualifiedMap b) }  -- | The type of widgets. --   A widget is an input-only way to assign Events to time.  A mouse is a widget.  A keyboard is a@@ -196,21 +205,21 @@ -- | The type of future events.. --   A behaviour doesn't know about the time that it assigns events, only that they exist --   at some point after the time that the Behaviour sampled.-type Future a = IO (MVar a)+type Future a = IO (Bus a, MVar [Diff a])  -- | An IO action sometime in the future.-future :: IO a -> Future a-future thunk = do+future :: Bus a -> IO [Diff a] -> Future a+future b thunk = do     ref <- newEmptyMVar     forkIO $ thunk >>= putMVar ref-    return ref+    return (b,ref)  -- | Obtain the final value of a Future.  Blocks until the value is available immediate = takeMVar  -- | The type of a Behaviour.  A behaviour maps the bus to a list of differences to apply to the bus --   before the next Behaviour's sample of time.-type Behaviour a = Bus a -> Future [Diff a]+type Behaviour a = Bus a -> Future a  instance Monoid (Behaviour a) where     mempty = passthrough@@ -218,27 +227,44 @@  -- | The null Behaviour.  Samples the bus and adds and deletes nothing. passthrough :: Behaviour a-passthrough a = future (return [])+passthrough a = future a (return [])  -- | the in front of behaviour combinator. behaviour 1 is in front of behaviour 0, so behavour 0 will see the bus filtered through behaviour 1 (<~<) :: Behaviour a -> Behaviour a -> Behaviour a-behaviour1 <~< behaviour0 = \m -> behaviour0 m >>= applyDiff m >>= behaviour1+behaviour1 <~< behaviour0 = \m -> behaviour0 m >>= applyDiff >>= behaviour1  -- | the behind behaviour combinator. behaviour 0 is behind behaviour 1, so behaviour 0 will see the bus filtered through behaviour 1 (>~>) :: Behaviour a -> Behaviour a -> Behaviour a-behaviour0 >~> behaviour1 = \m -> behaviour0 m >>= applyDiff m >>= behaviour1+behaviour0 >~> behaviour1 = \m -> behaviour0 m >>= applyDiff >>= behaviour1  -- | the beside behaviour combinator. All behaviours that are side-by-side see the same bus. (|~|) :: Behaviour a -> Behaviour a -> Behaviour a-behaviour0 |~| behaviour1 = \m -> do-    future0 <- behaviour0 m-    future1 <- behaviour1 m-    future $ concat <$> mapM immediate [future0, future1]+behaviour0 |~| behaviour1 = \m -> future m $ do+    (_,mv0) <- behaviour0 m+    (_,mv1) <- behaviour1 m+    value0 <- takeMVar mv0 -- :: IO [Diff a]+    value1 <- takeMVar mv1 -- :: IO [Diff a]+    return $ value0 ++ value1  behind = (>~>) beside = (|~|) infrontof = (<~<) +applyDiff (m,ds) = immediate ds >>= (\k -> {- trace ("------\n" ++ show k ++ "\n" ++ show m ++ "\n\nthen after diff applied\n\n" ++ (show . foldl' busDiff m $ k)) -} (return . foldl' busDiff m) $ k)+    where busDiff b (Insertion ev) = b{ nameMap = Map.insertWith (union') (ename ev) (singleton ev) (nameMap b)+                                      , srcMap = Map.insertWith (union') (src ev) (singleton ev) (srcMap b)+                                      , groupMap = Map.insertWith (union') (group ev) (singleton ev) (groupMap b)+                                      , fullyQualifiedMap = Map.insert (group ev, src ev, ename ev) ev (fullyQualifiedMap b) }+          busDiff b (Deletion ev) = b { nameMap = deleteOneFrom ev (ename ev) (nameMap b) -- should change this to alter instead of delete, check for empty lists+                                      , srcMap = deleteOneFrom ev (src ev) (srcMap b)+                                      , groupMap = deleteOneFrom ev (group ev) (groupMap b)+                                      , fullyQualifiedMap = Map.delete (group ev, src ev, ename ev) (fullyQualifiedMap b) }+          deleteOneFrom ev key mp = case Map.lookup key mp of+					Just eset -> let eset' = Set.delete ev eset in if eset' == Set.empty then Map.delete key mp else Map.insert key eset' mp+					Nothing -> mp+          union' v st = Set.union (Set.difference st v) v				++ -- | An infinite loop of behaviours and widgets over time, sampled forward. bus :: [Widget a] -> IO b -> Behaviour a -> IO () bus widgets widgetThunk behaviour = do@@ -258,7 +284,10 @@     v <- tryTakeMVar b     case v of         Nothing -> return ()-        Just m -> putMVar b . expire =<< decrementTimeSpan =<< applyDiff m =<< behaviour m+        Just m -> do diffs <- behaviour m+                     bus' <- applyDiff diffs+                     bus'' <- expire <$> decrementTimeSpan bus'+                     putMVar b bus''  -- | Assign an event to time given some event data and a TimeSpan. --@@ -275,34 +304,34 @@  -- | Sample all events with a given name at the current time and output their deletions as Diffs as --   well as any additional Diffs returned by the behaviour.-consumeNamedEventsCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]+consumeNamedEventsCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a consumeNamedEventsCollectivelyWith em nm f =-    maybe (future . return $ [])-          (\ev -> future $ (map Deletion (Set.toList ev) ++) <$> f ev)+    maybe (future em . return $ [])+          (\ev -> future em $ (map Deletion (Set.toList ev) ++) <$> f ev)           (Map.lookup nm (nameMap em))  consumeNamedEvents :: String -> Behaviour a consumeNamedEvents nm b =-    maybe (future . return $ [])-          (\ev -> future . return $ Deletion <$> Set.toList ev)+    maybe (future b . return $ [])+          (\ev -> future b . return $ Deletion <$> Set.toList ev)           (Map.lookup nm . nameMap $ b)  consumeEventGroup :: String -> Behaviour a consumeEventGroup g b =-    maybe (future . return $ [])-          (\ev -> future . return $ Deletion <$> Set.toList ev)+    maybe (future b . return $ [])+          (\ev -> future b . return $ Deletion <$> Set.toList ev)           (Map.lookup g . groupMap $ b)  consumeEventsFromSource :: String -> Behaviour a consumeEventsFromSource s b =-    maybe (future . return $ [])-          (\ev -> future . return $ Deletion <$> Set.toList ev)+    maybe (future b . return $ [])+          (\ev -> future b . return $ Deletion <$> Set.toList ev)           (Map.lookup s . srcMap $ b)  consumeFullyQualifiedEvent :: String -> String -> String -> Behaviour a consumeFullyQualifiedEvent g s n b =-    maybe (future . return $ [])-          (\ev -> future . return $ [Deletion ev])+    maybe (future b . return $ [])+          (\ev -> future b . return $ [Deletion ev])           (Map.lookup (g, s, n) . fullyQualifiedMap $ b)  modifyEventData :: Event a -> (a -> a) -> [Diff a]@@ -311,91 +340,79 @@ modifyEvent :: Event a -> (Event a -> Event a) -> [Diff a] modifyEvent ev f = let ev' = f ev in if ev==ev' then [Insertion ev'] else [Deletion ev, Insertion ev'] -consumeNamedEventsWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]+consumeNamedEventsWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a consumeNamedEventsWith b n f =-    future $ concat <$> ((\l -> (map Deletion l :) <$>  mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (nameMap b)))+    future b $ concat <$> ((\l -> (map Deletion l :) <$>  mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (nameMap b)))  -- | Sample all events with a given group at the current time and output their deletions as Diffs as --   well as any additional Diffs returned by the behaviour.-consumeEventGroupCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]+consumeEventGroupCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a consumeEventGroupCollectivelyWith em gp f =-    maybe (future . return $ [])-          (\ev -> future $ (map Deletion (Set.toList ev) ++) <$> f ev)+    maybe (future em . return $ [])+          (\ev -> future em $ (map Deletion (Set.toList ev) ++) <$> f ev)           (Map.lookup gp (groupMap em)) -consumeEventGroupWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]+consumeEventGroupWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a consumeEventGroupWith b n f =-    future $ concat <$> ((\l -> (map Deletion l :) <$>  mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (groupMap b)))+    future b $ concat <$> ((\l -> (map Deletion l :) <$>  mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (groupMap b)))  -- | Sample all events with a given source at the current time and output their deletions as Diffs as --   well as any additional Diffs returned by the behaviour.-consumeEventsFromSourceCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]+consumeEventsFromSourceCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a consumeEventsFromSourceCollectivelyWith em source f =-    maybe (future . return $ [])-          (\ev -> future $ (map Deletion (Set.toList ev) ++) <$> f ev)+    maybe (future em . return $ [])+          (\ev -> future em $ (map Deletion (Set.toList ev) ++) <$> f ev)           (Map.lookup source (srcMap em)) -consumeEventsFromSourceWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]+consumeEventsFromSourceWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a consumeEventsFromSourceWith b n f =-    future $ concat <$> ((\l -> (map Deletion l :) <$>  mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (srcMap b)))+    future b $ concat <$> ((\l -> (map Deletion l :) <$>  mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (srcMap b)))  -- | Sample a single fully qualified event at the current time and output their deletions as Diffs as --   well as any additional Diffs returned by the behaviour.  Parameter order is bus, group, source, name-consumeFullyQualifiedEventWith :: Bus a -> String -> String -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]+consumeFullyQualifiedEventWith :: Bus a -> String -> String -> String -> (Event a -> IO [Diff a]) -> Future a consumeFullyQualifiedEventWith em group source name f =-    maybe (future . return $ [])-          (\ev -> future $ (Deletion ev :) <$> f ev)+    maybe (future em . return $ [])+          (\ev -> future em $ (Deletion ev :) <$> f ev)           (Map.lookup (group,source,name) (fullyQualifiedMap em))  -- | Sample all events with a given name and apply a Behaviour-pollNamedEventsCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]-pollNamedEventsCollectivelyWith b nm f = maybe (future . return $[]) (future . f) (Map.lookup nm (nameMap b))+pollNamedEventsCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a+pollNamedEventsCollectivelyWith b nm f = maybe (future b . return $[]) (future b . f) (Map.lookup nm (nameMap b))  -- | Sample all events with a given name and apply a Behaviour to each-pollNamedEventsWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]-pollNamedEventsWith b nm f = future $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (nameMap b)))+pollNamedEventsWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a+pollNamedEventsWith b nm f = future b $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (nameMap b)))  -- | Sample all events with a given group and apply a Behaviour-pollEventGroupCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]-pollEventGroupCollectivelyWith b nm f = maybe (future . return $[]) (future . f) (Map.lookup nm (groupMap b))+pollEventGroupCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a+pollEventGroupCollectivelyWith b nm f = maybe (future b . return $[]) (future b . f) (Map.lookup nm (groupMap b))  -- | Sample all events with a gien group and apply a Behaviour to each.-pollEventGroupWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]-pollEventGroupWith b nm f = future $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (groupMap b)))+pollEventGroupWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a+pollEventGroupWith b nm f = future b $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (groupMap b)))  -- | Sample all events with a given source and apply a Behaviour-pollEventsFromSourceCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]-pollEventsFromSourceCollectivelyWith b nm f = maybe (future . return $[]) (future.f) (Map.lookup nm (srcMap b))+pollEventsFromSourceCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a+pollEventsFromSourceCollectivelyWith b nm f = maybe (future b . return $[]) (future b . f) (Map.lookup nm (srcMap b))  -- | Sample all events with a given source and apply a Behaviour to each.-pollEventsFromSourceWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]-pollEventsFromSourceWith b nm f = future $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (srcMap b)))+pollEventsFromSourceWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a+pollEventsFromSourceWith b nm f = future b $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (srcMap b)))  -- | Sample a single fully qualified event and output some Diffs. --   Parameter order is bus, group, source, name.-pollFullyQualifiedEventWith :: Bus a -> String -> String -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]-pollFullyQualifiedEventWith b gp source nm f = maybe (future . return $ []) (future . f) (Map.lookup (gp,source,nm) (fullyQualifiedMap b))+pollFullyQualifiedEventWith :: Bus a -> String -> String -> String -> (Event a -> IO [Diff a]) -> Future a+pollFullyQualifiedEventWith b gp source nm f = maybe (future b . return $ []) (future b . f) (Map.lookup (gp,source,nm) (fullyQualifiedMap b))  -- | Apply a behaviour to all events in the bus, one event at a time.-pollAllEventsWith :: Bus a -> (Event a -> IO [Diff a]) -> Future [Diff a]-pollAllEventsWith b f = future $ concat <$> (mapM f . Map.elems . fullyQualifiedMap $ b)+pollAllEventsWith :: Bus a -> (Event a -> IO [Diff a]) -> Future a+pollAllEventsWith b f = future b $ concat <$> (mapM f . Map.elems . fullyQualifiedMap $ b)  -- | Apply a behaviour to the collection of all events on the bus at once-pollAllEventsCollectivelyWith :: Bus a -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]-pollAllEventsCollectivelyWith b f = future $ f . Set.fromList . Map.elems . fullyQualifiedMap $ b+pollAllEventsCollectivelyWith :: Bus a -> (Set.Set (Event a) -> IO [Diff a]) -> Future a+pollAllEventsCollectivelyWith b f = future b $ f . Set.fromList . Map.elems . fullyQualifiedMap $ b -applyDiff m ds = immediate ds >>= (return . foldl' busDiff m)-    where busDiff b (Insertion ev) = b{ nameMap = Map.insertWith (Set.union) (name ev) (singleton ev) (nameMap b)-                                      , srcMap = Map.insertWith (Set.union) (src ev) (singleton ev) (srcMap b)-                                      , groupMap = Map.insertWith (Set.union) (group ev) (singleton ev) (groupMap b)-                                      , fullyQualifiedMap = Map.insert (group ev, src ev, name ev) ev (fullyQualifiedMap b) }-          busDiff b (Deletion ev) = b { nameMap = deleteOneFrom ev (name ev) (nameMap b) -- should change this to alter instead of delete, check for empty lists-                                      , srcMap = deleteOneFrom ev (src ev) (srcMap b)-                                      , groupMap = deleteOneFrom ev (group ev) (groupMap b)-                                      , fullyQualifiedMap = Map.delete (group ev, src ev, name ev) (fullyQualifiedMap b) }-          deleteOneFrom ev key mp = case Map.lookup key mp of-					Just eset -> let eset' = Set.delete ev eset in if eset' == Set.empty then Map.delete key mp else Map.insert key eset' mp-					Nothing -> mp 					 singleton a = Set.fromList [a]					 	@@ -409,14 +426,15 @@           decTimeSpan e (Time x) = Time . realToFrac $ diffUTCTime (addUTCTime (realToFrac x) (time e)) (unsafePerformIO getCurrentTime)           decTimeSpan _ (Iterations x) = (Iterations (x-1)) -expire b = Bus (Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . nameMap $ b)-               (Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . srcMap $ b)-               (Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . groupMap $ b)-               (Map.filter (current . timespan) . fullyQualifiedMap $ b)+expire b = b' 	where current (Time x) = x > 0 	      current Persistent = True 	      current (Iterations x) = x > 0-	+	      b' = Bus (Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . nameMap $ b)+                   (Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . srcMap $ b)+                   (Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . groupMap $ b)+                   (Map.filter (current . timespan) . fullyQualifiedMap $ b)+ listM v = v >>= return . (:[])	 	 {- example usage...
buster.cabal view
@@ -1,5 +1,5 @@ name: buster-version: 1.2+version: 2.0 cabal-version: -any build-type: Simple license: BSD3