buster 2.0 → 2.2

raw patch · 3 files changed

+101/−5 lines, 3 files

Files

• App/Behaviours/PrintEvents.hs +52/−0
• App/Widgets/Pacer.hs +43/−0
• buster.cabal +6/−5

@@ -5,6 +5,7 @@ import Data.Time import System.Locale import App.EventBus+import System.IO  printEventsBehaviour :: Behaviour [EData a] printEventsBehaviour b = pollAllEventsWith b $ (\(Event n g lifetime edata source t) -> do@@ -70,3 +71,54 @@     print (g,s,n)     return [] +checkpoint :: String -> Behaviour a+checkpoint message bus = do+    putStrLn message+    passthrough bus++logEventsBehaviour :: Handle -> Behaviour [EData a]+logEventsBehaviour handle  b = pollAllEventsWith b $ (\(Event n g lifetime edata source t) -> do+    hPutStrLn handle.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 [])++logEventGroupBehaviour :: Handle -> String -> Behaviour [EData a]+logEventGroupBehaviour handle grp b = pollEventGroupWith b grp $ (\(Event n g lifetime edata source t) -> do+    hPutStrLn handle.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 [])++logEventNameBehaviour :: Handle -> String -> Behaviour [EData a]+logEventNameBehaviour handle grp b = pollNamedEventsWith b grp $ (\(Event n g lifetime edata source t) -> do+    hPutStrLn handle . 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 [])++logEventSourceBehaviour :: Handle -> String -> Behaviour [EData a]+logEventSourceBehaviour handle grp b = pollEventsFromSourceWith b grp $ (\(Event n g lifetime edata source t) -> do+    hPutStrLn handle.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 [])+++logQNameBehaviour handle bus  = pollAllEventsWith bus $ \(Event n g _ _ s _) -> do+    hPutStrLn handle . show $ (g,s,n)+    return []++logCheckpoint handle message bus = hPutStrLn handle message >> passthrough bus

@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+--+-- Module      :  App.Widgets.Pacer+-- Copyright   :  2009 Renaissance Computing Institute+-- License     :  BSD3+--+-- Maintainer  :  Jeff Heard <jeff@renci.org>+-- Stability   :  Experimental+-- Portability :+--+-- | Widgets for sending a heartbeat out onto the bus to be caught by other behaviours.+--+-----------------------------------------------------------------------------+module App.Widgets.Pacer where++import App.EventBus+import Control.Concurrent++-- | @paceMicrosecondsWidget timeout timername bus@+-- |+-- | Send a heartbeat event out every /timeout/ microseconds to the bus+paceMicrosecondsWidget :: Int -> String -> Widget [a]+paceMicrosecondsWidget timeout timername b = do+    forkIO $ do+        threadDelay timeout+        produce' "Timers" "PacerWidget" timername once [] b+    return ()++-- | @paceMillisecondsWidget timeout timername bus@+-- |+-- | Send a heartbeat event out every /timeout/ milliseconds to the bus+paceMillisecondsWidget :: Int -> String -> Widget [a]+paceMillisecondsWidget timeout = paceMicrosecondsWidget (timeout*1000)++-- | @paceSecondsWidget timeout timername bus@+-- |+-- | Send a heartbeat event out every /timeout/ seconds to the bus+paceSecondsWidget :: Double -> String -> Widget [a]+paceSecondsWidget timeout = paceMillisecondsWidget (round $ timeout*1000*1000)++++

@@ -1,12 +1,14 @@ name: buster-version: 2.0+version: 2.2 cabal-version: -any build-type: Simple license: BSD3 license-file: "" copyright: 2009 Renaissance Computing Institute maintainer: Jeff Heard <jeff@renci.org>-build-depends: binary -any, parsec >=3.0.0, pretty -any, mtl -any, bytestring -any, base -any, containers -any, time -any, old-locale -any, dataenc -any+build-depends: base -any, binary -any, bytestring -any,+               containers -any, dataenc -any, mtl -any, old-locale -any,+               parsec >=3.0.0, pretty -any, time -any stability: Experimental homepage: http://vis.renci.org/jeff/buster package-url:@@ -30,9 +32,8 @@ data-dir: "" extra-source-files: extra-tmp-files:-exposed-modules: App.EventBus -                 App.Behaviours.PrintEvents App.Behaviours.Exception-                 App.Behaviours.FileOps +exposed-modules: App.EventBus App.Behaviours.PrintEvents+                 App.Behaviours.Exception App.Behaviours.FileOps App.Widgets.Pacer                  App.Widgets.Environment exposed: True buildable: True