packages feed

buster 0.99.2 → 0.99.5

raw patch · 4 files changed

+369/−12 lines, 4 filesdep +binary

Dependencies added: binary

Files

+ App/Behaviours/Exception.hs view
@@ -0,0 +1,53 @@+-- | Handle exceptions slightly more gracefully than the Haskell runtime does.+module App.Behaviours.Exception where++import Data.List (filter)+import Control.Applicative+import qualified Control.Exception as Ex+import App.EventBus+import Text.PrettyPrint+import qualified Data.Set as Set+import System.IO+import Data.Time+import System.Locale++renderException (Event nm _ _ edata source tm) =+            brackets (text (formatTime defaultTimeLocale "%T" tm)) <+> text "Exception thrown from" <+> text source <> colon <+> text nm $+$+            (nest 4 . vcat . map text . map (safeShow (Just 80)) $ edata)++-- | Bork the program when an unhandled exception makes it to this behaviour.+--   Catches all events with the group \"Exception\" and throws them as one big exception.+unhandledExceptionBehaviour :: Behaviour [EData a]+unhandledExceptionBehaviour b = consumeEventGroupCollectivelyWith b "Exception" $+    (return []) <$ (Ex.throwIO . Ex.ErrorCall . render . vcat . map renderException . Set.toList)++-- | Handle exceptions by completely ignoring them. Not recommended, really, but hey, who am I to judge?+disregardExceptionsFromSource :: String -> Behaviour [EData a]+disregardExceptionsFromSource s b = pollEventGroupWith b "Exception" $+    (\e -> return $ if src e == s then [Deletion e] else [])++-- | 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 [])++-- | Handle exceptions by printing them to stdout and then completely ignoring them.+printAndDisregardExceptionsFromSource :: String -> Behaviour [EData a]+printAndDisregardExceptionsFromSource s b = pollEventGroupWith b "Exception" $ \e ->+    if src e == s then (return . return $ [Deletion e]) =<<  (putStrLn . render . renderException $ e) else return []++-- | 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 []++-- | Handle exceptions by printing them to a handle and then completely ignoring them.+logAndDisregardExceptionsFromSource :: Handle -> String -> Behaviour [EData a]+logAndDisregardExceptionsFromSource h s b = pollEventGroupWith b "Exception" $ \e ->+    if src e == s then (return . return $ [Deletion e]) =<<  (hPutStrLn h . render . renderException $ e) else return []++-- | 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 []+
+ App/Behaviours/FileOps.hs view
@@ -0,0 +1,266 @@+-- | This module handles read, write, encode, and decode of files.  It also cleanly handles exceptions+--   by introducing Exception events that are handlable by the behaviours in "App.Behaviours.Exception"+--   which exit your program gracefully, or by your own user defined exception handlers.+--+--   It can handle datatypes @EData a@ with Binary, Show, and Read instances as well.+module App.Behaviours.FileOps where++import App.EventBus+import Control.Applicative+import qualified Data.ByteString.Char8 as SB+import qualified Data.ByteString.Lazy.Char8 as LB+import Data.Binary+import qualified Control.Exception as Ex++-- | @readFileBehaviour name datatype@ looks for any event with the name /name/ and reads the file+--   into an event following the pattern:+--+--      * name: same as filename.+--+--      * group: same as name of the behaviour, @name@+--+--      * source: \"ReadSource\"+--+--      * timespan: Persistent+--+--      * eventdata: the file, read in and processed using @read@ to be of the datatype that+--        corresponds to the constructor in the @datatype@ parameter.+--+--  NOTE: This function can only be used with @EData a@ where @a@ has a 'Read' instance.  For event+--  data without a read instance, use 'readFileBehaviourNR'+readFileBehaviour :: Read a => String -> EData a -> Behaviour [EData a]+readFileBehaviour n d b = consumeNamedEventsWith b n readFileCatch+    where readFileCatch e = Ex.catch (readFile0 e) (emitException e)+          readFile0 e = (rFile0 d . eventdata $ e) >>= produce n "ReadSource" (filename e) Persistent >>= return . (:[])+          emitException e ex = produce "Exception" "readFileBehaviour" n once (EString (show ex):eventdata e) >>= return . (:[])+          filename = (\(EString x) -> x) . head . eventdata++-- | @readFileBehaviourNR name datatype@ looks for any event with the name /name/ and reads the file+--   into an event following the pattern:+--+--      * name: same as filename.+--+--      * group: same as name of the behaviour, @name@+--+--      * source: \"ReadSource\"+--+--      * timespan: Persistent+--+--      * eventdata: the file, read in and processed using 'read' to be of the datatype that+--        corresponds to the constructor in the @datatype@ parameter.  The constructor itself should+--        not be serialized.+--+--  NOTE: Attempting to read datatype @EOther a@ using this will cause the program to emit an+--  event with \"Exception\" as the group and /name/ as the source.+readFileBehaviourNR :: String -> EData a -> Behaviour [EData a]+readFileBehaviourNR n d b = consumeNamedEventsWith b n readFileCatch+    where readFileCatch e = Ex.catch (readFile0 e) (emitException e)+          readFile0 e = (rFile d . eventdata $ e) >>= produce n "ReadSource" (filename e) Persistent >>= return . (:[])+          emitException e ex = produce "Exception" "readFileBehaviour" n once (EString (show ex):eventdata e) >>= return . (:[])+          filename = (\(EString x) -> x) . head . eventdata++-- | @decodeFileBehaviour name datatype@ looks for any event with the name /name/ and reads the file+--   into an event following the pattern:+--+--      * name: same as filename.+--+--      * group: same as name of the behaviour, @name@+--+--      * source: \"ReadSource\"+--+--      * timespan: Persistent+--+--      * eventdata: the file, read in and processed using 'Data.Binary.decodeFile' to be of the+--        datatype that corresponds to the constructor in the @datatype@ parameter.  The constructor+--        itself need not be serialized.+--+--  NOTE: This function can only be used with @EData a@ where @a@ has a 'Binary' instance.  For event+--  data without a read instance, use 'decodeFileBehaviourNB'+decodeFileBehaviour :: Binary a => String -> EData a -> Behaviour [EData a]+decodeFileBehaviour n d b = consumeNamedEventsWith b n decodeFileCatch+    where decodeFileCatch e = Ex.catch (decodeFile0 e) (emitException e)+          decodeFile0 e = (dFile0 d . eventdata $ e) >>= produce n "ReadSource" (filename e) Persistent >>= return . (:[])+          emitException e ex = produce "Exception" "decodeFileBehaviour" n once (EString (show ex):eventdata e) >>= return . (:[])+          filename = (\(EString x) -> x) . head . eventdata++-- | @readFileBehaviour name datatype@ looks for any event with the name /name/ and reads the file+--   into an event following the pattern:+--+--      * name: same as filename.+--+--      * group: same as name of the behaviour, @name@+--+--      * source: \"ReadSource\"+--+--      * timespan: Persistent+--+--      * eventdata: the file, read in and processed using @read@ to be of the datatype that+--        corresponds to the constructor in the @datatype@ parameter.+--+--  NOTE: Attempting to read datatype @EOther a@ using this will cause the program to raise an+--  Event with \"Exception\" as the group.+decodeFileBehaviourNB :: String -> EData a -> Behaviour [EData a]+decodeFileBehaviourNB n d b = consumeNamedEventsWith b n decodeFileCatch+    where decodeFileCatch e = Ex.catch (decodeFile0 e) (emitException e)+          decodeFile0 e = (dFile d . eventdata $ e) >>= (produce n "ReadSource" (filename e) Persistent) >>= return . (:[])+          emitException e ex = produce "Exception" "decodeFileBehaviourNB" n once (EString (show ex):eventdata e) >>= return . (:[])+          filename = (\(EString x) -> x) . head . eventdata++-- | @writeFileBehaviour@ looks for \"WriteFile\" named events with event data corresponding to+--   @[EString filepath,@ /data constructor/ @contents]@ and removes them from the bus, writing+--   the file named @filepath@.  Any error is placed on the bus with an Exception event with+--    \"WriteFile\" as the source.+writeFileBehaviourNS :: Behaviour [EData a]+writeFileBehaviourNS b = consumeNamedEventsWith b "WriteFile" $ \e -> Ex.catch+                            (wFile . eventdata $ e)+                            (\ex -> produce "Exception" "writeFileBehaviourNS" "WriteFile" once (EString (show ex):eventdata e) >>= return . (:[]))++-- | @writeFileBehaviour@ looks for \"WriteFile\" named events with event data corresponding to+--   @[EString filepath,@ /data constructor/ @contents]@ and removes them from the bus, writing+--   the file named @filepath@.  Any error is placed on the bus with an Exception event with+--    \"WriteFile\" as the source.+--+--   NOTE: Attempting to encode 'EOther a' using this will raise an Exception.+writeFileBehaviour :: Show a => Behaviour [EData a]+writeFileBehaviour b = consumeNamedEventsWith b "WriteFile" $ \e -> Ex.catch+                            (wFile0 . eventdata $ e)+                            (\ex -> produce "Exception" "writeFileBehaviour" "WriteFile" once (EString (show ex):eventdata e) >>= return . (:[]))++-- | @writeFileBehaviour@ looks for \"WriteFile\" named events with event data corresponding to+--   @[EString filepath,@ /data constructor/ @contents]@ and removes them from the bus, writing+--   the file named @filepath@.  Any error is placed on the bus with an Exception event with+--    \"WriteFile\" as the source.+--+--  NOTE: Attempting to encode 'EOther a' using this will raise an Exception.+encodeFileBehaviourNB :: Behaviour [EData a]+encodeFileBehaviourNB b = consumeNamedEventsWith b "WriteBinary" $ \e -> Ex.catch+                            (wBinary . eventdata $ e)+                            (\ex -> produce "Exception" "encodeFileBehaviourNB" "WriteFile" once (EString (show ex):eventdata e) >>= return . (:[]))++-- | @writeFileBehaviour@ looks for \"WriteFile\" named events with event data corresponding to+--   @[EString filepath,@ /data constructor/ @contents]@ and removes them from the bus, writing+--   the file named @filepath@.  Any error is placed on the bus with an Exception event with+--    \"WriteFile\" as the source.+--+--  NOTE: This can only be used with an EData a where a has a 'Data.Binary.Binary' instance.+encodeFileBehaviour :: Binary a => Behaviour [EData a]+encodeFileBehaviour b = consumeNamedEventsWith b "WriteBinary" $ \e -> Ex.catch+                            (wBinary0 . eventdata $ e)+                            (\ex -> produce "Exception" "encodeFileBehaviour" "WriteFile" once (EString (show ex):eventdata e) >>= return . (:[]))++wFile [EString filepath, EString contents] = [] <$ writeFile filepath contents+wFile [EString filepath, EStringL contents] = [] <$ (writeFile filepath . unlines $ contents)+wFile [EString filepath, ELByteString contents] = [] <$ (LB.writeFile filepath contents)+wFile [EString filepath, ELByteStringL contents] = [] <$ (LB.writeFile filepath . LB.unlines $ contents)+wFile [EString filepath, EByteString contents] = [] <$ SB.writeFile filepath contents+wFile [EString filepath, EByteStringL contents] = [] <$ (SB.writeFile filepath . SB.unlines $ contents)+wFile [EString filepath, EInt contents] = [] <$ (writeFile filepath . show $ contents)+wFile [EString filepath, EIntL contents] = [] <$ (writeFile filepath . show $ contents)+wFile [EString filepath, EDouble contents] = [] <$ (writeFile filepath . show $ contents)+wFile [EString filepath, EDoubleL contents] = [] <$ (writeFile filepath . show $ contents)+wFile [EString filepath, EBool contents] = [] <$ (writeFile filepath . show $ contents)+wFile [EString filepath, EBoolL contents] = [] <$ (writeFile filepath . show $ contents)++wFile0 [EString filepath, EString contents] = [] <$ writeFile filepath contents+wFile0 [EString filepath, EStringL contents] = [] <$ (writeFile filepath . unlines $ contents)+wFile0 [EString filepath, ELByteString contents] = [] <$ (LB.writeFile filepath contents)+wFile0 [EString filepath, ELByteStringL contents] = [] <$ (LB.writeFile filepath . LB.unlines $ contents)+wFile0 [EString filepath, EByteString contents] = [] <$ SB.writeFile filepath contents+wFile0 [EString filepath, EByteStringL contents] = [] <$ (SB.writeFile filepath . SB.unlines $ contents)+wFile0 [EString filepath, EInt contents] = [] <$ (writeFile filepath . show $ contents)+wFile0 [EString filepath, EIntL contents] = [] <$ (writeFile filepath . show $ contents)+wFile0 [EString filepath, EDouble contents] = [] <$ (writeFile filepath . show $ contents)+wFile0 [EString filepath, EDoubleL contents] = [] <$ (writeFile filepath . show $ contents)+wFile0 [EString filepath, EBool contents] = [] <$ (writeFile filepath . show $ contents)+wFile0 [EString filepath, EBoolL contents] = [] <$ (writeFile filepath . show $ contents)+wFile0 [EString filepath, EOther contents] = [] <$ (writeFile filepath . show $ contents)+wFile0 [EString filepath, EOtherL contents] = [] <$ (writeFile filepath . show $ contents)++wBinary [EString filepath, EString contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EStringL contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EByteString contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EByteStringL contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, ELByteString contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, ELByteStringL contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EInt contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EIntL contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EDouble contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EDoubleL contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EBool contents] = [] <$ (encodeFile filepath contents)+wBinary [EString filepath, EBoolL contents] = [] <$ (encodeFile filepath contents)+++wBinary0 [EString filepath, EString contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EStringL contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EByteString contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EByteStringL contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, ELByteString contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, ELByteStringL contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EInt contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EIntL contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EDouble contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EDoubleL contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EBool contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EBoolL contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EOther contents] = [] <$ (encodeFile filepath contents)+wBinary0 [EString filepath, EOtherL contents] = [] <$ (encodeFile filepath contents)++--rFile :: EData a -> [EData a] -> IO [EData a]+rFile (EString _) [EString filepath] = (:[]) . EString . LB.unpack <$> LB.readFile filepath+rFile (EStringL _) [EString filepath] = (:[]) . EStringL . read . LB.unpack <$> LB.readFile filepath+rFile (EByteString _) [EString filepath] = (:[]) . EByteString <$> SB.readFile filepath+rFile (EByteStringL _) [EString filepath] = (:[]) . EByteStringL . SB.lines <$> SB.readFile filepath+rFile (ELByteString _) [EString filepath] = (:[]) . ELByteString <$> LB.readFile filepath+rFile (ELByteStringL _) [EString filepath] = (:[]) . ELByteStringL . LB.lines <$> LB.readFile filepath+rFile (EInt _) [EString filepath] = (:[]) . EInt . read . LB.unpack <$> LB.readFile filepath+rFile (EIntL _) [EString filepath] = (:[]) . EIntL . read . LB.unpack <$> LB.readFile filepath+rFile (EDouble _) [EString filepath] = (:[]) . EDouble . read . LB.unpack <$> LB.readFile filepath+rFile (EDoubleL _) [EString filepath] = (:[]) . EDoubleL .  read . LB.unpack <$> LB.readFile filepath+rFile (EBool _) [EString filepath] = (:[]) . EBool . read . LB.unpack <$> LB.readFile filepath+rFile (EBoolL _) [EString filepath] = (:[]) . EBoolL . read . LB.unpack <$> LB.readFile filepath++--dFile :: EData a -> [EData a] -> IO [EData a]+dFile (EString _) [EString filepath] = (:[]) .EString <$> decodeFile filepath+dFile (EStringL _) [EString filepath] = (:[]) .EStringL <$>  decodeFile filepath+dFile (EByteString _) [EString filepath] = (:[]) .EByteString <$> decodeFile filepath+dFile (EByteStringL _) [EString filepath] = (:[]) .EByteStringL <$> decodeFile filepath+dFile (ELByteString _) [EString filepath] = (:[]) .ELByteString <$> decodeFile filepath+dFile (ELByteStringL _) [EString filepath] = (:[]) .ELByteStringL <$> decodeFile filepath+dFile (EInt _) [EString filepath] =(:[]) . EInt <$> decodeFile filepath+dFile (EIntL _) [EString filepath] =(:[]) . EIntL <$> decodeFile filepath+dFile (EDouble _) [EString filepath] =(:[]) . EDouble <$> decodeFile filepath+dFile (EDoubleL _) [EString filepath] =(:[]) . EDoubleL <$> decodeFile filepath+dFile (EBool _) [EString filepath] =(:[]) . EBool <$> decodeFile filepath+dFile (EBoolL _) [EString filepath] =(:[]) . EBoolL <$> decodeFile filepath++--rFile0 :: Read a => EData a -> [EData a] -> IO [EData a]+rFile0 (EString _) [EString filepath] =(:[]) . EString . LB.unpack <$> LB.readFile filepath+rFile0 (EStringL _) [EString filepath] =(:[]) . EStringL . read . LB.unpack <$> LB.readFile filepath+rFile0 (EByteString _) [EString filepath] =(:[]) . EByteString <$> SB.readFile filepath+rFile0 (EByteStringL _) [EString filepath] =(:[]) . EByteStringL . SB.lines <$> SB.readFile filepath+rFile0 (ELByteString _) [EString filepath] =(:[]) . ELByteString <$> LB.readFile filepath+rFile0 (ELByteStringL _) [EString filepath] =(:[])  . ELByteStringL . LB.lines <$> LB.readFile filepath+rFile0 (EInt _) [EString filepath] =(:[]) . EInt . read . LB.unpack <$> LB.readFile filepath+rFile0 (EIntL _) [EString filepath] =(:[]) . EIntL . read . LB.unpack <$> LB.readFile filepath+rFile0 (EDouble _) [EString filepath] = (:[]) . EDouble . read . LB.unpack <$> LB.readFile filepath+rFile0 (EDoubleL _) [EString filepath] = (:[]) . EDoubleL .  read . LB.unpack <$> LB.readFile filepath+rFile0 (EBool _) [EString filepath] =(:[]) . EBool . read . LB.unpack <$> LB.readFile filepath+rFile0 (EBoolL _) [EString filepath] =(:[]) . EBoolL . read . LB.unpack <$> LB.readFile filepath+rFile0 (EOther _) [EString filepath] =(:[]) . EOther . read . LB.unpack <$> LB.readFile filepath+rFile0 (EOtherL _) [EString filepath] =(:[]) . EOtherL . read . LB.unpack <$> LB.readFile filepath++--dFile0 :: Binary a => EData a -> [EData a] -> IO [EData a]+dFile0 (EString _) [EString filepath] = (:[]) . EString <$> decodeFile filepath+dFile0 (EStringL _) [EString filepath] =(:[]) . EStringL <$>  decodeFile filepath+dFile0 (EByteString _) [EString filepath] =(:[]) . EByteString <$> decodeFile filepath+dFile0 (EByteStringL _) [EString filepath] = (:[]) . EByteStringL <$> decodeFile filepath+dFile0 (ELByteString _) [EString filepath] = (:[]) . ELByteString <$> decodeFile filepath+dFile0 (ELByteStringL _) [EString filepath] = (:[]) . ELByteStringL <$> decodeFile filepath+dFile0 (EInt _) [EString filepath] = (:[]) . EInt <$> decodeFile filepath+dFile0 (EIntL _) [EString filepath] = (:[]) . EIntL <$> decodeFile filepath+dFile0 (EDouble _) [EString filepath] = (:[]) . EDouble <$> decodeFile filepath+dFile0 (EDoubleL _) [EString filepath] = (:[]) . EDoubleL <$> decodeFile filepath+dFile0 (EBool _) [EString filepath] = (:[]) . EBool <$> decodeFile filepath+dFile0 (EBoolL _) [EString filepath] = (:[]) . EBoolL <$> decodeFile filepath+dFile0 (EOther _) [EString filepath] = (:[]) . EOther <$> decodeFile filepath+dFile0 (EOtherL _) [EString filepath] = (:[]) . EOtherL <$> decodeFile filepath
App/EventBus.hs view
@@ -24,6 +24,7 @@ import Data.Time.Clock import qualified Data.Map as Map import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB import System.IO.Unsafe  -- generic functions for key ordering.  move somewhere else later@@ -74,6 +75,8 @@       EString String     | EByteString B.ByteString     | EByteStringL [B.ByteString]+    | ELByteString LB.ByteString+    | ELByteStringL [LB.ByteString]     | EChar Char     | EDouble Double     | EInt Int@@ -86,6 +89,23 @@     | EOtherL [a]     deriving (Eq, Show, Read) ++-- | Show without risking running into an unshowable type.+safeShow :: Maybe Int -> EData a -> String+safeShow n (EString s) = maybe s ((flip take) s) n+safeShow n (EStringL s) = maybe (show s) ((flip take) (show s)) n+safeShow n (EByteString _) = "ByteString data"+safeShow n (EByteStringL _) = "ByteString list data"+safeShow n (EChar c) = [c]+safeShow n (EDouble x) = maybe (show x) ((flip take) (show x)) n+safeShow n (EDoubleL x) = maybe (show x) ((flip take) (show x)) n+safeShow n (EInt x) = maybe (show x) ((flip take) (show x)) n+safeShow n (EIntL x) = maybe (show x) ((flip take) (show x)) n+safeShow n (EBool x) = maybe (show x) ((flip take) (show x)) n+safeShow n (EBoolL x) = maybe (show x) ((flip take) (show x)) n+safeShow n (EOther _) = "Other data"+safeShow n (EOtherL _) = "Other data list"+ -- | 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.@@ -202,40 +222,56 @@         Just m -> putMVar b . expire =<< decrementTimeSpan =<< applyDiff m =<< behaviour m  -- | Assign an event to time given some event data and a TimeSpan.+--+--   @produce group source nm timetolive edata@ produce :: String -> String -> String -> TimeSpan -> a -> IO (Diff a) produce group source nm timetolive edata =     (return . Insertion . Event nm group timetolive edata source) =<< getCurrentTime  -- | Assign an event to time from a widget.+--+-- @produce' group source nm timetolive edata bus@ produce' :: String -> String -> String -> TimeSpan -> a -> MVar (Bus a) -> IO () produce' group source nm timetolive edata b = getCurrentTime >>= \t -> modifyMVar_ b (return . addEvent (Event nm group timetolive edata source t))  -- | 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.-consumeNamedEventsWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]-consumeNamedEventsWith em nm f =+consumeNamedEventsCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]+consumeNamedEventsCollectivelyWith em nm f =     maybe (future . return $ [])           (\ev -> future $ (map Deletion (Set.toList ev) ++) <$> f ev)           (Map.lookup nm (nameMap em)) +consumeNamedEventsWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future [Diff a]+consumeNamedEventsWith b n f =+    future $ 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.-consumeEventGroupWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]-consumeEventGroupWith em gp f =+consumeEventGroupCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]+consumeEventGroupCollectivelyWith em gp f =     maybe (future . return $ [])           (\ev -> future $ (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 b n f =+    future $ 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.-consumeEventsFromSourceWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]-consumeEventsFromSourceWith em source f =+consumeEventsFromSourceCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future [Diff a]+consumeEventsFromSourceCollectivelyWith em source f =     maybe (future . return $ [])           (\ev -> future $ (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 b n f =+    future $ 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.+--   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 em group source name f =     maybe (future . return $ [])@@ -267,6 +303,7 @@ pollEventsFromSourceWith b nm f = future $ 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))
buster.cabal view
@@ -1,14 +1,14 @@ name: buster-version: 0.99.2+version: 0.99.5 cabal-version: -any build-type: Simple license: BSD3 license-file: "" copyright: 2009 Renaissance Computing Institute maintainer: Jeff Heard <jeff@renci.org>-build-depends: old-locale -any, time -any, containers -any,-               base -any, bytestring -any, gtk -any, mtl -any,-               pretty -any, parsec >= 3.0.0+build-depends: binary -any, parsec >=3.0.0, pretty -any, mtl -any,+               gtk -any, bytestring -any, base -any, containers -any, time -any,+               old-locale -any stability: Experimental homepage: http://vis.renci.org/jeff/buster package-url:@@ -33,7 +33,8 @@ extra-source-files: extra-tmp-files: exposed-modules: App.EventBus App.Behaviours.PrintEvents-                 App.Widgets.GtkMouseKeyboard App.Widgets.Environment +                 App.Behaviours.Exception App.Behaviours.FileOps+                 App.Widgets.GtkMouseKeyboard App.Widgets.Environment exposed: True buildable: True build-tools: